Fail Plutus V1-V3 translation with guards

eras/dijkstra/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 0.3.0.0
 
+* Add `GuardScriptHashesNotSupported` constructor to `DijkstraContextError`
 * Add `SubTxsAreNotSupported` constructor to `DijkstraContextError`
 * Add `decodeDijkstraTopTx`
 * Change `Signal` to `StAnnTx TopTx era` for: `DijkstraLEDGER`, `DijkstraMEMPOOL`, `DijkstraUTXOW`, `DijkstraUTXO`

eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxInfo.hs

@@ -46,7 +46,7 @@ import Cardano.Ledger.Conway.TxInfo (
   transTxInInfoV3,
  )
 import qualified Cardano.Ledger.Conway.TxInfo as Conway
-import Cardano.Ledger.Credential (StakeReference (..))
+import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
 import Cardano.Ledger.Dijkstra.Core
 import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
 import Cardano.Ledger.Dijkstra.Scripts (
@@ -77,7 +77,7 @@ import Cardano.Ledger.State (StakePoolParams (..))
 import Cardano.Ledger.TxIn (TxId)
 import Control.Arrow (left)
 import Control.DeepSeq (NFData)
-import Control.Monad (forM, forM_, unless, zipWithM)
+import Control.Monad (forM, unless, zipWithM)
 import Data.Aeson (KeyValue (..), ToJSON (..))
 import Data.Foldable (Foldable (..))
 import qualified Data.Foldable as F
@@ -104,8 +104,10 @@ data DijkstraContextError era
     DirectDepositsNotSupported DirectDeposits
   | -- | Attempt to use PlutusV1-V3 with non-empty account balance intervals will result in this failure
     AccountBalanceIntervalsNotSupported (AccountBalanceIntervals era)
-  | -- | Attempt to use sub-transactions with PlutusV1-V3 scripts at the top level
+  | -- | Attempt to use sub-transactions with PlutusV1-V3 scripts at the top level will result in this failure
     SubTxsAreNotSupported (NonEmpty TxId)
+  | -- | Attempt to use PlutusV1-V3 with script hashes in guards will result in this failure
+    GuardScriptHashesNotSupported (NonEmpty ScriptHash)
   deriving (Generic)
 
 deriving instance
@@ -163,6 +165,8 @@ instance
       kindObject "AccountBalanceIntervalsNotSupported" ["account_balance_intervals" .= show abi]
     SubTxsAreNotSupported txIds ->
       kindObject "SubTxsAreNotSupported" ["txIds" .= toJSON txIds]
+    GuardScriptHashesNotSupported scriptHashes ->
+      kindObject "GuardScriptHashesNotSupported" ["script_hashes" .= toJSON scriptHashes]
 
 instance
   ( EraPParams era
@@ -182,6 +186,7 @@ instance
     20 -> SumD DirectDepositsNotSupported <! From
     21 -> SumD AccountBalanceIntervalsNotSupported <! From
     22 -> SumD SubTxsAreNotSupported <! From
+    23 -> SumD GuardScriptHashesNotSupported <! From
     k -> Invalid k
 
 instance
@@ -204,6 +209,8 @@ instance
       DirectDepositsNotSupported dd -> Sum DirectDepositsNotSupported 20 !> To dd
       AccountBalanceIntervalsNotSupported abi -> Sum AccountBalanceIntervalsNotSupported 21 !> To abi
       SubTxsAreNotSupported txIds -> Sum SubTxsAreNotSupported 22 !> To txIds
+      GuardScriptHashesNotSupported scriptHashes ->
+        Sum GuardScriptHashesNotSupported 23 !> To scriptHashes
 
 instance Inject (ConwayContextError era) (DijkstraContextError era) where
   inject = ConwayContextError
@@ -421,15 +428,29 @@ guardDijkstraFeaturesForPlutusV1toV3 ::
 guardDijkstraFeaturesForPlutusV1toV3 tx = do
   let txBody = tx ^. bodyTxL
       directDeposits = txBody ^. directDepositsTxBodyL
+      accountBalanceIntervals = txBody ^. accountBalanceIntervalsTxBodyL
+      subTransactions = txBody ^. subTransactionsTxBodyL
+      scriptHashes = [sh | ScriptHashObj sh <- toList (txBody ^. guardsTxBodyL)]
   unless (null $ unDirectDeposits directDeposits) $
     Left $
-      inject (DirectDepositsNotSupported directDeposits :: DijkstraContextError era)
-  let accountBalanceIntervals = txBody ^. accountBalanceIntervalsTxBodyL
+      inject $
+        DirectDepositsNotSupported @era directDeposits
   unless (null $ unAccountBalanceIntervals accountBalanceIntervals) $
     Left $
-      inject (AccountBalanceIntervalsNotSupported accountBalanceIntervals :: DijkstraContextError era)
-  forM_ (NE.nonEmpty . toList . OMap.toStrictSeqOKeys $ txBody ^. subTransactionsTxBodyL) $ \subTxIds ->
-    Left $ inject $ SubTxsAreNotSupported @era subTxIds
+      inject $
+        AccountBalanceIntervalsNotSupported @era accountBalanceIntervals
+  case NE.nonEmpty . toList $ OMap.toStrictSeqOKeys subTransactions of
+    Nothing -> Right ()
+    Just subTxIds ->
+      Left $
+        inject $
+          SubTxsAreNotSupported @era subTxIds
+  case NE.nonEmpty scriptHashes of
+    Nothing -> Right ()
+    Just neScriptHashes ->
+      Left $
+        inject $
+          GuardScriptHashesNotSupported @era neScriptHashes
 
 transFailUnsupportedScriptInSubTx ::
   forall l era.

eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/TxInfoSpec.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -18,15 +17,19 @@ import Cardano.Ledger.Alonzo.Plutus.Context (
  )
 import Cardano.Ledger.Alonzo.Scripts (AsPurpose (..))
 import Cardano.Ledger.BaseTypes (Globals (..), Inject (..), Network (..), ProtVer (..))
-import Cardano.Ledger.Credential (StakeReference (..))
+import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
 import Cardano.Ledger.Dijkstra.Core
-import Cardano.Ledger.Dijkstra.Scripts (AccountBalanceIntervals (..))
+import Cardano.Ledger.Dijkstra.Scripts (
+  AccountBalanceIntervals (..),
+ )
 import Cardano.Ledger.Dijkstra.State (UTxO (..))
 import Cardano.Ledger.Dijkstra.TxInfo (DijkstraContextError (..))
 import Cardano.Ledger.Plutus (Language (..), SLanguage (..), plutusLanguage)
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map.NonEmpty as NEM
 import qualified Data.Map.Strict as Map
 import qualified Data.OMap.Strict as OMap
+import qualified Data.OSet.Strict as OSet
 import Lens.Micro ((&), (.~))
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Core.Utils (testGlobals)
@@ -165,3 +168,24 @@ spec = describe "TxInfo" $ do
               <$> unPlutusTxInfoResult (toPlutusTxInfo slang ledgerTxInfo)
         txInfoResult
           `shouldBeLeft` inject (SubTxsAreNotSupported @era (pure (txIdTx subTx)))
+      prop "GuardScriptHashesNotSupported" $ \(scriptHash :: ScriptHash) ->
+        let
+          neScriptHashes = scriptHash :| []
+          guards = OSet.fromList [ScriptHashObj scriptHash]
+          tx =
+            mkBasicTx @era @TopTx $
+              mkBasicTxBody & guardsTxBodyL .~ guards
+          ledgerTxInfo =
+            LedgerTxInfo
+              { ltiProtVer = ProtVer (eraProtVerLow @era) 0
+              , ltiEpochInfo = epochInfo testGlobals
+              , ltiSystemStart = systemStart testGlobals
+              , ltiUTxO = mempty
+              , ltiTx = tx
+              , ltiMemoizedSubTransactions = mempty
+              }
+          txInfoResult =
+            ($ SpendingPurpose AsPurpose)
+              <$> unPlutusTxInfoResult (toPlutusTxInfo slang ledgerTxInfo)
+         in
+          txInfoResult `shouldBeLeft` inject (GuardScriptHashesNotSupported @era neScriptHashes)