Merge #4034

4034: Wire up remaining Plutusv2 reference script types r=Jimbo4350 a=Jimbo4350

- [x] Withdrawal scripts
- [x] Minting scripts
- [x] Certifying scripts
- [x] Create example V2 scripts for each category above

Co-authored-by: Jordan Millar <jordan.millar@iohk.io>

cardano-api/src/Cardano/Api.hs

@@ -117,6 +117,7 @@ module Cardano.Api (
     AssetId(..),
     Value,
     parseValue,
+    policyId,
     selectAsset,
     valueFromList,
     valueToList,

cardano-api/src/Cardano/Api/Script.hs

@@ -728,13 +728,13 @@ data WitCtx witctx where
 -- or to mint tokens. This datatype encapsulates this concept.
 data PlutusScriptOrReferenceInput lang
   = PScript (PlutusScript lang)
-  | PReferenceScript TxIn
+  | PReferenceScript TxIn (Maybe ScriptHash)
   deriving (Eq, Show)
 
 
 data SimpleScriptOrReferenceInput lang
   = SScript (SimpleScript lang)
-  | SReferenceScript TxIn
+  | SReferenceScript TxIn (Maybe ScriptHash)
   deriving (Eq, Show)
 
 -- | A /use/ of a script within a transaction body to witness that something is
@@ -812,9 +812,9 @@ scriptWitnessScript (SimpleScriptWitness langInEra version (SScript script)) =
 scriptWitnessScript (PlutusScriptWitness langInEra version (PScript script) _ _ _) =
     Just $ ScriptInEra langInEra (PlutusScript version script)
 
-scriptWitnessScript (SimpleScriptWitness _ _ (SReferenceScript _)) =
+scriptWitnessScript (SimpleScriptWitness _ _ (SReferenceScript _ _)) =
     Nothing
-scriptWitnessScript (PlutusScriptWitness _ _ (PReferenceScript _) _ _ _) =
+scriptWitnessScript (PlutusScriptWitness _ _ (PReferenceScript _ _) _ _ _) =
     Nothing
 
 -- ----------------------------------------------------------------------------

cardano-api/src/Cardano/Api/Value.hs

@@ -144,7 +144,7 @@ quantityToLovelace :: Quantity -> Lovelace
 quantityToLovelace (Quantity x) = Lovelace x
 
 
-newtype PolicyId = PolicyId ScriptHash
+newtype PolicyId = PolicyId { unPolicyId :: ScriptHash }
   deriving stock (Eq, Ord)
   deriving (Show, IsString, ToJSON, FromJSON) via UsingRawBytesHex PolicyId
 

cardano-api/src/Cardano/Api/ValueParser.hs

@@ -1,6 +1,7 @@
 module Cardano.Api.ValueParser
   ( parseValue
   , assetName
+  , policyId
   ) where
 
 import           Prelude

cardano-cli/src/Cardano/CLI/Shelley/Output.hs

@@ -284,7 +284,7 @@ renderScriptCosts eUnitPrices scriptMapping executionCostMapping =
             Left err -> Left (PlutusScriptCostErrExecError sWitInd (Just scriptHash) err) : accum
         -- TODO: Create a new sum type to encapsulate the fact that we can also
         -- have a txin and render the txin in the case of reference scripts.
-        Just (AnyScriptWitness (PlutusScriptWitness _ _ (PReferenceScript _refTxIn) _ _ _)) ->
+        Just (AnyScriptWitness (PlutusScriptWitness _ _ (PReferenceScript _refTxIn _) _ _ _)) ->
           case eExecUnits of
             Right execUnits ->
               case calculateExecutionUnitsLovelace eUnitPrices execUnits of

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

@@ -229,74 +229,10 @@ pScriptFor name (Just deprecated) help =
         <> Opt.internal
         )
 
-pReferenceScriptWitnessFiles
-  :: WitCtx witctx
-  -> BalanceTxExecUnits -- ^ Use the @execution-units@ flag.
-  -> Parser (ScriptWitnessFiles witctx)
-pReferenceScriptWitnessFiles witctx autoBalanceExecUnits =
-   toReferenceScriptWitnessFiles
-     <$> pReferenceTxIn
-     <*> (simpleWit <|> pPWitness)
-
-
- where
-  pPWitness =
-    (,,,) <$> pPlutusScriptLanguage
-          <*> (Just <$> pScriptDatumOrFile "reference-tx-in" witctx)
-          <*> (Just <$> pScriptRedeemerOrFile "reference-tx-in")
-          <*> (case autoBalanceExecUnits of
-                AutoBalance -> pure $ Just (ExecutionUnits 0 0)
-                ManualBalance -> Just <$> pExecutionUnits "reference-tx-in")
-
-  simpleWit
-    :: Parser ( AnyScriptLanguage
-              , Maybe (ScriptDatumOrFile witctx)
-              , Maybe ScriptRedeemerOrFile
-              , Maybe ExecutionUnits
-              )
-  simpleWit =
-    (,,,) <$> pSimpleScriptLang
-          <*> pure Nothing
-          <*> pure Nothing
-          <*> pure Nothing
-
-  pPlutusScriptLanguage :: Parser AnyScriptLanguage
-  pPlutusScriptLanguage =
-    Opt.flag' (AnyScriptLanguage $ PlutusScriptLanguage PlutusScriptV2)
-      (  Opt.long "plutus-script-v2"
-      <> Opt.help "Specify a plutus script v2 reference script."
-      )
-
-  pSimpleScriptLang :: Parser AnyScriptLanguage
-  pSimpleScriptLang =
-    Opt.flag' (AnyScriptLanguage $ SimpleScriptLanguage SimpleScriptV2)
-      (  Opt.long "simple-script"
-      <> Opt.help "Specify a simple script reference script. \
-                  \See documentation at doc/reference/simple-scripts.md"
-      )
-
-  toReferenceScriptWitnessFiles
-    :: TxIn
-    -> ( AnyScriptLanguage
-       , Maybe (ScriptDatumOrFile witctx)
-       , Maybe ScriptRedeemerOrFile
-       , Maybe ExecutionUnits
-       )
-    -> ScriptWitnessFiles witctx
-  toReferenceScriptWitnessFiles txin (sLang, mD, mR, mE) =
-    case sLang of
-      AnyScriptLanguage (SimpleScriptLanguage _) ->
-        SimpleReferenceScriptWitnessFiles txin sLang
-      AnyScriptLanguage (PlutusScriptLanguage _) ->
-        case (mD, mR, mE) of
-          (Just d, Just r, Just e) -> PlutusReferenceScriptWitnessFiles txin sLang d r e
-          (_,_,_) -> panic "toReferenceScriptWitnessFiles: Should not be possible"
-
-
-pReferenceTxIn :: Parser TxIn
-pReferenceTxIn =
+pReferenceTxIn :: String ->  Parser TxIn
+pReferenceTxIn prefix =
   Opt.option (readerFromParsecParser parseTxIn)
-    (  Opt.long "tx-in-reference"
+    (  Opt.long (prefix ++ "tx-in-reference")
     <> Opt.metavar "TX-IN"
     <> Opt.help "TxId#TxIx - Specify a reference input. The reference input may or may not have\
                 \ a plutus reference script attached."
@@ -364,16 +300,16 @@ pScriptDatumOrFile scriptFlagPrefix witctx =
                        (scriptFlagPrefix ++ "-datum")
                        "The script datum, in JSON syntax."
                        "The script datum, in the given JSON file.") <|>
-                    pInlineDatumPresent scriptFlagPrefix
+                    pInlineDatumPresent
     WitCtxMint  -> pure NoScriptDatumOrFileForMint
     WitCtxStake -> pure NoScriptDatumOrFileForStake
-
-pInlineDatumPresent :: String -> Parser (ScriptDatumOrFile WitCtxTxIn)
-pInlineDatumPresent scriptFlagPrefix =
-  flag' InlineDatumPresentAtTxIn
-    (  long (scriptFlagPrefix ++ "-inline-datum-present")
-    <> Opt.help "Inline datum present at transaction input."
-    )
+ where
+  pInlineDatumPresent :: Parser (ScriptDatumOrFile WitCtxTxIn)
+  pInlineDatumPresent  =
+    flag' InlineDatumPresentAtTxIn
+      (  long (scriptFlagPrefix ++ "-inline-datum-present")
+      <> Opt.help "Inline datum present at transaction input."
+      )
 
 pScriptDataOrFile :: String -> String -> String -> Parser ScriptDataOrFile
 pScriptDataOrFile dataFlagPrefix helpTextForValue helpTextForFile =
@@ -1501,17 +1437,21 @@ pCertificateFile balanceExecUnits =
                      Opt.strOption (Opt.long "certificate" <> Opt.internal)
                   )
           )
-      <*> optional (pScriptWitnessFiles
-                      WitCtxStake
-                      balanceExecUnits
-                      "certificate" Nothing
-                      "the use of the certificate.")
+      <*> optional (pCertifyingScriptOrReferenceScriptWit balanceExecUnits)
  where
-   helpText = "Filepath of the certificate. This encompasses all \
-              \types of certificates (stake pool certificates, \
-              \stake key certificates etc). Optionally specify a script witness."
-
-
+  pCertifyingScriptOrReferenceScriptWit
+    :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
+  pCertifyingScriptOrReferenceScriptWit bExecUnits =
+    pScriptWitnessFiles
+     WitCtxStake
+     balanceExecUnits
+     "certificate" Nothing
+     "the use of the certificate." <|>
+    pPlutusStakeReferenceScriptWitnessFiles "certificate-" bExecUnits
+
+  helpText = "Filepath of the certificate. This encompasses all \
+             \types of certificates (stake pool certificates, \
+             \stake key certificates etc). Optionally specify a script witness."
 
 pPoolMetadataFile :: Parser PoolMetadataFile
 pPoolMetadataFile =
@@ -1578,21 +1518,47 @@ pWithdrawal balance =
             <> Opt.metavar "WITHDRAWAL"
             <> Opt.help helpText
             )
-      <*> optional (pScriptWitnessFiles
-                      WitCtxStake
-                      balance
-                      "withdrawal" Nothing
-                      "the withdrawal of rewards.")
+      <*> optional pWithdrawalScriptOrReferenceScriptWit
  where
-   helpText = "The reward withdrawal as StakeAddress+Lovelace where \
-              \StakeAddress is the Bech32-encoded stake address \
-              \followed by the amount in Lovelace. Optionally specify \
-              \a script witness."
-
-   parseWithdrawal :: Parsec.Parser (StakeAddress, Lovelace)
-   parseWithdrawal =
-     (,) <$> parseStakeAddress <* Parsec.char '+' <*> parseLovelace
-
+  pWithdrawalScriptOrReferenceScriptWit :: Parser (ScriptWitnessFiles WitCtxStake)
+  pWithdrawalScriptOrReferenceScriptWit =
+   pScriptWitnessFiles
+     WitCtxStake
+     balance
+     "withdrawal" Nothing
+     "the withdrawal of rewards." <|>
+   pPlutusStakeReferenceScriptWitnessFiles "withdrawal-" balance
+
+  helpText = "The reward withdrawal as StakeAddress+Lovelace where \
+             \StakeAddress is the Bech32-encoded stake address \
+             \followed by the amount in Lovelace. Optionally specify \
+             \a script witness."
+
+  parseWithdrawal :: Parsec.Parser (StakeAddress, Lovelace)
+  parseWithdrawal =
+    (,) <$> parseStakeAddress <* Parsec.char '+' <*> parseLovelace
+
+pPlutusStakeReferenceScriptWitnessFiles
+  :: String
+  -> BalanceTxExecUnits -- ^ Use the @execution-units@ flag.
+  -> Parser (ScriptWitnessFiles WitCtxStake)
+pPlutusStakeReferenceScriptWitnessFiles prefix autoBalanceExecUnits =
+  PlutusReferenceScriptWitnessFiles
+    <$> pReferenceTxIn prefix
+    <*> pPlutusScriptLanguage prefix
+    <*> pure NoScriptDatumOrFileForStake
+    <*> pScriptRedeemerOrFile (prefix ++ "reference-tx-in")
+    <*> (case autoBalanceExecUnits of
+          AutoBalance -> pure (ExecutionUnits 0 0)
+          ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in")
+    <*> pure Nothing
+
+pPlutusScriptLanguage :: String -> Parser AnyScriptLanguage
+pPlutusScriptLanguage prefix =
+  Opt.flag' (AnyScriptLanguage $ PlutusScriptLanguage PlutusScriptV2)
+    (  Opt.long (prefix ++ "plutus-script-v2")
+    <> Opt.help "Specify a plutus script v2 reference script."
+    )
 
 pUpdateProposalFile :: Parser UpdateProposalFile
 pUpdateProposalFile =
@@ -2109,15 +2075,51 @@ pTxIn balance =
                 <> Opt.metavar "TX-IN"
                <> Opt.help "TxId#TxIx"
                )
-         <*> optional pPlutusScriptOrReferenceInputWitness
+         <*> optional (pPlutusReferenceScriptWitness balance <|>
+                       pSimpleReferenceSpendingScriptWitess <|>
+                       pEmbeddedPlutusScriptWitness
+                       )
  where
-  pPlutusScriptOrReferenceInputWitness :: Parser (ScriptWitnessFiles WitCtxTxIn)
-  pPlutusScriptOrReferenceInputWitness =
-     pScriptWitnessFiles WitCtxTxIn balance
+  pSimpleReferenceSpendingScriptWitess :: Parser (ScriptWitnessFiles WitCtxTxIn)
+  pSimpleReferenceSpendingScriptWitess =
+    createSimpleReferenceScriptWitnessFiles
+      <$> pReferenceTxIn "simple-script-"
+   where
+    createSimpleReferenceScriptWitnessFiles
+      :: TxIn
+      -> ScriptWitnessFiles WitCtxTxIn
+    createSimpleReferenceScriptWitnessFiles refTxIn  =
+      let simpleLang = AnyScriptLanguage (SimpleScriptLanguage SimpleScriptV2)
+      in SimpleReferenceScriptWitnessFiles refTxIn simpleLang Nothing
+
+  pPlutusReferenceScriptWitness :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn)
+  pPlutusReferenceScriptWitness autoBalanceExecUnits =
+    createPlutusReferenceScriptWitnessFiles
+      <$> pReferenceTxIn "spending-"
+      <*> pPlutusScriptLanguage "spending-"
+      <*> pScriptDatumOrFile "spending-reference-tx-in" WitCtxTxIn
+      <*> pScriptRedeemerOrFile "spending-reference-tx-in"
+      <*> (case autoBalanceExecUnits of
+              AutoBalance -> pure (ExecutionUnits 0 0)
+              ManualBalance -> pExecutionUnits "spending-reference-tx-in")
+   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 =
+    pScriptWitnessFiles
+      WitCtxTxIn
+      balance
       "tx-in" (Just "txin")
-      "the spending of the transaction input." <|>
-     pReferenceScriptWitnessFiles WitCtxTxIn balance
-
+      "the spending of the transaction input."
 
 pTxInCollateral :: Parser TxIn
 pTxInCollateral =
@@ -2251,16 +2253,43 @@ pMintMultiAsset balanceExecUnits =
               <> Opt.metavar "VALUE"
               <> Opt.help helpText
               )
-      <*> some (pScriptWitnessFiles
-                  WitCtxMint
-                  balanceExecUnits
-                  "mint" (Just "minting")
-                  "the minting of assets for a particular policy Id."
-               )
+      <*> some (pMintingScriptOrReferenceScriptWit balanceExecUnits)
  where
+   pMintingScriptOrReferenceScriptWit
+     :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint)
+   pMintingScriptOrReferenceScriptWit bExecUnits =
+    pScriptWitnessFiles
+      WitCtxMint
+      balanceExecUnits
+      "mint" (Just "minting")
+      "the minting of assets for a particular policy Id." <|>
+    pPlutusMintReferenceScriptWitnessFiles bExecUnits
+
+   pPlutusMintReferenceScriptWitnessFiles
+     :: BalanceTxExecUnits ->  Parser (ScriptWitnessFiles WitCtxMint)
+   pPlutusMintReferenceScriptWitnessFiles autoBalanceExecUnits =
+    PlutusReferenceScriptWitnessFiles
+      <$> pReferenceTxIn "mint-"
+      <*> 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)
+
    helpText = "Mint multi-asset value(s) with the multi-asset cli syntax. \
                \You must specify a script witness."
 
+pPolicyId :: Parser PolicyId
+pPolicyId =
+  Opt.option (readerFromParsecParser policyId)
+     (  Opt.long "policy-id"
+     <> Opt.metavar "HASH"
+     <> Opt.help "Policy id of minting script."
+     )
+
+
 pInvalidBefore :: Parser SlotNo
 pInvalidBefore =
   SlotNo <$>