Add guards to scriptsNeeded

Author: Soupstraw

eras/dijkstra/src/Cardano/Ledger/Dijkstra/Scripts.hs

@@ -19,6 +19,7 @@
 module Cardano.Ledger.Dijkstra.Scripts (
   PlutusScript (..),
   DijkstraPlutusPurpose (..),
+  DijkstraEraScript (..),
   pattern GuardingPurpose,
 ) where
 

eras/dijkstra/src/Cardano/Ledger/Dijkstra/UTxO.hs

@@ -1,12 +1,16 @@
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Cardano.Ledger.Dijkstra.UTxO () where
+module Cardano.Ledger.Dijkstra.UTxO (
+  getDijkstraScriptsNeeded,
+) where
 
 import Cardano.Ledger.Alonzo.UTxO (
   AlonzoEraUTxO (..),
-  AlonzoScriptsNeeded,
+  AlonzoScriptsNeeded (..),
   getAlonzoScriptsHashesNeeded,
+  zipAsIxItem,
  )
 import Cardano.Ledger.Babbage.UTxO (
   getBabbageScriptsProvided,
@@ -20,11 +24,17 @@ import Cardano.Ledger.Conway.UTxO (
   getConwayScriptsNeeded,
   getConwayWitsVKeyNeeded,
  )
+import Cardano.Ledger.Credential (credScriptHash)
+import Cardano.Ledger.Dijkstra.Core (AsIxItem (..), EraTxBody (..))
 import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
-import Cardano.Ledger.Dijkstra.State (EraUTxO (..))
+import Cardano.Ledger.Dijkstra.Scripts (DijkstraEraScript (..), pattern GuardingPurpose)
+import Cardano.Ledger.Dijkstra.State (EraUTxO (..), UTxO)
 import Cardano.Ledger.Dijkstra.State.CertState ()
 import Cardano.Ledger.Dijkstra.Tx ()
+import Cardano.Ledger.Dijkstra.TxBody (DijkstraEraTxBody (..))
 import Cardano.Ledger.Mary.UTxO (getConsumedMaryValue)
+import Data.Maybe (catMaybes)
+import Lens.Micro ((^.))
 
 instance EraUTxO DijkstraEra where
   type ScriptsNeeded DijkstraEra = AlonzoScriptsNeeded DijkstraEra
@@ -37,14 +47,25 @@ instance EraUTxO DijkstraEra where
 
   getScriptsProvided = getBabbageScriptsProvided
 
-  getScriptsNeeded = getConwayScriptsNeeded
+  getScriptsNeeded = getDijkstraScriptsNeeded
 
   getScriptsHashesNeeded = getAlonzoScriptsHashesNeeded
 
   getWitsVKeyNeeded _ = getConwayWitsVKeyNeeded
 
   getMinFeeTxUtxo = getConwayMinFeeTxUtxo
 
+getDijkstraScriptsNeeded ::
+  (DijkstraEraTxBody era, DijkstraEraScript era) => UTxO era -> TxBody era -> AlonzoScriptsNeeded era
+getDijkstraScriptsNeeded utxo txb =
+  getConwayScriptsNeeded utxo txb
+    <> guardingScriptsNeeded
+  where
+    guardingScriptsNeeded = AlonzoScriptsNeeded $
+      catMaybes $
+        zipAsIxItem (txb ^. guardsTxBodyL) $
+          \(AsIxItem idx cred) -> (\sh -> (GuardingPurpose (AsIxItem idx sh), sh)) <$> credScriptHash cred
+
 instance AlonzoEraUTxO DijkstraEra where
   getSupplementalDataHashes = getBabbageSupplementalDataHashes