From 0633fcb5271a2f2b08bc17f094ba57f2dfb8ae0b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mateusz=20Go=C5=9Blinowski?= Date: Tue, 24 Sep 2024 16:02:01 +0200 Subject: [PATCH] Update cardano-cli to not use PReferenceScript/SReferenceScript ScriptHash field --- .../Cardano/CLI/EraBased/Run/Transaction.hs | 36 +++++------ cardano-cli/src/Cardano/CLI/Options/Debug.hs | 2 +- cardano-cli/src/Cardano/CLI/Read.hs | 60 +++++++++++-------- 3 files changed, 53 insertions(+), 45 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 6e16700432..2a82ffce1c 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -204,7 +204,7 @@ runTransactionBuildCmd let allReferenceInputs = getAllReferenceInputs inputsAndMaybeScriptWits - (snd valuesWithScriptWits) + (snd <$> snd valuesWithScriptWits) certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits votingProceduresAndMaybeScriptWits @@ -697,7 +697,7 @@ runTxBuildRaw -- ^ Tx upper bound -> Lovelace -- ^ Tx fee - -> (Value, [ScriptWitness WitCtxMint era]) + -> (Value, [(Maybe PolicyId, ScriptWitness WitCtxMint era)]) -- ^ Multi-Asset value(s) -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -- ^ Certificate with potential script witness @@ -783,7 +783,7 @@ constructTxBodyContent -- ^ Tx lower bound -> TxValidityUpperBound era -- ^ Tx upper bound - -> (Value, [ScriptWitness WitCtxMint era]) + -> (Value, [(Maybe PolicyId, ScriptWitness WitCtxMint era)]) -- ^ Multi-Asset value(s) -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -- ^ Certificate with potential script witness @@ -830,7 +830,7 @@ constructTxBodyContent let allReferenceInputs = getAllReferenceInputs inputsAndMaybeScriptWits - (snd valuesWithScriptWits) + (snd <$> snd valuesWithScriptWits) certsAndMaybeScriptWits withdrawals votingProcedures @@ -923,7 +923,7 @@ runTxBuild -- ^ Normal outputs -> TxOutChangeAddress -- ^ A change output - -> (Value, [ScriptWitness WitCtxMint era]) + -> (Value, [(Maybe PolicyId, ScriptWitness WitCtxMint era)]) -- ^ Multi-Asset value(s) -> Maybe SlotNo -- ^ Tx lower bound @@ -977,7 +977,7 @@ runTxBuild let allReferenceInputs = getAllReferenceInputs inputsAndMaybeScriptWits - (snd valuesWithScriptWits) + (snd <$> snd valuesWithScriptWits) certsAndMaybeScriptWits withdrawals votingProcedures @@ -1328,7 +1328,7 @@ toTxAlonzoDatum supp cliDatum = createTxMintValue :: forall era . ShelleyBasedEra era - -> (Value, [ScriptWitness WitCtxMint era]) + -> (Value, [(Maybe PolicyId, ScriptWitness WitCtxMint era)]) -> Either TxCmdError (TxMintValue BuildTx era) createTxMintValue era (val, scriptWitnesses) = if List.null (toList val) && List.null scriptWitnesses @@ -1354,11 +1354,11 @@ createTxMintValue era (val, scriptWitnesses) = era where gatherMintingWitnesses - :: [ScriptWitness WitCtxMint era] + :: [(Maybe PolicyId, ScriptWitness WitCtxMint era)] -> [(PolicyId, ScriptWitness WitCtxMint era)] gatherMintingWitnesses [] = [] - gatherMintingWitnesses (sWit : rest) = - case scriptWitnessPolicyId sWit of + gatherMintingWitnesses ((pid'm, sWit) : rest) = + case scriptWitnessPolicyId pid'm sWit of Nothing -> gatherMintingWitnesses rest Just pid -> (pid, sWit) : gatherMintingWitnesses rest @@ -1374,20 +1374,20 @@ createTxMintValue era (val, scriptWitnesses) = where witnessesExtra = Set.elems (witnessesProvided Set.\\ witnessesNeeded) -scriptWitnessPolicyId :: ScriptWitness witctx era -> Maybe PolicyId -scriptWitnessPolicyId (SimpleScriptWitness _ (SScript script)) = +scriptWitnessPolicyId :: Maybe PolicyId -> ScriptWitness witctx era -> Maybe PolicyId +scriptWitnessPolicyId _ (SimpleScriptWitness _ (SScript script)) = Just . scriptPolicyId $ SimpleScript script -scriptWitnessPolicyId (SimpleScriptWitness _ (SReferenceScript _ mPid)) = - PolicyId <$> mPid -scriptWitnessPolicyId (PlutusScriptWitness _ version (PScript script) _ _ _) = +scriptWitnessPolicyId mPid (SimpleScriptWitness _ SReferenceScript{}) = + mPid +scriptWitnessPolicyId _ (PlutusScriptWitness _ version (PScript script) _ _ _) = Just . scriptPolicyId $ PlutusScript version script -scriptWitnessPolicyId (PlutusScriptWitness _ _ (PReferenceScript _ mPid) _ _ _) = - PolicyId <$> mPid +scriptWitnessPolicyId mPid (PlutusScriptWitness _ _ PReferenceScript{} _ _ _) = + mPid readValueScriptWitnesses :: ShelleyBasedEra era -> (Value, [ScriptWitnessFiles WitCtxMint]) - -> ExceptT TxCmdError IO (Value, [ScriptWitness WitCtxMint era]) + -> ExceptT TxCmdError IO (Value, [(Maybe PolicyId, ScriptWitness WitCtxMint era)]) readValueScriptWitnesses era (v, sWitFiles) = do sWits <- mapM (firstExceptT TxCmdScriptWitnessError . readScriptWitness era) sWitFiles return (v, sWits) diff --git a/cardano-cli/src/Cardano/CLI/Options/Debug.hs b/cardano-cli/src/Cardano/CLI/Options/Debug.hs index a7ecbf9a3a..230fa0da2f 100644 --- a/cardano-cli/src/Cardano/CLI/Options/Debug.hs +++ b/cardano-cli/src/Cardano/CLI/Options/Debug.hs @@ -11,7 +11,7 @@ module Cardano.CLI.Options.Debug ) where -import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..), parseFilePath) +import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..), parseFilePath) import Cardano.CLI.Commands.Debug import Cardano.CLI.Commands.Debug.LogEpochState diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index 8ca249b1fa..87a0c0b865 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -264,7 +264,7 @@ readScriptWitnessFiles readScriptWitnessFiles era = mapM readSwitFile where readSwitFile (tIn, Just switFile) = do - sWit <- readScriptWitness era switFile + sWit <- snd <$> readScriptWitness era switFile return (tIn, Just sWit) readSwitFile (tIn, Nothing) = return (tIn, Nothing) @@ -275,14 +275,14 @@ readScriptWitnessFilesTuple readScriptWitnessFilesTuple era = mapM readSwitFile where readSwitFile (tIn, b, Just switFile) = do - sWit <- readScriptWitness era switFile + sWit <- snd <$> readScriptWitness era switFile return (tIn, b, Just sWit) readSwitFile (tIn, b, Nothing) = return (tIn, b, Nothing) readScriptWitness :: ShelleyBasedEra era -> ScriptWitnessFiles witctx - -> ExceptT ScriptWitnessError IO (ScriptWitness witctx era) + -> ExceptT ScriptWitnessError IO (Maybe PolicyId, ScriptWitness witctx era) readScriptWitness era (SimpleScriptWitnessFile (File scriptFile)) = do script@(ScriptInAnyLang lang _) <- firstExceptT ScriptWitnessErrorFile $ @@ -290,7 +290,7 @@ readScriptWitness era (SimpleScriptWitnessFile (File scriptFile)) = do ScriptInEra langInEra script' <- validateScriptSupportedInEra era script case script' of SimpleScript sscript -> - return . SimpleScriptWitness langInEra $ SScript sscript + return . (Nothing, ) . SimpleScriptWitness langInEra $ SScript sscript -- If the supplied cli flags were for a simple script (i.e. the user did -- not supply the datum, redeemer or ex units), but the script file turns -- out to be a valid plutus script, then we must fail. @@ -319,14 +319,16 @@ readScriptWitness redeemer <- firstExceptT ScriptWitnessErrorScriptData $ readScriptRedeemerOrFile redeemerOrFile - return $ - PlutusScriptWitness - langInEra - version - (PScript pscript) - datum - redeemer - execUnits + return + ( Nothing + , PlutusScriptWitness + langInEra + version + (PScript pscript) + datum + redeemer + execUnits + ) -- If the supplied cli flags were for a plutus script (i.e. the user did -- supply the datum, redeemer and ex units), but the script file turns @@ -367,14 +369,17 @@ readScriptWitness redeemer <- firstExceptT ScriptWitnessErrorScriptData $ readScriptRedeemerOrFile redeemerOrFile - return $ - PlutusScriptWitness - sLangInEra - version - (PReferenceScript refTxIn (unPolicyId <$> mPid)) - datum - redeemer - execUnits + return + ( mPid + , PlutusScriptWitness + sLangInEra + version + -- setting ScriptHash to Nothing as this field will be removed from PReferenceScript + (PReferenceScript refTxIn Nothing) + datum + redeemer + execUnits + ) Nothing -> left $ ScriptWitnessErrorScriptLanguageNotSupportedInEra anyScrLang (anyCardanoEra $ toCardanoEra era) @@ -398,8 +403,9 @@ readScriptWitness Just sLangInEra -> case languageOfScriptLanguageInEra sLangInEra of SimpleScriptLanguage -> - return . SimpleScriptWitness sLangInEra $ - SReferenceScript refTxIn (unPolicyId <$> mPid) + return . (mPid,) . SimpleScriptWitness sLangInEra $ + -- setting ScriptHash to Nothing as this field will be removed from SReferenceScript + SReferenceScript refTxIn Nothing PlutusScriptLanguage{} -> error "readScriptWitness: Should not be possible to specify a plutus script" Nothing -> @@ -917,8 +923,9 @@ readSingleVote w (voteFp, mScriptWitFiles) = do let sbe = conwayEraOnwardsToShelleyBasedEra w runExceptT $ do sWits <- - firstExceptT VoteErrorScriptWitness $ - mapM (readScriptWitness sbe) sWitFile + fmap (fmap snd) $ + firstExceptT VoteErrorScriptWitness $ + mapM (readScriptWitness sbe) sWitFile hoistEither $ (,sWits) <$> votProceds data ConstitutionError @@ -963,8 +970,9 @@ readProposal w (fp, mScriptWit) = do let sbe = conwayEraOnwardsToShelleyBasedEra w runExceptT $ do sWit <- - firstExceptT ProposalErrorScriptWitness $ - mapM (readScriptWitness sbe) sWitFile + fmap (fmap snd) $ + firstExceptT ProposalErrorScriptWitness $ + mapM (readScriptWitness sbe) sWitFile hoistEither $ (,sWit) <$> prop constitutionHashSourceToHash