From 8453b12b7f8600264137a789faf9a01f458dd430 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 20 Nov 2024 14:26:15 -0400 Subject: [PATCH] Review rename and refactor suggestions --- .../Cardano/CLI/EraBased/Options/Common.hs | 6 +-- .../Cardano/CLI/EraBased/Run/Transaction.hs | 10 ++-- cardano-cli/src/Cardano/CLI/Plutus/Minting.hs | 48 ++++++++--------- cardano-cli/src/Cardano/CLI/Read.hs | 51 ++++++++++++------- 4 files changed, 64 insertions(+), 51 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index 1a2364283..35aeaa702 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -2174,20 +2174,20 @@ pMintMultiAsset sbe balanceExecUnits = where pMintingScript :: Parser CliMintScriptRequirements pMintingScript = - createOnDiskSimpleOfPlutusScriptCliArgs + createSimpleOrPlutusScriptFromCliArgs <$> pMintScriptFile <*> optional (pPlutusMintScriptWitnessData sbe WitCtxMint balanceExecUnits) pSimpleReferenceMintingScriptWitness :: Parser CliMintScriptRequirements pSimpleReferenceMintingScriptWitness = - createOnDiskSimpleReferenceScriptCliArgs + createSimpleReferenceScriptFromCliArgs <$> pReferenceTxIn "simple-minting-script-" "simple" <*> pPolicyId pPlutusMintReferenceScriptWitnessFiles :: BalanceTxExecUnits -> Parser CliMintScriptRequirements pPlutusMintReferenceScriptWitnessFiles autoBalanceExecUnits = - createOnDiskPlutusReferenceScriptCliArgs + createPlutusReferenceScriptFromCliArgs <$> pReferenceTxIn "mint-" "plutus" <*> pPlutusScriptLanguage "mint-" <*> pScriptRedeemerOrFile "mint-reference-tx-in" diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 1636c738f..3940f377f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -762,7 +762,7 @@ runTxBuildRaw -- ^ Tx upper bound -> Lovelace -- ^ Tx fee - -> (Value, [MintScriptWitWithPolId era]) + -> (Value, [MintScriptWitnessWithPolicyId era]) -- ^ Multi-Asset value(s) -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -- ^ Certificate with potential script witness @@ -848,7 +848,7 @@ constructTxBodyContent -- ^ Tx lower bound -> TxValidityUpperBound era -- ^ Tx upper bound - -> (Value, [MintScriptWitWithPolId era]) + -> (Value, [MintScriptWitnessWithPolicyId era]) -- ^ Multi-Asset value(s) -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -- ^ Certificate with potential script witness @@ -988,7 +988,7 @@ runTxBuild -- ^ Normal outputs -> TxOutChangeAddress -- ^ A change output - -> (Value, [MintScriptWitWithPolId era]) + -> (Value, [MintScriptWitnessWithPolicyId era]) -- ^ Multi-Asset value(s) -> Maybe SlotNo -- ^ Tx lower bound @@ -1393,7 +1393,7 @@ toTxAlonzoDatum supp cliDatum = createTxMintValue :: forall era . ShelleyBasedEra era - -> (Value, [MintScriptWitWithPolId era]) + -> (Value, [MintScriptWitnessWithPolicyId era]) -> Either TxCmdError (TxMintValue BuildTx era) createTxMintValue era (val, scriptWitnesses) = if List.null (toList val) && List.null scriptWitnesses @@ -1408,7 +1408,7 @@ createTxMintValue era (val, scriptWitnesses) = fromList [pid | (AssetId pid _, _) <- toList val] let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era) - witnessesProvidedMap = fromList $ [(polid, sWit) | MintScriptWitWithPolId polid sWit <- scriptWitnesses] + witnessesProvidedMap = fromList $ [(polid, sWit) | MintScriptWitnessWithPolicyId polid sWit <- scriptWitnesses] witnessesProvidedSet = Map.keysSet witnessesProvidedMap -- Check not too many, nor too few: diff --git a/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs b/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs index aa51a3cb7..5e5edaf01 100644 --- a/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs +++ b/cardano-cli/src/Cardano/CLI/Plutus/Minting.hs @@ -5,10 +5,10 @@ module Cardano.CLI.Plutus.Minting ( CliMintScriptRequirements (..) - , MintScriptWitWithPolId (..) - , createOnDiskSimpleOfPlutusScriptCliArgs - , createOnDiskSimpleReferenceScriptCliArgs - , createOnDiskPlutusReferenceScriptCliArgs + , MintScriptWitnessWithPolicyId (..) + , createSimpleOrPlutusScriptFromCliArgs + , createSimpleReferenceScriptFromCliArgs + , createPlutusReferenceScriptFromCliArgs , CliScriptWitnessError , readMintScriptWitness ) @@ -23,13 +23,19 @@ import Cardano.CLI.Types.Common (ScriptDataOrFile) -- We always need the policy id when constructing a transaction that mints. -- In the case of reference scripts, the user currently must provide the policy id (script hash) -- in order to correctly construct the transaction. -data MintScriptWitWithPolId era - = MintScriptWitWithPolId +data MintScriptWitnessWithPolicyId era + = MintScriptWitnessWithPolicyId { mswPolId :: PolicyId , mswScriptWitness :: ScriptWitness WitCtxMint era } deriving Show +data CliMintScriptRequirements + = OnDiskSimpleOrPlutusScript OnDiskSimpleOrPlutusScriptCliArgs + | OnDiskSimpleRefScript SimpleRefScriptCliArgs + | OnDiskPlutusRefScript PlutusRefScriptCliArgs + deriving Show + data OnDiskSimpleOrPlutusScriptCliArgs = OnDiskSimpleScriptCliArgs (File ScriptInAnyLang In) @@ -39,13 +45,13 @@ data OnDiskSimpleOrPlutusScriptCliArgs ExecutionUnits deriving Show -createOnDiskSimpleOfPlutusScriptCliArgs +createSimpleOrPlutusScriptFromCliArgs :: File ScriptInAnyLang In -> Maybe (ScriptDataOrFile, ExecutionUnits) -> CliMintScriptRequirements -createOnDiskSimpleOfPlutusScriptCliArgs scriptFp Nothing = +createSimpleOrPlutusScriptFromCliArgs scriptFp Nothing = OnDiskSimpleOrPlutusScript $ OnDiskSimpleScriptCliArgs scriptFp -createOnDiskSimpleOfPlutusScriptCliArgs scriptFp (Just (redeemerFile, execUnits)) = +createSimpleOrPlutusScriptFromCliArgs scriptFp (Just (redeemerFile, execUnits)) = OnDiskSimpleOrPlutusScript $ OnDiskPlutusScriptCliArgs scriptFp redeemerFile execUnits data SimpleRefScriptCliArgs @@ -54,11 +60,11 @@ data SimpleRefScriptCliArgs PolicyId deriving Show -createOnDiskSimpleReferenceScriptCliArgs +createSimpleReferenceScriptFromCliArgs :: TxIn -> PolicyId -> CliMintScriptRequirements -createOnDiskSimpleReferenceScriptCliArgs txin polid = +createSimpleReferenceScriptFromCliArgs txin polid = OnDiskSimpleRefScript $ SimpleRefScriptCliArgs txin polid data PlutusRefScriptCliArgs @@ -70,22 +76,16 @@ data PlutusRefScriptCliArgs PolicyId deriving Show -createOnDiskPlutusReferenceScriptCliArgs +createPlutusReferenceScriptFromCliArgs :: TxIn -> AnyPlutusScriptVersion -> ScriptDataOrFile -> ExecutionUnits -> PolicyId -> CliMintScriptRequirements -createOnDiskPlutusReferenceScriptCliArgs txin scriptVersion scriptData execUnits polid = +createPlutusReferenceScriptFromCliArgs txin scriptVersion scriptData execUnits polid = OnDiskPlutusRefScript $ PlutusRefScriptCliArgs txin scriptVersion scriptData execUnits polid -data CliMintScriptRequirements - = OnDiskSimpleOrPlutusScript OnDiskSimpleOrPlutusScriptCliArgs - | OnDiskSimpleRefScript SimpleRefScriptCliArgs - | OnDiskPlutusRefScript PlutusRefScriptCliArgs - deriving Show - data CliScriptWitnessError = SimpleScriptWitnessDecodeError ScriptDecodeError | PlutusScriptWitnessDecodeError PlutusScriptDecodeError @@ -104,7 +104,7 @@ instance Error CliScriptWitnessError where readMintScriptWitness :: MonadIOTransError (FileError CliScriptWitnessError) t m - => ShelleyBasedEra era -> CliMintScriptRequirements -> t m (MintScriptWitWithPolId era) + => ShelleyBasedEra era -> CliMintScriptRequirements -> t m (MintScriptWitnessWithPolicyId era) readMintScriptWitness sbe (OnDiskSimpleOrPlutusScript simpleOrPlutus) = case simpleOrPlutus of OnDiskSimpleScriptCliArgs simpleFp -> do @@ -115,7 +115,7 @@ readMintScriptWitness sbe (OnDiskSimpleOrPlutusScript simpleOrPlutus) = SimpleScript ss -> do let polId = PolicyId $ hashScript s return $ - MintScriptWitWithPolId polId $ + MintScriptWitnessWithPolicyId polId $ SimpleScriptWitness (sbeToSimpleScriptLangInEra sbe) $ SScript ss OnDiskPlutusScriptCliArgs plutusScriptFp redeemerFile execUnits -> do @@ -142,7 +142,7 @@ readMintScriptWitness sbe (OnDiskSimpleOrPlutusScript simpleOrPlutus) = $ scriptLanguageSupportedInEra sbe $ PlutusScriptLanguage lang return $ - MintScriptWitWithPolId polId $ + MintScriptWitnessWithPolicyId polId $ PlutusScriptWitness sLangSupported lang @@ -152,7 +152,7 @@ readMintScriptWitness sbe (OnDiskSimpleOrPlutusScript simpleOrPlutus) = execUnits readMintScriptWitness sbe (OnDiskSimpleRefScript (SimpleRefScriptCliArgs refTxIn polId)) = return $ - MintScriptWitWithPolId polId $ + MintScriptWitnessWithPolicyId polId $ SimpleScriptWitness (sbeToSimpleScriptLangInEra sbe) (SReferenceScript refTxIn $ Just $ unPolicyId polId) @@ -181,7 +181,7 @@ readMintScriptWitness $ scriptLanguageSupportedInEra sbe $ PlutusScriptLanguage lang return $ - MintScriptWitWithPolId polId $ + MintScriptWitnessWithPolicyId polId $ PlutusScriptWitness sLangSupported lang diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index d59d86ac2..22673eabd 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -634,6 +634,11 @@ data PlutusScriptDecodeError = PlutusScriptDecodeErrorUnknownVersion !Text | PlutusScriptJsonDecodeError !JsonDecodeError | PlutusScriptDecodeTextEnvelopeError !TextEnvelopeError + | PlutusScriptDecodeErrorVersionMismatch + !Text + -- ^ Script version + !AnyPlutusScriptVersion + -- ^ Attempted to decode with version instance Error PlutusScriptDecodeError where prettyError = \case @@ -643,30 +648,38 @@ instance Error PlutusScriptDecodeError where prettyError err PlutusScriptDecodeTextEnvelopeError err -> prettyError err + PlutusScriptDecodeErrorVersionMismatch version (AnyPlutusScriptVersion v) -> + "Version mismatch in code: script version that was read" + <> pretty version + <> " but tried to decode script version: " + <> pshow v deserialisePlutusScript :: BS.ByteString -> Either PlutusScriptDecodeError AnyPlutusScript -deserialisePlutusScript bs = - case deserialiseFromJSON AsTextEnvelope bs of - Left err -> Left $ PlutusScriptJsonDecodeError err - Right te -> - case teType te of - "PlutusScriptV1" -> - case deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion PlutusScriptV1)] te of - Left err -> Left (PlutusScriptDecodeTextEnvelopeError err) - Right script -> Right script - "PlutusScriptV2" -> - case deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion PlutusScriptV2)] te of - Left err -> Left (PlutusScriptDecodeTextEnvelopeError err) - Right script -> Right script - "PlutusScriptV3" -> - case deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion PlutusScriptV3)] te of - Left err -> Left (PlutusScriptDecodeTextEnvelopeError err) - Right script -> Right script - (TextEnvelopeType unknownScriptVersion) -> - Left . PlutusScriptDecodeErrorUnknownVersion $ Text.pack unknownScriptVersion +deserialisePlutusScript bs = do + te <- first PlutusScriptJsonDecodeError $ deserialiseFromJSON AsTextEnvelope bs + case teType te of + TextEnvelopeType s -> case s of + sVer@"PlutusScriptV1" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV1 te + sVer@"PlutusScriptV2" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV2 te + sVer@"PlutusScriptV3" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV3 te + unknownScriptVersion -> + Left . PlutusScriptDecodeErrorUnknownVersion $ Text.pack unknownScriptVersion where + deserialiseAnyPlutusScriptVersion + :: IsPlutusScriptLanguage lang + => String + -> PlutusScriptVersion lang + -> TextEnvelope + -> Either PlutusScriptDecodeError AnyPlutusScript + deserialiseAnyPlutusScriptVersion v lang tEnv = + if v == show lang + then case deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion lang)] tEnv of + Left err -> Left (PlutusScriptDecodeTextEnvelopeError err) + Right script -> Right script + else Left $ PlutusScriptDecodeErrorVersionMismatch (Text.pack v) (AnyPlutusScriptVersion lang) + teTypes :: AnyPlutusScriptVersion -> FromSomeType HasTextEnvelope AnyPlutusScript teTypes = \case