Minting script witness refactor

cabal.project

@@ -57,3 +57,9 @@ write-ghc-environment-files: always
 -- IMPORTANT
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
+-- https://github.com/IntersectMBO/cardano-api/compare/master...jordan/is-plutus-language needed for contraint propagation
+source-repository-package
+    type: git
+    location: https://github.com/IntersectMBO/cardano-api.git
+    tag: ce28333ef641e77087f185a100ad0cb9ed555f45
+    subdir: cardano-api

cardano-cli/cardano-cli.cabal

@@ -135,6 +135,7 @@ library
     Cardano.CLI.Options.Key
     Cardano.CLI.Options.Node
     Cardano.CLI.Options.Ping
+    Cardano.CLI.Plutus.Minting
     Cardano.CLI.Orphans
     Cardano.CLI.Parser
     Cardano.CLI.Read

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.Plutus.Minting
 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

@@ -19,6 +19,7 @@ import           Cardano.Api.Shelley
 
 import           Cardano.CLI.Environment (EnvCli (..), envCliAnyEon)
 import           Cardano.CLI.Parser
+import           Cardano.CLI.Plutus.Minting
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Governance
@@ -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
@@ -1535,13 +1558,15 @@ pPlutusStakeReferenceScriptWitnessFiles prefix autoBalanceExecUnits =
         )
     <*> 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.")
     )
@@ -1954,7 +1979,7 @@ pTxIn sbe balance =
    where
     createPlutusReferenceScriptWitnessFiles
       :: TxIn
-      -> AnyScriptLanguage
+      -> AnyPlutusScriptVersion
       -> ScriptDatumOrFile WitCtxTxIn
       -> ScriptRedeemerOrFile
       -> ExecutionUnits
@@ -2132,7 +2157,7 @@ pRefScriptFp =
 pMintMultiAsset
   :: ShelleyBasedEra era
   -> BalanceTxExecUnits
-  -> Parser (Value, [ScriptWitnessFiles WitCtxMint])
+  -> Parser (Value, [CliMintScriptRequirements])
 pMintMultiAsset sbe balanceExecUnits =
   (,)
     <$> Opt.option
@@ -2142,49 +2167,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 =
+    createOnDiskSimpleOfPlutusScriptCliArgs
+      <$> pMintScriptFile
+      <*> optional (pPlutusMintScriptWitnessData sbe WitCtxMint balanceExecUnits)
 
-  pSimpleReferenceMintingScriptWitness :: Parser (ScriptWitnessFiles WitCtxMint)
+  pSimpleReferenceMintingScriptWitness :: Parser CliMintScriptRequirements
   pSimpleReferenceMintingScriptWitness =
-    createSimpleMintingReferenceScriptWitnessFiles
+    createOnDiskSimpleReferenceScriptCliArgs
       <$> 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
+    createOnDiskPlutusReferenceScriptCliArgs
       <$> 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/Run/Transaction.hs

@@ -49,6 +49,7 @@ import           Cardano.CLI.EraBased.Run.Genesis.Common (readProtocolParameters
 import           Cardano.CLI.EraBased.Run.Query
 import           Cardano.CLI.EraBased.Transaction.HashCheck (checkCertificateHashes,
                    checkProposalHashes, checkVotingProcedureHashes)
+import           Cardano.CLI.Plutus.Minting
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.BootstrapWitnessError
@@ -174,7 +175,9 @@ runTransactionBuildCmd
     txMetadata <-
       firstExceptT TxCmdMetadataError . newExceptT $
         readTxMetadata eon metadataSchema metadataFiles
-    valuesWithScriptWits <- readValueScriptWitnesses eon $ fromMaybe mempty mValue
+    let (mas, sWitFiles) = fromMaybe (mempty, mempty) mValue
+    usedToGetReferenceInputs <-
+      (mas,) <$> firstExceptT TxCmdCliScriptWitnessError (mapM (readMintScriptWitness eon) sWitFiles)
     scripts <-
       firstExceptT TxCmdScriptFileError $
         mapM (readFileScriptInAnyLang . unFile) scriptFiles
@@ -252,7 +255,7 @@ runTransactionBuildCmd
     let allReferenceInputs =
           getAllReferenceInputs
             inputsAndMaybeScriptWits
-            (snd valuesWithScriptWits)
+            (map mswScriptWitness $ snd usedToGetReferenceInputs)
             certsAndMaybeScriptWits
             withdrawalsAndMaybeScriptWits
             votingProceduresAndMaybeScriptWits
@@ -277,6 +280,8 @@ runTransactionBuildCmd
         & onLeft (left . TxCmdQueryConvenienceError . AcqFailure)
         & onLeft (left . TxCmdQueryConvenienceError)
 
+    valuesWithScriptWits <-
+      (mas,) <$> firstExceptT TxCmdCliScriptWitnessError (mapM (readMintScriptWitness eon) sWitFiles)
     let currentTreasuryValueAndDonation =
           case (treasuryDonation, unFeatured <$> featuredCurrentTreasuryValueM) of
             (Nothing, _) -> Nothing -- We shouldn't specify the treasury value when no donation is being done
@@ -407,7 +412,11 @@ runTransactionBuildEstimateCmd -- TODO change type
       firstExceptT TxCmdMetadataError
         . newExceptT
         $ readTxMetadata sbe metadataSchema metadataFiles
-    valuesWithScriptWits <- readValueScriptWitnesses sbe $ fromMaybe mempty mValue
+
+    let (mas, sWitFiles) = fromMaybe (mempty, mempty) mValue
+    valuesWithScriptWits <-
+      (mas,) <$> firstExceptT TxCmdCliScriptWitnessError (mapM (readMintScriptWitness sbe) sWitFiles)
+
     scripts <-
       firstExceptT TxCmdScriptFileError $
         mapM (readFileScriptInAnyLang . unFile) scriptFiles
@@ -641,7 +650,11 @@ runTransactionBuildRawCmd
       firstExceptT TxCmdMetadataError
         . newExceptT
         $ readTxMetadata eon metadataSchema metadataFiles
-    valuesWithScriptWits <- readValueScriptWitnesses eon $ fromMaybe mempty mValue
+
+    let (mas, sWitFiles) = fromMaybe (mempty, mempty) mValue
+    valuesWithScriptWits <-
+      (mas,) <$> firstExceptT TxCmdCliScriptWitnessError (mapM (readMintScriptWitness eon) sWitFiles)
+
     scripts <-
       firstExceptT TxCmdScriptFileError $
         mapM (readFileScriptInAnyLang . unFile) scriptFiles
@@ -745,7 +758,7 @@ runTxBuildRaw
   -- ^ Tx upper bound
   -> Lovelace
   -- ^ Tx fee
-  -> (Value, [ScriptWitness WitCtxMint era])
+  -> (Value, [MintScriptWitWithPolId era])
   -- ^ Multi-Asset value(s)
   -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
   -- ^ Certificate with potential script witness
@@ -831,7 +844,7 @@ constructTxBodyContent
   -- ^ Tx lower bound
   -> TxValidityUpperBound era
   -- ^ Tx upper bound
-  -> (Value, [ScriptWitness WitCtxMint era])
+  -> (Value, [MintScriptWitWithPolId era])
   -- ^ Multi-Asset value(s)
   -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
   -- ^ Certificate with potential script witness
@@ -878,7 +891,7 @@ constructTxBodyContent
       let allReferenceInputs =
             getAllReferenceInputs
               inputsAndMaybeScriptWits
-              (snd valuesWithScriptWits)
+              (map mswScriptWitness $ snd valuesWithScriptWits)
               certsAndMaybeScriptWits
               withdrawals
               votingProcedures
@@ -971,7 +984,7 @@ runTxBuild
   -- ^ Normal outputs
   -> TxOutChangeAddress
   -- ^ A change output
-  -> (Value, [ScriptWitness WitCtxMint era])
+  -> (Value, [MintScriptWitWithPolId era])
   -- ^ Multi-Asset value(s)
   -> Maybe SlotNo
   -- ^ Tx lower bound
@@ -1025,7 +1038,7 @@ runTxBuild
       let allReferenceInputs =
             getAllReferenceInputs
               inputsAndMaybeScriptWits
-              (snd valuesWithScriptWits)
+              (map mswScriptWitness $ snd valuesWithScriptWits)
               certsAndMaybeScriptWits
               withdrawals
               votingProcedures
@@ -1376,7 +1389,7 @@ toTxAlonzoDatum supp cliDatum =
 createTxMintValue
   :: forall era
    . ShelleyBasedEra era
-  -> (Value, [ScriptWitness WitCtxMint era])
+  -> (Value, [MintScriptWitWithPolId era])
   -> Either TxCmdError (TxMintValue BuildTx era)
 createTxMintValue era (val, scriptWitnesses) =
   if List.null (toList val) && List.null scriptWitnesses
@@ -1391,7 +1404,7 @@ createTxMintValue era (val, scriptWitnesses) =
                   fromList [pid | (AssetId pid _, _) <- toList val]
 
             let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
-                witnessesProvidedMap = fromList $ gatherMintingWitnesses scriptWitnesses
+                witnessesProvidedMap = fromList $ [(polid, sWit) | MintScriptWitWithPolId polid sWit <- scriptWitnesses]
                 witnessesProvidedSet = Map.keysSet witnessesProvidedMap
 
             -- Check not too many, nor too few:
@@ -1401,15 +1414,6 @@ createTxMintValue era (val, scriptWitnesses) =
         )
         era
  where
-  gatherMintingWitnesses
-    :: [ScriptWitness WitCtxMint era]
-    -> [(PolicyId, ScriptWitness WitCtxMint era)]
-  gatherMintingWitnesses [] = []
-  gatherMintingWitnesses (sWit : rest) =
-    case scriptWitnessPolicyId sWit of
-      Nothing -> gatherMintingWitnesses rest
-      Just pid -> (pid, sWit) : gatherMintingWitnesses rest
-
   validateAllWitnessesProvided witnessesNeeded witnessesProvided
     | null witnessesMissing = return ()
     | otherwise = Left (TxCmdPolicyIdsMissing witnessesMissing (toList witnessesProvided))
@@ -1422,24 +1426,6 @@ createTxMintValue era (val, scriptWitnesses) =
    where
     witnessesExtra = Set.elems (witnessesProvided Set.\\ witnessesNeeded)
 
-scriptWitnessPolicyId :: ScriptWitness witctx era -> Maybe PolicyId
-scriptWitnessPolicyId (SimpleScriptWitness _ (SScript script)) =
-  Just . scriptPolicyId $ SimpleScript script
-scriptWitnessPolicyId (SimpleScriptWitness _ (SReferenceScript _ mPid)) =
-  PolicyId <$> mPid
-scriptWitnessPolicyId (PlutusScriptWitness _ version (PScript script) _ _ _) =
-  Just . scriptPolicyId $ PlutusScript version script
-scriptWitnessPolicyId (PlutusScriptWitness _ _ (PReferenceScript _ mPid) _ _ _) =
-  PolicyId <$> mPid
-
-readValueScriptWitnesses
-  :: ShelleyBasedEra era
-  -> (Value, [ScriptWitnessFiles WitCtxMint])
-  -> ExceptT TxCmdError IO (Value, [ScriptWitness WitCtxMint era])
-readValueScriptWitnesses era (v, sWitFiles) = do
-  sWits <- mapM (firstExceptT TxCmdScriptWitnessError . readScriptWitness era) sWitFiles
-  return (v, sWits)
-
 -- ----------------------------------------------------------------------------
 -- Transaction signing
 --