Skip to content

Commit b1ea106

Browse files
committed
more fixs
1 parent 7af708c commit b1ea106

File tree

5 files changed

+63
-62
lines changed

5 files changed

+63
-62
lines changed

examples/debug/src/Tools.hs

Lines changed: 2 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,7 @@
11
module Tools where
22

33
import Cardano.Api qualified as CAPI
4-
import Data.Aeson ((.=))
5-
import Data.Aeson qualified as JSON
4+
import Data.String (fromString)
65
import Data.Text (Text)
76
import GHC.Word (Word32)
87
import Ledger (Address (Address), PubKeyHash)
@@ -11,11 +10,7 @@ import Plutus.V1.Ledger.Api (Credential (PubKeyCredential))
1110
import Prelude
1211

1312
pkhFromHash :: String -> PubKeyHash
14-
pkhFromHash key =
15-
let res = JSON.fromJSON $ JSON.object ["getPubKeyHash" .= key]
16-
in case res of
17-
JSON.Success pkh -> pkh
18-
_ -> error "failed to parse pkh"
13+
pkhFromHash = fromString
1914

2015
pkToAddr :: PubKeyHash -> Address
2116
pkToAddr = flip Address Nothing . PubKeyCredential

src/BotPlutusInterface/Balance.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ module BotPlutusInterface.Balance (
66
balanceTxStep,
77
balanceTxIO,
88
balanceTxIO',
9+
defaultBalanceConfig,
910
txUsesScripts,
1011
withFee,
1112
) where
@@ -32,7 +33,6 @@ import Control.Monad.Trans.Either (EitherT, hoistEither, newEitherT, runEitherT)
3233
import Control.Monad.Trans.Except (throwE)
3334
import Data.Bifunctor (bimap)
3435
import Data.Coerce (coerce)
35-
import Data.Default (Default (def))
3636
import Data.Either.Combinators (rightToMaybe)
3737
import Data.Kind (Type)
3838
import Data.List ((\\))
@@ -85,8 +85,8 @@ data BalanceConfig = BalanceConfig
8585
}
8686
deriving stock (Show, Eq)
8787

88-
instance Default BalanceConfig where
89-
def = BalanceConfig {bcHasScripts = False, bcSeparateChange = False}
88+
defaultBalanceConfig :: BalanceConfig
89+
defaultBalanceConfig = BalanceConfig {bcHasScripts = False, bcSeparateChange = False}
9090

9191
{- | Collect necessary tx inputs and collaterals, add minimum lovelace values and balance non ada
9292
assets. `balanceTxIO` calls `balanceTxIO' with default `BalanceConfig`.
@@ -98,7 +98,7 @@ balanceTxIO ::
9898
PubKeyHash ->
9999
UnbalancedTx ->
100100
Eff effs (Either Text Tx)
101-
balanceTxIO = balanceTxIO' @w def
101+
balanceTxIO = balanceTxIO' @w defaultBalanceConfig
102102

103103
-- | `balanceTxIO'` is more flexible version of `balanceTxIO`, this let us specify custom `BalanceConfig`.
104104
balanceTxIO' ::

src/BotPlutusInterface/ChainIndex.hs

Lines changed: 51 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -5,9 +5,18 @@ module BotPlutusInterface.ChainIndex (
55
) where
66

77
import BotPlutusInterface.Collateral (removeCollateralFromPage)
8-
import BotPlutusInterface.Types (ContractEnvironment, PABConfig, readCollateralUtxo)
8+
import BotPlutusInterface.Types (
9+
ContractEnvironment (ContractEnvironment, cePABConfig),
10+
PABConfig,
11+
readCollateralUtxo,
12+
)
913
import Data.Kind (Type)
10-
import Network.HTTP.Client (ManagerSettings (managerResponseTimeout), defaultManagerSettings, newManager, responseTimeoutNone)
14+
import Network.HTTP.Client (
15+
ManagerSettings (managerResponseTimeout),
16+
defaultManagerSettings,
17+
newManager,
18+
responseTimeoutNone,
19+
)
1120
import Network.HTTP.Types (Status (statusCode))
1221
import Plutus.ChainIndex.Api (
1322
TxoAtAddressRequest (TxoAtAddressRequest),
@@ -28,47 +37,46 @@ import Servant.Client (
2837
import Prelude
2938

3039
handleChainIndexReq :: forall (w :: Type). ContractEnvironment w -> ChainIndexQuery -> IO ChainIndexResponse
31-
handleChainIndexReq contractEnv =
32-
let pabConf = contractEnv.cePABConfig
33-
in \case
34-
DatumFromHash datumHash ->
35-
DatumHashResponse <$> chainIndexQueryOne pabConf (ChainIndexClient.getDatum datumHash)
36-
ValidatorFromHash validatorHash ->
37-
ValidatorHashResponse <$> chainIndexQueryOne pabConf (ChainIndexClient.getValidator validatorHash)
38-
MintingPolicyFromHash mintingPolicyHash ->
39-
MintingPolicyHashResponse
40-
<$> chainIndexQueryOne pabConf (ChainIndexClient.getMintingPolicy mintingPolicyHash)
41-
StakeValidatorFromHash stakeValidatorHash ->
42-
StakeValidatorHashResponse
43-
<$> chainIndexQueryOne pabConf (ChainIndexClient.getStakeValidator stakeValidatorHash)
44-
RedeemerFromHash _ ->
45-
pure $ RedeemerHashResponse Nothing
46-
-- RedeemerFromHash redeemerHash ->
47-
-- pure $ RedeemerHashResponse (Maybe Redeemer)
48-
TxOutFromRef txOutRef ->
49-
TxOutRefResponse <$> chainIndexQueryOne pabConf (ChainIndexClient.getTxOut txOutRef)
50-
TxFromTxId txId ->
51-
TxIdResponse <$> chainIndexQueryOne pabConf (ChainIndexClient.getTx txId)
52-
UtxoSetMembership txOutRef ->
53-
UtxoSetMembershipResponse <$> chainIndexQueryMany pabConf (ChainIndexClient.getIsUtxo txOutRef)
54-
UtxoSetAtAddress page credential ->
55-
UtxoSetAtResponse
56-
<$> chainIndexUtxoQuery
57-
contractEnv
58-
(ChainIndexClient.getUtxoSetAtAddress (UtxoAtAddressRequest (Just page) credential))
59-
UtxoSetWithCurrency page assetClass ->
60-
UtxoSetAtResponse
61-
<$> chainIndexUtxoQuery
62-
contractEnv
63-
(ChainIndexClient.getUtxoSetWithCurrency (UtxoWithCurrencyRequest (Just page) assetClass))
64-
GetTip ->
65-
GetTipResponse <$> chainIndexQueryMany pabConf ChainIndexClient.getTip
66-
TxsFromTxIds txIds -> TxIdsResponse <$> chainIndexQueryMany pabConf (ChainIndexClient.getTxs txIds)
67-
TxoSetAtAddress page credential ->
68-
TxoSetAtResponse
69-
<$> chainIndexTxoQuery
70-
contractEnv
71-
(ChainIndexClient.getTxoSetAtAddress (TxoAtAddressRequest (Just page) credential))
40+
handleChainIndexReq contractEnv@ContractEnvironment {cePABConfig} =
41+
\case
42+
DatumFromHash datumHash ->
43+
DatumHashResponse <$> chainIndexQueryOne cePABConfig (ChainIndexClient.getDatum datumHash)
44+
ValidatorFromHash validatorHash ->
45+
ValidatorHashResponse <$> chainIndexQueryOne cePABConfig (ChainIndexClient.getValidator validatorHash)
46+
MintingPolicyFromHash mintingPolicyHash ->
47+
MintingPolicyHashResponse
48+
<$> chainIndexQueryOne cePABConfig (ChainIndexClient.getMintingPolicy mintingPolicyHash)
49+
StakeValidatorFromHash stakeValidatorHash ->
50+
StakeValidatorHashResponse
51+
<$> chainIndexQueryOne cePABConfig (ChainIndexClient.getStakeValidator stakeValidatorHash)
52+
RedeemerFromHash _ ->
53+
pure $ RedeemerHashResponse Nothing
54+
-- RedeemerFromHash redeemerHash ->
55+
-- pure $ RedeemerHashResponse (Maybe Redeemer)
56+
TxOutFromRef txOutRef ->
57+
TxOutRefResponse <$> chainIndexQueryOne cePABConfig (ChainIndexClient.getTxOut txOutRef)
58+
TxFromTxId txId ->
59+
TxIdResponse <$> chainIndexQueryOne cePABConfig (ChainIndexClient.getTx txId)
60+
UtxoSetMembership txOutRef ->
61+
UtxoSetMembershipResponse <$> chainIndexQueryMany cePABConfig (ChainIndexClient.getIsUtxo txOutRef)
62+
UtxoSetAtAddress page credential ->
63+
UtxoSetAtResponse
64+
<$> chainIndexUtxoQuery
65+
contractEnv
66+
(ChainIndexClient.getUtxoSetAtAddress (UtxoAtAddressRequest (Just page) credential))
67+
UtxoSetWithCurrency page assetClass ->
68+
UtxoSetAtResponse
69+
<$> chainIndexUtxoQuery
70+
contractEnv
71+
(ChainIndexClient.getUtxoSetWithCurrency (UtxoWithCurrencyRequest (Just page) assetClass))
72+
GetTip ->
73+
GetTipResponse <$> chainIndexQueryMany cePABConfig ChainIndexClient.getTip
74+
TxsFromTxIds txIds -> TxIdsResponse <$> chainIndexQueryMany cePABConfig (ChainIndexClient.getTxs txIds)
75+
TxoSetAtAddress page credential ->
76+
TxoSetAtResponse
77+
<$> chainIndexTxoQuery
78+
contractEnv
79+
(ChainIndexClient.getTxoSetAtAddress (TxoAtAddressRequest (Just page) credential))
7280

7381
chainIndexQuery' :: forall (a :: Type). PABConfig -> ClientM a -> IO (Either ClientError a)
7482
chainIndexQuery' pabConf endpoint = do

src/BotPlutusInterface/Contract.hs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,6 @@ import Control.Monad.Trans.Either (EitherT, eitherT, firstEitherT, hoistEither,
5151
import Control.Monad.Trans.Except (ExceptT, throwE)
5252
import Data.Aeson (ToJSON, Value (Array, Bool, Null, Number, Object, String))
5353
import Data.Aeson.Extras (encodeByteString)
54-
import Data.Default (def)
5554
import Data.Either.Combinators (maybeToLeft, swapEither)
5655
import Data.Function (fix)
5756
import Data.HashMap.Strict qualified as HM
@@ -299,7 +298,7 @@ balanceTx contractEnv unbalancedTx = do
299298
if PreBalance.txUsesScripts (unBalancedTxTx unbalancedTx)
300299
then
301300
PreBalance.balanceTxIO' @w
302-
def {PreBalance.bcHasScripts = True}
301+
PreBalance.defaultBalanceConfig {PreBalance.bcHasScripts = True}
303302
pabConf
304303
pabConf.pcOwnPubKeyHash
305304
unbalancedTx
@@ -509,7 +508,7 @@ makeCollateral cEnv = runEitherT $ do
509508
balancedTx <-
510509
newEitherT $
511510
PreBalance.balanceTxIO' @w
512-
def {PreBalance.bcHasScripts = False, PreBalance.bcSeparateChange = True}
511+
PreBalance.defaultBalanceConfig {PreBalance.bcHasScripts = False, PreBalance.bcSeparateChange = True}
513512
pabConf
514513
pabConf.pcOwnPubKeyHash unbalancedTx
515514

test/Spec/BotPlutusInterface/Balance.hs

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,7 @@
11
module Spec.BotPlutusInterface.Balance (tests) where
22

3-
import BotPlutusInterface.Balance (withFee)
3+
import BotPlutusInterface.Balance (defaultBalanceConfig, withFee)
44
import BotPlutusInterface.Balance qualified as Balance
5-
import Data.Default (def)
65
import Data.Map qualified as Map
76
import Data.Set qualified as Set
87
import Ledger qualified
@@ -64,7 +63,7 @@ addUtxosForFees = do
6463
utxoIndex = Map.fromList [utxo1, utxo2, utxo3]
6564
ownAddr = addr1
6665
balancedTx =
67-
Balance.balanceTxStep def minUtxo utxoIndex ownAddr tx
66+
Balance.balanceTxStep defaultBalanceConfig minUtxo utxoIndex ownAddr tx
6867

6968
txInputs <$> balancedTx @?= Right (Set.fromList [txIn1, txIn2])
7069

@@ -76,7 +75,7 @@ addUtxosForNativeTokens = do
7675
utxoIndex = Map.fromList [utxo1, utxo2, utxo3, utxo4]
7776
ownAddr = addr1
7877
balancedTx =
79-
Balance.balanceTxStep def minUtxo utxoIndex ownAddr tx
78+
Balance.balanceTxStep defaultBalanceConfig minUtxo utxoIndex ownAddr tx
8079

8180
txInputs <$> balancedTx @?= Right (Set.fromList [txIn1, txIn2, txIn3, txIn4])
8281

@@ -88,6 +87,6 @@ addUtxosForChange = do
8887
utxoIndex = Map.fromList [utxo1, utxo2, utxo3]
8988
ownAddr = addr1
9089
balancedTx =
91-
Balance.balanceTxStep def minUtxo utxoIndex ownAddr tx
90+
Balance.balanceTxStep defaultBalanceConfig minUtxo utxoIndex ownAddr tx
9291

9392
txInputs <$> balancedTx @?= Right (Set.fromList [txIn1, txIn2])

0 commit comments

Comments
 (0)