Merge pull request #1181 from IntersectMBO/issue-1363-build-raw-script-data-hash

makeUnsignedTx: error when Plutus scripts present without protocol params

Author: Jimbo4350

cardano-api/src/Cardano/Api/Experimental.hs

@@ -12,6 +12,7 @@ module Cardano.Api.Experimental
     -- ** Transaction-related
     UnsignedTx (..)
   , SignedTx (..)
+  , MakeUnsignedTxError (..)
   , makeUnsignedTx
   , makeKeyWitness
   , signTx

cardano-api/src/Cardano/Api/Experimental/Tx.hs

@@ -78,7 +78,9 @@ module Cardano.Api.Experimental.Tx
     -- 'TxBodyContent' that we defined earlier:
     --
     -- @
-    -- let (Right unsignedTx) = Exp.makeUnsignedTx era txBodyContent
+    -- case Exp.makeUnsignedTx era txBodyContent of
+    --   Left err -> error (show err)
+    --   Right unsignedTx -> ...
     -- @
     --
     -- Next, use the key witness to sign the unsigned transaction with the 'makeKeyWitness' function:
@@ -117,6 +119,7 @@ module Cardano.Api.Experimental.Tx
     -- * Contents
     UnsignedTx (..)
   , SignedTx (..)
+  , MakeUnsignedTxError (..)
   , makeUnsignedTx
   , makeKeyWitness
   , signTx

cardano-api/src/Cardano/Api/Experimental/Tx/Internal/BodyContent/New.hs

@@ -24,6 +24,7 @@ module Cardano.Api.Experimental.Tx.Internal.BodyContent.New
   , TxWithdrawals (..)
   , TxBodyContent (..)
   , Datum (..)
+  , MakeUnsignedTxError (..)
   , defaultTxBodyContent
   , extractDatumsAndHashes
   , getDatums
@@ -106,6 +107,7 @@ import Cardano.Api.Governance.Internal.Action.VotingProcedure
 import Cardano.Api.Key.Internal
 import Cardano.Api.Ledger.Internal.Reexport (StrictMaybe (..))
 import Cardano.Api.Ledger.Internal.Reexport qualified as L
+import Cardano.Api.Monad.Error (liftMaybe)
 import Cardano.Api.Plutus.Internal.Script
   ( PlutusScript (..)
   , PlutusScriptVersion (..)
@@ -170,11 +172,27 @@ import Data.Typeable (cast)
 import GHC.Exts (IsList (..))
 import Lens.Micro
 
+-- | Error that can occur when constructing an unsigned transaction.
+data MakeUnsignedTxError
+  = -- | Plutus scripts are present in the transaction but no protocol
+    -- parameters were provided. Protocol parameters are required to
+    -- compute the script integrity hash (script_data_hash).
+    MakeUnsignedTxMissingProtocolParams
+  deriving (Eq, Show)
+
+instance Error MakeUnsignedTxError where
+  prettyError MakeUnsignedTxMissingProtocolParams =
+    mconcat
+      [ "Transaction uses Plutus scripts but no protocol parameters were provided. "
+      , "Protocol parameters are required to compute the script integrity hash "
+      , "(script_data_hash) from the cost models."
+      ]
+
 makeUnsignedTx
   :: forall era
    . Era era
   -> TxBodyContent (LedgerEra era)
-  -> UnsignedTx (LedgerEra era)
+  -> Either MakeUnsignedTxError (UnsignedTx (LedgerEra era))
 makeUnsignedTx DijkstraEra _ = error "makeUnsignedTx: Dijkstra era not supported yet"
 makeUnsignedTx era@ConwayEra bc = obtainCommonConstraints era $ do
   let TxScriptWitnessRequirements languages scripts datums redeemers = collectTxBodyScriptWitnessRequirements bc
@@ -197,12 +215,13 @@ makeUnsignedTx era@ConwayEra bc = obtainCommonConstraints era $ do
       totCollateral = unTxTotalCollateral <$> txTotalCollateral bc
       txAuxData = toAuxiliaryData (txMetadata bc) (txAuxScripts bc)
       scriptValidity = scriptValidityToIsValid $ txScriptValidity bc
-      scriptIntegrityHash =
-        convPParamsToScriptIntegrityHash
-          protocolParameters
-          redeemers
-          datums
-          languages
+
+  scriptIntegrityHash <-
+    convPParamsToScriptIntegrityHash
+      protocolParameters
+      redeemers
+      datums
+      languages
 
   let setMint = convMintValue apiMintValue
       setReqSignerHashes = convExtraKeyWitnesses apiExtraKeyWitnesses
@@ -235,11 +254,12 @@ makeUnsignedTx era@ConwayEra bc = obtainCommonConstraints era $ do
           & L.rdmrsTxWitsL .~ redeemers
 
   let eraSpecificTxBody = eraSpecificLedgerTxBody era ledgerTxBody bc
-  UnsignedTx $
-    L.mkBasicTx eraSpecificTxBody
-      & L.witsTxL .~ scriptWitnesses
-      & L.auxDataTxL .~ L.maybeToStrictMaybe (toAuxiliaryData (txMetadata bc) (txAuxScripts bc))
-      & L.isValidTxL .~ scriptValidity
+  Right $
+    UnsignedTx $
+      L.mkBasicTx eraSpecificTxBody
+        & L.witsTxL .~ scriptWitnesses
+        & L.auxDataTxL .~ L.maybeToStrictMaybe (toAuxiliaryData (txMetadata bc) (txAuxScripts bc))
+        & L.isValidTxL .~ scriptValidity
 
 convTxIns :: [(TxIn, AnyWitness era)] -> Set L.TxIn
 convTxIns inputs =
@@ -283,19 +303,23 @@ convPParamsToScriptIntegrityHash
   -> L.Redeemers (LedgerEra era)
   -> L.TxDats (LedgerEra era)
   -> Set Plutus.Language
-  -> StrictMaybe L.ScriptIntegrityHash
+  -> Either MakeUnsignedTxError (StrictMaybe L.ScriptIntegrityHash)
 convPParamsToScriptIntegrityHash mTxProtocolParams redeemers datums languages = obtainCommonConstraints (useEra @era) $ do
-  pp <- L.maybeToStrictMaybe mTxProtocolParams
   -- This logic is copied from ledger, because their code is not reusable
   -- c.f. https://github.com/IntersectMBO/cardano-ledger/commit/5a975d9af507c9ee835a86d3bb77f3e2670ad228#diff-8236dfec9688f22550b91fc9a87af9915523ab9c5bd817218ecceec8ca7a789bR282
   let shouldCalculateHash =
         not $
           null (redeemers ^. L.unRedeemersL)
             && null (datums ^. L.unTxDatsL)
             && null languages
-  guard shouldCalculateHash
-  let scriptIntegrity = L.ScriptIntegrity redeemers datums (Set.map (L.getLanguageView pp) languages)
-  pure $ L.hashScriptIntegrity scriptIntegrity
+  if shouldCalculateHash
+    then do
+      pp <- liftMaybe MakeUnsignedTxMissingProtocolParams mTxProtocolParams
+      pure $
+        SJust $
+          L.hashScriptIntegrity $
+            L.ScriptIntegrity redeemers datums (Set.map (L.getLanguageView pp) languages)
+    else pure SNothing
 
 convProposalProcedures
   :: forall era

cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs

@@ -138,6 +138,7 @@ data TxBodyErrorAutoBalance era
       -- ^ Total deposits
       L.MaryValue
       -- ^ Balance
+  | TxBodyErrorMakeUnsignedTx MakeUnsignedTxError
 
 deriving instance Show (TxBodyErrorAutoBalance era)
 
@@ -203,6 +204,8 @@ instance Error (TxBodyErrorAutoBalance era) where
         , "\nBalance (UTxO value - deposits): "
         , pshow balance
         ]
+    TxBodyErrorMakeUnsignedTx err ->
+      prettyError err
 
 -- | Use when you do not have access to the UTxOs you intend to spend
 estimateBalancedTxBody
@@ -254,12 +257,14 @@ estimateBalancedTxBody
 data TxFeeEstimationError era
   = TxFeeEstimationScriptExecutionError (TxBodyErrorAutoBalance (LedgerEra era))
   | TxFeeEstimationBalanceError (TxBodyErrorAutoBalance (LedgerEra era))
+  | TxFeeEstimationMakeUnsignedTxError MakeUnsignedTxError
   deriving Show
 
 instance Error (TxFeeEstimationError era) where
   prettyError = \case
     TxFeeEstimationScriptExecutionError e -> prettyError e
     TxFeeEstimationBalanceError e -> prettyError e
+    TxFeeEstimationMakeUnsignedTxError e -> prettyError e
 
 -- | Use when you do not have access to the UTxOs you intend to spend
 estimateBalancedTxBody'
@@ -365,17 +370,18 @@ estimateBalancedTxBody'
     -- Step 3. Create a tx body with out max lovelace fee. This is strictly for
     -- calculating our fee with evaluateTransactionFee.
     let maxLovelaceFee = L.Coin (2 ^ (32 :: Integer) - 1)
-    let txbody1ForFeeEstimateOnly =
-          makeUnsignedTx
-            useEra
-            txbodycontent1
-              { txFee = maxLovelaceFee
-              , txOuts =
-                  obtainCommonConstraints (useEra @era) (TxOut changeTxOut)
-                    : txOuts txbodycontent
-              , txReturnCollateral = mDummyReturnCollateral
-              , txTotalCollateral = mDummyTotalCollateral
-              }
+    txbody1ForFeeEstimateOnly <-
+      first TxFeeEstimationMakeUnsignedTxError $
+        makeUnsignedTx
+          useEra
+          txbodycontent1
+            { txFee = maxLovelaceFee
+            , txOuts =
+                obtainCommonConstraints (useEra @era) (TxOut changeTxOut)
+                  : txOuts txbodycontent
+            , txReturnCollateral = mDummyReturnCollateral
+            , txTotalCollateral = mDummyTotalCollateral
+            }
     let fee =
           evaluateTransactionFee
             pparams
@@ -400,8 +406,8 @@ estimateBalancedTxBody'
     --  1. The original outputs
     --  2. Tx fee
     --  3. Return and total collateral
-    let
-      txbody2 =
+    txbody2 <-
+      first TxFeeEstimationMakeUnsignedTxError $
         makeUnsignedTx
           useEra
           txbodycontent1
@@ -1420,10 +1426,11 @@ makeTransactionBodyAutoBalance
     -- 3. update tx with fees
     -- 4. balance the transaction and update tx change output
 
-    let txbodyForChange =
-          makeUnsignedTx
-            useEra
-            txbodycontent
+    txbodyForChange <-
+      first TxBodyErrorMakeUnsignedTx $
+        makeUnsignedTx
+          useEra
+          txbodycontent
 
     let initialChangeTxOutValue :: Ledger.Value (LedgerEra era) =
           evaluateTransactionBalance pp poolids stakeDelegDeposits drepDelegDeposits utxo txbodyForChange
@@ -1441,13 +1448,14 @@ makeTransactionBodyAutoBalance
     -- scripts execution costs.
     -- TODO: The txbody is made (leder tx) so this
     -- is where the execution units map is made
-    let UnsignedTx txbody =
-          makeUnsignedTx
-            useEra
-            ( txbodycontent
-                & modTxOuts
-                  (<> [initialChangeTxOut])
-            )
+    UnsignedTx txbody <-
+      first TxBodyErrorMakeUnsignedTx $
+        makeUnsignedTx
+          useEra
+          ( txbodycontent
+              & modTxOuts
+                (<> [initialChangeTxOut])
+          )
     let exUnitsMapWithLogs =
           evaluateTransactionExecutionUnits
             systemstart
@@ -1479,17 +1487,18 @@ makeTransactionBodyAutoBalance
     let maxLovelaceFee = L.Coin (2 ^ (32 :: Integer) - 1)
     -- Make a txbody that we will use for calculating the fees.
     let (maybeDummyReturnTxCollateral, maybeDummyTotalTxCollateral) = maybeDummyTotalCollAndCollReturnOutput txbodycontent changeaddr
-    let txbody1 =
-          makeUnsignedTx
-            useEra
-            txbodycontent1
-              { txFee = maxLovelaceFee
-              , txReturnCollateral = maybeDummyReturnTxCollateral
-              , txTotalCollateral = maybeDummyTotalTxCollateral
-              , txOuts =
-                  txOuts txbodycontent
-                    <> [initialChangeTxOut]
-              }
+    txbody1 <-
+      first TxBodyErrorMakeUnsignedTx $
+        makeUnsignedTx
+          useEra
+          txbodycontent1
+            { txFee = maxLovelaceFee
+            , txReturnCollateral = maybeDummyReturnTxCollateral
+            , txTotalCollateral = maybeDummyTotalTxCollateral
+            , txOuts =
+                txOuts txbodycontent
+                  <> [initialChangeTxOut]
+            }
 
     -- NB: This has the potential to over estimate the fees because estimateTransactionKeyWitnessCount
     -- makes the conservative assumption that all inputs are from distinct
@@ -1521,14 +1530,15 @@ makeTransactionBodyAutoBalance
     -- does not matter, instead it's just the values of the fee and outputs.
     -- Here we do not want to start with any change output, since that's what
     -- we need to calculate.
-    let txbody2 =
-          makeUnsignedTx
-            useEra
-            txbodycontent1
-              { txFee = fee
-              , txReturnCollateral = maybeReturnTxCollateral
-              , txTotalCollateral = maybeTotalTxCollateral
-              }
+    txbody2 <-
+      first TxBodyErrorMakeUnsignedTx $
+        makeUnsignedTx
+          useEra
+          txbodycontent1
+            { txFee = fee
+            , txReturnCollateral = maybeReturnTxCollateral
+            , txTotalCollateral = maybeTotalTxCollateral
+            }
 
     case useEra @era of
       DijkstraEra -> error "makeTransactionBodyAutoBalance: DijkstraEra not supported"
@@ -1566,10 +1576,11 @@ makeTransactionBodyAutoBalance
                 , txReturnCollateral = maybeReturnTxCollateral
                 , txTotalCollateral = maybeTotalTxCollateral
                 }
-        let txbody3 =
-              makeUnsignedTx
-                useEra
-                finalTxBodyContent
+        txbody3 <-
+          first TxBodyErrorMakeUnsignedTx $
+            makeUnsignedTx
+              useEra
+              finalTxBodyContent
         return
           (txbody3, finalTxBodyContent)
 

cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Tx.hs

@@ -99,10 +99,11 @@ tx_canonical = H.propertyOnce $ do
             & Exp.setTxTotalCollateral txTotalColl
             & Exp.setTxFee (L.Coin 0)
 
-    let unsignedTx = Exp.makeUnsignedTx era txBodyContent'
-        tx = Exp.signTx era [] [] unsignedTx
-        Exp.SignedTx ledgerTx = tx
-        oldStyleTx = OldApi.ShelleyTx sbe ledgerTx
+    unsignedTx <- H.evalEither $ Exp.makeUnsignedTx era txBodyContent'
+    let
+      tx = Exp.signTx era [] [] unsignedTx
+      Exp.SignedTx ledgerTx = tx
+      oldStyleTx = OldApi.ShelleyTx sbe ledgerTx
 
     void . H.evalIO $ OldApi.writeTxFileTextEnvelope sbe (OldApi.File outFileNonCanonical) oldStyleTx
     void . H.evalIO $