Skip to content

Commit

Permalink
Merge pull request #822 from IntersectMBO/jordan/plutus-v3-fixes
Browse files Browse the repository at this point in the history
Plutus V3 script updates
  • Loading branch information
Jimbo4350 authored Jul 24, 2024
2 parents 43bfc78 + 7a4271a commit 897e437
Show file tree
Hide file tree
Showing 13 changed files with 542 additions and 158 deletions.
162 changes: 122 additions & 40 deletions cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1190,31 +1190,38 @@ pPollNonce =
--------------------------------------------------------------------------------

pScriptWitnessFiles
:: forall witctx
. WitCtx witctx
:: forall witctx era
. ShelleyBasedEra era
-> WitCtx witctx
-> BalanceTxExecUnits
-- ^ Use the @execution-units@ flag.
-> String
-- ^ Script flag prefix
-> Maybe String
-> String
-> Parser (ScriptWitnessFiles witctx)
pScriptWitnessFiles witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help =
pScriptWitnessFiles sbe witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefixDeprecated help =
toScriptWitnessFiles
<$> pScriptFor
(scriptFlagPrefix ++ "-script-file")
((++ "-script-file") <$> scriptFlagPrefixDeprecated)
("The file containing the script to witness " ++ help)
<*> optional
( (,,)
<$> pScriptDatumOrFile scriptFlagPrefix witctx
<$> cip69Modification sbe
<*> pScriptRedeemerOrFile scriptFlagPrefix
<*> ( case autoBalanceExecUnits of
AutoBalance -> pure (ExecutionUnits 0 0)
ManualBalance -> pExecutionUnits scriptFlagPrefix
)
)
where
cip69Modification :: ShelleyBasedEra era -> Parser (ScriptDatumOrFile witctx)
cip69Modification =
caseShelleyToBabbageOrConwayEraOnwards
(const $ pScriptDatumOrFile scriptFlagPrefix witctx)
(const $ pScriptDatumOrFileCip69 scriptFlagPrefix witctx)

toScriptWitnessFiles
:: ScriptFile
-> Maybe
Expand Down Expand Up @@ -1243,12 +1250,37 @@ pScriptRedeemerOrFile scriptFlagPrefix =
"The script redeemer value."
"The script redeemer file."

pScriptDatumOrFileCip69 :: String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx)
pScriptDatumOrFileCip69 scriptFlagPrefix witctx =
case witctx of
WitCtxTxIn ->
asum
[ ScriptDatumOrFileForTxIn
<$> optional
( pScriptDataOrFile
(scriptFlagPrefix ++ "-datum")
"The script datum."
"The script datum file."
)
, pInlineDatumPresent
]
WitCtxMint -> pure NoScriptDatumOrFileForMint
WitCtxStake -> pure NoScriptDatumOrFileForStake
where
pInlineDatumPresent :: Parser (ScriptDatumOrFile WitCtxTxIn)
pInlineDatumPresent =
flag' InlineDatumPresentAtTxIn $
mconcat
[ long (scriptFlagPrefix ++ "-inline-datum-present")
, Opt.help "Inline datum present at transaction input."
]

pScriptDatumOrFile :: String -> WitCtx witctx -> Parser (ScriptDatumOrFile witctx)
pScriptDatumOrFile scriptFlagPrefix witctx =
case witctx of
WitCtxTxIn ->
asum
[ ScriptDatumOrFileForTxIn
[ ScriptDatumOrFileForTxIn . Just
<$> pScriptDataOrFile
(scriptFlagPrefix ++ "-datum")
"The script datum."
Expand Down Expand Up @@ -1336,11 +1368,14 @@ pVoteFiles
pVoteFiles sbe bExUnits =
caseShelleyToBabbageOrConwayEraOnwards
(const $ pure [])
(const . many $ pVoteFile bExUnits)
(const . many $ pVoteFile sbe bExUnits)
sbe

pVoteFile :: BalanceTxExecUnits -> Parser (VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))
pVoteFile balExUnits =
pVoteFile
:: ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))
pVoteFile sbe balExUnits =
(,)
<$> pFileInDirection "vote-file" "Filepath of the vote."
<*> optional (pVoteScriptOrReferenceScriptWitness balExUnits)
Expand All @@ -1349,11 +1384,13 @@ pVoteFile balExUnits =
:: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pVoteScriptOrReferenceScriptWitness bExUnits =
pScriptWitnessFiles
sbe
WitCtxStake
bExUnits
"vote"
Nothing
"a vote"
<|> pPlutusStakeReferenceScriptWitnessFilesVotingProposing "vote-" balExUnits

pProposalFiles
:: ShelleyBasedEra era
Expand All @@ -1362,12 +1399,14 @@ pProposalFiles
pProposalFiles sbe balExUnits =
caseShelleyToBabbageOrConwayEraOnwards
(const $ pure [])
(const $ many (pProposalFile balExUnits))
(const $ many (pProposalFile sbe balExUnits))
sbe

pProposalFile
:: BalanceTxExecUnits -> Parser (ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))
pProposalFile balExUnits =
:: ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))
pProposalFile sbe balExUnits =
(,)
<$> pFileInDirection "proposal-file" "Filepath of the proposal."
<*> optional (pProposingScriptOrReferenceScriptWitness balExUnits)
Expand All @@ -1376,11 +1415,13 @@ pProposalFile balExUnits =
:: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pProposingScriptOrReferenceScriptWitness bExUnits =
pScriptWitnessFiles
sbe
WitCtxStake
bExUnits
"proposal"
Nothing
"a proposal"
<|> pPlutusStakeReferenceScriptWitnessFilesVotingProposing "proposal-" balExUnits

pCurrentTreasuryValueAndDonation
:: ShelleyBasedEra era -> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation))
Expand Down Expand Up @@ -1542,9 +1583,10 @@ pTxBuildOutputOptions =
)

pCertificateFile
:: BalanceTxExecUnits
:: ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))
pCertificateFile balanceExecUnits =
pCertificateFile sbe balanceExecUnits =
(,)
<$> ( fmap CertificateFile $
asum
Expand All @@ -1564,6 +1606,7 @@ pCertificateFile balanceExecUnits =
:: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxStake)
pCertifyingScriptOrReferenceScriptWit bExecUnits =
pScriptWitnessFiles
sbe
WitCtxStake
balanceExecUnits
"certificate"
Expand Down Expand Up @@ -1641,13 +1684,14 @@ pMetadataFile =
]

pWithdrawal
:: BalanceTxExecUnits
:: ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser
( StakeAddress
, L.Coin
, Maybe (ScriptWitnessFiles WitCtxStake)
)
pWithdrawal balance =
pWithdrawal sbe balance =
(\(stakeAddr, lovelace) maybeScriptFp -> (stakeAddr, lovelace, maybeScriptFp))
<$> Opt.option
(readerFromParsecParser parseWithdrawal)
Expand All @@ -1660,6 +1704,7 @@ pWithdrawal balance =
pWithdrawalScriptOrReferenceScriptWit :: Parser (ScriptWitnessFiles WitCtxStake)
pWithdrawalScriptOrReferenceScriptWit =
pScriptWitnessFiles
sbe
WitCtxStake
balance
"withdrawal"
Expand All @@ -1679,6 +1724,23 @@ pWithdrawal balance =
parseWithdrawal =
(,) <$> parseStakeAddress <* Parsec.char '+' <*> parseLovelace

pPlutusStakeReferenceScriptWitnessFilesVotingProposing
:: String
-> BalanceTxExecUnits
-- ^ Use the @execution-units@ flag.
-> Parser (ScriptWitnessFiles WitCtxStake)
pPlutusStakeReferenceScriptWitnessFilesVotingProposing prefix autoBalanceExecUnits =
PlutusReferenceScriptWitnessFiles
<$> pReferenceTxIn prefix "plutus"
<*> plutusP prefix PlutusScriptV3 "v3"
<*> pure NoScriptDatumOrFileForStake
<*> pScriptRedeemerOrFile (prefix ++ "reference-tx-in")
<*> ( case autoBalanceExecUnits of
AutoBalance -> pure (ExecutionUnits 0 0)
ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in"
)
<*> pure Nothing

pPlutusStakeReferenceScriptWitnessFiles
:: String
-> BalanceTxExecUnits
Expand All @@ -1697,15 +1759,15 @@ pPlutusStakeReferenceScriptWitnessFiles prefix autoBalanceExecUnits =
<*> pure Nothing

pPlutusScriptLanguage :: String -> Parser AnyScriptLanguage
pPlutusScriptLanguage prefix = plutusP PlutusScriptV2 "v2" <|> plutusP PlutusScriptV3 "v3"
where
plutusP :: PlutusScriptVersion lang -> String -> Parser AnyScriptLanguage
plutusP plutusVersion versionString =
Opt.flag'
(AnyScriptLanguage $ PlutusScriptLanguage plutusVersion)
( Opt.long (prefix <> "plutus-script-" <> versionString)
<> Opt.help ("Specify a plutus script " <> versionString <> " reference script.")
)
pPlutusScriptLanguage prefix = plutusP prefix PlutusScriptV2 "v2" <|> plutusP prefix PlutusScriptV3 "v3"

plutusP :: String -> PlutusScriptVersion lang -> String -> Parser AnyScriptLanguage
plutusP prefix plutusVersion versionString =
Opt.flag'
(AnyScriptLanguage $ PlutusScriptLanguage plutusVersion)
( Opt.long (prefix <> "plutus-script-" <> versionString)
<> Opt.help ("Specify a plutus script " <> versionString <> " reference script.")
)

pUpdateProposalFile :: Parser UpdateProposalFile
pUpdateProposalFile =
Expand Down Expand Up @@ -2141,9 +2203,10 @@ pTxSubmitFile =
]

pTxIn
:: BalanceTxExecUnits
:: ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))
pTxIn balance =
pTxIn sbe balance =
(,)
<$> Opt.option
(readerFromParsecParser parseTxIn)
Expand All @@ -2152,7 +2215,7 @@ pTxIn balance =
<> Opt.help "TxId#TxIx"
)
<*> optional
( pPlutusReferenceScriptWitness balance
( pPlutusReferenceScriptWitness sbe balance
<|> pSimpleReferenceSpendingScriptWitess
<|> pEmbeddedPlutusScriptWitness
)
Expand All @@ -2169,17 +2232,33 @@ pTxIn balance =
let simpleLang = AnyScriptLanguage SimpleScriptLanguage
in SimpleReferenceScriptWitnessFiles refTxIn simpleLang Nothing

pPlutusReferenceScriptWitness :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn)
pPlutusReferenceScriptWitness autoBalanceExecUnits =
createPlutusReferenceScriptWitnessFiles
<$> pReferenceTxIn "spending-" "plutus"
<*> 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"
)
pPlutusReferenceScriptWitness
:: ShelleyBasedEra era -> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn)
pPlutusReferenceScriptWitness sbe' autoBalanceExecUnits =
caseShelleyToBabbageOrConwayEraOnwards
( const $
createPlutusReferenceScriptWitnessFiles
<$> pReferenceTxIn "spending-" "plutus"
<*> 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"
)
)
( const $
createPlutusReferenceScriptWitnessFiles
<$> pReferenceTxIn "spending-" "plutus"
<*> pPlutusScriptLanguage "spending-"
<*> pScriptDatumOrFileCip69 "spending-reference-tx-in" WitCtxTxIn
<*> pScriptRedeemerOrFile "spending-reference-tx-in"
<*> ( case autoBalanceExecUnits of
AutoBalance -> pure (ExecutionUnits 0 0)
ManualBalance -> pExecutionUnits "spending-reference-tx-in"
)
)
sbe'
where
createPlutusReferenceScriptWitnessFiles
:: TxIn
Expand All @@ -2194,6 +2273,7 @@ pTxIn balance =
pEmbeddedPlutusScriptWitness :: Parser (ScriptWitnessFiles WitCtxTxIn)
pEmbeddedPlutusScriptWitness =
pScriptWitnessFiles
sbe
WitCtxTxIn
balance
"tx-in"
Expand Down Expand Up @@ -2363,9 +2443,10 @@ pRefScriptFp =
<|> pure ReferenceScriptAnyEraNone

pMintMultiAsset
:: BalanceTxExecUnits
:: ShelleyBasedEra era
-> BalanceTxExecUnits
-> Parser (Value, [ScriptWitnessFiles WitCtxMint])
pMintMultiAsset balanceExecUnits =
pMintMultiAsset sbe balanceExecUnits =
(,)
<$> Opt.option
(readerFromParsecParser parseValue)
Expand All @@ -2383,6 +2464,7 @@ pMintMultiAsset balanceExecUnits =
:: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint)
pMintingScriptOrReferenceScriptWit bExecUnits =
pScriptWitnessFiles
sbe
WitCtxMint
bExecUnits
"mint"
Expand Down
Loading

0 comments on commit 897e437

Please sign in to comment.