Merge pull request #428 from tweag/mm/redeemer

Homogeneous redeemers and reference scripts
tweag · Jul 3, 2024 · c291eb5 · c291eb5
2 parents 0d85443 + 7376cbc
commit c291eb5
Show file tree

Hide file tree

Showing 19 changed files with 242 additions and 159 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,5 +1,27 @@
 # Changelog
 
+## Unreleased
+
+### Added
+
+- `quickCurrencyPolicyV3` and `permanentCurrencyPolicyV3` which should be the
+  most commonly used.
+
+### Removed
+
+### Changed
+
+- Internal representation of redeemers have changed, and are similar for any
+  supported script purpose (minting, spending or proposing).
+- Redeemers should now be built using one of the four following smart
+  constructors: `txSkelSomeRedeemer`, `txSkelEmptyRedeemer`,
+  `txSkelSomeRedeemerAndReferenceScript`,
+  `txSkelEmptyRedeemerAndReferenceScript`.
+
+### Fixed
+
+- All kinds of scripts can now be used as reference scripts.
+
 ## [[4.0.0]](https://github.com/tweag/cooked-validators/releases/tag/v4.0.0) - 2024-06-28
 
 ### Added

diff --git a/doc/CHEATSHEET.md b/doc/CHEATSHEET.md
@@ -167,10 +167,10 @@ txSkelTemplate
 
 ### Spend some UTxOs
 
-* No redeemer: `TxSkelNoRedeemer`
-* With redeemer:
-    * Regular script: `TxSkelRedeemerForScript typedRedeemer`
-    * Reference script: `TxSkelRedeemerForReferencedScript txOutRefCarryingReferenceScript typedRedeemer`
+* No redeemer: `txSkelEmptyRedeemer`
+* With a given redeemer: `txSkelSomeRedeemer`
+* A redeemer and a reference script: `txSkelSomeRedeemerAndReferenceScript`
+* No redeemer but a reference script: `txSkelEmptyRedeemerAndReferenceScript`
 
 ```haskell
 txSkelTemplate
@@ -218,10 +218,13 @@ foo txOutRef = do
 
 ### Mint or burn tokens
 
-* No redeemer: `(Script.Versioned fooPolicy Script.PlutusV3, TxSkelNoRedeemer, "fooName", 3)`
-* With redeemer: `(Script.Versioned barPolicy Script.PlutusV3, TxSkelRedeemerForScript typedRedeemer, "barName", 12)`
-* With a reference script: `(Script.Versioned barPolicy Script.PlutusV3, TxSkelRedeemerForReferenceScript txOutRef typedRedeemer, "barName", 12)`
-* Burn tokens (negative amount): `(Script.Versioned bazPolicy Script.PlutusV3, ..., "bazName", -7)`
+* Mint tokens: positive amount
+* Burn tokens: negative amount
+
+* No redeemer: `(Script.Versioned fooPolicy Script.PlutusV3, txSkelEmptyRedeemer, "fooName", 3)`
+* With redeemer: `(Script.Versioned barPolicy Script.PlutusV3, txSkelSomeRedeemer typedRedeemer, "barName", -3)`
+* With a redeemer and reference script: `(Script.Versioned barPolicy Script.PlutusV3, txSkelSomeRedeemerAndReferenceScript txOutRef typedRedeemer, "barName", 12)`
+* With no redeemer but a reference scrip: `(Script.Versioned barPolicy Script.PlutusV3, txSkelEmptyRedeemerAndReferenceScript txOutRef, "fooName", -6)`
 
 ```haskell
 txSkelTemplate
@@ -293,7 +296,7 @@ txSkelTemplate
 ```haskell
 txSkelTemplate
   { ...
-    txSkelIns = Map.fromList [(scriptTxOutRefToSpend, TxSkelRedeemerForReferencedScript txOutRefCarryingReferenceScript redeemer), ...],
+    txSkelIns = Map.fromList [(scriptTxOutRefToSpend, txSkelSomeRedeemerForReferencedScript txOutRefCarryingReferenceScript redeemer), ...],
     ...
   }
 ```
@@ -446,7 +449,7 @@ foo = do
     bar `withTweak` ( do
                         addOutputTweak $ paysScript bazValidator bazDatum bazValue
                         removeOutputTweak (\(Pays out) -> somePredicate out)
-                        addInputTweak somePkTxOutRef C.TxSkelNoRedeemer
+                        addInputTweak somePkTxOutRef txSkelEmptyRedeemer
                         removeInputTweak (\txOutRef redeemer -> somePredicate txOutRef redeemer)
                     )
 ```

diff --git a/src/Cooked/Currencies.hs b/src/Cooked/Currencies.hs
@@ -23,8 +23,10 @@ module Cooked.Currencies
     permanentAssetClass,
     permanentValue,
     quickCurrencyPolicy,
+    quickCurrencyPolicyV3,
     quickCurrencySymbol,
     permanentCurrencyPolicy,
+    permanentCurrencyPolicyV3,
     permanentCurrencySymbol,
     currencySymbolFromLanguageAndMP,
   )
@@ -66,6 +68,9 @@ mkQuickCurrencyPolicy _ _ = True
 quickCurrencyPolicy :: Script.MintingPolicy
 quickCurrencyPolicy = Script.mkMintingPolicyScript $$(PlutusTx.compile [||Script.mkUntypedMintingPolicy mkQuickCurrencyPolicy||])
 
+quickCurrencyPolicyV3 :: Script.Versioned Script.MintingPolicy
+quickCurrencyPolicyV3 = Script.Versioned quickCurrencyPolicy Script.PlutusV3
+
 quickCurrencySymbol :: Script.CurrencySymbol
 quickCurrencySymbol = currencySymbolFromLanguageAndMP Script.PlutusV3 quickCurrencyPolicy
 
@@ -90,5 +95,8 @@ mkPermanentCurrencyPolicy _ _ = False
 permanentCurrencyPolicy :: Script.MintingPolicy
 permanentCurrencyPolicy = Script.mkMintingPolicyScript $$(PlutusTx.compile [||Script.mkUntypedMintingPolicy mkPermanentCurrencyPolicy||])
 
+permanentCurrencyPolicyV3 :: Script.Versioned Script.MintingPolicy
+permanentCurrencyPolicyV3 = Script.Versioned permanentCurrencyPolicy Script.PlutusV3
+
 permanentCurrencySymbol :: Script.CurrencySymbol
 permanentCurrencySymbol = currencySymbolFromLanguageAndMP Script.PlutusV3 permanentCurrencyPolicy
diff --git a/src/Cooked/MockChain/Balancing.hs b/src/Cooked/MockChain/Balancing.hs
@@ -325,5 +325,5 @@ computeBalancedTxSkel balancingWallet balancingUtxos txSkel@TxSkel {..} (lovelac
       -- a new output at the end of the list, to keep the order intact.
       (txOutRefs, val) <- getOptimalCandidate candidatesRaw balancingWallet balancingError
       return (txOutRefs, txSkelOuts ++ [paysPK balancingWallet val])
-  let newTxSkelIns = txSkelIns <> Map.fromList ((,TxSkelNoRedeemer) <$> additionalInsTxOutRefs)
+  let newTxSkelIns = txSkelIns <> Map.fromList ((,txSkelEmptyRedeemer) <$> additionalInsTxOutRefs)
   return $ (txSkel & txSkelOutsL .~ newTxSkelOuts) & txSkelInsL .~ newTxSkelIns
diff --git a/src/Cooked/MockChain/BlockChain.hs b/src/Cooked/MockChain/BlockChain.hs
@@ -77,7 +77,6 @@ import Data.Kind
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Maybe
-import Data.Set qualified as Set
 import Ledger.Index qualified as Ledger
 import Ledger.Slot qualified as Ledger
 import Ledger.Tx qualified as Ledger
@@ -319,8 +318,7 @@ txSkelReferenceInputUtxosPl :: (MonadBlockChainBalancing m) => TxSkel -> m (Map
 txSkelReferenceInputUtxosPl = (Map.map txOutV2FromLedger <$>) . txSkelReferenceInputUtxos
 
 txSkelReferenceInputUtxos :: (MonadBlockChainBalancing m) => TxSkel -> m (Map Api.TxOutRef Ledger.TxOut)
-txSkelReferenceInputUtxos TxSkel {..} =
-  lookupUtxos $ mapMaybe txSkelReferenceScript (Map.elems txSkelIns) ++ Set.toList txSkelInsReference
+txSkelReferenceInputUtxos = lookupUtxos . txSkelReferenceTxOutRefs
 
 -- | Retrieves the required deposit amount for issuing governance actions.
 govActionDeposit :: (MonadBlockChainBalancing m) => m Api.Lovelace

diff --git a/src/Cooked/MockChain/GenerateTx/Witness.hs b/src/Cooked/MockChain/GenerateTx/Witness.hs
@@ -43,44 +43,43 @@ toRewardAccount cred =
           (Ledger.toCardanoStakeKeyHash pubkeyHash)
       return $ Cardano.KeyHashObj pkHash
 
--- | Translates a serialised script and a redeemer to their Cardano
--- counterparts. They cannot be uncoupled because of the possible presence of a
--- reference script utxo in the redeemer.
-toScriptAndRedeemerData :: Api.SerialisedScript -> TxSkelRedeemer -> WitnessGen (Cardano.PlutusScriptOrReferenceInput lang, Cardano.HashableScriptData)
-toScriptAndRedeemerData script TxSkelNoRedeemer =
-  return (Cardano.PScript $ Cardano.PlutusScriptSerialised script, Ledger.toCardanoScriptData $ Api.toBuiltinData ())
-toScriptAndRedeemerData script (TxSkelRedeemerForScript redeemer) =
-  return (Cardano.PScript $ Cardano.PlutusScriptSerialised script, Ledger.toCardanoScriptData $ Api.toBuiltinData redeemer)
-toScriptAndRedeemerData script (TxSkelRedeemerForReferenceScript validatorOref redeemer) = do
+-- | Translate a script and a reference script utxo into into either a plutus
+-- script or a reference input containing the right script
+toPlutusScriptOrReferenceInput :: Api.SerialisedScript -> Maybe Api.TxOutRef -> WitnessGen (Cardano.PlutusScriptOrReferenceInput lang)
+toPlutusScriptOrReferenceInput script Nothing = return $ Cardano.PScript $ Cardano.PlutusScriptSerialised script
+toPlutusScriptOrReferenceInput script (Just scriptOutRef) = do
   referenceScriptsMap <- asks $ Map.mapMaybe (^. outputReferenceScriptL)
   refScriptHash <-
     throwOnLookup
-      "toScriptAndRedeemerData: Can't resolve reference script utxo."
-      validatorOref
+      "toPlutusScriptOrReferenceInput: Can't resolve reference script utxo."
+      scriptOutRef
       referenceScriptsMap
   when (refScriptHash /= toScriptHash script) $
-    throwOnString "toScriptAndRedeemerData: Wrong reference script hash."
-  validatorTxIn <-
+    throwOnString "toPlutusScriptOrReferenceInput: Wrong reference script hash."
+  scriptTxIn <-
     throwOnToCardanoError
-      "toScriptAndRedeemerData: Unable to translate reference script utxo."
-      (Ledger.toCardanoTxIn validatorOref)
+      "toPlutusScriptOrReferenceInput: Unable to translate reference script utxo."
+      (Ledger.toCardanoTxIn scriptOutRef)
   scriptHash <-
     throwOnToCardanoError
-      "toScriptAndRedeemerData: Unable to translate script hash of reference script."
+      "toPlutusScriptOrReferenceInput: Unable to translate script hash of reference script."
       (Ledger.toCardanoScriptHash refScriptHash)
-  return (Cardano.PReferenceScript validatorTxIn (Just scriptHash), Ledger.toCardanoScriptData $ Api.toBuiltinData redeemer)
+  return $ Cardano.PReferenceScript scriptTxIn (Just scriptHash)
 
 -- | Translates a script with its associated redeemer and datum to a script
 -- witness.
 toScriptWitness :: (ToScript a) => a -> TxSkelRedeemer -> Cardano.ScriptDatum b -> WitnessGen (Cardano.ScriptWitness b Cardano.ConwayEra)
-toScriptWitness (toScript -> (Script.Versioned (Script.Script script) version)) redeemer datum =
-  case version of
-    Script.PlutusV1 ->
-      (\(x, y) -> Cardano.PlutusScriptWitness Cardano.PlutusScriptV1InConway Cardano.PlutusScriptV1 x datum y Ledger.zeroExecutionUnits)
-        <$> toScriptAndRedeemerData script redeemer
-    Script.PlutusV2 ->
-      (\(x, y) -> Cardano.PlutusScriptWitness Cardano.PlutusScriptV2InConway Cardano.PlutusScriptV2 x datum y Ledger.zeroExecutionUnits)
-        <$> toScriptAndRedeemerData script redeemer
-    Script.PlutusV3 ->
-      (\(x, y) -> Cardano.PlutusScriptWitness Cardano.PlutusScriptV3InConway Cardano.PlutusScriptV3 x datum y Ledger.zeroExecutionUnits)
-        <$> toScriptAndRedeemerData script redeemer
+toScriptWitness (toScript -> (Script.Versioned (Script.Script script) version)) (TxSkelRedeemer {..}) datum =
+  let scriptData = case txSkelRedeemer of
+        EmptyRedeemer -> Ledger.toCardanoScriptData $ Api.toBuiltinData ()
+        SomeRedeemer s -> Ledger.toCardanoScriptData $ Api.toBuiltinData s
+   in case version of
+        Script.PlutusV1 ->
+          (\x -> Cardano.PlutusScriptWitness Cardano.PlutusScriptV1InConway Cardano.PlutusScriptV1 x datum scriptData Ledger.zeroExecutionUnits)
+            <$> toPlutusScriptOrReferenceInput script txSkelReferenceScript
+        Script.PlutusV2 ->
+          (\x -> Cardano.PlutusScriptWitness Cardano.PlutusScriptV2InConway Cardano.PlutusScriptV2 x datum scriptData Ledger.zeroExecutionUnits)
+            <$> toPlutusScriptOrReferenceInput script txSkelReferenceScript
+        Script.PlutusV3 ->
+          (\x -> Cardano.PlutusScriptWitness Cardano.PlutusScriptV3InConway Cardano.PlutusScriptV3 x datum scriptData Ledger.zeroExecutionUnits)
+            <$> toPlutusScriptOrReferenceInput script txSkelReferenceScript
diff --git a/src/Cooked/Pretty/Cooked.hs b/src/Cooked/Pretty/Cooked.hs
@@ -260,6 +260,15 @@ prettyTxParameterChange opts (GovActionDeposit n) = "Governance action deposit:"
 prettyTxParameterChange opts (DRepRegistrationDeposit n) = "DRep registration deposit:" <+> prettyCookedOpt opts n
 prettyTxParameterChange opts (DRepActivity n) = "DRep activity:" <+> prettyCookedOpt opts n
 
+prettyTxSkelRedeemer :: PrettyCookedOpts -> TxSkelRedeemer -> [DocCooked]
+prettyTxSkelRedeemer opts (TxSkelRedeemer red mRefScript) =
+  catMaybes
+    [ case red of
+        EmptyRedeemer -> Nothing
+        SomeRedeemer s -> Just $ "Redeemer" <+> prettyCookedOpt opts s,
+      ("Reference script at:" <+>) . prettyCookedOpt opts <$> mRefScript
+    ]
+
 prettyTxSkelProposal :: PrettyCookedOpts -> TxSkelProposal -> DocCooked
 prettyTxSkelProposal opts TxSkelProposal {..} =
   prettyItemizeNoTitle "-" $
@@ -270,16 +279,7 @@ prettyTxSkelProposal opts TxSkelProposal {..} =
             prettyItemize
               "Witness:"
               "-"
-              [ prettyCookedOpt opts script,
-                case redeemer of
-                  TxSkelNoRedeemer -> "No redeemer"
-                  TxSkelRedeemerForScript red -> "With the following redeemer:" <+> prettyCooked red
-                  TxSkelRedeemerForReferenceScript red txOutRef ->
-                    "With the following redeemer:"
-                      <+> prettyCooked red
-                      <+> "and reference script sitting at:"
-                      <+> prettyCookedOpt opts txOutRef
-              ]
+              (prettyCookedOpt opts script : prettyTxSkelRedeemer opts redeemer)
         )
           <$> txSkelProposalWitness,
         ("Anchor:" <+>) . PP.pretty <$> txSkelProposalAnchor
@@ -332,30 +332,16 @@ prettySigners _ _ [] = []
 -- | Prints a minting specification
 --
 -- Examples without and with redeemer
--- > #abcdef "Foo" -> 500
--- > #123456 "Bar" | Redeemer -> 1000
+-- > #abcdef "Foo": 500
+-- > #123456 "Bar": 1000
+--     - Redeemer: red
+--     - Reference script at: txOutRef
 prettyMints :: PrettyCookedOpts -> (Script.Versioned Script.MintingPolicy, TxSkelRedeemer, Api.TokenName, Integer) -> DocCooked
-prettyMints opts (policy, TxSkelNoRedeemer, tokenName, amount) =
-  prettyCookedOpt opts policy
-    <+> PP.viaShow tokenName
-    <+> "->"
-    <+> PP.viaShow amount
-prettyMints opts (policy, TxSkelRedeemerForScript redeemer, tokenName, amount) =
-  prettyCookedOpt opts policy
-    <+> PP.viaShow tokenName
-    <+> "|"
-    <+> prettyCookedOpt opts redeemer
-    <+> "->"
-    <+> PP.viaShow amount
-prettyMints opts (policy, TxSkelRedeemerForReferenceScript oref redeemer, tokenName, amount) =
-  prettyCookedOpt opts policy
-    <+> PP.viaShow tokenName
-    <+> "|"
-    <+> prettyCookedOpt opts redeemer
-    <+> " (with reference script at "
-    <+> prettyCookedOpt opts oref
-    <+> ") ->"
-    <+> PP.viaShow amount
+prettyMints opts (policy, redeemer, tokenName, amount) =
+  let docTitle = prettyCookedOpt opts policy <+> PP.viaShow tokenName <> ":" <+> PP.viaShow amount
+   in case prettyTxSkelRedeemer opts redeemer of
+        [] -> docTitle
+        l -> prettyItemize docTitle "-" l
 
 prettyTxSkelOut :: PrettyCookedOpts -> TxSkelOut -> DocCooked
 prettyTxSkelOut opts (Pays output) =
@@ -396,28 +382,16 @@ prettyTxSkelIn opts skelContext (txOutRef, txSkelRedeemer) = do
   case lookupOutput skelContext txOutRef of
     Nothing -> "Spends" <+> prettyCookedOpt opts txOutRef <+> "(non resolved)"
     Just (output, txSkelOutDatum) ->
-      let (redeemerDoc, ownerDoc) =
-            case txSkelRedeemer of
-              TxSkelRedeemerForScript redeemer ->
-                ( Just ("Redeemer:" <+> prettyCookedOpt opts redeemer),
-                  prettyCookedOpt opts (outputAddress output)
-                )
-              TxSkelRedeemerForReferenceScript refScriptOref redeemer ->
-                ( Just ("Redeemer:" <+> prettyCookedOpt opts redeemer),
-                  prettyCookedOpt opts (outputAddress output)
-                    <+> PP.parens ("Reference Script at" <+> prettyCookedOpt opts refScriptOref)
-                )
-              TxSkelNoRedeemer -> (Nothing, prettyCookedOpt opts (outputAddress output))
-       in prettyItemize
-            ("Spends from" <+> ownerDoc)
-            "-"
-            ( prettyCookedOpt opts (outputValue output)
-                : catMaybes
-                  [ redeemerDoc,
-                    prettyTxSkelOutDatumMaybe opts txSkelOutDatum,
-                    getReferenceScriptDoc opts output
-                  ]
-            )
+      prettyItemize
+        ("Spends from" <+> prettyCookedOpt opts (outputAddress output))
+        "-"
+        ( prettyCookedOpt opts (outputValue output)
+            : prettyTxSkelRedeemer opts txSkelRedeemer
+              <> catMaybes
+                [ prettyTxSkelOutDatumMaybe opts txSkelOutDatum,
+                  getReferenceScriptDoc opts output
+                ]
+        )
 
 prettyTxSkelInReference :: PrettyCookedOpts -> SkelContext -> Api.TxOutRef -> Maybe DocCooked
 prettyTxSkelInReference opts skelContext txOutRef = do