Implement extractAllIndexedPlutusScriptWitnesses

Author: Jimbo4350

cardano-api/cardano-api.cabal

@@ -225,6 +225,7 @@ library
     Cardano.Api.Experimental.Plutus.Internal.ScriptWitness
     Cardano.Api.Experimental.Plutus.Internal.Shim.LegacyScripts
     Cardano.Api.Experimental.Tx.Internal.AnyWitness
+    Cardano.Api.Experimental.Tx.Internal.Body
     Cardano.Api.Experimental.Tx.Internal.Certificate
     Cardano.Api.Experimental.Tx.Internal.Fee
     Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements

cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Script.hs

@@ -36,10 +36,12 @@ data PlutusScriptInEra (lang :: L.Language) era where
 
 deriving instance Show (PlutusScriptInEra lang era)
 
+deriving instance Eq (PlutusScriptInEra lang era)
+
 -- | You can provide the plutus script directly in the transaction
 -- or a reference input that points to the script in the UTxO.
 -- Using a reference script saves space in your transaction.
 data PlutusScriptOrReferenceInput lang era
   = PScript (PlutusScriptInEra lang era)
   | PReferenceScript TxIn
-  deriving Show
+  deriving (Show, Eq)

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

@@ -18,7 +18,9 @@ data SimpleScript era where
 
 deriving instance Show (SimpleScript era)
 
+deriving instance Eq (SimpleScript era)
+
 data SimpleScriptOrReferenceInput era
   = SScript (SimpleScript era)
   | SReferenceScript TxIn
-  deriving Show
+  deriving (Show, Eq)

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

@@ -136,6 +136,7 @@ module Cardano.Api.Experimental.Tx
   , TxScriptWitnessRequirements (..)
 
     -- ** Collecting plutus script witness related transaction requirements.
+  , extractAllIndexedPlutusScriptWitnesses
   , getTxScriptWitnessesRequirements
   , obtainMonoidConstraint
 
@@ -151,6 +152,7 @@ import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
 import Cardano.Api.Era.Internal.Feature
 import Cardano.Api.Experimental.Era
 import Cardano.Api.Experimental.Tx.Internal.AnyWitness
+import Cardano.Api.Experimental.Tx.Internal.Body
 import Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
 import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy, asType)
 import Cardano.Api.Ledger.Internal.Reexport (StrictMaybe (..), maybeToStrictMaybe)

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

@@ -0,0 +1,70 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Cardano.Api.Experimental.Tx.Internal.Body
+  ( extractAllIndexedPlutusScriptWitnesses
+  )
+where
+
+import Cardano.Api.Era
+import Cardano.Api.Experimental.Era
+import Cardano.Api.Experimental.Plutus
+import Cardano.Api.Plutus.Internal.Script
+import Cardano.Api.Tx.Internal.Body
+
+import Cardano.Binary qualified as CBOR
+
+extractAllIndexedPlutusScriptWitnesses
+  :: forall era
+   . Era era
+  -> TxBodyContent BuildTx era
+  -> Either
+       CBOR.DecoderError
+       [AnyIndexedPlutusScriptWitness (LedgerEra era)]
+extractAllIndexedPlutusScriptWitnesses era b = obtainCommonConstraints era $ do
+  let sbe = convert era
+      aeon = convert era
+      legacyTxInWits = extractWitnessableTxIns aeon b
+      legacyCertWits = extractWitnessableCertificates aeon b
+      legacyMintWits = extractWitnessableMints aeon b
+      proposalWits
+        :: [(Witnessable ProposalItem (ShelleyLedgerEra era), BuildTxWith BuildTx (Witness WitCtxStake era))] =
+          caseShelleyToBabbageOrConwayEraOnwards
+            (const [])
+            (`extractWitnessableProposals` b)
+            sbe
+      legacyWithdrawalWits = extractWitnessableWithdrawals aeon b
+      legacyVoteWits
+        :: [(Witnessable VoterItem (ShelleyLedgerEra era), BuildTxWith BuildTx (Witness WitCtxStake era))] =
+          caseShelleyToBabbageOrConwayEraOnwards
+            (const [])
+            (`extractWitnessableVotes` b)
+            sbe
+
+  txInWits <- legacyWitnessConversion aeon legacyTxInWits
+  let indexedScriptTxInWits = alonzoEraOnwardsConstraints aeon $ createIndexedPlutusScriptWitnesses txInWits
+
+  certWits <- legacyWitnessConversion aeon legacyCertWits
+  let indexedCertScriptWits = alonzoEraOnwardsConstraints aeon $ createIndexedPlutusScriptWitnesses certWits
+
+  mintWits <- legacyWitnessConversion aeon legacyMintWits
+  let indexedMintScriptWits = alonzoEraOnwardsConstraints aeon $ createIndexedPlutusScriptWitnesses mintWits
+
+  withdrawalWits <- legacyWitnessConversion aeon legacyWithdrawalWits
+  let indexedWithdrawalScriptWits = alonzoEraOnwardsConstraints aeon $ createIndexedPlutusScriptWitnesses withdrawalWits
+
+  proposalScriptWits <- legacyWitnessConversion aeon proposalWits
+  let indexedProposalScriptWits = alonzoEraOnwardsConstraints aeon $ createIndexedPlutusScriptWitnesses proposalScriptWits
+
+  voteWits <- legacyWitnessConversion aeon legacyVoteWits
+  let indexedVoteScriptWits = alonzoEraOnwardsConstraints aeon $ createIndexedPlutusScriptWitnesses voteWits
+  return $
+    mconcat
+      [ indexedScriptTxInWits
+      , indexedMintScriptWits
+      , indexedCertScriptWits
+      , indexedWithdrawalScriptWits
+      , indexedProposalScriptWits
+      , indexedVoteScriptWits
+      ]

cardano-api/src/Cardano/Api/Tx/Internal/Body.hs

@@ -193,6 +193,12 @@ module Cardano.Api.Tx.Internal.Body
   , convValidityUpperBound
   , convVotingProcedures
   , convWithdrawals
+  , extractWitnessableCertificates
+  , extractWitnessableTxIns
+  , extractWitnessableMints
+  , extractWitnessableProposals
+  , extractWitnessableWithdrawals
+  , extractWitnessableVotes
   , getScriptIntegrityHash
   , mkCommonTxBody
   , toAuxiliaryData