Merge pull request #83 from mlabs-haskell/nazrhom/await-tx-status-change

Add support for AwaitTxStatusChangeReq contract request

Author: nazrhom

bot-plutus-interface.cabal

@@ -85,6 +85,7 @@ library
     BotPlutusInterface.Types
     BotPlutusInterface.UtxoParser
     BotPlutusInterface.Server
+    BotPlutusInterface.Helpers
   build-depends:
     , aeson                      ^>=1.5.0.0
     , attoparsec                 >=0.13.2.2

examples/plutus-game/app/Main.hs

@@ -61,13 +61,14 @@ main = do
           , pcTipPollingInterval = 10_000_000
           , pcSlotConfig = def
           , pcOwnPubKeyHash = "0f45aaf1b2959db6e5ff94dbb1f823bf257680c3c723ac2d49f97546"
+          , pcOwnStakePubKeyHash = Nothing
           , pcScriptFileDir = "./scripts"
           , pcSigningKeyFileDir = "./signing-keys"
           , pcTxFileDir = "./txs"
           , pcDryRun = True
           , pcLogLevel = Debug
           , pcProtocolParamsFile = "./protocol.json"
-          , pcForceBudget = Just (1000, 1000)
+          , pcForceBudget = Just (9_000_000_000, 15_000_000)
           , pcEnableTxEndpoint = True
           }
   BotPlutusInterface.runPAB @GameContracts pabConf

examples/plutus-game/guess.sh

@@ -6,7 +6,7 @@ CONTRACT_INST_ID=$(curl --location --request POST 'localhost:9080/api/contract/a
     "caID": {
         "tag": "Guess",
         "contents": {
-            "guessGameId": 2,
+            "guessGameId": 3,
             "guessSecret": "secret"
         }
     }

examples/plutus-game/lock.sh

@@ -6,7 +6,7 @@ CONTRACT_INST_ID=$(curl --location --request POST 'localhost:9080/api/contract/a
     "caID": {
         "tag": "Lock",
         "contents": {
-            "lockGameId": 2,
+            "lockGameId": 3,
             "lockAmount": 1000000,
             "lockSecret": "secret"
         }

examples/plutus-game/plutus-game.cabal

@@ -81,6 +81,7 @@ library
     , cardano-crypto
     , cardano-ledger-alonzo
     , containers
+    , bot-plutus-interface
     , data-default
     , data-default-class
     , directory

examples/plutus-game/protocol.json

@@ -61,6 +61,7 @@ main = do
           , pcTipPollingInterval = 10_000_000
           , pcSlotConfig = def
           , pcOwnPubKeyHash = "0f45aaf1b2959db6e5ff94dbb1f823bf257680c3c723ac2d49f97546"
+          , pcOwnStakePubKeyHash = Nothing
           , pcScriptFileDir = "./scripts"
           , pcSigningKeyFileDir = "./signing-keys"
           , pcTxFileDir = "./txs"

examples/plutus-nft/app/Main.hs

@@ -60,6 +60,7 @@ main = do
           , pcTipPollingInterval = 10_000_000
           , pcSlotConfig = def
           , pcOwnPubKeyHash = "0f45aaf1b2959db6e5ff94dbb1f823bf257680c3c723ac2d49f97546"
+          , pcOwnStakePubKeyHash = Nothing
           , pcScriptFileDir = "./scripts"
           , pcSigningKeyFileDir = "./signing-keys"
           , pcTxFileDir = "./txs"

examples/plutus-transfer/app/Main.hs

@@ -73,7 +73,7 @@ balanceTxIO ::
 balanceTxIO pabConf ownPkh unbalancedTx =
   runEitherT $
     do
-      utxos <- newEitherT $ CardanoCLI.utxosAt @w pabConf $ Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) Nothing
+      utxos <- newEitherT $ CardanoCLI.utxosAt @w pabConf changeAddr
       privKeys <- newEitherT $ Files.readPrivateKeys @w pabConf
       let utxoIndex = fmap Tx.toTxOut utxos <> unBalancedTxUtxoIndex unbalancedTx
           requiredSigs = map Ledger.unPaymentPubKeyHash $ Map.keys (unBalancedTxRequiredSignatories unbalancedTx)
@@ -101,17 +101,19 @@ balanceTxIO pabConf ownPkh unbalancedTx =
       -- If we have change but no change UTxO, we need to add an output for it
       -- We'll add a minimal output, run the loop again so it gets minUTxO, then update change
       balancedTxWithChange <-
-        if adaChange /= 0 && not (hasChangeUTxO ownPkh balancedTx)
-          then fst <$> loop utxoIndex privKeys minUtxos (addOutput ownPkh balancedTx)
+        if adaChange /= 0 && not (hasChangeUTxO changeAddr balancedTx)
+          then fst <$> loop utxoIndex privKeys minUtxos (addOutput changeAddr balancedTx)
           else pure balancedTx
 
       -- Get the updated change, add it to the tx
       let finalAdaChange = getAdaChange utxoIndex balancedTxWithChange
-          fullyBalancedTx = addAdaChange ownPkh finalAdaChange balancedTxWithChange
+          fullyBalancedTx = addAdaChange changeAddr finalAdaChange balancedTxWithChange
 
       -- finally, we must update the signatories
       hoistEither $ addSignatories ownPkh privKeys requiredSigs fullyBalancedTx
   where
+    changeAddr :: Address
+    changeAddr = Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) (pabConf.pcOwnStakePubKeyHash)
     loop ::
       Map TxOutRef TxOut ->
       Map PubKeyHash DummyPrivKey ->
@@ -130,7 +132,7 @@ balanceTxIO pabConf ownPkh unbalancedTx =
 
       -- Calculate fees by pre-balancing the tx, building it, and running the CLI on result
       txWithoutFees <-
-        hoistEither $ balanceTxStep minUtxos utxoIndex ownPkh $ tx `withFee` 0
+        hoistEither $ balanceTxStep minUtxos utxoIndex changeAddr $ tx `withFee` 0
 
       exBudget <- newEitherT $ CardanoCLI.buildTx @w pabConf privKeys txWithoutFees
       nonBudgettedFees <- newEitherT $ CardanoCLI.calculateMinFee @w pabConf txWithoutFees
@@ -140,7 +142,7 @@ balanceTxIO pabConf ownPkh unbalancedTx =
       lift $ printLog @w Debug $ "Fees: " ++ show fees
 
       -- Rebalance the initial tx with the above fees
-      balancedTx <- hoistEither $ balanceTxStep minUtxos utxoIndex ownPkh $ tx `withFee` fees
+      balancedTx <- hoistEither $ balanceTxStep minUtxos utxoIndex changeAddr $ tx `withFee` fees
 
       if balancedTx == tx
         then pure (balancedTx, minUtxos)
@@ -175,13 +177,13 @@ calculateMinUtxos pabConf datums txOuts =
 balanceTxStep ::
   [(TxOut, Integer)] ->
   Map TxOutRef TxOut ->
-  PubKeyHash ->
+  Address ->
   Tx ->
   Either Text Tx
-balanceTxStep minUtxos utxos ownPkh tx =
+balanceTxStep minUtxos utxos changeAddr tx =
   Right (addLovelaces minUtxos tx)
     >>= balanceTxIns utxos
-    >>= handleNonAdaChange ownPkh utxos
+    >>= handleNonAdaChange changeAddr utxos
 
 -- | Get change value of a transaction, taking inputs, outputs, mint and fees into account
 getChange :: Map TxOutRef TxOut -> Tx -> Value
@@ -288,10 +290,9 @@ addTxCollaterals utxos tx = do
     filterAdaOnly = Map.filter (isAdaOnly . txOutValue)
 
 -- | Ensures all non ada change goes back to user
-handleNonAdaChange :: PubKeyHash -> Map TxOutRef TxOut -> Tx -> Either Text Tx
-handleNonAdaChange ownPkh utxos tx =
-  let changeAddr = Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) Nothing
-      nonAdaChange = getNonAdaChange utxos tx
+handleNonAdaChange :: Address -> Map TxOutRef TxOut -> Tx -> Either Text Tx
+handleNonAdaChange changeAddr utxos tx =
+  let nonAdaChange = getNonAdaChange utxos tx
       outputs =
         case partition ((==) changeAddr . Tx.txOutAddress) $ txOutputs tx of
           ([], txOuts) ->
@@ -307,38 +308,33 @@ handleNonAdaChange ownPkh utxos tx =
         then Right $ if Value.isZero nonAdaChange then tx else tx {txOutputs = outputs}
         else Left "Not enough inputs to balance tokens."
 
-hasChangeUTxO :: PubKeyHash -> Tx -> Bool
-hasChangeUTxO ownPkh tx =
+hasChangeUTxO :: Address -> Tx -> Bool
+hasChangeUTxO changeAddr tx =
   any ((==) changeAddr . Tx.txOutAddress) $ txOutputs tx
-  where
-    changeAddr = Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) Nothing
 
 -- | Adds ada change to a transaction, assuming there is already an output going to ownPkh. Otherwise, this is identity
-addAdaChange :: PubKeyHash -> Integer -> Tx -> Tx
-addAdaChange ownPkh change tx =
+addAdaChange :: Address -> Integer -> Tx -> Tx
+addAdaChange changeAddr change tx =
   tx
     { txOutputs =
         case partition ((==) changeAddr . Tx.txOutAddress) $ txOutputs tx of
           (txOut@TxOut {txOutValue = v} : txOuts, txOuts') ->
             txOut {txOutValue = v <> Ada.lovelaceValueOf change} : (txOuts <> txOuts')
           _ -> txOutputs tx
     }
-  where
-    changeAddr = Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) Nothing
 
 -- | Adds a 1 lovelace output to a transaction
-addOutput :: PubKeyHash -> Tx -> Tx
-addOutput ownPkh tx = tx {txOutputs = changeTxOut : txOutputs tx}
+addOutput :: Address -> Tx -> Tx
+addOutput changeAddr tx = tx {txOutputs = changeTxOut : txOutputs tx}
   where
-    changeAddr = Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) Nothing
     changeTxOut =
       TxOut
         { txOutAddress = changeAddr
         , txOutValue = Ada.lovelaceValueOf 1
         , txOutDatumHash = Nothing
         }
 
-{- | Add the required signatorioes to the transaction. Be aware the the signature itself is invalid,
+{- | Add the required signatories to the transaction. Be aware the the signature itself is invalid,
  and will be ignored. Only the pub key hashes are used, mapped to signing key files on disk.
 -}
 addSignatories :: PubKeyHash -> Map PubKeyHash DummyPrivKey -> [PubKeyHash] -> Tx -> Either Text Tx

src/BotPlutusInterface/Balance.hs

@@ -76,6 +76,7 @@ import Ledger.Tx (
   TxInType (..),
   TxOut (..),
   TxOutRef (..),
+  txId,
  )
 import Ledger.TxId (TxId (..))
 import Ledger.Value (Value)
@@ -176,7 +177,7 @@ calculateMinFee pabConf tx =
         , cmdArgs =
             mconcat
               [ ["transaction", "calculate-min-fee"]
-              , ["--tx-body-file", txFilePath pabConf "raw" tx]
+              , ["--tx-body-file", txFilePath pabConf "raw" (txId tx)]
               , ["--tx-in-count", showText $ length $ txInputs tx]
               , ["--tx-out-count", showText $ length $ txOutputs tx]
               , ["--witness-count", showText $ length $ txSignatures tx]
@@ -295,7 +296,7 @@ buildTx pabConf privKeys tx = do
         , ["--fee", showText . getLovelace . fromValue $ txFee tx]
         , mconcat
             [ ["--protocol-params-file", pabConf.pcProtocolParamsFile]
-            , ["--out-file", txFilePath pabConf "raw" tx]
+            , ["--out-file", txFilePath pabConf "raw" (txId tx)]
             ]
         ]
 
@@ -318,9 +319,9 @@ signTx pabConf tx pubKeys =
     opts =
       mconcat
         [ ["transaction", "sign"]
-        , ["--tx-body-file", txFilePath pabConf "raw" tx]
+        , ["--tx-body-file", txFilePath pabConf "raw" (txId tx)]
         , signingKeyFiles
-        , ["--out-file", txFilePath pabConf "signed" tx]
+        , ["--out-file", txFilePath pabConf "signed" (txId tx)]
         ]
 
 budgetFromConfig :: PABConfig -> ExBudget -> ExBudget
@@ -343,7 +344,7 @@ submitTx pabConf tx =
       "cardano-cli"
       ( mconcat
           [ ["transaction", "submit"]
-          , ["--tx-file", txFilePath pabConf "signed" tx]
+          , ["--tx-file", txFilePath pabConf "signed" (txId tx)]
           , networkOpt pabConf
           ]
       )
@@ -480,8 +481,8 @@ networkOpt pabConf = case pabConf.pcNetwork of
   Mainnet -> ["--mainnet"]
 
 txOutRefToCliArg :: TxOutRef -> Text
-txOutRefToCliArg (TxOutRef (TxId txId) txIx) =
-  encodeByteString (fromBuiltin txId) <> "#" <> showText txIx
+txOutRefToCliArg (TxOutRef (TxId tId) txIx) =
+  encodeByteString (fromBuiltin tId) <> "#" <> showText txIx
 
 flatValueToCliArg :: (CurrencySymbol, TokenName, Integer) -> Text
 flatValueToCliArg (curSymbol, name, amount)