TODO: Write EQ instance for AnyScriptWitness

Author: Jimbo4350

cardano-api/cardano-api.cabal

@@ -72,6 +72,7 @@ library
     Cardano.Api.Era
     Cardano.Api.Error
     Cardano.Api.Experimental
+    Cardano.Api.Experimental.AnyScriptWitness
     Cardano.Api.Experimental.Certificate
     Cardano.Api.Experimental.Era
     Cardano.Api.Experimental.Plutus

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

@@ -0,0 +1,18 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Cardano.Api.Experimental.AnyScriptWitness
+  ( AnyScriptWitness(..)
+  ) where 
+
+import Cardano.Api.Experimental.Simple.Script
+import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness
+  
+data AnyScriptWitness era where 
+  AnyScriptWitnessSimple :: SimpleScriptOrReferenceInput era -> AnyScriptWitness era
+  AnyScriptWitnessPlutus :: PlutusScriptWitness lang purpose era -> AnyScriptWitness era
+
+
+deriving instance Show (AnyScriptWitness era)
+instance Eq (AnyScriptWitness era) where 
+  -- TODO LEFT OFF HERE!

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

@@ -19,6 +19,8 @@ where
 import Cardano.Api.Address
 import Cardano.Api.Certificate.Internal
 import Cardano.Api.Era.Internal.Eon.Convert
+import Cardano.Api.Experimental.AnyScriptWitness
+import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp
 import Cardano.Api.Experimental.Era
 import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness
 import Cardano.Api.Experimental.Tx.Internal.AnyWitness
@@ -28,7 +30,12 @@ import Cardano.Api.Experimental.Tx.Internal.Type
 import Cardano.Api.Key.Internal qualified as Api
 import Cardano.Api.Ledger.Internal.Reexport qualified as L
 import Cardano.Api.ProtocolParameters
-import Cardano.Api.Tx.Internal.Body (CtxTx, ScriptWitnessIndex (..), toScriptIndex)
+import Cardano.Api.Tx.Internal.Body
+  ( AnyScriptWitness (AnyScriptWitness)
+  , CtxTx
+  , ScriptWitnessIndex (..)
+  , toScriptIndex
+  )
 import Cardano.Api.Tx.Internal.TxIn
 import Cardano.Api.Value.Internal
 
@@ -756,6 +763,89 @@ substituteExecutionUnits
       pure $
         mkTxProposalProcedures substitutedExecutionUnits
 
+collectTxBodyScriptWitnesses
+  :: forall era
+   . IsEra era
+  => TxBodyContent (LedgerEra era)
+  -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
+collectTxBodyScriptWitnesses
+  TxBodyContent
+    { txIns
+    , txWithdrawals
+    , txCertificates
+    , txMintValue
+    , txVotingProcedures
+    , txProposalProcedures
+    } =
+    concat
+      [ scriptWitnessesTxIns txIns
+      , scriptWitnessesWithdrawals txWithdrawals
+      , scriptWitnessesCertificates txCertificates
+      , scriptWitnessesMinting txMintValue
+      , maybe [] scriptWitnessesVoting txVotingProcedures
+      --   , maybe [] scriptWitnessesProposing txProposalProcedures
+      ]
+   where
+    scriptWitnessesTxIns
+      :: [(TxIn, AnyWitness (LedgerEra era))]
+      -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
+    scriptWitnessesTxIns txIns' =
+      List.nub
+        [ (ix, anyScriptWitness)
+        | (ix, _, Just anyScriptWitness) <- fmap toAnyScriptWitness <$> indexTxIns txIns'
+        ]
+
+    scriptWitnessesWithdrawals
+      :: TxWithdrawals (LedgerEra era)
+      -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
+    scriptWitnessesWithdrawals txw =
+      List.nub
+        [ (ix, anyScriptWitness)
+        | (ix, _, _, Just anyScriptWitness) <- fmap toAnyScriptWitness <$> indexTxWithdrawals txw
+        ]
+
+    scriptWitnessesCertificates
+      :: TxCertificates (LedgerEra era)
+      -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
+    scriptWitnessesCertificates txc =
+      List.nub
+        [ (ix, anyScriptWitness)
+        | (ix, _, _, Just anyScriptWitness) <- fmap toAnyScriptWitness <$> indexTxCertificates txc
+        ]
+
+    scriptWitnessesMinting
+      :: TxMintValue (LedgerEra era)
+      -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
+    scriptWitnessesMinting txMintValue' =
+      List.nub
+        [ (ix, anyScriptWitness)
+        | (ix, _, _, Just anyScriptWitness) <- fmap toAnyScriptWitness <$> indexTxMintValue txMintValue'
+        ]
+
+    scriptWitnessesVoting
+      :: TxVotingProcedures (LedgerEra era)
+      -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
+    scriptWitnessesVoting txv =
+      List.nub
+        [ (ix, anyScriptWitness)
+        | (ix, _, Just anyScriptWitness) <- fmap toAnyScriptWitness <$> indexTxVotingProcedures txv
+        ]
+
+    scriptWitnessesProposing
+      :: TxProposalProcedures (LedgerEra era)
+      -> [(ScriptWitnessIndex, Exp.AnyScriptWitness (LedgerEra era))]
+    scriptWitnessesProposing txp =
+      List.nub
+        [ (ix, anyScriptWitness)
+        | (_, (ix, Just anyScriptWitness)) <-
+            (fmap . fmap) toAnyScriptWitness <$> indexWitnessedTxProposalProcedures txp
+        ]
+
+toAnyScriptWitness :: AnyWitness era -> Maybe (Exp.AnyScriptWitness era)
+toAnyScriptWitness AnyKeyWitnessPlaceholder = Nothing
+toAnyScriptWitness (AnySimpleScriptWitness ssw) = Just $ AnyScriptWitnessSimple ssw
+toAnyScriptWitness (AnyPlutusScriptWitness psw) = Just $ AnyScriptWitnessPlutus psw
+
 traverseScriptWitnesses
   :: [(a, Either (TxBodyErrorAutoBalance era) b)]
   -> Either (TxBodyErrorAutoBalance era) [(a, b)]