Add TxPlutusWitnesses to TxBodyContent

IntersectMBO · May 14, 2021 · 8d1a75b · 8d1a75b
1 parent 0a8e861
commit 8d1a75b
Show file tree

Hide file tree

Showing 3 changed files with 45 additions and 16 deletions.
diff --git a/cardano-api/src/Cardano/Api/Script.hs b/cardano-api/src/Cardano/Api/Script.hs
@@ -37,6 +37,7 @@ module Cardano.Api.Script (
     fromScriptExecutionUnits,
     Witness(..),
     KeyWitnessInCtx(..),
+    WitCtxPlutus,
     ScriptWitnessInCtx(..),
 
     -- ** Languages supported in each era
@@ -662,6 +663,13 @@ data WitCtxMint
 --
 data WitCtxStake
 
+-- | A tag type for the context in which a key witness is used in a transaction.
+--
+-- This type tags the context as being a Plutus script requiring additional
+-- key witnesses.
+
+data WitCtxPlutus
+
 -- | A /use/ of a script within a transaction body to witness that something is
 -- being used in an authorised manner. That can be
 --
@@ -776,9 +784,10 @@ deriving instance Show (Witness witctx era)
 
 data KeyWitnessInCtx witctx where
 
-     KeyWitnessForPlutusFee :: KeyWitnessInCtx WitCtxTxIn
-     KeyWitnessForSpending  :: KeyWitnessInCtx WitCtxTxIn
-     KeyWitnessForStakeAddr :: KeyWitnessInCtx WitCtxStake
+     KeyWitnessForPlutusFee    :: KeyWitnessInCtx WitCtxTxIn
+     KeyWitnessForSpending     :: KeyWitnessInCtx WitCtxTxIn
+     KeyWitnessForStakeAddr    :: KeyWitnessInCtx WitCtxStake
+     KeyWitnessForPlutusScript :: KeyWitness era -> KeyWitnessInCtx WitCtxPlutus
 
 data ScriptWitnessInCtx witctx where
 

diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs
@@ -910,6 +910,22 @@ data TxMintValue build era where
 deriving instance Eq   (TxMintValue build era)
 deriving instance Show (TxMintValue build era)
 
+
+data TxPlutusWitnesses build era where
+    TxPlutusWitnessesNone :: TxPlutusWitnesses build era
+    TxPlutusWitnesses      :: TxPlutusWitnessesSupportedInEra era
+                           -> [BuildTxWith build (Witness WitCtxPlutus era)]
+                           -> TxPlutusWitnesses build era
+
+deriving instance Eq   (TxPlutusWitnesses build era)
+deriving instance Show (TxPlutusWitnesses build era)
+
+data TxPlutusWitnessesSupportedInEra era where
+    TxPlutusWitnessesSupportedInAlonzoEra :: TxPlutusWitnessesSupportedInEra AlonzoEra
+
+deriving instance Eq   (TxPlutusWitnessesSupportedInEra era)
+deriving instance Show (TxPlutusWitnessesSupportedInEra era)
+
 -- ----------------------------------------------------------------------------
 -- Data necessary to create a hash of the script execution data.
 --
@@ -944,18 +960,19 @@ _witnessPPDataSupportedInEra AlonzoEra  = Just WitnessPPDataSupportedInAlonzoEra
 
 data TxBodyContent build era =
      TxBodyContent {
-       txIns            :: [(TxIn, BuildTxWith build (Witness WitCtxTxIn era))],
-       txOuts           :: [TxOut era],
-       txFee            :: TxFee era,
-       txValidityRange  :: (TxValidityLowerBound era,
-                            TxValidityUpperBound era),
-       txMetadata       :: TxMetadataInEra era,
-       txAuxScripts     :: TxAuxScripts era,
-       txWithdrawals    :: TxWithdrawals  build era,
-       txCertificates   :: TxCertificates build era,
-       txUpdateProposal :: TxUpdateProposal era,
-       txMintValue      :: TxMintValue build era,
-       txWitnessPPData  :: TxWitnessPPDataHash era
+       txIns             :: [(TxIn, BuildTxWith build (Witness WitCtxTxIn era))],
+       txOuts            :: [TxOut era],
+       txFee             :: TxFee era,
+       txValidityRange   :: (TxValidityLowerBound era,
+                             TxValidityUpperBound era),
+       txMetadata        :: TxMetadataInEra era,
+       txAuxScripts      :: TxAuxScripts era,
+       txWithdrawals     :: TxWithdrawals  build era,
+       txCertificates    :: TxCertificates build era,
+       txUpdateProposal  :: TxUpdateProposal era,
+       txMintValue       :: TxMintValue build era,
+       txPlutusWitnesses :: TxPlutusWitnesses build era,
+       txWitnessPPData   :: TxWitnessPPDataHash era
      }
 
 
@@ -2172,7 +2189,9 @@ makeByronTransactionBodyContent txIns txOuts =
     txWithdrawals    = TxWithdrawalsNone,
     txCertificates   = TxCertificatesNone,
     txUpdateProposal = TxUpdateProposalNone,
-    txMintValue      = TxMintNone
+    txMintValue      = TxMintNone,
+    txPlutusWitnesses = TxPlutusWitnessesNone,
+    txWitnessPPData   = TxWitnessPPDataHashNone
   }
 
 

diff --git a/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs b/cardano-api/test/Test/Cardano/Api/Typed/Gen.hs
@@ -578,6 +578,7 @@ genTxBodyContent era = do
     , txCertificates = certs
     , txUpdateProposal = updateProposal
     , txMintValue = mintValue
+    , txPlutusWitnesses = panic "TODO"
     , txWitnessPPData = panic "TODO"
     }