Merge pull request #971 from IntersectMBO/jordan/minting-script-witne…

…ss-refactor

Minting script witness refactor

cabal.project

@@ -14,7 +14,7 @@ repository cardano-haskell-packages
 -- you need to run if you change them
 index-state:
   , hackage.haskell.org 2024-10-11T15:49:11Z
-  , cardano-haskell-packages 2024-11-12T08:40:13Z
+  , cardano-haskell-packages 2024-11-20T20:05:41Z
 
 packages:
   cardano-cli

cardano-cli/cardano-cli.cabal

@@ -116,6 +116,8 @@ library
     Cardano.CLI.EraBased.Run.StakePool
     Cardano.CLI.EraBased.Run.TextView
     Cardano.CLI.EraBased.Run.Transaction
+    Cardano.CLI.EraBased.Script.Mint.Read
+    Cardano.CLI.EraBased.Script.Mint.Types
     Cardano.CLI.EraBased.Transaction.HashCheck
     Cardano.CLI.Helpers
     Cardano.CLI.IO.Lazy
@@ -170,10 +172,12 @@ library
     Cardano.CLI.Types.Errors.KeyCmdError
     Cardano.CLI.Types.Errors.NodeCmdError
     Cardano.CLI.Types.Errors.NodeEraMismatchError
+    Cardano.CLI.Types.Errors.PlutusScriptDecodeError
     Cardano.CLI.Types.Errors.ProtocolParamsError
     Cardano.CLI.Types.Errors.QueryCmdError
     Cardano.CLI.Types.Errors.QueryCmdLocalStateQueryError
     Cardano.CLI.Types.Errors.RegistrationError
+    Cardano.CLI.Types.Errors.ScriptDataError
     Cardano.CLI.Types.Errors.ScriptDecodeError
     Cardano.CLI.Types.Errors.StakeAddressCmdError
     Cardano.CLI.Types.Errors.StakeAddressDelegationError
@@ -203,7 +207,7 @@ library
     binary,
     bytestring,
     canonical-json,
-    cardano-api ^>=10.2,
+    cardano-api ^>=10.3,
     cardano-binary,
     cardano-crypto,
     cardano-crypto-class ^>=2.1.2,

cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs

@@ -270,18 +270,18 @@ readUpdateProposalFile
   :: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)
   -> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era)
 readUpdateProposalFile (Featured sToB Nothing) =
-  return $ NoPParamsUpdate $ shelleyToBabbageEraToShelleyBasedEra sToB
+  return $ NoPParamsUpdate $ inject sToB
 readUpdateProposalFile (Featured sToB (Just updateProposalFile)) = do
   prop <- firstExceptT CompatibleFileError $ readTxUpdateProposal sToB updateProposalFile
   case prop of
-    TxUpdateProposalNone -> return $ NoPParamsUpdate $ shelleyToBabbageEraToShelleyBasedEra sToB
+    TxUpdateProposalNone -> return $ NoPParamsUpdate $ inject sToB
     TxUpdateProposal _ proposal -> return $ ProtocolUpdate sToB proposal
 
 readProposalProcedureFile
   :: Featured ConwayEraOnwards era [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
   -> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era)
 readProposalProcedureFile (Featured cEraOnwards []) =
-  let sbe = conwayEraOnwardsToShelleyBasedEra cEraOnwards
+  let sbe = inject cEraOnwards
    in return $ NoPParamsUpdate sbe
 readProposalProcedureFile (Featured cEraOnwards proposals) = do
   props <-

cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs

@@ -25,6 +25,7 @@ import qualified Cardano.Api.Experimental as Exp
 import           Cardano.Api.Ledger (Coin)
 import           Cardano.Api.Shelley
 
+import           Cardano.CLI.EraBased.Script.Mint.Types
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Governance
 
@@ -61,7 +62,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
   , requiredSigners :: ![RequiredSigner]
   -- ^ Required signers
   , txouts :: ![TxOutAnyEra]
-  , mValue :: !(Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
+  , mValue :: !(Maybe (Value, [CliMintScriptRequirements]))
   -- ^ Multi-Asset value with script witness
   , mValidityLowerBound :: !(Maybe SlotNo)
   -- ^ Transaction validity lower bound
@@ -111,7 +112,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs
   -- ^ Normal outputs
   , changeAddresses :: !TxOutChangeAddress
   -- ^ A change output
-  , mValue :: !(Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
+  , mValue :: !(Maybe (Value, [CliMintScriptRequirements]))
   -- ^ Multi-Asset value with script witness
   , mValidityLowerBound :: !(Maybe SlotNo)
   -- ^ Transaction validity lower bound
@@ -157,7 +158,7 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs
   -- ^ Normal outputs
   , changeAddress :: !TxOutChangeAddress
   -- ^ A change output
-  , mValue :: !(Maybe (Value, [ScriptWitnessFiles WitCtxMint]))
+  , mValue :: !(Maybe (Value, [CliMintScriptRequirements]))
   -- ^ Multi-Asset value with script witness
   , mValidityLowerBound :: !(Maybe SlotNo)
   -- ^ Transaction validity lower bound

cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs

@@ -18,6 +18,7 @@ import qualified Cardano.Api.Network as Consensus
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.Environment (EnvCli (..), envCliAnyEon)
+import           Cardano.CLI.EraBased.Script.Mint.Types
 import           Cardano.CLI.Parser
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
@@ -1006,6 +1007,28 @@ pPollNonce =
 
 --------------------------------------------------------------------------------
 
+pMintScriptFile :: Parser (File ScriptInAnyLang In)
+pMintScriptFile =
+  pScriptFor
+    "mint-script-file"
+    (Just "minting-script-file")
+    "The file containing the script to witness the minting of assets for a particular policy Id."
+
+pPlutusMintScriptWitnessData
+  :: ShelleyBasedEra era
+  -> WitCtx witctx
+  -> BalanceTxExecUnits
+  -> Parser (ScriptDataOrFile, ExecutionUnits)
+pPlutusMintScriptWitnessData _sbe _witctx autoBalanceExecUnits =
+  let scriptFlagPrefix = "mint"
+   in ( (,)
+          <$> pScriptRedeemerOrFile scriptFlagPrefix
+          <*> ( case autoBalanceExecUnits of
+                  AutoBalance -> pure (ExecutionUnits 0 0)
+                  ManualBalance -> pExecutionUnits scriptFlagPrefix
+              )
+      )
+
 pScriptWitnessFiles
   :: forall witctx era
    . ShelleyBasedEra era
@@ -1516,7 +1539,6 @@ pPlutusStakeReferenceScriptWitnessFilesVotingProposing prefix autoBalanceExecUni
             AutoBalance -> pure (ExecutionUnits 0 0)
             ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in"
         )
-    <*> pure Nothing
 
 pPlutusStakeReferenceScriptWitnessFiles
   :: String
@@ -1533,15 +1555,16 @@ pPlutusStakeReferenceScriptWitnessFiles prefix autoBalanceExecUnits =
             AutoBalance -> pure (ExecutionUnits 0 0)
             ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in"
         )
-    <*> pure Nothing
 
-pPlutusScriptLanguage :: String -> Parser AnyScriptLanguage
+pPlutusScriptLanguage :: String -> Parser AnyPlutusScriptVersion
 pPlutusScriptLanguage prefix = plutusP prefix PlutusScriptV2 "v2" <|> plutusP prefix PlutusScriptV3 "v3"
 
-plutusP :: String -> PlutusScriptVersion lang -> String -> Parser AnyScriptLanguage
+plutusP
+  :: IsPlutusScriptLanguage lang
+  => String -> PlutusScriptVersion lang -> String -> Parser AnyPlutusScriptVersion
 plutusP prefix plutusVersion versionString =
   Opt.flag'
-    (AnyScriptLanguage $ PlutusScriptLanguage plutusVersion)
+    (AnyPlutusScriptVersion plutusVersion)
     ( Opt.long (prefix <> "plutus-script-" <> versionString)
         <> Opt.help ("Specify a plutus script " <> versionString <> " reference script.")
     )
@@ -1922,14 +1945,14 @@ pTxIn sbe balance =
       -> ScriptWitnessFiles WitCtxTxIn
     createSimpleReferenceScriptWitnessFiles refTxIn =
       let simpleLang = AnyScriptLanguage SimpleScriptLanguage
-       in SimpleReferenceScriptWitnessFiles refTxIn simpleLang Nothing
+       in SimpleReferenceScriptWitnessFiles refTxIn simpleLang
 
   pPlutusReferenceScriptWitness
     :: ShelleyBasedEra era -> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn)
   pPlutusReferenceScriptWitness sbe' autoBalanceExecUnits =
     caseShelleyToBabbageOrConwayEraOnwards
       ( const $
-          createPlutusReferenceScriptWitnessFiles
+          PlutusReferenceScriptWitnessFiles
             <$> pReferenceTxIn "spending-" "plutus"
             <*> pPlutusScriptLanguage "spending-"
             <*> pScriptDatumOrFile "spending-reference-tx-in" WitCtxTxIn
@@ -1940,7 +1963,7 @@ pTxIn sbe balance =
                 )
       )
       ( const $
-          createPlutusReferenceScriptWitnessFiles
+          PlutusReferenceScriptWitnessFiles
             <$> pReferenceTxIn "spending-" "plutus"
             <*> pPlutusScriptLanguage "spending-"
             <*> pScriptDatumOrFileCip69 "spending-reference-tx-in" WitCtxTxIn
@@ -1951,16 +1974,6 @@ pTxIn sbe balance =
                 )
       )
       sbe'
-   where
-    createPlutusReferenceScriptWitnessFiles
-      :: TxIn
-      -> AnyScriptLanguage
-      -> ScriptDatumOrFile WitCtxTxIn
-      -> ScriptRedeemerOrFile
-      -> ExecutionUnits
-      -> ScriptWitnessFiles WitCtxTxIn
-    createPlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits =
-      PlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits Nothing
 
   pEmbeddedPlutusScriptWitness :: Parser (ScriptWitnessFiles WitCtxTxIn)
   pEmbeddedPlutusScriptWitness =
@@ -2132,7 +2145,7 @@ pRefScriptFp =
 pMintMultiAsset
   :: ShelleyBasedEra era
   -> BalanceTxExecUnits
-  -> Parser (Value, [ScriptWitnessFiles WitCtxMint])
+  -> Parser (Value, [CliMintScriptRequirements])
 pMintMultiAsset sbe balanceExecUnits =
   (,)
     <$> Opt.option
@@ -2142,49 +2155,35 @@ pMintMultiAsset sbe balanceExecUnits =
           <> Opt.help helpText
       )
     <*> some
-      ( pMintingScriptOrReferenceScriptWit balanceExecUnits
+      ( pMintingScript
           <|> pSimpleReferenceMintingScriptWitness
           <|> pPlutusMintReferenceScriptWitnessFiles balanceExecUnits
       )
  where
-  pMintingScriptOrReferenceScriptWit
-    :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint)
-  pMintingScriptOrReferenceScriptWit bExecUnits =
-    pScriptWitnessFiles
-      sbe
-      WitCtxMint
-      bExecUnits
-      "mint"
-      (Just "minting")
-      "the minting of assets for a particular policy Id."
+  pMintingScript :: Parser CliMintScriptRequirements
+  pMintingScript =
+    createSimpleOrPlutusScriptFromCliArgs
+      <$> pMintScriptFile
+      <*> optional (pPlutusMintScriptWitnessData sbe WitCtxMint balanceExecUnits)
 
-  pSimpleReferenceMintingScriptWitness :: Parser (ScriptWitnessFiles WitCtxMint)
+  pSimpleReferenceMintingScriptWitness :: Parser CliMintScriptRequirements
   pSimpleReferenceMintingScriptWitness =
-    createSimpleMintingReferenceScriptWitnessFiles
+    createSimpleReferenceScriptFromCliArgs
       <$> pReferenceTxIn "simple-minting-script-" "simple"
       <*> pPolicyId
-   where
-    createSimpleMintingReferenceScriptWitnessFiles
-      :: TxIn
-      -> PolicyId
-      -> ScriptWitnessFiles WitCtxMint
-    createSimpleMintingReferenceScriptWitnessFiles refTxIn pid =
-      let simpleLang = AnyScriptLanguage SimpleScriptLanguage
-       in SimpleReferenceScriptWitnessFiles refTxIn simpleLang (Just pid)
 
   pPlutusMintReferenceScriptWitnessFiles
-    :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint)
+    :: BalanceTxExecUnits -> Parser CliMintScriptRequirements
   pPlutusMintReferenceScriptWitnessFiles autoBalanceExecUnits =
-    PlutusReferenceScriptWitnessFiles
+    createPlutusReferenceScriptFromCliArgs
       <$> pReferenceTxIn "mint-" "plutus"
       <*> pPlutusScriptLanguage "mint-"
-      <*> pure NoScriptDatumOrFileForMint
       <*> pScriptRedeemerOrFile "mint-reference-tx-in"
       <*> ( case autoBalanceExecUnits of
               AutoBalance -> pure (ExecutionUnits 0 0)
               ManualBalance -> pExecutionUnits "mint-reference-tx-in"
           )
-      <*> (Just <$> pPolicyId)
+      <*> pPolicyId
 
   helpText =
     mconcat

cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs

@@ -185,11 +185,11 @@ pUpdateProtocolParametersCmd
 pUpdateProtocolParametersCmd =
   caseShelleyToBabbageOrConwayEraOnwards
     ( \shelleyToBab ->
-        let sbe = shelleyToBabbageEraToShelleyBasedEra shelleyToBab
+        let sbe = inject shelleyToBab
          in subParser "create-protocol-parameters-update"
               $ Opt.info
                 ( Cmd.GovernanceActionProtocolParametersUpdateCmdArgs
-                    (shelleyToBabbageEraToShelleyBasedEra shelleyToBab)
+                    (inject shelleyToBab)
                     <$> fmap Just (pUpdateProtocolParametersPreConway shelleyToBab)
                     <*> pure Nothing
                     <*> dpGovActionProtocolParametersUpdate sbe
@@ -199,11 +199,11 @@ pUpdateProtocolParametersCmd =
               $ Opt.progDesc "Create a protocol parameters update."
     )
     ( \conwayOnwards ->
-        let sbe = conwayEraOnwardsToShelleyBasedEra conwayOnwards
+        let sbe = inject conwayOnwards
          in subParser "create-protocol-parameters-update"
               $ Opt.info
                 ( Cmd.GovernanceActionProtocolParametersUpdateCmdArgs
-                    (conwayEraOnwardsToShelleyBasedEra conwayOnwards)
+                    (inject conwayOnwards)
                     Nothing
                     <$> fmap Just (pUpdateProtocolParametersPostConway conwayOnwards)
                     <*> dpGovActionProtocolParametersUpdate sbe

cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs

@@ -678,7 +678,8 @@ pQueryTreasuryValueCmd era envCli = do
       <*> optional pOutputFile
 
 pQueryNoArgCmdArgs
-  :: ()
+  :: forall era
+   . ()
   => ConwayEraOnwards era
   -> EnvCli
   -> Parser (QueryNoArgCmdArgs era)
@@ -687,5 +688,5 @@ pQueryNoArgCmdArgs w envCli =
     <$> pSocketPath envCli
     <*> pConsensusModeParams
     <*> pNetworkId envCli
-    <*> pTarget (conwayEraOnwardsToShelleyBasedEra w)
+    <*> pTarget (inject w :: ShelleyBasedEra era)
     <*> optional pOutputFile

cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs

@@ -121,7 +121,7 @@ pStakeAddressDeregistrationCertificateCmd =
     ( \shelleyToBabbage ->
         subParser "deregistration-certificate"
           $ Opt.info
-            ( StakeAddressDeregistrationCertificateCmd (shelleyToBabbageEraToShelleyBasedEra shelleyToBabbage)
+            ( StakeAddressDeregistrationCertificateCmd (inject shelleyToBabbage)
                 <$> pStakeIdentifier Nothing
                 <*> pure Nothing
                 <*> pOutputFile
@@ -131,7 +131,7 @@ pStakeAddressDeregistrationCertificateCmd =
     ( \conwayOnwards ->
         subParser "deregistration-certificate"
           $ Opt.info
-            ( StakeAddressDeregistrationCertificateCmd (conwayEraOnwardsToShelleyBasedEra conwayOnwards)
+            ( StakeAddressDeregistrationCertificateCmd (inject conwayOnwards)
                 <$> pStakeIdentifier Nothing
                 <*> fmap Just pKeyRegistDeposit
                 <*> pOutputFile

cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs

@@ -227,7 +227,7 @@ pTransactionBuildEstimateCmd eon' _envCli = do
  where
   pCmd :: Exp.Era era -> Parser (TransactionCmds era)
   pCmd era' = do
-    let sbe = Exp.eraToSbe era'
+    let sbe = inject era'
     fmap TransactionBuildEstimateCmd $
       TransactionBuildEstimateCmdArgs era'
         <$> optional pScriptValidity