diff --git a/eras/dijkstra/impl/CHANGELOG.md b/eras/dijkstra/impl/CHANGELOG.md index ee691d13cda..42b5da10848 100644 --- a/eras/dijkstra/impl/CHANGELOG.md +++ b/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` diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxInfo.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxInfo.hs index a1812485461..685dd615b12 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxInfo.hs +++ b/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 SumD AccountBalanceIntervalsNotSupported SumD SubTxsAreNotSupported SumD GuardScriptHashesNotSupported 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. diff --git a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/TxInfoSpec.hs b/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/TxInfoSpec.hs index ea1d2726917..3e09a989d72 100644 --- a/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/TxInfoSpec.hs +++ b/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)