New initial distributions with datums and reference scripts

CHANGELOG.md

@@ -38,6 +38,16 @@
 - New pretty-printing options related to hashes in `pcOptHashes` including the
   possibility to assign human readable names to hashes (pubkeys, scripts,
   minting policies)
+- Initial distributions of funds can now include arbitrat payments
+  instead of only consisting of values belonging to wallets. In
+  particular, we can now initially pay to scripts and have utxos with
+  datums and reference scripts. We can still create an initial
+  distribution in the old fashion way with `distributionFromList` or
+  directly provide a list of payments with `InitialDistribution`.
+- Dummy pre-existing validators in `Cooked.Validators` to be used for
+  testing purposes mainly but also as targets for attacks and tweaks.
+- Small QOL helpers (`ada`, `lovelace` and `adaAssetClass`) to create
+  values in `Cooked.ValueUtils`.
 
 ### Removed
 
@@ -63,6 +73,7 @@
   3. (Bonus) simplify, knowing that ``Cooked.testFailsFrom o x def ==
      Cooked.testFails o x``
 - Quick and permanent value minting policies have been migrated to PlutusV2.
+- Default initial distribution only provides 5 UTxOs per wallet instead of 10.
 
 ### Fixes
 

cooked-validators.cabal

@@ -19,6 +19,7 @@ library
       Cooked.Attack.DoubleSat
       Cooked.Attack.DupToken
       Cooked.Currencies
+      Cooked.InitialDistribution
       Cooked.Ltl
       Cooked.MockChain
       Cooked.MockChain.Balancing
@@ -47,6 +48,7 @@ library
       Cooked.Tweak.Signers
       Cooked.Tweak.TamperDatum
       Cooked.Tweak.ValidityRange
+      Cooked.Validators
       Cooked.ValueUtils
       Cooked.Wallet
   other-modules:
@@ -110,6 +112,7 @@ test-suite spec
       Cooked.Attack.DoubleSatSpec
       Cooked.Attack.DupTokenSpec
       Cooked.AttackSpec
+      Cooked.InitialDistributionSpec
       Cooked.InlineDatumsSpec
       Cooked.LtlSpec
       Cooked.MinAdaSpec

doc/CHEATSHEET.md

@@ -16,12 +16,32 @@
     * `printCooked $ interpretAndRun foo` for all traces
     * `printCooked $ runMockChain foo` for `MonadBlockChain` traces only
 
-### Use a custom initial distribution of value
+### Custom initial distributions of UTxOs
+
+#### Creation
+
+* With only values
+  ```haskell
+  initDist :: InitialDistribution
+  initDist = distributionFromList $
+	  [ (wallet 1 , [ ada 42 , ada 2 <> quickValue "TOK" 1 ]
+	  , (wallet 2 , [ ada 10 ])
+	  , (wallet 3 , [ ada 10 <> permanentValue "XYZ" 10])
+	  ]
+  ```
+* With arbitrary payments
+  ```haskell
+  initDist :: InitialDistribution
+  initDist = InitialDistribution
+	  [ paysPK (walletPKHash (wallet 3)) (ada 6)
+      , paysScript fooTypedValidator FooTypedDatum (lovelaceValueOf 6_000_000)
+	  , paysPK (walletPKHash (wallet 2)) (ada 2) `withDatum` fooDatum
+	  , paysPK (walletPKHash (wallet 1)) (ada 2) `withReferenceScript` fooValidator
+	  ]
+  ```
+
+#### Usage
 
-```haskell
-initDist :: InitialDistribution
-initDist = initialDistribution [(i, [lovelaceValueOf 25_000_000]) | i <- knownWallets]
-```
 * In a test `Tasty.testCase "foo" $ testSucceedsFrom def initDist foo`
 * In the REPL `printCooked $ interpretAndRunWith (runMockChainTFrom initDist) foo`
 

src/Cooked.hs

@@ -9,6 +9,7 @@ where
 
 import Cooked.Attack as X
 import Cooked.Currencies as X
+import Cooked.InitialDistribution as X
 import qualified Cooked.Ltl as Ltl
 import Cooked.MockChain as X
 import Cooked.Output as X
@@ -17,5 +18,6 @@ import Cooked.RawUPLC as X
 import Cooked.ShowBS as X
 import Cooked.Skeleton as X
 import Cooked.Tweak as X
+import Cooked.Validators as X
 import Cooked.ValueUtils as X
 import Cooked.Wallet as X

src/Cooked/Attack/DatumHijacking.hs

@@ -1,31 +1,26 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Cooked.Attack.DatumHijacking
   ( redirectScriptOutputTweak,
     datumHijackingAttack,
     DatumHijackingLbl (..),
-    datumHijackingTarget,
   )
 where
 
 import Control.Monad
 import Cooked.Output
 import Cooked.Pretty.Class
-import Cooked.RawUPLC
 import Cooked.Skeleton
 import Cooked.Tweak
+import Cooked.Validators
 import Optics.Core
 import qualified Plutus.Script.Utils.Typed as Pl
 import qualified Plutus.V2.Ledger.Api as Pl
-import qualified PlutusTx as Pl
 import Type.Reflection
 
 -- | Redirect script outputs from one validator to another validator of the same
@@ -101,16 +96,7 @@ datumHijackingAttack change select = do
   addLabelTweak $ DatumHijackingLbl $ Pl.validatorAddress thief
   return redirected
   where
-    thief = datumHijackingTarget @a
+    thief = alwaysTrueValidator @a
 
 newtype DatumHijackingLbl = DatumHijackingLbl Pl.Address
   deriving (Show, Eq, Ord)
-
--- | The trivial validator that always succeds; this is a sufficient target for
--- the datum hijacking attack since we only want to show feasibility of the
--- attack.
-datumHijackingTarget :: Pl.TypedValidator a
-datumHijackingTarget = unsafeTypedValidatorFromUPLC (Pl.getPlc $$(Pl.compile [||tgt||]))
-  where
-    tgt :: Pl.BuiltinData -> Pl.BuiltinData -> Pl.BuiltinData -> ()
-    tgt _ _ _ = ()

src/Cooked/InitialDistribution.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE GADTs #-}
+
+-- | This module provides a convenient way to spread assets between
+-- wallets and scripts at the initialization of the mock chain. These
+-- initial assets can be accompanied by datums and reference scripts.
+module Cooked.InitialDistribution
+  ( InitialDistribution (..),
+    distributionFromList,
+  )
+where
+
+import Cooked.Skeleton
+import Cooked.ValueUtils
+import Cooked.Wallet
+import Data.Default
+import Data.List
+import qualified Plutus.Script.Utils.Value as Pl
+
+-- * Initial distribution of funds
+
+-- | Describes the initial distribution of UTxOs per wallet. This is
+-- important since transaction validation must specify a
+-- /collateral/. Hence, wallets must have more than one UTxO to begin
+-- with in order to execute a transaction and have some collateral
+-- option. The @txCollateral@ is transferred to the node operator in
+-- case the transaction fails to validate.
+--
+--  The following specifies a starting state where @wallet 1@ owns two
+--  UTxOs, one with 42 Ada and one with 2 Ada and one "TOK" token;
+--  @wallet 2@ owns a single UTxO with 10 Ada and @wallet 3@ has 10
+--  Ada and a permanent value. See "Cooked.Currencies" for more
+--  information on quick and permanent values.
+--
+--  > i0 = distributionFromList $
+--  >        [ (wallet 1 , [ ada 42 , ada 2 <> quickValue "TOK" 1 ]
+--  >        , (wallet 2 , [ ada 10 ])
+--  >        , (wallet 3 , [ ada 10 <> permanentValue "XYZ" 10])
+--  >        ]
+data InitialDistribution where
+  InitialDistribution :: {initialDistribution :: [TxSkelOut]} -> InitialDistribution
+
+-- | 5 UTxOs with 100 Ada each, for each of the 'knownWallets',
+-- without any datum nor scripts
+instance Default InitialDistribution where
+  def =
+    distributionFromList
+      . zip knownWallets
+      . repeat
+      . replicate 5
+      $ ada 100
+
+distributionFromList :: [(Wallet, [Pl.Value])] -> InitialDistribution
+distributionFromList = InitialDistribution . foldl' (\x (user, values) -> x <> map (paysPK (walletPKHash user)) values) []

src/Cooked/MockChain/Balancing.hs

@@ -15,6 +15,7 @@ import qualified Cardano.Api as C
 import qualified Cardano.Api.Shelley as C
 import qualified Cardano.Ledger.Shelley.API as CardanoLedger
 import qualified Cardano.Node.Emulator as Emulator
+import qualified Cardano.Node.Emulator.Params as Pl
 import Control.Arrow
 import Control.Monad.Except
 import Cooked.MockChain.BlockChain
@@ -98,7 +99,7 @@ ensureTxSkelOutsMinAda skel = do
   where
     ensureTxSkelOutHasMinAda :: Emulator.Params -> TxSkelOut -> Either GenerateTxError TxSkelOut
     ensureTxSkelOutHasMinAda theParams txSkelOut@(Pays output) = do
-      cardanoTxOut <- txSkelOutToCardanoTxOut theParams txSkelOut
+      cardanoTxOut <- txSkelOutToCardanoTxOut (Pl.pNetworkId theParams) txSkelOut
       let Pl.Lovelace oldAda = output ^. outputValueL % adaL
           CardanoLedger.Coin requiredAda =
             CardanoLedger.evaluateMinLovelaceOutput (Emulator.emulatorPParams theParams)