Review rename and refactor suggestions

IntersectMBO · Nov 21, 2024 · 8453b12 · 8453b12
1 parent 34281ab
commit 8453b12
Show file tree

Hide file tree

Showing 4 changed files with 64 additions and 51 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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