Merge pull request #640 from IntersectMBO/jordan/introduce-supplement…

…ary-datums Introduce supplementary datums
IntersectMBO · Sep 20, 2024 · 77c8b0d · 77c8b0d
2 parents 9b3cbd9 + ecc1623
commit 77c8b0d
Show file tree

Hide file tree

Showing 5 changed files with 53 additions and 4 deletions.
diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
@@ -696,6 +696,7 @@ genTxBodyContent sbe = do
       , Api.txValidityUpperBound
       , Api.txMetadata
       , Api.txAuxScripts
+      , Api.txSupplementalData = Api.BuildTxWith Api.TxSupplementalDataNone
       , Api.txExtraKeyWits
       , Api.txProtocolParams
       , Api.txWithdrawals

diff --git a/cardano-api/internal/Cardano/Api/Experimental/Tx.hs b/cardano-api/internal/Cardano/Api/Experimental/Tx.hs
@@ -76,6 +76,7 @@ makeUnsignedTx era bc = obtainCommonConstraints era $ do
       apiExtraKeyWitnesses = txExtraKeyWits bc
       apiReturnCollateral = txReturnCollateral bc
       apiTotalCollateral = txTotalCollateral bc
+      apiSupplementaryData = txSupplementalData bc
 
       -- Ledger types
       txins = convTxIns $ txIns bc
@@ -90,10 +91,11 @@ makeUnsignedTx era bc = obtainCommonConstraints era $ do
       txAuxData = toAuxiliaryData sbe (txMetadata bc) (txAuxScripts bc)
       scripts = convScripts apiScriptWitnesses
       languages = convLanguages apiScriptWitnesses
-      sData = convScriptData sbe apiTxOuts apiScriptWitnesses
+      sData = convScriptData sbe apiTxOuts apiScriptWitnesses apiSupplementaryData
       (datums, redeemers) = case sData of
         TxBodyScriptData _ ds rs -> (ds, rs)
         TxBodyNoScriptData -> (mempty, L.Redeemers mempty)
+
   let setMint = convMintValue apiMintValue
       setReqSignerHashes = convExtraKeyWitnesses apiExtraKeyWitnesses
       ledgerTxBody =

diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs
@@ -1438,6 +1438,7 @@ substituteExecutionUnits
                     _
                     _
                     _
+                    _
                     txWithdrawals
                     txCertificates
                     _

diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs
@@ -57,6 +57,7 @@ module Cardano.Api.Tx.Body
   , setTxVotingProcedures
   , setTxMintValue
   , setTxScriptValidity
+  , setTxSupplementalDatums
   , setTxCurrentTreasuryValue
   , setTxTreasuryDonation
   , TxBodyError (..)
@@ -105,6 +106,7 @@ module Cardano.Api.Tx.Body
   , TxValidityLowerBound (..)
   , TxValidityUpperBound (..)
   , TxMetadataInEra (..)
+  , TxSupplementalDatums (..)
   , TxAuxScripts (..)
   , TxExtraKeyWitnesses (..)
   , TxWithdrawals (..)
@@ -143,6 +145,7 @@ module Cardano.Api.Tx.Body
   , convReturnCollateral
   , convScripts
   , convScriptData
+  , convSupplementalDatums
   , convTotalCollateral
   , convTransactionFee
   , convTxIns
@@ -1151,6 +1154,21 @@ deriving instance Eq (TxMetadataInEra era)
 
 deriving instance Show (TxMetadataInEra era)
 
+-- ----------------------------------------------------------------------------
+-- Transaction supplemental data (era-dependent)
+--
+-- Supplemental datums can be added to the transaction if the corresponding
+-- datum hash exists at a input in that transaction.
+data TxSupplementalDatums era where
+  TxSupplementalDataNone :: TxSupplementalDatums era
+  TxSupplementalDatums
+    :: [HashableScriptData]
+    -> TxSupplementalDatums era
+
+deriving instance Eq (TxSupplementalDatums era)
+
+deriving instance Show (TxSupplementalDatums era)
+
 -- ----------------------------------------------------------------------------
 -- Auxiliary scripts (era-dependent)
 --
@@ -1359,6 +1377,7 @@ data TxBodyContent build era
   , txValidityUpperBound :: TxValidityUpperBound era
   , txMetadata :: TxMetadataInEra era
   , txAuxScripts :: TxAuxScripts era
+  , txSupplementalData :: BuildTxWith build (TxSupplementalDatums era)
   , txExtraKeyWits :: TxExtraKeyWitnesses era
   , txProtocolParams :: BuildTxWith build (Maybe (LedgerProtocolParameters era))
   , txWithdrawals :: TxWithdrawals build era
@@ -1390,6 +1409,7 @@ defaultTxBodyContent era =
     , txFee = defaultTxFee era
     , txValidityLowerBound = TxValidityNoLowerBound
     , txValidityUpperBound = defaultTxValidityUpperBound era
+    , txSupplementalData = BuildTxWith TxSupplementalDataNone
     , txMetadata = TxMetadataNone
     , txAuxScripts = TxAuxScriptsNone
     , txExtraKeyWits = TxExtraKeyWitnessesNone
@@ -1482,6 +1502,10 @@ setTxMintValue v txBodyContent = txBodyContent{txMintValue = v}
 setTxScriptValidity :: TxScriptValidity era -> TxBodyContent build era -> TxBodyContent build era
 setTxScriptValidity v txBodyContent = txBodyContent{txScriptValidity = v}
 
+setTxSupplementalDatums
+  :: TxSupplementalDatums era -> TxBodyContent BuildTx era -> TxBodyContent BuildTx era
+setTxSupplementalDatums v txBodyContent = txBodyContent{txSupplementalData = BuildTxWith v}
+
 setTxProposalProcedures
   :: Maybe (Featured ConwayEraOnwards era (TxProposalProcedures build era))
   -> TxBodyContent build era
@@ -1611,6 +1635,7 @@ createTransactionBody sbe bc =
         apiExtraKeyWitnesses = txExtraKeyWits bc
         apiReturnCollateral = txReturnCollateral bc
         apiTotalCollateral = txTotalCollateral bc
+        apiSupplementalData = txSupplementalData bc
 
         -- Ledger types
         collTxIns = convCollateralTxIns apiCollateralTxIns
@@ -1621,7 +1646,7 @@ createTransactionBody sbe bc =
         txAuxData = toAuxiliaryData sbe (txMetadata bc) (txAuxScripts bc)
         scripts = convScripts apiScriptWitnesses
         languages = convLanguages apiScriptWitnesses
-        sData = convScriptData sbe apiTxOuts apiScriptWitnesses
+        sData = convScriptData sbe apiTxOuts apiScriptWitnesses apiSupplementalData
         proposalProcedures = convProposalProcedures $ maybe TxProposalProceduresNone unFeatured (txProposalProcedures bc)
         votingProcedures = convVotingProcedures $ maybe TxVotingProceduresNone unFeatured (txVotingProcedures bc)
         currentTreasuryValue = Ledger.maybeToStrictMaybe $ unFeatured =<< txCurrentTreasuryValue bc
@@ -1897,6 +1922,7 @@ fromLedgerTxBody sbe scriptValidity body scriptdata mAux =
     , txMintValue = fromLedgerTxMintValue sbe body
     , txExtraKeyWits = fromLedgerTxExtraKeyWitnesses sbe body
     , txProtocolParams = ViewTx
+    , txSupplementalData = ViewTx
     , txMetadata
     , txAuxScripts
     , txScriptValidity = scriptValidity
@@ -2418,8 +2444,9 @@ convScriptData
   => ShelleyBasedEra era
   -> [TxOut CtxTx era]
   -> [(ScriptWitnessIndex, AnyScriptWitness era)]
+  -> BuildTxWith BuildTx (TxSupplementalDatums era)
   -> TxBodyScriptData era
-convScriptData sbe txOuts scriptWitnesses =
+convScriptData sbe txOuts scriptWitnesses (BuildTxWith txSuppDatums) =
   caseShelleyToMaryOrAlonzoEraOnwards
     (const TxBodyNoScriptData)
     ( \w ->
@@ -2443,6 +2470,8 @@ convScriptData sbe txOuts scriptWitnesses =
                   , let d' = toAlonzoData d
                   ]
 
+            supplementalDatums = convSupplementalDatums sbe txSuppDatums
+
             scriptdata :: [HashableScriptData]
             scriptdata =
               [d | TxOut _ _ (TxOutDatumInTx _ d) _ <- txOuts]
@@ -2460,7 +2489,7 @@ convScriptData sbe txOuts scriptWitnesses =
                       ) <-
                       scriptWitnesses
                    ]
-         in TxBodyScriptData w datums redeemers
+         in TxBodyScriptData w (datums <> supplementalDatums) redeemers
     )
     sbe
 
@@ -3361,6 +3390,20 @@ fromShelleyWithdrawal (L.Withdrawals withdrawals) =
   | (stakeAddr, value) <- Map.assocs withdrawals
   ]
 
+convSupplementalDatums
+  :: ShelleyBasedEra era
+  -> TxSupplementalDatums era
+  -> L.TxDats (ShelleyLedgerEra era)
+convSupplementalDatums sbe TxSupplementalDataNone =
+  shelleyBasedEraConstraints sbe mempty
+convSupplementalDatums sbe (TxSupplementalDatums datums) =
+  shelleyBasedEraConstraints sbe $
+    L.TxDats $
+      fromList
+        [ (L.hashData d, d)
+        | d <- map toAlonzoData datums
+        ]
+
 -- | In the Allegra and Mary eras the auxiliary data consists of the tx metadata
 -- and the axiliary scripts. In the Alonzo and later eras the auxiliary data consists of the tx metadata
 -- and the axiliary scripts, and the axiliary script data.

diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -313,6 +313,7 @@ module Cardano.Api
   , setTxUpdateProposal
   , setTxMintValue
   , setTxScriptValidity
+  , setTxSupplementalDatums
   , setTxProposalProcedures
   , setTxVotingProcedures
   , setTxCurrentTreasuryValue
@@ -357,6 +358,7 @@ module Cardano.Api
   , EpochSlots (..)
   , TxMetadataInEra (..)
   , TxAuxScripts (..)
+  , TxSupplementalDatums (..)
   , TxExtraKeyWitnesses (..)
   , TxWithdrawals (..)
   , TxCertificates (..)