Skip to content

Commit 30b9701

Browse files
IAmPara0xIAmPara0x
committed
WIP updating tests suite
1 parent 038c333 commit 30b9701

File tree

8 files changed

+127
-114
lines changed

8 files changed

+127
-114
lines changed

‎src/BotPlutusInterface/Balance.hs‎

Lines changed: 15 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -13,13 +13,14 @@ module BotPlutusInterface.Balance (
1313

1414
import BotPlutusInterface.BodyBuilder qualified as BodyBuilder
1515
import BotPlutusInterface.CardanoCLI qualified as CardanoCLI
16-
import BotPlutusInterface.CardanoNode.Effects (NodeQuery (MinUtxo, UtxosAt))
16+
import BotPlutusInterface.CardanoNode.Effects (NodeQuery (UtxosAt))
1717
import BotPlutusInterface.CoinSelection (selectTxIns)
1818
import BotPlutusInterface.Collateral (removeCollateralFromMap)
1919
import BotPlutusInterface.Effects (
2020
PABEffect,
2121
createDirectoryIfMissingCLI,
2222
getInMemCollateral,
23+
minUtxo,
2324
posixTimeRangeToContainedSlotRange,
2425
printBpiLog,
2526
queryNode,
@@ -79,6 +80,7 @@ import Plutus.V1.Ledger.Api (
7980
CurrencySymbol (..),
8081
TokenName (..),
8182
)
83+
8284
import Prettyprinter (pretty, viaShow, (<+>))
8385
import Prelude
8486

@@ -115,9 +117,17 @@ balanceTxIO' ::
115117
PubKeyHash ->
116118
UnbalancedTx ->
117119
Eff effs (Either Text Tx)
118-
balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx =
120+
balanceTxIO' balanceCfg pabConf ownPkh unbalancedTx' =
119121
runEitherT $
120122
do
123+
-- TODO: add this later after fixing the tests.
124+
-- updatedOuts <-
125+
-- firstEitherT (Text.pack . show) $
126+
-- newEitherT $
127+
-- sequence <$> traverse (minUtxo @w) (unbalancedTx' ^. Constraints.tx . Tx.outputs)
128+
129+
let unbalancedTx = unbalancedTx'
130+
121131
(utxos, mcollateral) <-
122132
newEitherT $
123133
utxosAndCollateralAtAddress
@@ -374,14 +384,13 @@ handleNonAdaChange balanceCfg changeAddr utxos tx = runEitherT $ do
374384
newOutput =
375385
TxOut
376386
{ txOutAddress = changeAddr
377-
, txOutValue = nonAdaChange
387+
, txOutValue = nonAdaChange <> Ada.lovelaceValueOf 1
378388
, txOutDatumHash = Nothing
379389
}
380390

381391
newOutputWithMinAmt <-
382392
firstEitherT (Text.pack . show) $
383-
newEitherT $
384-
queryNode @w (MinUtxo newOutput)
393+
newEitherT $ minUtxo @w newOutput
385394

386395
let outputs :: [TxOut]
387396
outputs =
@@ -442,7 +451,7 @@ addOutput changeAddr tx =
442451
changeTxOutWithMinAmt <-
443452
firstEitherT (Text.pack . show) $
444453
newEitherT $
445-
queryNode @w (MinUtxo changeTxOut)
454+
minUtxo @w changeTxOut
446455

447456
return $ tx {txOutputs = txOutputs tx ++ [changeTxOutWithMinAmt]}
448457

‎src/BotPlutusInterface/CardanoNode/Effects.hs‎

Lines changed: 0 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,6 @@
1111
module BotPlutusInterface.CardanoNode.Effects (
1212
utxosAt,
1313
pparams,
14-
minUtxo,
1514
handleNodeQuery,
1615
runNodeQuery,
1716
NodeQuery (..),
@@ -35,9 +34,6 @@ import BotPlutusInterface.Types (PABConfig)
3534
import Cardano.Api (LocalNodeConnectInfo (..))
3635
import Cardano.Api qualified as CApi
3736
import Cardano.Api.Shelley qualified as CApi.S
38-
import Cardano.Ledger.Shelley.API.Wallet (
39-
CLI (evaluateMinLovelaceOutput),
40-
)
4137
import Control.Lens (folded, to, (^..))
4238
import Control.Monad.Freer (Eff, Members, interpret, runM, send, type (~>))
4339
import Control.Monad.Freer.Reader (Reader, ask, runReader)
@@ -46,19 +42,15 @@ import Control.Monad.Trans.Either (firstEitherT, hoistEither, newEitherT, runEit
4642
import Data.Map (Map)
4743
import Data.Map qualified as Map
4844
import Data.Set qualified as Set
49-
import Ledger qualified
50-
import Ledger.Ada qualified as Ada
5145
import Ledger.Address (Address)
5246
import Ledger.Tx (ChainIndexTxOut (..))
5347
import Ledger.Tx.CardanoAPI qualified as TxApi
54-
import Ledger.Validation (Coin (Coin))
5548
import Plutus.V2.Ledger.Tx qualified as V2
5649
import Prelude
5750

5851
data NodeQuery a where
5952
UtxosAt :: Address -> NodeQuery (Either NodeQueryError (Map V2.TxOutRef ChainIndexTxOut))
6053
PParams :: NodeQuery (Either NodeQueryError CApi.S.ProtocolParameters)
61-
MinUtxo :: Ledger.TxOut -> NodeQuery (Either NodeQueryError Ledger.TxOut)
6254

6355
utxosAt ::
6456
forall effs.
@@ -73,13 +65,6 @@ pparams ::
7365
Eff effs (Either NodeQueryError CApi.S.ProtocolParameters)
7466
pparams = send PParams
7567

76-
minUtxo ::
77-
forall effs.
78-
Members '[NodeQuery] effs =>
79-
Ledger.TxOut ->
80-
Eff effs (Either NodeQueryError Ledger.TxOut)
81-
minUtxo = send . MinUtxo
82-
8368
handleNodeQuery ::
8469
forall effs.
8570
QueryConstraint effs =>
@@ -88,7 +73,6 @@ handleNodeQuery =
8873
interpret $ \case
8974
UtxosAt addr -> handleUtxosAt addr
9075
PParams -> queryBabbageEra CApi.QueryProtocolParameters
91-
MinUtxo txout -> handleMinUtxo txout
9276

9377
handleUtxosAt ::
9478
forall effs.
@@ -119,36 +103,6 @@ handleUtxosAt addr = runEitherT $ do
119103

120104
return $ Map.fromList $ zip txOutRefs chainIndexTxOuts
121105

122-
handleMinUtxo ::
123-
forall effs.
124-
QueryConstraint effs =>
125-
Ledger.TxOut ->
126-
Eff effs (Either NodeQueryError Ledger.TxOut)
127-
handleMinUtxo txout = runEitherT $ do
128-
conn <- lift $ ask @NodeConn
129-
130-
params <- newEitherT $ queryBabbageEra CApi.QueryProtocolParameters
131-
132-
let pparamsInEra = CApi.toLedgerPParams CApi.ShelleyBasedEraBabbage params
133-
netId = localNodeNetworkId conn
134-
135-
ctxout <-
136-
firstEitherT toQueryError $
137-
hoistEither $
138-
TxApi.toCardanoTxOut netId TxApi.toCardanoTxOutDatumHash txout
139-
140-
let (Coin minTxOut) =
141-
evaluateMinLovelaceOutput pparamsInEra $
142-
CApi.S.toShelleyTxOut CApi.ShelleyBasedEraBabbage ctxout
143-
144-
missingLovelace = Ada.lovelaceOf minTxOut - Ada.fromValue (Ledger.txOutValue txout)
145-
146-
if missingLovelace > 0
147-
then
148-
newEitherT $
149-
handleMinUtxo (txout {Ledger.txOutValue = Ledger.txOutValue txout <> Ada.toValue missingLovelace})
150-
else return txout
151-
152106
runNodeQuery :: PABConfig -> Eff '[NodeQuery, Reader NodeConn, IO] ~> IO
153107
runNodeQuery conf effs = do
154108
conn <- connectionInfo conf

‎src/BotPlutusInterface/Contract.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ module BotPlutusInterface.Contract (runContract, handleContract) where
77
import BotPlutusInterface.Balance qualified as Balance
88
import BotPlutusInterface.BodyBuilder qualified as BodyBuilder
99
import BotPlutusInterface.CardanoCLI qualified as CardanoCLI
10-
import BotPlutusInterface.CardanoNode.Effects (NodeQuery (MinUtxo, UtxosAt))
10+
import BotPlutusInterface.CardanoNode.Effects (NodeQuery (UtxosAt))
1111
import BotPlutusInterface.Collateral qualified as Collateral
1212
import BotPlutusInterface.Effects (
1313
PABEffect,
@@ -19,6 +19,7 @@ import BotPlutusInterface.Effects (
1919
handleContractLog,
2020
handlePABEffect,
2121
logToContract,
22+
minUtxo,
2223
posixTimeRangeToContainedSlotRange,
2324
posixTimeToSlot,
2425
printBpiLog,
@@ -246,11 +247,10 @@ adjustUnbalancedTx' ::
246247
UnbalancedTx ->
247248
Eff effs (Either Tx.ToCardanoError UnbalancedTx)
248249
adjustUnbalancedTx' unbalancedTx = runEitherT $ do
249-
-- traverse (queryNode . MinUtxo)
250250
updatedOuts <-
251251
firstEitherT (Tx.TxBodyError . show) $
252252
newEitherT $
253-
sequence <$> traverse (queryNode @w . MinUtxo) (unbalancedTx ^. tx . outputs)
253+
sequence <$> traverse (minUtxo @w) (unbalancedTx ^. tx . outputs)
254254

255255
return $ unbalancedTx & (tx . outputs .~ updatedOuts)
256256

‎src/BotPlutusInterface/Effects.hs‎

Lines changed: 44 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,8 @@ module BotPlutusInterface.Effects (
3131
getInMemCollateral,
3232
setInMemCollateral,
3333
queryNode,
34+
minUtxo,
35+
calcMinUtxo,
3436
) where
3537

3638
import BotPlutusInterface.CardanoNode.Effects (NodeQuery, runNodeQuery)
@@ -42,20 +44,27 @@ import BotPlutusInterface.Types (
4244
BudgetEstimationError,
4345
CLILocation (..),
4446
CollateralUtxo,
45-
ContractEnvironment,
47+
ContractEnvironment (..),
4648
ContractState (ContractState),
4749
LogContext (BpiLog, ContractLog),
4850
LogLevel (..),
4951
LogLine (..),
5052
LogType (..),
5153
LogsList (LogsList),
54+
PABConfig (..),
5255
TxBudget,
5356
TxFile,
5457
addBudget,
5558
sufficientLogLevel,
5659
)
5760
import Cardano.Api (AsType, FileError (FileIOError), HasTextEnvelope, TextEnvelopeDescr, TextEnvelopeError)
5861
import Cardano.Api qualified
62+
import Cardano.Api qualified as CApi
63+
import Cardano.Api.Shelley qualified as CApi.S
64+
import Cardano.Ledger.Shelley.API.Wallet (
65+
CLI (evaluateMinLovelaceOutput),
66+
)
67+
import Cardano.Prelude (maybeToEither)
5968
import Control.Concurrent qualified as Concurrent
6069
import Control.Concurrent.STM (TVar, atomically, modifyTVar, modifyTVar')
6170
import Control.Lens ((^.))
@@ -68,12 +77,16 @@ import Data.Aeson (ToJSON)
6877
import Data.Aeson qualified as JSON
6978
import Data.Bifunctor (second)
7079
import Data.ByteString qualified as ByteString
80+
import Data.Either.Combinators (mapLeft)
7181
import Data.Kind (Type)
7282
import Data.Maybe (catMaybes)
7383
import Data.String (IsString, fromString)
7484
import Data.Text (Text)
7585
import Data.Text qualified as Text
7686
import Ledger qualified
87+
import Ledger.Ada qualified as Ada
88+
import Ledger.Tx.CardanoAPI qualified as TxApi
89+
import Ledger.Validation (Coin (Coin))
7790
import Plutus.Contract.Effects (ChainIndexQuery, ChainIndexResponse)
7891
import Plutus.PAB.Core.ContractInstance.STM (Activity)
7992
import PlutusTx.Builtins.Internal (BuiltinByteString (BuiltinByteString))
@@ -131,6 +144,7 @@ data PABEffect (w :: Type) (r :: Type) where
131144
PABEffect w (Either TimeSlot.TimeSlotConversionError Ledger.SlotRange)
132145
GetInMemCollateral :: PABEffect w (Maybe CollateralUtxo)
133146
SetInMemCollateral :: CollateralUtxo -> PABEffect w ()
147+
MinUtxo :: Ledger.TxOut -> PABEffect w (Either Text Ledger.TxOut)
134148

135149
handlePABEffect ::
136150
forall (w :: Type) (effs :: [Type -> Type]).
@@ -193,6 +207,7 @@ handlePABEffect contractEnv =
193207
TimeSlot.posixTimeRangeToContainedSlotRangeIO contractEnv.cePABConfig pTimeRange
194208
GetInMemCollateral -> Collateral.getInMemCollateral contractEnv
195209
SetInMemCollateral c -> Collateral.setInMemCollateral contractEnv c
210+
MinUtxo utxo -> return $ calcMinUtxo contractEnv.cePABConfig utxo
196211
)
197212

198213
printLog' :: LogLevel -> LogLine -> IO ()
@@ -265,6 +280,27 @@ saveBudgetImpl contractEnv txId budget =
265280
atomically $
266281
modifyTVar' contractEnv.ceContractStats (addBudget txId budget)
267282

283+
calcMinUtxo :: PABConfig -> Ledger.TxOut -> Either Text Ledger.TxOut
284+
calcMinUtxo pabconf txout = do
285+
params <- maybeToEither "Expected protocol parameters." $ pcProtocolParams pabconf
286+
287+
let pparamsInEra = CApi.toLedgerPParams CApi.ShelleyBasedEraBabbage params
288+
netId = pcNetwork pabconf
289+
290+
ctxout <-
291+
mapLeft (Text.pack . show) $
292+
TxApi.toCardanoTxOut netId TxApi.toCardanoTxOutDatumHash txout
293+
294+
let (Coin minTxOut) =
295+
evaluateMinLovelaceOutput pparamsInEra $
296+
CApi.S.toShelleyTxOut CApi.ShelleyBasedEraBabbage ctxout
297+
298+
missingLovelace = Ada.lovelaceOf minTxOut - Ada.fromValue (Ledger.txOutValue txout)
299+
300+
if missingLovelace > 0
301+
then calcMinUtxo pabconf (txout {Ledger.txOutValue = Ledger.txOutValue txout <> Ada.toValue missingLovelace})
302+
else return txout
303+
268304
-- Couldn't use the template haskell makeEffect here, because it caused an OverlappingInstances problem.
269305
-- For some reason, we need to manually propagate the @w@ type variable to @send@
270306

@@ -430,3 +466,10 @@ queryNode ::
430466
NodeQuery a ->
431467
Eff effs a
432468
queryNode = send @(PABEffect w) . QueryNode
469+
470+
minUtxo ::
471+
forall (w :: Type) (effs :: [Type -> Type]).
472+
Member (PABEffect w) effs =>
473+
Ledger.TxOut ->
474+
Eff effs (Either Text Ledger.TxOut)
475+
minUtxo = send @(PABEffect w) . MinUtxo

0 commit comments

Comments
 (0)