diff --git a/.changes/20261016_top_level_script_guards.yml b/.changes/20261016_top_level_script_guards.yml new file mode 100644 index 0000000000..21bb3ac800 --- /dev/null +++ b/.changes/20261016_top_level_script_guards.yml @@ -0,0 +1,5 @@ +project: cardano-cli +pr: 1477 +kind: + - feature +description: Add native and Plutus V4 script guards to Dijkstra transaction build, build-raw, and build-estimate, with inline or reference scripts, guarding redeemers, and automatic or explicit execution budgets. diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index b050e64b36..495ed91508 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -121,6 +121,16 @@ jobs: # that appears only in CI when the golden files are removed and then recreated run: cabal test all --enable-tests --test-show-details=direct --ghc-options="-threaded -rtsopts \"-with-rtsopts=-N1 -T\"" + - name: Preserve failed test diagnostics + if: failure() + uses: actions/upload-artifact@v4 + with: + name: test-diagnostics-${{ matrix.os }}-${{ matrix.ghc }} + path: | + dist-newstyle/**/test/*.log + ~/Library/Logs/DiagnosticReports/cardano-cli*.ips + if-no-files-found: ignore + # We want this check to run first because $(git ls-files -m) (see below) returns both # modified files *and* deleted files. So we want to fail on deleted files first. # This makes sure we only report modified files (and not deleted ones) in the next step, diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 021da3bec6..f394efc27c 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -112,6 +112,9 @@ library Cardano.CLI.EraBased.Run Cardano.CLI.EraBased.Script.Certificate.Read Cardano.CLI.EraBased.Script.Certificate.Type + Cardano.CLI.EraBased.Script.Guard.Option + Cardano.CLI.EraBased.Script.Guard.Read + Cardano.CLI.EraBased.Script.Guard.Type Cardano.CLI.EraBased.Script.Mint.Read Cardano.CLI.EraBased.Script.Mint.Type Cardano.CLI.EraBased.Script.Proposal.Read @@ -434,6 +437,7 @@ test-suite cardano-cli-test Test.Cli.Transaction.AccountBalanceInterval Test.Cli.Transaction.Build Test.Cli.Transaction.DirectDeposit + Test.Cli.Transaction.Guard Test.Cli.Transaction.SubTransaction Test.Cli.VerificationKey diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs index 34484ebfa1..8a91837c5e 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs @@ -49,6 +49,7 @@ import Cardano.Ledger.Api.Tx qualified as L import Cardano.Ledger.BaseTypes (Exclusive (..), Inclusive (..)) import Cardano.Ledger.Core qualified as C import Cardano.Ledger.Credential (credKeyHash, credScriptHash) +import Cardano.Ledger.Dijkstra.Scripts qualified as Dijkstra import Cardano.Ledger.Dijkstra.TxBody qualified as L import Cardano.Ledger.Keys (coerceKeyRole) @@ -465,8 +466,8 @@ renderPurpose era purpose = case era of ] dijkstraView - :: Ledger.PlutusPurpose L.AsIxItem ledgerEra -> Maybe Aeson.Value - dijkstraView _ = error "TODO Dijkstra" + :: Ledger.PlutusPurpose L.AsIxItem (Exp.LedgerEra DijkstraEra) -> Maybe Aeson.Value + dijkstraView p = labelPurpose "guarding script" . unAsIxItem <$> Dijkstra.toGuardingPurpose p renderScriptData :: ( L.AlonzoEraTxWits (Exp.LedgerEra era) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Guard/Option.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Guard/Option.hs new file mode 100644 index 0000000000..a29e3e3d61 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Guard/Option.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE GADTs #-} + +module Cardano.CLI.EraBased.Script.Guard.Option (pTxGuardArguments) where + +import Cardano.Api +import Cardano.Api.Experimental qualified as Exp + +import Cardano.CLI.EraBased.Common.Option +import Cardano.CLI.EraBased.Script.Guard.Type +import Cardano.CLI.Type.Common + +import Control.Applicative ((<|>)) +import Options.Applicative (Parser, many, optional) + +pTxGuardArguments :: Exp.Era era -> BalanceTxExecUnits -> Parser (TxGuardArguments era) +pTxGuardArguments Exp.ConwayEra _ = ConwayRequiredSignerArguments <$> many pRequiredSigner +pTxGuardArguments Exp.DijkstraEra balance = + DijkstraGuardArguments <$> many ((KeyGuard <$> pRequiredSigner) <|> pScriptGuard balance) + +pScriptGuard :: BalanceTxExecUnits -> Parser Guard +pScriptGuard balance = + ScriptGuard + <$> ( GuardScriptOnDisk + <$> pScriptFor + "guard-script-file" + Nothing + "Native or Plutus V4 script whose approval this transaction requires. Plutus guards require a redeemer; native guards accept neither redeemers nor execution units." + <|> GuardScriptReference + <$> pReferenceTxIn "guard-" "native or Plutus V4" + <*> pScriptHash + "guard-script-hash" + "Hash of the guard script at the preceding reference input. Supply a redeemer for Plutus V4; omit it for a native script." + ) + <*> optional + ( (,) + <$> pScriptDataOrFile + "guard-redeemer" + "Redeemer for the preceding Plutus V4 guard." + "Redeemer file for the preceding Plutus V4 guard." + <*> case balance of + AutoBalance -> pure (ExecutionUnits 0 0) + ManualBalance -> pExecutionUnits "guard" + ) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Guard/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Guard/Read.hs new file mode 100644 index 0000000000..10a0ebc2cd --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Guard/Read.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.CLI.EraBased.Script.Guard.Read + ( readConwayRequiredSigners + , readDijkstraGuards + , getTxGuardReferenceInputs + ) +where + +import Cardano.Api +import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as P +import Cardano.Api.Ledger qualified as L + +import Cardano.CLI.Compatible.Exception +import Cardano.CLI.EraBased.Script.Guard.Type +import Cardano.CLI.EraBased.Script.Read.Common (readScriptDataOrFile) +import Cardano.CLI.EraBased.Transaction.Internal.Common (findDuplicates) +import Cardano.CLI.Read +import Cardano.CLI.Type.Common (RequiredSigner) +import Cardano.CLI.Type.Error.TxCmdError +import Cardano.Ledger.Keys (coerceKeyRole) +import Cardano.Ledger.Plutus.Language qualified as L + +import Control.Monad (forM, unless) +import Data.Bifunctor (first) +import Data.Maybe (mapMaybe) +import Data.Set qualified as Set +import GHC.Exts (toList) + +-- | Conway retains the separate required-signers field in the transaction body. +readConwayRequiredSigners :: [RequiredSigner] -> CIO e [Hash PaymentKey] +readConwayRequiredSigners = mapM (fromEitherIOCli . readRequiredSigner) + +-- | Read both key and script guards into the API's unified collection. +-- The required-signer CLI flags supply key guards in Dijkstra. Their signatures +-- are added during signing; Nothing here means no script witness is attached. +readDijkstraGuards + :: [Guard] + -> CIO e (Exp.TxGuards (Exp.LedgerEra Exp.DijkstraEra)) +readDijkstraGuards guards = do + entries <- mapM readGuard guards + -- Preserve the existing order: scripts first, then sorted, distinct key guards. + -- Changing guard positions would change Plutus redeemer indices. + let scripts = [(credential, witness) | (credential@L.ScriptHashObj{}, witness) <- entries] + keys = Set.toAscList $ Set.fromList [credential | (credential@L.KeyHashObj{}, _) <- entries] + duplicates = findDuplicates (map fst scripts) + unless (null duplicates) $ throwCliError $ TxCmdDuplicateGuards duplicates + fromEitherCli $ first TxCmdGuardsError $ Exp.mkTxGuards (scripts ++ [(key, Nothing) | key <- keys]) + +getTxGuardReferenceInputs :: TxGuardRequirements era -> [TxIn] +getTxGuardReferenceInputs (ConwayRequiredSigners _) = [] +getTxGuardReferenceInputs (DijkstraGuards guards) = + mapMaybe (\(_, witness) -> witness >>= getGuardScriptReferenceInput) (toList guards) + +getGuardScriptReferenceInput :: Exp.ScriptGuardWitness era -> Maybe TxIn +getGuardScriptReferenceInput (Exp.NativeGuardWitness (Exp.SReferenceScript input)) = Just input +getGuardScriptReferenceInput (Exp.NativeGuardWitness (Exp.SScript _)) = Nothing +getGuardScriptReferenceInput (Exp.PlutusGuardWitness (P.PlutusScriptWitness _ source _ _ _)) = + case source of + P.PReferenceScript input -> Just input + P.PScript _ -> Nothing + +readGuard + :: Guard + -> CIO e (L.Credential L.Guard, Maybe (Exp.ScriptGuardWitness (Exp.LedgerEra Exp.DijkstraEra))) +readGuard (KeyGuard signer) = do + PaymentKeyHash key <- fromEitherIOCli $ readRequiredSigner signer + pure (L.KeyHashObj (coerceKeyRole key), Nothing) +readGuard (ScriptGuard source mRedeemer) = do + (credential, witness) <- readScriptGuard + pure (credential, Just witness) + where + readScriptGuard = do + redeemer <- forM mRedeemer $ \(datum, units) -> do + value <- fromExceptTCli $ readScriptDataOrFile datum + pure (value, units) + case source of + GuardScriptOnDisk (File path) -> do + script <- readAnyScript @_ @Exp.DijkstraEra path + case script of + Exp.AnySimpleScript native -> do + let credential = L.ScriptHashObj (Exp.hashSimpleScript native) + maybe + (pure (credential, Exp.NativeGuardWitness (Exp.SScript native))) + (const $ throwCliError $ TxCmdNativeGuardWithRedeemer credential) + redeemer + Exp.AnyPlutusScript scriptInEra -> + case P.plutusScriptInEraSLanguage scriptInEra of + L.SPlutusV1 -> throwCliError $ TxCmdTopLevelGuardUnsupportedPlutusLanguage path L.PlutusV1 + L.SPlutusV2 -> throwCliError $ TxCmdTopLevelGuardUnsupportedPlutusLanguage path L.PlutusV2 + L.SPlutusV3 -> throwCliError $ TxCmdTopLevelGuardUnsupportedPlutusLanguage path L.PlutusV3 + L.SPlutusV4 -> do + let credential = L.ScriptHashObj (P.hashPlutusScriptInEra scriptInEra) + maybe + (throwCliError $ TxCmdPlutusGuardMissingRedeemer credential) + (\(datum, units) -> pure (credential, plutusWitness (P.PScript scriptInEra) datum units)) + redeemer + GuardScriptReference input (ScriptHash scriptHash) -> + pure + ( L.ScriptHashObj scriptHash + , maybe + (Exp.NativeGuardWitness (Exp.SReferenceScript input)) + (uncurry $ plutusWitness (P.PReferenceScript input)) + redeemer + ) + plutusWitness + :: P.PlutusScriptOrReferenceInput L.PlutusV4 era + -> HashableScriptData + -> ExecutionUnits + -> Exp.ScriptGuardWitness era + plutusWitness scriptSource datum units = + Exp.PlutusGuardWitness $ + P.PlutusScriptWitness L.SPlutusV4 scriptSource P.NoScriptDatum datum units diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Guard/Type.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Guard/Type.hs new file mode 100644 index 0000000000..a21b325231 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Guard/Type.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} + +module Cardano.CLI.EraBased.Script.Guard.Type + ( Guard (..) + , GuardScriptSource (..) + , TxGuardArguments (..) + , TxGuardRequirements (..) + ) +where + +import Cardano.Api +import Cardano.Api.Experimental qualified as Exp + +import Cardano.CLI.Type.Common + +-- | The guard credential is derived from a file or supplied with a reference input. +data GuardScriptSource + = GuardScriptOnDisk ScriptFile + | GuardScriptReference TxIn ScriptHash + deriving Show + +-- | A Dijkstra guard supplied on the command line. Files are read before +-- constructing the API's unified 'Exp.TxGuards' collection. +data Guard + = KeyGuard RequiredSigner + | ScriptGuard GuardScriptSource (Maybe (ScriptDataOrFile, ExecutionUnits)) + deriving Show + +-- | Conway accepts required signers; Dijkstra accepts one list of key and script guards. +data TxGuardArguments era where + ConwayRequiredSignerArguments :: [RequiredSigner] -> TxGuardArguments Exp.ConwayEra + DijkstraGuardArguments :: [Guard] -> TxGuardArguments Exp.DijkstraEra + +deriving instance Show (TxGuardArguments era) + +-- | Resolved requirements passed to the transaction builders. Dijkstra keeps +-- key and script guards together in the API's validated collection. +data TxGuardRequirements era where + ConwayRequiredSigners :: [Hash PaymentKey] -> TxGuardRequirements Exp.ConwayEra + DijkstraGuards + :: Exp.TxGuards (Exp.LedgerEra Exp.DijkstraEra) + -> TxGuardRequirements Exp.DijkstraEra diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Command.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Command.hs index 0d1f31ac5e..13f9cf54b5 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Command.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Command.hs @@ -35,6 +35,7 @@ import Cardano.Api import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Ledger qualified as L +import Cardano.CLI.EraBased.Script.Guard.Type import Cardano.CLI.EraBased.Script.Type import Cardano.CLI.Orphan () import Cardano.CLI.Type.Common @@ -79,8 +80,8 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs -- ^ Return collateral , mTotalCollateral :: !(Maybe Coin) -- ^ Total collateral - , requiredSigners :: ![RequiredSigner] - -- ^ Required signers + , guardArguments :: !(TxGuardArguments era) + -- ^ Conway required signers or Dijkstra key and script guards. , txouts :: ![TxOutAnyEra] , mMintedAssets :: !(Maybe (L.MultiAsset, [AnyMintScript])) -- ^ Multi-Asset minted value with script witness @@ -141,8 +142,8 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs -- ^ Transaction inputs with optional spending scripts , readOnlyReferenceInputs :: ![TxIn] -- ^ Read only reference inputs - , requiredSigners :: ![RequiredSigner] - -- ^ Required signers + , guardArguments :: !(TxGuardArguments era) + -- ^ Conway required signers or Dijkstra key and script guards. , txinsc :: ![TxIn] -- ^ Transaction inputs for collateral, only key witnesses, no scripts. , mReturnCollateral :: !(Maybe TxOutShelleyBasedEra) @@ -194,8 +195,8 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs -- ^ Transaction inputs with optional spending scripts , readOnlyReferenceInputs :: ![TxIn] -- ^ Read only reference inputs - , requiredSigners :: ![RequiredSigner] - -- ^ Required signers + , guardArguments :: !(TxGuardArguments era) + -- ^ Conway required signers or Dijkstra key and script guards. , txinsc :: ![TxIn] -- ^ Transaction inputs for collateral, only key witnesses, no scripts. , mReturnCollateral :: !(Maybe TxOutShelleyBasedEra) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Option.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Option.hs index 7d6109f18c..b9443cde7b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Option.hs @@ -15,6 +15,7 @@ import Cardano.Api.Experimental qualified as Exp import Cardano.CLI.Environment (EnvCli (..)) import Cardano.CLI.EraBased.Common.Option +import Cardano.CLI.EraBased.Script.Guard.Option import Cardano.CLI.EraBased.Transaction.Command import Cardano.CLI.EraBased.Transaction.SubTransaction.Option import Cardano.CLI.Option.Flag @@ -204,7 +205,7 @@ pTransactionBuildCmd envCli = do <*> optional pWitnessOverride <*> some (pTxInForEra (Exp.useEra @era) AutoBalance) <*> many pReadOnlyReferenceTxIn - <*> many pRequiredSigner + <*> pTxGuardArguments (Exp.useEra @era) AutoBalance <*> many pTxInCollateral <*> optional pReturnCollateral <*> optional pTotalCollateral @@ -270,7 +271,7 @@ pTransactionBuildEstimateCmd _envCli = do <*> pTotalUTxOValue <*> some (pTxInForEra (Exp.useEra @era) ManualBalance) <*> many pReadOnlyReferenceTxIn - <*> many pRequiredSigner + <*> pTxGuardArguments (Exp.useEra @era) ManualBalance <*> many pTxInCollateral <*> optional pReturnCollateral <*> many pTxOut @@ -320,7 +321,7 @@ pTransactionBuildRaw = <*> many pTxInCollateral <*> optional pReturnCollateral <*> optional pTotalCollateral - <*> many pRequiredSigner + <*> pTxGuardArguments (Exp.useEra @era) ManualBalance <*> many pTxOut <*> (fmap join . optional $ pMintMultiAsset @era ManualBalance) <*> optional pInvalidBefore diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs index 92623a6a92..cc76346d86 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs @@ -48,6 +48,8 @@ import Cardano.Binary qualified as CBOR import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Genesis.Internal.Common (readProtocolParameters) import Cardano.CLI.EraBased.Script.Certificate.Read +import Cardano.CLI.EraBased.Script.Guard.Read +import Cardano.CLI.EraBased.Script.Guard.Type (TxGuardArguments (..), TxGuardRequirements (..)) import Cardano.CLI.EraBased.Script.Mint.Read import Cardano.CLI.EraBased.Script.Proposal.Read import Cardano.CLI.EraBased.Script.Read.Common @@ -138,7 +140,7 @@ runTransactionBuildCmd , mOverrideWitnesses = mOverrideWitnesses , txins , readOnlyReferenceInputs - , requiredSigners = reqSigners + , guardArguments , txinsc , mReturnCollateral = mReturnColl , mTotalCollateral @@ -162,6 +164,9 @@ runTransactionBuildCmd , isCborOutCanonical , buildOutputOptions } = do + guardRequirements <- case guardArguments of + ConwayRequiredSignerArguments signers -> ConwayRequiredSigners <$> readConwayRequiredSigners signers + DijkstraGuardArguments guards -> DijkstraGuards <$> readDijkstraGuards guards -- Reject duplicate deposits and interval assertions before any node queries. void $ fromEitherCli $ convertDirectDeposits directDeposits void $ @@ -211,8 +216,6 @@ runTransactionBuildCmd txAuxScripts <- fromEitherCli $ validateTxAuxScripts scripts - requiredSigners <- - mapM (fromEitherIOCli . readRequiredSigner) reqSigners mReturnCollateralAndDatums <- forM mReturnColl toTxOutInShelleyBasedEra let mReturnCollateral = fst <$> mReturnCollateralAndDatums @@ -281,7 +284,9 @@ runTransactionBuildCmd (map (\(_, _, wit) -> wit) withdrawalsAndMaybeScriptWits) (map snd votingProceduresAndMaybeScriptWits) (map snd proposals) - readOnlyReferenceInputs + ( readOnlyReferenceInputs + ++ getTxGuardReferenceInputs guardRequirements + ) let inputsThatRequireWitnessing = [input | (input, _) <- txins] allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ filteredTxinsc @@ -325,7 +330,7 @@ runTransactionBuildCmd directDeposits accountBalanceIntervals startingAccountBalanceIntervals - requiredSigners + guardRequirements txAuxScripts txMetadata mOverrideWitnesses @@ -400,7 +405,7 @@ runTransactionBuildEstimateCmd -- TODO change type , totalUTxOValue , txins , readOnlyReferenceInputs = readOnlyRefIns - , requiredSigners = reqSigners + , guardArguments , txinsc = txInsCollateral , mReturnCollateral = mReturnColl , txouts @@ -425,6 +430,9 @@ runTransactionBuildEstimateCmd -- TODO change type , isCborOutCanonical , txBodyOutFile } = do + guardRequirements <- case guardArguments of + ConwayRequiredSignerArguments signers -> ConwayRequiredSigners <$> readConwayRequiredSigners signers + DijkstraGuardArguments guards -> DijkstraGuards <$> readDijkstraGuards guards let sbe = convert currentEra ledgerPParams <- @@ -451,9 +459,6 @@ runTransactionBuildEstimateCmd -- TODO change type txAuxScripts <- fromEitherCli $ validateTxAuxScripts scripts - requiredSigners <- - mapM (fromEitherIOCli . readRequiredSigner) reqSigners - mReturnCollateralAndDatums <- mapM toTxOutInShelleyBasedEra mReturnColl let mReturnCollateral = fst <$> mReturnCollateralAndDatums returnCollDatums = maybe mempty snd mReturnCollateralAndDatums @@ -508,7 +513,7 @@ runTransactionBuildEstimateCmd -- TODO change type directDeposits accountBalanceIntervals startingAccountBalanceIntervals - requiredSigners + guardRequirements 0 txAuxScripts txMetadata @@ -614,7 +619,7 @@ runTransactionBuildRawCmd , txInsCollateral , mReturnCollateral = mReturnColl , mTotalCollateral - , requiredSigners = reqSigners + , guardArguments , txouts , mMintedAssets , mValidityLowerBound @@ -637,6 +642,9 @@ runTransactionBuildRawCmd , isCborOutCanonical , txBodyOutFile } = Exp.obtainCommonConstraints eon $ do + guardRequirements <- case guardArguments of + ConwayRequiredSignerArguments signers -> ConwayRequiredSigners <$> readConwayRequiredSigners signers + DijkstraGuardArguments guards -> DijkstraGuards <$> readDijkstraGuards guards signedSubTxs <- readSignedSubTransactions subTransactionFiles txInsAndMaybeScriptWits <- @@ -666,9 +674,6 @@ runTransactionBuildRawCmd let mLedgerPParams = LedgerProtocolParameters <$> pparams - requiredSigners <- - mapM (fromEitherIOCli . readRequiredSigner) reqSigners - mReturnCollateralAndDatums <- mapM toTxOutInShelleyBasedEra mReturnColl let mReturnCollateral = fst <$> mReturnCollateralAndDatums returnCollDatums = maybe mempty snd mReturnCollateralAndDatums @@ -717,7 +722,7 @@ runTransactionBuildRawCmd directDeposits accountBalanceIntervals startingAccountBalanceIntervals - requiredSigners + guardRequirements txAuxScripts txMetadata mLedgerPParams @@ -766,8 +771,8 @@ runTxBuildRaw -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace. -> [(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))] -> [(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))] - -> [Hash PaymentKey] - -- ^ Required signers + -> TxGuardRequirements era + -- ^ Conway required signers or Dijkstra key and script guards -> TxAuxScripts era -> TxMetadataInEra era -> Maybe (LedgerProtocolParameters era) @@ -796,7 +801,7 @@ runTxBuildRaw directDeposits accountBalanceIntervals startingAccountBalanceIntervals - reqSigners + guardRequirements txAuxScripts txMetadata mpparams @@ -824,7 +829,7 @@ runTxBuildRaw directDeposits accountBalanceIntervals startingAccountBalanceIntervals - reqSigners + guardRequirements fee txAuxScripts txMetadata @@ -836,6 +841,15 @@ runTxBuildRaw first TxCmdMakeUnsignedTxError $ Exp.makeUnsignedTx Exp.useEra txBodyContent +-- | Apply the era-specific requirements when constructing the transaction body. +setTxGuardRequirements + :: TxGuardRequirements era + -> Exp.TxBodyContent (Exp.LedgerEra era) + -> Exp.TxBodyContent (Exp.LedgerEra era) +setTxGuardRequirements (ConwayRequiredSigners keys) = + Exp.setTxExtraKeyWits (Exp.TxExtraKeyWitnesses keys) +setTxGuardRequirements (DijkstraGuards guards) = Exp.setTxGuards guards + constructTxBodyContent :: forall era . Exp.IsEra era @@ -869,8 +883,8 @@ constructTxBodyContent -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace. -> [(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))] -> [(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))] - -> [Hash PaymentKey] - -- ^ Required signers + -> TxGuardRequirements era + -- ^ Conway required signers or Dijkstra key and script guards -> Lovelace -- ^ Tx fee -> TxAuxScripts era @@ -903,7 +917,7 @@ constructTxBodyContent directDeposits accountBalanceIntervals startingAccountBalanceIntervals - reqSigners + guardRequirements fee txAuxScripts txMetadata @@ -921,7 +935,9 @@ constructTxBodyContent (map (\(_, _, mSwit) -> mSwit) withdrawals) (map snd votingProcedures) (map snd proposals) - readOnlyRefIns + ( readOnlyRefIns + ++ getTxGuardReferenceInputs guardRequirements + ) -- TODO The last argument of validateTxInsReference is a datum set from reference inputs -- Should we allow providing of datum from CLI? -- TODO: Figure how to expose resolved datums @@ -975,7 +991,7 @@ constructTxBodyContent & Exp.setTxDirectDeposits validatedDirectDeposits & Exp.setTxAccountBalanceIntervals validatedIntervals & Exp.setTxStartingAccountBalanceIntervals validatedStartingIntervals - & Exp.setTxExtraKeyWits (Exp.TxExtraKeyWitnesses reqSigners) + & setTxGuardRequirements guardRequirements & maybe id (Exp.setTxProtocolParams . Exp.obtainCommonConstraints (Exp.useEra @era)) mPparams & Exp.setTxCertificates (Exp.mkTxCertificates Exp.useEra certsAndMaybeScriptWits) @@ -1032,8 +1048,8 @@ runTxBuild -- ^ Direct ADA deposits as recipient stake addresses and amounts in lovelace. -> [(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))] -> [(StakeAddress, L.AccountBalanceInterval (Exp.LedgerEra era))] - -> [Hash PaymentKey] - -- ^ Required signers + -> TxGuardRequirements era + -- ^ Conway required signers or Dijkstra key and script guards -> TxAuxScripts era -> TxMetadataInEra era -> Maybe Word @@ -1064,7 +1080,7 @@ runTxBuild directDeposits accountBalanceIntervals startingAccountBalanceIntervals - reqSigners + guardRequirements txAuxScripts txMetadata mOverrideWits @@ -1087,7 +1103,9 @@ runTxBuild (map (\(_, _, wit) -> wit) withdrawals) (map snd votingProcedures) (map snd proposals) - readOnlyRefIns + ( readOnlyRefIns + ++ getTxGuardReferenceInputs guardRequirements + ) let allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ txinsc localNodeConnInfo = @@ -1135,7 +1153,7 @@ runTxBuild directDeposits accountBalanceIntervals startingAccountBalanceIntervals - reqSigners + guardRequirements 0 txAuxScripts txMetadata diff --git a/cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs index f94c493a25..b01269cd12 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs @@ -236,7 +236,7 @@ renderTxCmdError = \case TxCmdPlutusGuardMissingRedeemer credential -> "Plutus guard " <> pretty (L.credToText credential) - <> " requires --guard-redeemer-* and --guard-execution-units." + <> " requires --guard-redeemer-* and --guard-execution-units (transaction build calculates execution units automatically)." TxCmdNativeGuardWithRedeemer credential -> "Native script guard " <> pretty (L.credToText credential) diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli index 300da6da21..d9cb69ce1e 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -5528,6 +5528,16 @@ Usage: cardano-cli dijkstra transaction build-raw (--tx-in TX_IN [--tx-total-collateral INTEGER] [ --required-signer FILEPATH | --required-signer-hash HASH + | ( --guard-script-file FILEPATH + | --guard-tx-in-reference TX_IN + --guard-script-hash HASH + ) + [ + ( --guard-redeemer-cbor-file CBOR_FILE + | --guard-redeemer-file JSON_FILE + | --guard-redeemer-value JSON_VALUE + ) + --guard-execution-units (INT, INT)] ] [--tx-out ADDRESS VALUE [ --tx-out-datum-hash HASH @@ -5702,6 +5712,14 @@ Usage: cardano-cli dijkstra transaction build [--read-only-tx-in-reference TX_IN] [ --required-signer FILEPATH | --required-signer-hash HASH + | ( --guard-script-file FILEPATH + | --guard-tx-in-reference TX_IN + --guard-script-hash HASH + ) + [ --guard-redeemer-cbor-file CBOR_FILE + | --guard-redeemer-file JSON_FILE + | --guard-redeemer-value JSON_VALUE + ] ] [--tx-in-collateral TX_IN] [--tx-out-return-collateral ADDRESS VALUE] @@ -5862,6 +5880,16 @@ Usage: cardano-cli dijkstra transaction build-estimate --shelley-key-witnesses I [--read-only-tx-in-reference TX_IN] [ --required-signer FILEPATH | --required-signer-hash HASH + | ( --guard-script-file FILEPATH + | --guard-tx-in-reference TX_IN + --guard-script-hash HASH + ) + [ + ( --guard-redeemer-cbor-file CBOR_FILE + | --guard-redeemer-file JSON_FILE + | --guard-redeemer-value JSON_VALUE + ) + --guard-execution-units (INT, INT)] ] [--tx-in-collateral TX_IN] [--tx-out-return-collateral ADDRESS VALUE] diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/dijkstra_transaction_build-estimate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/dijkstra_transaction_build-estimate.cli index 038b1991e3..e182d57097 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/dijkstra_transaction_build-estimate.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/dijkstra_transaction_build-estimate.cli @@ -35,6 +35,16 @@ Usage: cardano-cli dijkstra transaction build-estimate --shelley-key-witnesses I [--read-only-tx-in-reference TX_IN] [ --required-signer FILEPATH | --required-signer-hash HASH + | ( --guard-script-file FILEPATH + | --guard-tx-in-reference TX_IN + --guard-script-hash HASH + ) + [ + ( --guard-redeemer-cbor-file CBOR_FILE + | --guard-redeemer-file JSON_FILE + | --guard-redeemer-value JSON_VALUE + ) + --guard-execution-units (INT, INT)] ] [--tx-in-collateral TX_IN] [--tx-out-return-collateral ADDRESS VALUE] @@ -258,6 +268,31 @@ Available options: --required-signer-hash HASH Hash of the verification key (zero or more) whose signature is required. + --guard-script-file FILEPATH + Native or Plutus V4 script whose approval this + transaction requires. Plutus guards require a + redeemer; native guards accept neither redeemers nor + execution units. + --guard-tx-in-reference TX_IN + TxId#TxIx - Specify a reference input. The reference + input must have a native or Plutus V4 reference + script attached. + --guard-script-hash HASH Hash of the guard script at the preceding reference + input. Supply a redeemer for Plutus V4; omit it for a + native script. + --guard-redeemer-cbor-file CBOR_FILE + Redeemer file for the preceding Plutus V4 guard. The + file has to be in CBOR format. + --guard-redeemer-file JSON_FILE + Redeemer file for the preceding Plutus V4 guard. The + file must follow the detailed JSON schema for script + data. + --guard-redeemer-value JSON_VALUE + Redeemer for the preceding Plutus V4 guard. There is + no schema: (almost) any JSON value is supported, + including top-level strings and numbers. + --guard-execution-units (INT, INT) + The time and space units needed by the script. --tx-in-collateral TX_IN TxId#TxIx --tx-out-return-collateral ADDRESS VALUE The transaction output as ADDRESS VALUE where ADDRESS diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/dijkstra_transaction_build-raw.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/dijkstra_transaction_build-raw.cli index 6211603119..f8087729ce 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/dijkstra_transaction_build-raw.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/dijkstra_transaction_build-raw.cli @@ -34,6 +34,16 @@ Usage: cardano-cli dijkstra transaction build-raw (--tx-in TX_IN [--tx-total-collateral INTEGER] [ --required-signer FILEPATH | --required-signer-hash HASH + | ( --guard-script-file FILEPATH + | --guard-tx-in-reference TX_IN + --guard-script-hash HASH + ) + [ + ( --guard-redeemer-cbor-file CBOR_FILE + | --guard-redeemer-file JSON_FILE + | --guard-redeemer-value JSON_VALUE + ) + --guard-execution-units (INT, INT)] ] [--tx-out ADDRESS VALUE [ --tx-out-datum-hash HASH @@ -257,6 +267,31 @@ Available options: --required-signer-hash HASH Hash of the verification key (zero or more) whose signature is required. + --guard-script-file FILEPATH + Native or Plutus V4 script whose approval this + transaction requires. Plutus guards require a + redeemer; native guards accept neither redeemers nor + execution units. + --guard-tx-in-reference TX_IN + TxId#TxIx - Specify a reference input. The reference + input must have a native or Plutus V4 reference + script attached. + --guard-script-hash HASH Hash of the guard script at the preceding reference + input. Supply a redeemer for Plutus V4; omit it for a + native script. + --guard-redeemer-cbor-file CBOR_FILE + Redeemer file for the preceding Plutus V4 guard. The + file has to be in CBOR format. + --guard-redeemer-file JSON_FILE + Redeemer file for the preceding Plutus V4 guard. The + file must follow the detailed JSON schema for script + data. + --guard-redeemer-value JSON_VALUE + Redeemer for the preceding Plutus V4 guard. There is + no schema: (almost) any JSON value is supported, + including top-level strings and numbers. + --guard-execution-units (INT, INT) + The time and space units needed by the script. --tx-out ADDRESS VALUE The transaction output as ADDRESS VALUE where ADDRESS is the Bech32-encoded address followed by the value in the multi-asset syntax (including simply diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/dijkstra_transaction_build.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/dijkstra_transaction_build.cli index 0474854bfb..bc2cc621f9 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/dijkstra_transaction_build.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/dijkstra_transaction_build.cli @@ -37,6 +37,14 @@ Usage: cardano-cli dijkstra transaction build [--read-only-tx-in-reference TX_IN] [ --required-signer FILEPATH | --required-signer-hash HASH + | ( --guard-script-file FILEPATH + | --guard-tx-in-reference TX_IN + --guard-script-hash HASH + ) + [ --guard-redeemer-cbor-file CBOR_FILE + | --guard-redeemer-file JSON_FILE + | --guard-redeemer-value JSON_VALUE + ] ] [--tx-in-collateral TX_IN] [--tx-out-return-collateral ADDRESS VALUE] @@ -246,6 +254,29 @@ Available options: --required-signer-hash HASH Hash of the verification key (zero or more) whose signature is required. + --guard-script-file FILEPATH + Native or Plutus V4 script whose approval this + transaction requires. Plutus guards require a + redeemer; native guards accept neither redeemers nor + execution units. + --guard-tx-in-reference TX_IN + TxId#TxIx - Specify a reference input. The reference + input must have a native or Plutus V4 reference + script attached. + --guard-script-hash HASH Hash of the guard script at the preceding reference + input. Supply a redeemer for Plutus V4; omit it for a + native script. + --guard-redeemer-cbor-file CBOR_FILE + Redeemer file for the preceding Plutus V4 guard. The + file has to be in CBOR format. + --guard-redeemer-file JSON_FILE + Redeemer file for the preceding Plutus V4 guard. The + file must follow the detailed JSON schema for script + data. + --guard-redeemer-value JSON_VALUE + Redeemer for the preceding Plutus V4 guard. There is + no schema: (almost) any JSON value is supported, + including top-level strings and numbers. --tx-in-collateral TX_IN TxId#TxIx --tx-out-return-collateral ADDRESS VALUE The transaction output as ADDRESS VALUE where ADDRESS diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Transaction/Guard.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Transaction/Guard.hs new file mode 100644 index 0000000000..db690362ac --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Transaction/Guard.hs @@ -0,0 +1,411 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module Test.Cli.Transaction.Guard where + +import Cardano.Api +import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Experimental.Tx qualified as Exp +import Cardano.Api.Ledger qualified as L + +import Cardano.Ledger.Coin qualified as L +import Cardano.Ledger.Core qualified as L +import Cardano.Ledger.Dijkstra.TxBody qualified as L +import Cardano.Ledger.Keys qualified as L +import Cardano.Ledger.Tools qualified as L +import Cardano.Slotting.EpochInfo qualified as Slotting +import Cardano.Slotting.Slot qualified as Slotting +import Cardano.Slotting.Time qualified as Slotting + +import Control.Monad (forM, forM_, replicateM, void) +import Data.Aeson qualified as Aeson +import Data.Foldable (toList) +import Data.List (isInfixOf) +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Text qualified as Text +import Data.Time.Clock.POSIX qualified as Time +import Lens.Micro ((&), (.~), (^.)) +import System.Exit (ExitCode (..)) + +import Test.Cardano.CLI.Util + +import Hedgehog (Property, (===)) +import Hedgehog qualified as H +import Hedgehog.Extras qualified as H +import Test.Cli.Transaction.SubTransaction + ( nativeScriptFile + , plutusScriptFile + , readDijkstraTransaction + , transactionArgs + , txIn + , txOut + , writeDijkstraProtocolParams + ) + +-- Required-signer flags remain compatible in Conway and become key guards in +-- Dijkstra. Repeating a key by file and hash must not create duplicate guards. +hprop_top_level_key_guards :: Property +hprop_top_level_key_guards = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + keyFile <- H.noteTempFile tempDir "payment.skey" + bodyFile <- H.noteTempFile tempDir "tx.body" + signedFile <- H.noteTempFile tempDir "tx.signed" + key <- H.evalIO $ generateSigningKey AsPaymentKey + H.evalEither =<< H.evalIO (writeFileTextEnvelope (File keyFile) Nothing key) + let keyHash@(PaymentKeyHash ledgerKeyHash) = verificationKeyHash $ getVerificationKey key + fileArgs = ["--required-signer", keyFile] + hashArgs = ["--required-signer-hash", Text.unpack $ serialiseToRawBytesHexText keyHash] + forM_ [fileArgs, hashArgs, fileArgs ++ hashArgs] $ \args -> do + void $ execCardanoCLI $ transactionArgs "conway" ++ args ++ ["--out-file", bodyFile] + ShelleyTx _ conway <- + H.evalEither + =<< H.evalIO + (readFileTextEnvelope (File bodyFile) :: IO (Either (FileError TextEnvelopeError) (Tx ConwayEra))) + -- Conway still stores the key in required signers, even when supplied twice. + conway ^. L.bodyTxL . L.reqSignerHashesTxBodyL === Set.singleton (L.coerceKeyRole ledgerKeyHash) + void $ execCardanoCLI $ transactionArgs "dijkstra" ++ args ++ ["--out-file", bodyFile] + ShelleyTx _ dijkstra <- readDijkstraTransaction bodyFile + -- Both CLI forms produce one key guard in the unified Dijkstra collection. + toList (dijkstra ^. L.bodyTxL . L.guardsTxBodyL) === [L.KeyHashObj (L.coerceKeyRole ledgerKeyHash)] + -- Building records the requirement; it must not add a signature yet. + dijkstra ^. L.witsTxL . L.addrTxWitsL === mempty + void $ + execCardanoCLI + [ "dijkstra" + , "transaction" + , "sign" + , "--tx-body-file" + , bodyFile + , "--signing-key-file" + , keyFile + , "--out-file" + , signedFile + ] + ShelleyTx _ signed <- readDijkstraTransaction signedFile + -- Normal transaction signing supplies the key witness required by the guard. + Set.size (signed ^. L.witsTxL . L.addrTxWitsL) === 1 + -- Adding that signature must preserve the body, including its guard requirement. + signed ^. L.bodyTxL === dijkstra ^. L.bodyTxL + +-- Native guards need no protocol parameters or Plutus witness data. +hprop_top_level_native_guard :: Property +hprop_top_level_native_guard = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + outFile <- H.noteTempFile tempDir "tx.body" + void $ + execCardanoCLI $ + transactionArgs "dijkstra" + ++ ["--guard-script-file", nativeScriptFile, "--out-file", outFile] + ShelleyTx _ tx <- readDijkstraTransaction outFile + -- The native guard credential must match the script included in the witnesses. + toList (tx ^. L.bodyTxL . L.guardsTxBodyL) + === map L.ScriptHashObj (Map.keys $ tx ^. L.witsTxL . L.scriptTxWitsL) + -- The one inline guard supplies exactly one script witness. + Map.size (tx ^. L.witsTxL . L.scriptTxWitsL) === 1 + -- Native guards do not require Plutus redeemers. + L.unRedeemers (tx ^. L.witsTxL . L.rdmrsTxWitsL) === mempty + +-- Index native guards too, keep spending/guarding redeemers separate, and +-- commit guard data to the script integrity hash before signing. +hprop_top_level_guard_redeemers :: Property +hprop_top_level_guard_redeemers = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + params <- H.noteTempFile tempDir "params.json" + first <- H.noteTempFile tempDir "first.body" + second <- H.noteTempFile tempDir "second.body" + H.evalIO $ writeDijkstraProtocolParams params + forM_ [(first, "42"), (second, "43")] $ \(outFile, value) -> + void $ + execCardanoCLI $ + transactionArgs "dijkstra" + ++ [ "--tx-in-script-file" + , plutusScriptFile 4 + , "--tx-in-redeemer-value" + , "0" + , "--tx-in-execution-units" + , "(1,2)" + , "--required-signer-hash" + , replicate 56 '0' + , "--guard-script-file" + , nativeScriptFile + , "--guard-script-file" + , plutusScriptFile 4 + , "--guard-redeemer-value" + , value + , "--guard-execution-units" + , "(3,4)" + , "--protocol-params-file" + , params + , "--out-file" + , outFile + ] + ShelleyTx _ tx <- readDijkstraTransaction first + ShelleyTx _ changed <- readDijkstraTransaction second + let redeemers = L.unRedeemers $ tx ^. L.witsTxL . L.rdmrsTxWitsL + datum = toAlonzoData . unsafeHashableScriptData . ScriptDataNumber + -- The spending redeemer retains its own purpose, index, data and budget. + Map.lookup (L.DijkstraSpending (L.AsIx 0)) redeemers + === Just (datum 0, toAlonzoExUnits $ ExecutionUnits 1 2) + -- The native guard occupies index 0, so the Plutus guard stays at index 1. + -- Appending the required key guard must not move either script guard. + Map.lookup (L.DijkstraGuarding (L.AsIx 1)) redeemers + === Just (datum 42, toAlonzoExUnits $ ExecutionUnits 3 4) + -- Only the spending input and the Plutus guard contribute redeemers. + Map.size redeemers === 2 + -- The unified collection contains the native, Plutus and required-key guards. + length (tx ^. L.bodyTxL . L.guardsTxBodyL) === 3 + -- Spending and guarding reuse one Plutus script, alongside the native script. + Map.size (tx ^. L.witsTxL . L.scriptTxWitsL) === 2 + H.assert $ + tx ^. L.bodyTxL . L.scriptIntegrityHashTxBodyL + /= changed ^. L.bodyTxL . L.scriptIntegrityHashTxBodyL + view <- execCardanoCLI ["debug", "transaction", "view", "--tx-file", first] + H.assertWith view ("guarding script" `isInfixOf`) + +-- Interleaved key and script options must preserve guard order and redeemer indices. +-- Repeating a key among scripts must still produce only one key guard. +hprop_top_level_mixed_guard_ordering :: Property +hprop_top_level_mixed_guard_ordering = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + params <- H.noteTempFile tempDir "params.json" + outFile <- H.noteTempFile tempDir "tx.body" + H.evalIO $ writeDijkstraProtocolParams params + let key = ["--required-signer-hash", replicate 56 '0'] + native = ["--guard-script-file", nativeScriptFile] + plutus = + [ "--guard-script-file" + , plutusScriptFile 4 + , "--guard-redeemer-value" + , "42" + , "--guard-execution-units" + , "(3,4)" + ] + transactions <- forM [key ++ native ++ plutus, native ++ key ++ plutus ++ key, native ++ plutus ++ key] $ \guards -> do + void $ + execCardanoCLI $ + transactionArgs "dijkstra" + ++ guards + ++ ["--protocol-params-file", params, "--out-file", outFile] + ShelleyTx _ tx <- readDijkstraTransaction outFile + length (tx ^. L.bodyTxL . L.guardsTxBodyL) === 3 + Map.lookup (L.DijkstraGuarding (L.AsIx 1)) (L.unRedeemers $ tx ^. L.witsTxL . L.rdmrsTxWitsL) + === Just + ( toAlonzoData $ unsafeHashableScriptData $ ScriptDataNumber 42 + , toAlonzoExUnits $ ExecutionUnits 3 4 + ) + pure tx + case transactions of + first : rest -> forM_ rest $ \tx -> do + tx ^. L.bodyTxL === first ^. L.bodyTxL + tx ^. L.witsTxL === first ^. L.witsTxL + [] -> H.failure + +-- Reference guards add their UTxO to reference inputs, with no inline script. +hprop_top_level_reference_guards :: Property +hprop_top_level_reference_guards = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + params <- H.noteTempFile tempDir "params.json" + outFile <- H.noteTempFile tempDir "tx.body" + H.evalIO $ writeDijkstraProtocolParams params + let reference = init txIn ++ "1" + input <- + H.evalEither $ + deserialiseFromRawBytesHex "63e6a9a8e58e48cc025cae04daaed9d36fc7b70bc292721d9f5057ae37b24981" + forM_ [[], ["--guard-redeemer-value", "42", "--guard-execution-units", "(3,4)"]] $ \redeemer -> do + void $ + execCardanoCLI $ + transactionArgs "dijkstra" + ++ ["--guard-tx-in-reference", reference, "--guard-script-hash", replicate 56 '0'] + ++ redeemer + ++ ["--protocol-params-file", params, "--out-file", outFile] + ShelleyTx _ tx <- readDijkstraTransaction outFile + -- The guard's reference input must be included in the transaction body. + tx ^. L.bodyTxL . L.referenceInputsTxBodyL === Set.singleton (toShelleyTxIn $ TxIn input (TxIx 1)) + -- Reference scripts must not also be embedded as inline witnesses. + Map.size (tx ^. L.witsTxL . L.scriptTxWitsL) === 0 + -- Either reference-script form contributes one guard credential. + length (tx ^. L.bodyTxL . L.guardsTxBodyL) === 1 + -- A native reference has no redeemer; the Plutus reference has exactly one. + Map.size (L.unRedeemers $ tx ^. L.witsTxL . L.rdmrsTxWitsL) === if null redeemer then 0 else 1 + +hprop_top_level_guard_rejects_invalid_witnesses :: Property +hprop_top_level_guard_rejects_invalid_witnesses = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + outFile <- H.noteTempFile tempDir "unused" + let budget = ["--guard-redeemer-value", "0", "--guard-execution-units", "(1,2)"] + cases = + [ ["--guard-script-file", plutusScriptFile 4] + , ["--guard-script-file", plutusScriptFile 4, "--guard-redeemer-value", "0"] + , ["--guard-script-file", nativeScriptFile] ++ budget + , ["--guard-script-file", nativeScriptFile, "--guard-script-file", nativeScriptFile] + ] + ++ [["--guard-script-file", plutusScriptFile v] ++ budget | v <- [1 .. 3]] + forM_ cases $ \args -> do + (code, _, _) <- execDetailCardanoCLI $ transactionArgs "dijkstra" ++ args ++ ["--out-file", outFile] + -- Reject missing Plutus data/budgets, native redeemers, duplicates and older scripts. + code === ExitFailure 1 + +hprop_top_level_guard_options :: Property +hprop_top_level_guard_options = watchdogProp . propertyOnce $ do + forM_ ["build", "build-raw", "build-estimate"] $ \command -> do + help <- execCardanoCLI ["dijkstra", "transaction", command, "--help"] + H.assertWith help ("--guard-script-file" `isInfixOf`) + H.assertWith help ("--guard-tx-in-reference" `isInfixOf`) + -- Online build computes budgets; raw and estimated builds require explicit units. + ("--guard-execution-units" `isInfixOf` help) === (command /= "build") + forM_ ["conway", "latest"] $ \era -> do + (code, _, stderr) <- + execDetailCardanoCLI [era, "transaction", command, "--guard-script-file", nativeScriptFile] + -- Conway and the current latest-era alias must reject Dijkstra guard flags. + code === ExitFailure 1 + H.assertWith stderr ("Invalid option `--guard-script-file'" `isInfixOf`) + +-- Online build validates witnesses before contacting the node, and accepts +-- a redeemer without an execution budget (which is calculated by the API). +hprop_top_level_guard_build_validation :: Property +hprop_top_level_guard_build_validation = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + outFile <- H.noteTempFile tempDir "unused" + socket <- H.noteTempFile tempDir "missing.socket" + forM_ [(nativeScriptFile, "does not accept a redeemer"), (plutusScriptFile 3, "must be Plutus V4")] $ \(script, message) -> do + (code, _, stderr) <- + execDetailCardanoCLI + [ "dijkstra" + , "transaction" + , "build" + , "--testnet-magic" + , "42" + , "--socket-path" + , socket + , "--tx-in" + , txIn + , "--change-address" + , takeWhile (/= '+') txOut + , "--guard-script-file" + , script + , "--guard-redeemer-value" + , "0" + , "--out-file" + , outFile + ] + -- Invalid guard witnesses must fail before attempting the missing node socket. + code === ExitFailure 1 + H.assertWith stderr (message `isInfixOf`) + +-- Offline balancing must preserve the guarding budget and charge for the +-- extra script/redeemer bytes, even without a script spending input. +hprop_top_level_guard_build_estimate :: Property +hprop_top_level_guard_build_estimate = watchdogProp . propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + paramsFile <- H.noteTempFile tempDir "params.json" + plainFile <- H.noteTempFile tempDir "plain.body" + guardFile <- H.noteTempFile tempDir "guard.body" + largerBudgetFile <- H.noteTempFile tempDir "larger-budget.body" + memoryPrice <- H.evalMaybe $ L.boundRational 2 + stepPrice <- H.evalMaybe $ L.boundRational 3 + let params = + (L.PParams L.emptyPParamsIdentity :: L.PParams (Exp.LedgerEra Exp.DijkstraEra)) + & L.ppMaxTxSizeL .~ 16384 + & L.ppTxFeePerByteL .~ L.CoinPerByte (L.CompactCoin 44) + & L.ppTxFeeFixedL .~ 155381 + & L.ppPricesL .~ L.Prices memoryPrice stepPrice + guardArgs budget = + [ "--guard-script-file" + , plutusScriptFile 4 + , "--guard-redeemer-value" + , "42" + , "--guard-execution-units" + , budget + ] + H.evalIO $ Aeson.encodeFile paramsFile params + forM_ + [ (plainFile, []) + , (guardFile, guardArgs "(3,4)") + , (largerBudgetFile, guardArgs "(6,8)") + ] + $ \(outFile, guards) -> + void $ + execCardanoCLI $ + [ "dijkstra" + , "transaction" + , "build-estimate" + , "--tx-in" + , txIn + , "--total-utxo-value" + , "100000000" + , "--shelley-key-witnesses" + , "1" + , "--protocol-params-file" + , paramsFile + , "--change-address" + , takeWhile (/= '+') txOut + , "--out-file" + , outFile + ] + ++ guards + ShelleyTx _ plain <- readDijkstraTransaction plainFile + ShelleyTx _ guarded <- readDijkstraTransaction guardFile + ShelleyTx _ largerBudget <- readDijkstraTransaction largerBudgetFile + H.assert $ guarded ^. L.bodyTxL . L.feeTxBodyL > plain ^. L.bodyTxL . L.feeTxBodyL + -- These budgets have equal CBOR sizes. Only execution costs change: + -- three extra steps at 3 lovelace and four extra memory units at 2 lovelace. + (largerBudget ^. L.bodyTxL . L.feeTxBodyL) - (guarded ^. L.bodyTxL . L.feeTxBodyL) === L.Coin 17 + let datum = toAlonzoData $ unsafeHashableScriptData $ ScriptDataNumber 42 + -- Fee estimation must retain the Plutus guard's redeemer and explicit budget. + Map.lookup (L.DijkstraGuarding (L.AsIx 0)) (L.unRedeemers $ guarded ^. L.witsTxL . L.rdmrsTxWitsL) + === Just (datum, toAlonzoExUnits $ ExecutionUnits 3 4) + Map.lookup + (L.DijkstraGuarding (L.AsIx 0)) + (L.unRedeemers $ largerBudget ^. L.witsTxL . L.rdmrsTxWitsL) + === Just (datum, toAlonzoExUnits $ ExecutionUnits 6 8) + +-- Like ordinary native reference scripts, reference guards use the explicit +-- witness override to account for signatures inside the referenced script. +hprop_top_level_native_reference_guard_witness_override :: Property +hprop_top_level_native_reference_guard_witness_override = watchdogProp . propertyOnce $ do + keys <- H.evalIO $ replicateM 3 $ generateSigningKey AsPaymentKey + address <- + H.evalMaybe $ + deserialiseAddress (AsAddressInEra AsDijkstraEra) $ + Text.pack $ + takeWhile (/= '+') txOut + inputId <- + H.evalEither $ + deserialiseFromRawBytesHex "63e6a9a8e58e48cc025cae04daaed9d36fc7b70bc292721d9f5057ae37b24981" + let input = TxIn inputId (TxIx 0) + reference = TxIn inputId (TxIx 1) + native = + toDijkstraNativeScript $ + RequireAllOf [RequireSignature (verificationKeyHash $ getVerificationKey key) | key <- keys] + credential = L.ScriptHashObj $ Exp.hashSimpleScript $ Exp.SimpleScript native + params = + (L.PParams L.emptyPParamsIdentity :: L.PParams (Exp.LedgerEra Exp.DijkstraEra)) + & L.ppProtocolVersionL .~ L.ProtVer (L.eraProtVerLow @(Exp.LedgerEra Exp.DijkstraEra)) 0 + & L.ppMaxTxSizeL .~ 16384 + & L.ppTxFeePerByteL .~ L.CoinPerByte (L.CompactCoin 44) + & L.ppTxFeeFixedL .~ 155381 + funding = L.mkBasicTxOut (toShelleyAddr address) (L.MaryValue (L.Coin 100000000) mempty) + referenceOutput = funding & L.referenceScriptTxOutL .~ L.SJust (L.fromNativeScript native) + utxo = + L.UTxO $ Map.fromList [(toShelleyTxIn input, funding), (toShelleyTxIn reference, referenceOutput)] + systemStart = SystemStart $ Time.posixSecondsToUTCTime 0 + epochInfo = LedgerEpochInfo $ Slotting.fixedEpochInfo (Slotting.EpochSize 100) (Slotting.mkSlotLength 1000) + guards <- + H.evalEither $ + Exp.mkTxGuards [(credential, Just $ Exp.NativeGuardWitness $ Exp.SReferenceScript reference)] + let body = + Exp.defaultTxBodyContent + & Exp.setTxIns [(input, Exp.AnyKeyWitnessPlaceholder)] + & Exp.setTxInsReference (Exp.TxInsReference [reference] Set.empty) + & Exp.setTxGuards guards + & Exp.setTxProtocolParams params + (Exp.UnsignedTx tx, balanced) <- + H.evalEither $ + Exp.makeTransactionBodyAutoBalance + systemStart + epochInfo + params + mempty + mempty + utxo + body + address + (Just 3) + H.assert $ tx ^. L.bodyTxL . L.feeTxBodyL >= L.calcMinFeeTx utxo params tx 3 + tx ^. L.witsTxL . L.scriptTxWitsL === mempty + tx ^. L.bodyTxL . L.referenceInputsTxBodyL === Set.singleton (toShelleyTxIn reference) + Exp.txGuards balanced === guards