Mm/proposal procedures

CHANGELOG.md

@@ -39,7 +39,16 @@
 - Two filters in `Output.hs`, `isScriptOutput` and `isPKOutput`
 - A new helper function to get the full output value of a skeleton,
   `txSkelOutputsValue`
-
+- Proposal procedures can now be issued and described in transaction
+  skeletons. If they contain parameter changes or treasury withdrawals, a
+  witness script can be attached and will be run.
+- `TxSkelRedeemer` is now used for all kinds of scripts.
+- File [CONWAY](doc/CONWAY.md) to document which Conway features are currently
+  supported.
+- A new option `txOptAnchorResolution` to decide whether to resolve urls
+  locally or on the web (unsafe). The default is to resolve them locally with a
+  given map from urls to page content as bytestring.
+
 ### Removed
 - Extraneous dependencies in package.yaml
 - File `Cooked.TestUtils`, its content has been added to `Cooked.MockChain.Testing`
@@ -49,6 +58,7 @@
 - Deprecated use of `*` instead of `Type`
 - Many unused pragmas
 - Orphan default instance for `Ledger.Slot`
+- `MintsRedeemer` (replaced by `TxSkelRedeemer`)
 
 ### Changed
 - Default era from Babbage to Conway

README.md

@@ -112,6 +112,8 @@ ready-to-use recipes book.
   automated balancing mechanism and associated options (including options
   revolving around fees and collaterals).
 
+- The [CONWAY](doc/CONWAY.md) file describes the Conway features that are currently supported by `cooked-validators`.
+
 - We also have a [repository](https://github.com/tweag/cooked-smart-contracts)
 of example contracts with offchain code and tests written using
 `cooked-validators`. Note that some examples are not maintained and thus written

cooked-validators.cabal

@@ -34,6 +34,14 @@ library
       Cooked.MockChain.BlockChain
       Cooked.MockChain.Direct
       Cooked.MockChain.GenerateTx
+      Cooked.MockChain.GenerateTx.Body
+      Cooked.MockChain.GenerateTx.Collateral
+      Cooked.MockChain.GenerateTx.Common
+      Cooked.MockChain.GenerateTx.Input
+      Cooked.MockChain.GenerateTx.Mint
+      Cooked.MockChain.GenerateTx.Output
+      Cooked.MockChain.GenerateTx.Proposal
+      Cooked.MockChain.GenerateTx.Witness
       Cooked.MockChain.MinAda
       Cooked.MockChain.Staged
       Cooked.MockChain.Testing
@@ -101,13 +109,21 @@ library
     , bytestring
     , cardano-api
     , cardano-crypto
+    , cardano-data
+    , cardano-ledger-conway
+    , cardano-ledger-core
     , cardano-ledger-shelley
     , cardano-node-emulator
+    , cardano-strict-containers
     , containers
     , data-default
     , either
+    , exceptions
     , flat
+    , http-conduit
+    , lens
     , list-t
+    , microlens
     , monad-control
     , mtl
     , nonempty-containers
@@ -146,6 +162,7 @@ test-suite spec
       Cooked.MinAdaSpec
       Cooked.MockChain.BlockChainSpec
       Cooked.MockChainSpec
+      Cooked.ProposingScriptSpec
       Cooked.ReferenceInputsSpec
       Cooked.ReferenceScriptsSpec
       Cooked.ShowBSSpec
@@ -185,14 +202,22 @@ test-suite spec
     , bytestring
     , cardano-api
     , cardano-crypto
+    , cardano-data
+    , cardano-ledger-conway
+    , cardano-ledger-core
     , cardano-ledger-shelley
     , cardano-node-emulator
+    , cardano-strict-containers
     , containers
     , cooked-validators
     , data-default
     , either
+    , exceptions
     , flat
+    , http-conduit
+    , lens
     , list-t
+    , microlens
     , monad-control
     , mtl
     , nonempty-containers

doc/CHEATSHEET.md

@@ -167,7 +167,7 @@ txSkelTemplate
 
 ### Spend some UTxOs
 
-* No redeemer: `TxSkelNoRedeemerForPK`
+* No redeemer: `TxSkelNoRedeemer`
 * With redeemer:
     * Regular script: `TxSkelRedeemerForScript typedRedeemer`
     * Reference script: `TxSkelRedeemerForReferencedScript txOutRefCarryingReferenceScript typedRedeemer`
@@ -218,8 +218,9 @@ foo txOutRef = do
 
 ### Mint or burn tokens
 
-* No redeemer: `(Script.Versioned fooPolicy Script.PlutusV3, NoMintsRedeemer, "fooName", 3)`
-* With redeemer: `(Script.Versioned barPolicy Script.PlutusV3, SomeMintsRedeemer typedRedeemer, "barName", 12)`
+* 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)`
 
 ```haskell
@@ -242,7 +243,6 @@ txSkelTemplate
       ...
     }
 ```
-
 ### Have pre-existing non-Ada tokens that cannot be minted or burnt
 
 * `distributionFromList [..., (... <> permanentValue "customToken" 1000), ...]`
@@ -446,7 +446,7 @@ foo = do
     bar `withTweak` ( do
                         addOutputTweak $ paysScript bazValidator bazDatum bazValue
                         removeOutputTweak (\(Pays out) -> somePredicate out)
-                        addInputTweak somePkTxOutRef C.TxSkelNoRedeemerForPK
+                        addInputTweak somePkTxOutRef C.TxSkelNoRedeemer
                         removeInputTweak (\txOutRef redeemer -> somePredicate txOutRef redeemer)
                     )
 ```
@@ -474,3 +474,64 @@ foo = do
                           (<> assetClassValue bazAssetClass 10) -- Add 10 baz tokens
                     )
 ```
+
+## Proposal procedures
+
+### Attach a Proposal Procedure to a transaction
+
+* Using the builtin constructor for proposals.
+
+```haskell
+txSkelTemplate
+  { ...
+    txSkelProposals =
+      [ TxSkelProposal
+          { txSkelProposalAddress = walletAddress (wallet 1),
+            txSkelProposalAction =
+              TxGovActionTreasuryWithdrawals $
+                Map.fromList
+                  [ (toCredential $ wallet 1, Api.Lovelace 100),
+                    (toCredential $ wallet 2, Api.Lovelace 10_000)
+                  ],
+            txSkelProposalWitness = (toScript myScript, myRedeemer),
+            txSkelProposalAnchor = Nothing
+          }
+      ]
+    ...
+  }
+```
+
+* Using smart constructors and (optional) helpers.
+
+```haskell 
+txSkelTemplate
+  { ...
+    txSkelProposals =
+      [ simpleTxSkelProposal
+          (wallet 1)
+          (TxGovActionParameterChange [FeePerByte 100, FeeFixed 1_000])
+          `withWitness` (myScript, myRedeemer)
+          `withAnchor` "https://www.tweag.io/"
+      ]
+    ...
+  } 
+```
+
+### Anchor resolution policy
+
+* Auto resolution using a given map with resolved page content as bytestrings
+  (default behavior)
+
+```haskell 
+    txSkelOpts = def 
+	  { txOptAnchorResolution = AnchorResolutionLocal $ Map.singleton "https://www.tweag.io/" someByteString
+	  }
+```
+
+* Auto resolution using web requests (very unsafe, prevents reproducibility)
+
+```haskell 
+    txSkelOpts = def 
+	  { txOptAnchorResolution = AnchorResolutionHttp
+	  }
+```	

doc/CONWAY.md

@@ -0,0 +1,34 @@
+# Supported Conway features
+
+With the arrival of the Conway era, the Cardano blockchain is being enriched
+with a significant set of features revolving around governance. Governance can
+be defined as the ability for ada holders to take part in various on-chain
+decisions as described in
+[CIP-1694](https://github.com/cardano-foundation/CIPs/tree/master/CIP-1694). These
+new features have brought a substantial set of changes, such as new script
+purposes, new centralized data like committee, and new transaction
+features. This documents describes which of those features are currently being
+supported by cooked-validators, and to which extent. Each of the following items
+describes a feature that is currently supported. The reader can assume that
+everything that is not directly mentioned here about Conway is not yet
+supported.
+
+## Proposal procedures
+
+It is currently possible to describe proposal procedures and attach an arbitrary
+number of those in transaction skeletons. The balancing mechanism will take into
+account the required deposit for each of these procedures.
+
+### Parameter changes
+
+It is possible to issue proposal procedures with a request for changes in
+parameters. If a script witness is attached to this proposal (typically the
+constitution script), it will be ran against the proposal. All kinds of
+parameter changes are supported, except for the cost models, which contain too
+many values and are not even yet taken into account by the current constitution.
+
+### Treasury withdrawals
+
+It is possible to issue proposal procedures with a request for treasury
+withdrawals. If a script witness is attached to this proposal (typically the
+constitution script), it will be ran against the proposal.

doc/IMPORTS.md

@@ -12,7 +12,7 @@ a challenge. This is why this file exists. We detail here the two main keys to
 have a standardized way of importing definition in cooked-validators: qualified
 modules and preferred import locations.
 
-## Names of qualified modules
+## Names of qualified modules related to Cardano
 
 Here is the correspondance between package and prefix for each of our main
 dependencies:
@@ -39,6 +39,7 @@ dependencies:
 ### [`cardano-ledger`](https://github.com/IntersectMBO/cardano-ledger)
 
 - package `cardano-ledger-shelley`, prefix `Shelley`
+- package `cardano-ledger-conway`, prefix `Conway`
 
 ### Exception
 
@@ -47,6 +48,15 @@ When using `PlutusTx.Prelude` (from `plutus-tx`) in conjunction with the
 functions coming from the usual prelude should be prefixed `Haskell` in those
 modules instead.
 
+## Names of qualifed modules unrelated to Cardano
+
+`cooked-validators` uses optics in various places of the codebase. These optics
+come from the module `Optics.Core` of the `optics` package and are used
+unqualified in the code. Some of our dependencies however use optics coming from
+the `lens` or `microlens` packages. When using those, we should make very clear
+that they do not come from our default optics library, and thus prefix them with
+`Lens` or `Microlens` respectively.
+
 ## Preferred import locations rules
 
 Here is a list of preferred rules to ensure each definition always comes from a

package.yaml

@@ -10,13 +10,21 @@ dependencies:
   - bytestring
   - cardano-api
   - cardano-crypto
+  - cardano-data
+  - cardano-ledger-core
   - cardano-ledger-shelley
+  - cardano-ledger-conway
   - cardano-node-emulator
+  - cardano-strict-containers
   - containers
   - data-default
   - either
+  - exceptions
   - flat
+  - http-conduit
+  - lens
   - list-t
+  - microlens
   - monad-control
   - mtl
   - nonempty-containers

src/Cooked/Conversion/ToCredential.hs

@@ -13,6 +13,9 @@ class ToCredential a where
 instance ToCredential Api.Credential where
   toCredential = id
 
+instance ToCredential Api.Address where
+  toCredential (Api.Address cred _) = cred
+
 instance ToCredential Api.PubKeyHash where
   toCredential = Api.PubKeyCredential
 

src/Cooked/Conversion/ToScriptHash.hs

@@ -2,8 +2,9 @@
 module Cooked.Conversion.ToScriptHash where
 
 import Cooked.Conversion.ToScript
-import Plutus.Script.Utils.Scripts qualified as Script
+import Plutus.Script.Utils.Scripts qualified as Script hiding (scriptHash)
 import Plutus.Script.Utils.Typed qualified as Script
+import Plutus.Script.Utils.V3.Scripts qualified as Script (scriptHash)
 import PlutusLedgerApi.V3 qualified as Api
 
 class ToScriptHash a where
@@ -12,11 +13,17 @@ class ToScriptHash a where
 instance ToScriptHash Api.ScriptHash where
   toScriptHash = id
 
+instance ToScriptHash Script.Script where
+  toScriptHash = Script.scriptHash
+
+instance ToScriptHash Api.SerialisedScript where
+  toScriptHash = toScriptHash . Script.Script
+
 instance ToScriptHash Script.ValidatorHash where
   toScriptHash (Script.ValidatorHash h) = Script.ScriptHash h
 
 instance ToScriptHash (Script.Versioned Script.Script) where
-  toScriptHash = Script.scriptHash
+  toScriptHash (Script.Versioned s _) = toScriptHash s
 
 instance ToScriptHash (Script.Versioned Script.Validator) where
   toScriptHash = toScriptHash . toScript

src/Cooked/Conversion/ToValue.hs

@@ -16,3 +16,6 @@ instance ToValue Script.Ada where
 
 instance ToValue Cardano.Coin where
   toValue (Cardano.Coin x) = toValue (Script.Lovelace x)
+
+instance ToValue Api.Lovelace where
+  toValue (Api.Lovelace lv) = toValue (Script.Lovelace lv)

src/Cooked/MockChain/Balancing.hs

@@ -276,18 +276,19 @@ estimateTxSkelFee skel fee collateralIns returnCollateralWallet = do
   -- We return an accurate estimate of the resulting transaction fee
   return $ Emulator.unCoin $ Cardano.evaluateTransactionFee Cardano.ShelleyBasedEraConway (Emulator.pEmulatorPParams params) txBody nkeys 0
 
--- | This creates a balanced skeleton from a given skeleton and fee
--- In other words, this ensures that the following equation holds:
--- input value + minted value = output value + burned value + fee
+-- | This creates a balanced skeleton from a given skeleton and fee. In other
+-- words, this ensures that the following equation holds: input value + minted
+-- value = output value + burned value + fee + deposits
 computeBalancedTxSkel :: (MonadBlockChainBalancing m) => Wallet -> BalancingOutputs -> TxSkel -> Fee -> m TxSkel
 computeBalancedTxSkel balancingWallet balancingUtxos txSkel@TxSkel {..} (lovelace -> feeValue) = do
   -- We compute the necessary values from the skeleton that are part of the
   -- equation, except for the `feeValue` which we already have.
   let (burnedValue, mintedValue) = Api.split $ txSkelMintsValue txSkelMints
       outValue = txSkelValueInOutputs txSkel
   inValue <- txSkelInputValue txSkel
+  depositedValue <- toValue <$> txSkelProposalsDeposit txSkel
   -- We compute the values missing in the left and right side of the equation
-  let (missingRight, missingLeft) = Api.split $ outValue <> burnedValue <> feeValue <> PlutusTx.negate (inValue <> mintedValue)
+  let (missingRight, missingLeft) = Api.split $ outValue <> burnedValue <> feeValue <> depositedValue <> PlutusTx.negate (inValue <> mintedValue)
   -- This gives us what we need to run our `reachValue` algorithm and append to
   -- the resulting values whatever payment was missing in the initial skeleton
   let candidatesRaw = second (<> missingRight) <$> reachValue balancingUtxos missingLeft (toInteger $ length balancingUtxos)
@@ -324,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 ((,TxSkelNoRedeemerForPK) <$> additionalInsTxOutRefs)
+  let newTxSkelIns = txSkelIns <> Map.fromList ((,TxSkelNoRedeemer) <$> additionalInsTxOutRefs)
   return $ (txSkel & txSkelOutsL .~ newTxSkelOuts) & txSkelInsL .~ newTxSkelIns