Update the raw and signed files generated by cardano-cli with the new tx id

Change-type: minor
Signed-off-by: Giovanni Garufi <giovanni@mlabs.city>

Author: nazrhom

src/BotPlutusInterface/CardanoCLI.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)

src/BotPlutusInterface/Contract.hs

@@ -7,6 +7,8 @@ import BotPlutusInterface.Balance qualified as PreBalance
 import BotPlutusInterface.CardanoCLI qualified as CardanoCLI
 import BotPlutusInterface.Effects (
   PABEffect,
+  ShellArgs (..),
+  callCommand,
   createDirectoryIfMissing,
   handlePABEffect,
   logToContract,
@@ -28,7 +30,7 @@ import Control.Monad.Freer.Extras.Log (handleLogIgnore)
 import Control.Monad.Freer.Extras.Modify (raiseEnd)
 import Control.Monad.Freer.Writer (Writer (Tell))
 import Control.Monad.Trans.Class (lift)
-import Control.Monad.Trans.Either (eitherT, firstEitherT, newEitherT)
+import Control.Monad.Trans.Either (EitherT, eitherT, firstEitherT, newEitherT)
 import Data.Aeson (ToJSON, Value)
 import Data.Aeson.Extras (encodeByteString)
 import Data.Either (fromRight)
@@ -253,20 +255,34 @@ writeBalancedTx contractEnv (Right tx) = do
       else
         lift . printLog @w Warn . Text.unpack . Text.unlines $
           [ "Not all required signatures have signing key files. Please sign and submit the tx manually:"
-          , "Tx file: " <> Files.txFilePath pabConf "raw" tx
+          , "Tx file: " <> Files.txFilePath pabConf "raw" (Tx.txId tx)
           , "Signatories (pkh): " <> Text.unwords (map pkhToText requiredSigners)
           ]
 
+    -- TODO: This whole part is hacky and we should remove it.
     let ext = if signable then "signed" else "raw"
-        path = Text.unpack $ Files.txFilePath pabConf ext tx
+        path = Text.unpack $ Files.txFilePath pabConf ext (Tx.txId tx)
     -- We read back the tx from file as tx currently has the wrong id (but the one we create with cardano-cli is correct)
     alonxoTx <- firstEitherT (Text.pack . show) $ newEitherT $ readFileTextEnvelope @w (AsTx AsAlonzoEra) path
     let cardanoTx = Tx.SomeTx alonxoTx AlonzoEraInCardanoMode
+    -- We need to replace the outfile we created at the previous step, as it currently still has the old (incorrect) id
+    mvFiles (Files.txFilePath pabConf "raw" (Tx.txId tx)) (Files.txFilePath pabConf "raw" (Ledger.getCardanoTxId $ Left cardanoTx))
+    when signable $ mvFiles (Files.txFilePath pabConf "signed" (Tx.txId tx)) (Files.txFilePath pabConf "signed" (Ledger.getCardanoTxId $ Left cardanoTx))
 
     when (not pabConf.pcDryRun && signable) $ do
       newEitherT $ CardanoCLI.submitTx @w pabConf tx
 
     pure cardanoTx
+  where
+    mvFiles :: Text -> Text -> EitherT Text (Eff effs) ()
+    mvFiles src dst =
+      newEitherT $
+        callCommand @w
+          ShellArgs
+            { cmdName = "mv"
+            , cmdArgs = [src, dst]
+            , cmdOutParser = const ()
+            }
 
 pkhToText :: Ledger.PubKey -> Text
 pkhToText = encodeByteString . fromBuiltin . Ledger.getPubKeyHash . Ledger.pubKeyHash

src/BotPlutusInterface/Files.hs

@@ -115,8 +115,8 @@ signingKeyFilePath pabConf (PubKeyHash pubKeyHash) =
   let h = encodeByteString $ fromBuiltin pubKeyHash
    in pabConf.pcSigningKeyFileDir <> "/signing-key-" <> h <> ".skey"
 
-txFilePath :: PABConfig -> Text -> Tx.Tx -> Text
-txFilePath pabConf ext tx = pabConf.pcTxFileDir <> "/" <> txFileName (Tx.txId tx) ext
+txFilePath :: PABConfig -> Text -> TxId.TxId -> Text
+txFilePath pabConf ext txId = pabConf.pcTxFileDir <> "/" <> txFileName txId ext
 
 txFileName :: TxId.TxId -> Text -> Text
 txFileName txId ext = "tx-" <> txIdToText txId <> "." <> ext

test/Spec/MockContract.hs

@@ -346,6 +346,7 @@ mockCallCommand ShellArgs {cmdName, cmdArgs, cmdOutParser} = do
       pure $ Right $ cmdOutParser ""
     ("cardano-cli", "transaction" : "submit" : _) ->
       pure $ Right $ cmdOutParser ""
+    ("mv", _) -> pure $ Right $ cmdOutParser ""
     (unsupportedCmd, unsupportedArgs) ->
       throwError @Text
         ("Unsupported command: " <> Text.intercalate " " (unsupportedCmd : unsupportedArgs))