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