Batch of changes post-audit work (#445)

* Hash computation for script of various Plutus version was wrong, and is now fixed.
* Some helpers and qol changes where added (see changelog for more details)
* MockChainSt has been extended and given its own module
* Hashed datums can now be used in reference inputs. The corresponding datum is properly fed to the transaction. This is done through somewhat a hack, see this issue for more details.
* Rewarding scripts are now supported. The reward mechanism is not at all identical to the one on-chain, due to likely limitation in the emulator, but the scripts are properly called and the skeleton accounts for the withdrawals properly.
* A bug in balancing has been fixed, where the balancing would wrongfully fail in some corner cases with excess inputs but not enough to ensure min ada in the created output.

CHANGELOG.md

@@ -9,9 +9,20 @@
 - `toInitDistWithMinAda` and `unsafeToInitDistWithMinAda` to ensure the initial
   distribution only provides outputs with the required minimal ada based on
   default parameters.
+- All kinds of scripts can now be used as reference scripts.
+- `validateTxSkel_` which validates a skeleton and ignores the output.
+- `txSkelMintsFromList'` which only allows one redeemer per minting policy.
+- `validatorToTypedValidatorV2`
+- `walletPKHashToWallet` that retrives a wallet from a pkh. It used to be
+  present but somehow disapeared.
+- It is now possible to reference an output which has a hashed datum.
+- `txSkelHashedData` the gives all the datum hashes in inputs and reference inputs.
+- Partial support for withdrawals in txSkels. The rewarding scripts will be run
+  and assets will be transferred. However, these withdrawals are not properly
+  constrained yet.
 - PrettyCooked option `pcOptPrintLog`, which is a boolean, to turn on or off the log
   display in the pretty printer. The default value is `True`.
-  
+
 ### Removed
 
 - `positivePart` and `negativePart` in `ValueUtils.hs`. Replaced by `Api.split`.
@@ -26,6 +37,12 @@
   constructors: `txSkelSomeRedeemer`, `txSkelEmptyRedeemer`,
   `txSkelSomeRedeemerAndReferenceScript`,
   `txSkelEmptyRedeemerAndReferenceScript`.
+- `mkProposingScript` changed to `mkScript`
+- `withDatumHashed` changed to `withUnresolvedDatumHash`
+- `paysScriptDatumHashed` changed to `paysScriptUnresolvedDatumHash`
+- `txSkelInputData` changed to `txSkelInputDataAsHashes`
+- Pretty printing of hashed datum now includes the hash (and not only the
+  resolved datum).
 - Dependency to cardano-api bumped to 8.46.
 - Logging has been reworked: 
   * it is no longer limited to `StagedMockChain` runs
@@ -34,12 +51,16 @@
   * it now displays the discarding of utxos during balancing.
   * it now displays when the user specifies useless collateral utxos.
   * it is not visible from outside of `cooked-validators`
+- Dependency to cardano-api bumped to 8.46.
 
 ### Fixed
 
+- A bug where the script hashes would not be computed properly for early plutus
+  version (V1 and V2).
+- A bug where balancing would fail with excessive inputs and not enough min ada
+  in the excess.
+- Transactions that do not involve script are now properly generated without any
 - All kinds of scripts can now be used as reference scripts.
-- Transactions that do not involve scripts are now properly generated without any
-  collateral.
 
 ## [[4.0.0]](https://github.com/tweag/cooked-validators/releases/tag/v4.0.0) - 2024-06-28
 

cooked-validators.cabal

@@ -42,8 +42,10 @@ library
       Cooked.MockChain.GenerateTx.Mint
       Cooked.MockChain.GenerateTx.Output
       Cooked.MockChain.GenerateTx.Proposal
+      Cooked.MockChain.GenerateTx.Withdrawals
       Cooked.MockChain.GenerateTx.Witness
       Cooked.MockChain.MinAda
+      Cooked.MockChain.MockChainSt
       Cooked.MockChain.Staged
       Cooked.MockChain.Testing
       Cooked.MockChain.UtxoSearch
@@ -109,6 +111,7 @@ library
     , cardano-api
     , cardano-crypto
     , cardano-data
+    , cardano-ledger-alonzo
     , cardano-ledger-conway
     , cardano-ledger-core
     , cardano-ledger-shelley
@@ -169,6 +172,7 @@ test-suite spec
       Cooked.Tweak.TamperDatumSpec
       Cooked.Tweak.ValidityRangeSpec
       Cooked.TweakSpec
+      Cooked.WithdrawalsSpec
       Paths_cooked_validators
   autogen-modules:
       Paths_cooked_validators
@@ -201,6 +205,7 @@ test-suite spec
     , cardano-api
     , cardano-crypto
     , cardano-data
+    , cardano-ledger-alonzo
     , cardano-ledger-conway
     , cardano-ledger-core
     , cardano-ledger-shelley

package.yaml

@@ -11,6 +11,7 @@ dependencies:
   - cardano-api
   - cardano-crypto
   - cardano-data
+  - cardano-ledger-alonzo
   - cardano-ledger-core
   - cardano-ledger-shelley
   - cardano-ledger-conway

src/Cooked/Conversion/ToScriptHash.hs

@@ -2,9 +2,8 @@
 module Cooked.Conversion.ToScriptHash where
 
 import Cooked.Conversion.ToScript
-import Plutus.Script.Utils.Scripts qualified as Script hiding (scriptHash)
+import Plutus.Script.Utils.Scripts qualified as Script
 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
@@ -13,17 +12,14 @@ 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.MintingPolicyHash where
+  toScriptHash (Script.MintingPolicyHash hash) = Script.ScriptHash hash
 
 instance ToScriptHash Script.ValidatorHash where
-  toScriptHash (Script.ValidatorHash h) = Script.ScriptHash h
+  toScriptHash (Script.ValidatorHash hash) = Script.ScriptHash hash
 
 instance ToScriptHash (Script.Versioned Script.Script) where
-  toScriptHash (Script.Versioned s _) = toScriptHash s
+  toScriptHash = Script.scriptHash
 
 instance ToScriptHash (Script.Versioned Script.Validator) where
   toScriptHash = toScriptHash . toScript
@@ -32,4 +28,4 @@ instance ToScriptHash (Script.TypedValidator a) where
   toScriptHash = toScriptHash . toScript
 
 instance ToScriptHash (Script.Versioned Script.MintingPolicy) where
-  toScriptHash = toScriptHash . toScript
+  toScriptHash = toScriptHash . Script.mintingPolicyHash

src/Cooked/MockChain.hs

@@ -6,6 +6,7 @@ import Cooked.MockChain.Balancing as X
 import Cooked.MockChain.BlockChain as X hiding (MockChainLogEntry, logEvent)
 import Cooked.MockChain.Direct as X hiding (MockChainReturn)
 import Cooked.MockChain.MinAda as X
+import Cooked.MockChain.MockChainSt as X (MockChainSt (..), mockChainSt0From)
 import Cooked.MockChain.Staged as X hiding (StagedMockChain)
 import Cooked.MockChain.Testing as X
 import Cooked.MockChain.UtxoSearch as X

src/Cooked/MockChain/Balancing.hs

@@ -78,7 +78,11 @@ balanceTxSkel skelUnbal@TxSkel {..} = do
     -- We retrieve the various kinds of scripts
     spendingScripts <- txSkelInputValidators skelUnbal
     -- The transaction will only require collaterals when involving scripts
-    let noScriptInvolved = Map.null txSkelMints && null (mapMaybe txSkelProposalWitness txSkelProposals) && Map.null spendingScripts
+    let noScriptInvolved =
+          Map.null txSkelMints
+            && null (mapMaybe txSkelProposalWitness txSkelProposals)
+            && Map.null spendingScripts
+            && null (txSkelWithdrawalsScripts skelUnbal)
     case (noScriptInvolved, txOptCollateralUtxos txSkelOpts) of
       (True, CollateralUtxosFromSet utxos _) -> logEvent (MCLogUnusedCollaterals $ Right utxos) >> return Nothing
       (True, CollateralUtxosFromWallet cWallet) -> logEvent (MCLogUnusedCollaterals $ Left cWallet) >> return Nothing
@@ -298,7 +302,7 @@ estimateTxSkelFee :: (MonadBlockChainBalancing m) => TxSkel -> Fee -> Maybe (Col
 estimateTxSkelFee skel fee mCollaterals = do
   -- We retrieve the necessary data to generate the transaction body
   params <- getParams
-  managedData <- txSkelInputData skel
+  managedData <- txSkelHashedData skel
   let collateralIns = case mCollaterals of
         Nothing -> []
         Just (s, _) -> Set.toList s
@@ -310,7 +314,7 @@ estimateTxSkelFee skel fee mCollaterals = do
     Right txBodyContent -> return txBodyContent
   -- We create the actual body and send if for validation
   txBody <- case Cardano.createAndValidateTransactionBody Cardano.ShelleyBasedEraConway txBodyContent of
-    Left err -> throwError $ MCEGenerationError (TxBodyError "Error creating body when estimating fees" err)
+    Left err -> throwError $ MCEGenerationError $ TxBodyError "Error creating body when estimating fees" err
     Right txBody -> return txBody
   -- We retrieve the estimate number of required witness in the transaction
   let nkeys = Cardano.estimateTransactionKeyWitnessCount txBodyContent
@@ -331,24 +335,40 @@ estimateTxSkelFee skel fee mCollaterals = do
 
 -- | 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
+-- value + withdrawn value = output value + burned value + fee + deposits
 computeBalancedTxSkel :: (MonadBlockChainBalancing m) => Wallet -> BalancingOutputs -> TxSkel -> Fee -> m TxSkel
 computeBalancedTxSkel balancingWallet balancingUtxos txSkel@TxSkel {..} (Script.lovelace -> feeValue) = do
+  params <- getParams
   -- 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
+      withdrawnValue = txSkelWithdrawnValue 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 <> depositedValue <> PlutusTx.negate (inValue <> mintedValue)
+  let (missingRight, missingLeft) = Api.split $ outValue <> burnedValue <> feeValue <> depositedValue <> PlutusTx.negate (inValue <> mintedValue <> withdrawnValue)
+  -- We compute the minimal ada requirement of the missing payment
+  rightMinAda <- case getTxSkelOutMinAda params $ paysPK balancingWallet missingRight of
+    Left err -> throwError $ MCEGenerationError err
+    Right a -> return a
+  -- We compute the current ada of the missing payment. If the missing payment
+  -- is not empty and the minimal ada is not present, some value is missing.
+  let Script.Lovelace rightAda = missingRight ^. Script.adaL
+      missingAda = rightMinAda - rightAda
+      missingAdaValue = if missingRight /= mempty && missingAda > 0 then Script.lovelace missingAda else mempty
+  -- The actual missing value on the left might needs to account for any missing
+  -- min ada on the missing payment of the transaction skeleton. This also has
+  -- to be repercuted on the missing value on the right.
+  let missingLeft' = missingLeft <> missingAdaValue
+      missingRight' = missingRight <> missingAdaValue
   -- 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)
+  let candidatesRaw = second (<> missingRight') <$> reachValue balancingUtxos missingLeft' (toInteger $ length balancingUtxos)
   -- We prepare a possible balancing error with the difference between the
   -- requested amount and the maximum amount provided by the balancing wallet
   let totalValue = mconcat $ Api.txOutValue . snd <$> balancingUtxos
-      difference = snd $ Api.split $ missingLeft <> PlutusTx.negate totalValue
+      difference = snd $ Api.split $ missingLeft' <> PlutusTx.negate totalValue
       balancingError = MCEUnbalanceable balancingWallet difference txSkel
   -- Which one of our candidates should be picked depends on three factors
   -- - Whether there exists a perfect candidate set with empty surplus value