Skip to content

Commit 7af708c

Browse files
IAmPara0xIAmPara0x
committed
minor f9ixs
1 parent c29de74 commit 7af708c

File tree

6 files changed

+45
-31
lines changed

6 files changed

+45
-31
lines changed

‎examples/debug/src/SomeDebugContract.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,8 @@
11
module SomeDebugContract where
22

3-
import Data.Text (Text)
4-
53
import Data.Map (size)
64
import Data.Map qualified as M
5+
import Data.Text (Text)
76
import Debug.Trace (traceM)
87
import Ledger (Address (Address), PaymentPubKeyHash (PaymentPubKeyHash), getCardanoTxId)
98
import Ledger.Constraints qualified as Constraints

‎examples/debug/src/TestRun.hs‎

Lines changed: 14 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,27 @@
11
module TestRun (testnetRun, main) where
22

33
import BotPlutusInterface.Contract qualified as BPI
4-
import BotPlutusInterface.Types
4+
import BotPlutusInterface.Types (
5+
CLILocation (Local),
6+
CollateralVar (CollateralVar, unCollateralVar),
7+
ContractEnvironment (..),
8+
ContractState (ContractState),
9+
ContractStats (ContractStats),
10+
LogLevel (Notice),
11+
LogsList (LogsList),
12+
PABConfig (..),
13+
TxStatusPolling (TxStatusPolling),
14+
)
515
import Cardano.Api (NetworkId (Mainnet))
616
import Cardano.Api.Shelley (ProtocolParameters)
717
import Control.Concurrent.STM (newTVarIO, readTVarIO)
818
import Control.Monad (void)
919
import Data.Aeson (decodeFileStrict)
1020
import Data.Text (Text)
21+
1122
import Data.Text qualified as Text
1223
import Data.UUID.V4 qualified as UUID
13-
import GHC.IO.Encoding
24+
import GHC.IO.Encoding (setLocaleEncoding, utf8)
1425
import Ledger (PubKeyHash)
1526
import Plutus.PAB.Core.ContractInstance.STM (Activity (Active))
1627
import Servant.Client (BaseUrl (BaseUrl), Scheme (Http))
@@ -19,7 +30,7 @@ import System.Directory (listDirectory)
1930
import System.Environment (getArgs, getEnv, setEnv)
2031
import System.FilePath ((</>))
2132
import TimeDebugContract qualified
22-
import Tools
33+
import Tools (pkhFromHash)
2334
import Wallet.Types (ContractInstanceId (ContractInstanceId))
2435
import Prelude
2536

‎examples/debug/src/Tools.hs‎

Lines changed: 5 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ import Cardano.Api qualified as CAPI
44
import Data.Aeson ((.=))
55
import Data.Aeson qualified as JSON
66
import Data.Text (Text)
7-
import GHC.Natural (Natural)
7+
import GHC.Word (Word32)
88
import Ledger (Address (Address), PubKeyHash)
99
import Ledger.Tx.CardanoAPI (toCardanoAddress)
1010
import Plutus.V1.Ledger.Api (Credential (PubKeyCredential))
@@ -20,20 +20,17 @@ pkhFromHash key =
2020
pkToAddr :: PubKeyHash -> Address
2121
pkToAddr = flip Address Nothing . PubKeyCredential
2222

23-
addrToCapiAddr :: Natural -> Address -> Text
23+
addrToCapiAddr :: Word32 -> Address -> Text
2424
addrToCapiAddr nId addr =
2525
let networkId = getNetId nId
2626
capiAddr = toCardanoAddress networkId addr
2727
in CAPI.serialiseAddress
2828
. either (error . show) id
2929
$ capiAddr
3030

31-
getNetId :: Natural -> CAPI.NetworkId
31+
getNetId :: Word32 -> CAPI.NetworkId
3232
getNetId = \case
3333
0 -> CAPI.Mainnet
3434
n ->
35-
CAPI.Testnet
36-
. CAPI.NetworkMagic
37-
. fromInteger
38-
. toInteger
39-
$ n
35+
CAPI.Testnet $
36+
CAPI.NetworkMagic n

‎src/BotPlutusInterface/Balance.hs‎

Lines changed: 20 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,9 @@ module BotPlutusInterface.Balance (
1010
withFee,
1111
) where
1212

13+
import BotPlutusInterface.BodyBuilder qualified as BodyBuilder
1314
import BotPlutusInterface.CardanoCLI qualified as CardanoCLI
15+
import BotPlutusInterface.Collateral (removeCollateralFromMap)
1416
import BotPlutusInterface.Effects (
1517
PABEffect,
1618
createDirectoryIfMissingCLI,
@@ -21,7 +23,7 @@ import BotPlutusInterface.Effects (
2123
import BotPlutusInterface.Files (DummyPrivKey, unDummyPrivateKey)
2224
import BotPlutusInterface.Files qualified as Files
2325
import BotPlutusInterface.Types (CollateralUtxo, LogLevel (Debug), PABConfig, collateralTxOutRef)
24-
import Cardano.Api (ExecutionUnitPrices (ExecutionUnitPrices), UTxO (UTxO))
26+
import Cardano.Api (ExecutionUnitPrices (ExecutionUnitPrices))
2527
import Cardano.Api.Shelley (ProtocolParameters (protocolParamPrices))
2628
import Control.Monad (foldM, void, zipWithM)
2729
import Control.Monad.Freer (Eff, Member)
@@ -71,10 +73,6 @@ import Plutus.V1.Ledger.Api (
7173
CurrencySymbol (..),
7274
TokenName (..),
7375
)
74-
75-
import BotPlutusInterface.BodyBuilder qualified as BodyBuilder
76-
77-
import BotPlutusInterface.Collateral (removeCollateralFromMap)
7876
import Prettyprinter (pretty, viaShow, (<+>))
7977
import Prelude
8078

@@ -157,8 +155,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
157155
-- the changeAddr.
158156
balancedTxWithChange <-
159157
case adaChange /= 0 of
160-
True | bcSeparateChange balanceCfg -> bTx
161-
True | not (hasChangeUTxO changeAddr balancedTx) -> bTx
158+
True | bcSeparateChange balanceCfg || not (hasChangeUTxO changeAddr balancedTx) -> bTx
162159
_ -> pure balancedTx
163160

164161
-- Get the updated change, add it to the tx
@@ -189,7 +186,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
189186

190187
-- Calculate fees by pre-balancing the tx, building it, and running the CLI on result
191188
txWithoutFees <-
192-
hoistEither $ balanceTxStep minUtxos utxoIndex changeAddr $ tx `withFee` 0
189+
hoistEither $ balanceTxStep balanceCfg minUtxos utxoIndex changeAddr $ tx `withFee` 0
193190

194191
exBudget <- newEitherT $ BodyBuilder.buildAndEstimateBudget @w pabConf privKeys txWithoutFees
195192

@@ -200,7 +197,7 @@ balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
200197
lift $ printBpiLog @w Debug $ "Fees:" <+> pretty fees
201198

202199
-- Rebalance the initial tx with the above fees
203-
balancedTx <- hoistEither $ balanceTxStep minUtxos utxoIndex changeAddr $ tx `withFee` fees
200+
balancedTx <- hoistEither $ balanceTxStep balanceCfg minUtxos utxoIndex changeAddr $ tx `withFee` fees
204201

205202
if balancedTx == tx
206203
then pure (balancedTx, minUtxos)
@@ -268,15 +265,16 @@ calculateMinUtxos pabConf datums txOuts =
268265
zipWithM (fmap . (,)) txOuts <$> mapM (CardanoCLI.calculateMinUtxo @w pabConf datums) txOuts
269266

270267
balanceTxStep ::
268+
BalanceConfig ->
271269
[(TxOut, Integer)] ->
272270
Map TxOutRef TxOut ->
273271
Address ->
274272
Tx ->
275273
Either Text Tx
276-
balanceTxStep minUtxos utxos changeAddr tx =
274+
balanceTxStep balanceCfg minUtxos utxos changeAddr tx =
277275
Right (addLovelaces minUtxos tx)
278276
>>= balanceTxIns utxos
279-
>>= handleNonAdaChange changeAddr utxos
277+
>>= handleNonAdaChange balanceCfg changeAddr utxos
280278

281279
-- | Get change value of a transaction, taking inputs, outputs, mint and fees into account
282280
getChange :: Map TxOutRef TxOut -> Tx -> Value
@@ -380,9 +378,17 @@ txUsesScripts Tx {txInputs, txMintScripts} =
380378
(Set.toList txInputs)
381379

382380
-- | Ensures all non ada change goes back to user
383-
handleNonAdaChange :: Address -> Map TxOutRef TxOut -> Tx -> Either Text Tx
384-
handleNonAdaChange changeAddr utxos tx =
381+
handleNonAdaChange :: BalanceConfig -> Address -> Map TxOutRef TxOut -> Tx -> Either Text Tx
382+
handleNonAdaChange balanceCfg changeAddr utxos tx =
385383
let nonAdaChange = getNonAdaChange utxos tx
384+
predicate =
385+
if bcSeparateChange balanceCfg
386+
then
387+
( \txout ->
388+
Tx.txOutAddress txout == changeAddr
389+
&& not (justLovelace $ Tx.txOutValue txout)
390+
)
391+
else (\txout -> Tx.txOutAddress txout == changeAddr)
386392
newOutput =
387393
TxOut
388394
{ txOutAddress = changeAddr
@@ -391,7 +397,7 @@ handleNonAdaChange changeAddr utxos tx =
391397
}
392398
outputs =
393399
modifyFirst
394-
((==) changeAddr . Tx.txOutAddress)
400+
predicate
395401
(Just . maybe newOutput (addValueToTxOut nonAdaChange))
396402
(txOutputs tx)
397403
in if isValueNat nonAdaChange

‎test/Spec/BotPlutusInterface/Balance.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ module Spec.BotPlutusInterface.Balance (tests) where
22

33
import BotPlutusInterface.Balance (withFee)
44
import BotPlutusInterface.Balance qualified as Balance
5+
import Data.Default (def)
56
import Data.Map qualified as Map
67
import Data.Set qualified as Set
78
import Ledger qualified
@@ -63,7 +64,7 @@ addUtxosForFees = do
6364
utxoIndex = Map.fromList [utxo1, utxo2, utxo3]
6465
ownAddr = addr1
6566
balancedTx =
66-
Balance.balanceTxStep minUtxo utxoIndex ownAddr tx
67+
Balance.balanceTxStep def minUtxo utxoIndex ownAddr tx
6768

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

@@ -75,7 +76,7 @@ addUtxosForNativeTokens = do
7576
utxoIndex = Map.fromList [utxo1, utxo2, utxo3, utxo4]
7677
ownAddr = addr1
7778
balancedTx =
78-
Balance.balanceTxStep minUtxo utxoIndex ownAddr tx
79+
Balance.balanceTxStep def minUtxo utxoIndex ownAddr tx
7980

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

@@ -87,6 +88,6 @@ addUtxosForChange = do
8788
utxoIndex = Map.fromList [utxo1, utxo2, utxo3]
8889
ownAddr = addr1
8990
balancedTx =
90-
Balance.balanceTxStep minUtxo utxoIndex ownAddr tx
91+
Balance.balanceTxStep def minUtxo utxoIndex ownAddr tx
9192

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

‎test/Spec/BotPlutusInterface/Collateral.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ import Ledger.TxId qualified as TxId
1818
import Ledger.Value qualified as Value
1919
import NeatInterpolation (text)
2020
import Plutus.Contract (
21-
Contract (..),
21+
Contract,
2222
Endpoint,
2323
submitTxConstraintsWith,
2424
)

0 commit comments

Comments
 (0)