updating cooked, some new requirements to meet

cabal.project

@@ -23,9 +23,9 @@ repository cardano-haskell-packages
     d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
 
 index-state:
-  , hackage.haskell.org 2025-04-16T16:04:13Z
-  , cardano-haskell-packages 2025-05-16T15:25:35Z
-    
+  , hackage.haskell.org 2025-06-22T20:18:27Z
+  , cardano-haskell-packages 2025-07-14T17:31:29Z
+
 -- We never, ever, want this.
 write-ghc-environment-files: never
 
@@ -47,12 +47,12 @@ package cardano-crypto-praos
   flags: -external-libsodium-vrf
 
 constraints:
-  cardano-api == 10.16.1.0
+  cardano-api == 10.17.2.0
 
 source-repository-package
     type: git
     location: https://github.com/intersectMBO/cardano-node-emulator
-    tag: 6d65996418d2b00fa791407ec47e2fe77c208790
+    tag: origin/mm/update-prot-version
     subdir:
       plutus-script-utils
       plutus-ledger

cooked-validators.cabal

@@ -17,7 +17,6 @@ library
       Cooked.Attack.AddToken
       Cooked.Attack.DatumHijacking
       Cooked.Attack.DoubleSat
-      Cooked.Attack.DupToken
       Cooked.InitialDistribution
       Cooked.Ltl
       Cooked.MockChain
@@ -26,7 +25,9 @@ library
       Cooked.MockChain.BlockChain
       Cooked.MockChain.Direct
       Cooked.MockChain.GenerateTx
+      Cooked.MockChain.GenerateTx.Anchor
       Cooked.MockChain.GenerateTx.Body
+      Cooked.MockChain.GenerateTx.Certificate
       Cooked.MockChain.GenerateTx.Collateral
       Cooked.MockChain.GenerateTx.Common
       Cooked.MockChain.GenerateTx.Input
@@ -51,15 +52,18 @@ library
       Cooked.Pretty.Skeleton
       Cooked.ShowBS
       Cooked.Skeleton
+      Cooked.Skeleton.Anchor
+      Cooked.Skeleton.Certificate
       Cooked.Skeleton.Datum
+      Cooked.Skeleton.Families
       Cooked.Skeleton.Label
       Cooked.Skeleton.Mint
       Cooked.Skeleton.Option
       Cooked.Skeleton.Output
-      Cooked.Skeleton.Payable
       Cooked.Skeleton.Proposal
       Cooked.Skeleton.Redeemer
-      Cooked.Skeleton.ReferenceScript
+      Cooked.Skeleton.User
+      Cooked.Skeleton.Value
       Cooked.Skeleton.Withdrawal
       Cooked.Tweak
       Cooked.Tweak.Common
@@ -169,6 +173,7 @@ test-suite spec
       Spec.Attack.DupToken
       Spec.Balancing
       Spec.BasicUsage
+      Spec.Certificates
       Spec.InitialDistribution
       Spec.InlineDatums
       Spec.Ltl

flake.nix

@@ -66,7 +66,8 @@
           LD_LIBRARY_PATH = pkgs.lib.strings.makeLibraryPath [
             pkgs.xz
             pkgs.zlib
-            pkgs.openssl_3_4
+            pkgs.lmdb
+            pkgs.openssl_3_5
             pkgs.postgresql # For cardano-node-emulator
             pkgs.openldap # For freer-extras‽
             pkgs.libsodium

src/Cooked.hs

@@ -1,10 +1,16 @@
 -- | Re-exports the entirety of the library, which is always eventually necessary
 --  when writing large test-suites.
-module Cooked (module X) where
+module Cooked
+  ( module X,
+    Ltl (..),
+    MonadModal (..),
+    ltlDelay,
+  )
+where
 
 import Cooked.Attack as X
 import Cooked.InitialDistribution as X
-import Cooked.Ltl as X (Ltl (..), MonadModal (..), ltlDelay)
+import Cooked.Ltl (Ltl (..), MonadModal (..), ltlDelay)
 import Cooked.MockChain as X
 import Cooked.Pretty as X
 import Cooked.ShowBS as X

src/Cooked/Attack.hs

@@ -15,4 +15,3 @@ module Cooked.Attack (module X) where
 import Cooked.Attack.AddToken as X
 import Cooked.Attack.DatumHijacking as X
 import Cooked.Attack.DoubleSat as X
-import Cooked.Attack.DupToken as X

src/Cooked/Attack/AddToken.hs

@@ -1,53 +1,95 @@
--- | This module provides an automated attack to mint and give extra tokens to a
--- certain wallet.
-module Cooked.Attack.AddToken (addTokenAttack, AddTokenLbl (..)) where
+-- | This module provides two automated attacks to mint and give extra tokens to
+-- a certain target.
+module Cooked.Attack.AddToken
+  ( addTokenAttack,
+    AddTokenLbl (..),
+    dupTokenAttack,
+    DupTokenLbl (..),
+  )
+where
 
 import Control.Monad
 import Cooked.Pretty
 import Cooked.Skeleton
 import Cooked.Tweak
+import Data.List.NonEmpty qualified as NEList
+import Data.Map qualified as Map
+import Data.Map.NonEmpty qualified as NEMap
 import Optics.Core
-import Plutus.Script.Utils.Scripts qualified as Script
+import Plutus.Script.Utils.Value qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
-import PlutusTx.AssocMap qualified as PMap
+import PlutusTx.Numeric qualified as PlutusTx
 import Prettyprinter qualified as PP
+import Test.QuickCheck.Modifiers
 
--- | This attack adds extra tokens, depending on the minting policy. It is
--- different from the 'Cooked.Attack.DupToken.dupTokenAttack' in that it does
--- not merely try to increase the amount of tokens minted: It tries to mint
--- tokens of asset classes that were not necessarily present on the unmodified
--- transaction.
+-- | This attack adds extra tokens of any kind for minting policies already
+-- present in the minted value. The additional minted value is redirected to a
+-- certain owner in a dedicated output.
 --
 -- This attack adds an 'AddTokenLbl' label.
 addTokenAttack ::
-  (MonadTweak m, OwnerConstrs o) =>
+  (MonadTweak m, IsTxSkelOutAllowedOwner o) =>
   -- | For each policy that occurs in some 'Mint' constraint, return a list of
   -- token names together with how many tokens with that name should be minted.
-  (Script.Versioned Script.MintingPolicy -> [(Api.TokenName, Integer)]) ->
+  (VScript -> [(Api.TokenName, Integer)]) ->
   -- | The wallet of the attacker where extra tokens will be paid to
   o ->
   m Api.Value
 addTokenAttack extraTokens attacker = do
-  oldMintsList <- viewTweak $ txSkelMintsL % txSkelMintsListI
-  let (newMintsList, totalIncrement) =
-        foldl
-          ( \(newMs, addVal) (Mint mp@(Script.toVersioned @Script.MintingPolicy -> mp') red tks) ->
-              let change = extraTokens mp'
-               in ( Mint mp red (tks ++ change) : newMs,
-                    Api.Value (PMap.singleton (Script.toCurrencySymbol mp') (PMap.unsafeFromList change)) <> addVal
-                  )
-          )
-          ([], mempty)
-          oldMintsList
+  currencies <- viewTweak (txSkelMintsL % txSkelMintsAssetClassesG % to (fmap fst))
+  oldMintsValue <- viewTweak (txSkelMintsL % to Script.toValue)
+  forM_ [(mp, tk, n) | mp <- currencies, (tk, n) <- extraTokens mp] $ \(mp, tk, n) ->
+    overTweak (txSkelMintsL % txSkelMintsAssetClassAmountL mp tk % _2) (+ n)
+  totalIncrement <- viewTweak (txSkelMintsL % to Script.toValue % to (<> PlutusTx.negate oldMintsValue))
   guard (totalIncrement /= mempty)
-  setTweak (txSkelMintsL % txSkelMintsListI) newMintsList
   addOutputTweak $ attacker `receives` Value totalIncrement
   addLabelTweak AddTokenLbl
   return totalIncrement
 
+-- | This attack is similar to 'addTokenAttack' with the exception that it only
+-- tampers with token names already present.
+--
+-- This attack adds an 'DupTokenLbl' label
+dupTokenAttack ::
+  (MonadTweak m, IsTxSkelOutAllowedOwner o) =>
+  -- | A function describing how the amount of tokens specified by a 'Mint'
+  -- constraint should be changed, depending on the asset class and the amount
+  -- specified by the constraint. The given function @f@ should probably satisfy
+  -- @f ac i > i@ for all @ac@ and @i@, i.e. it should increase the minted
+  -- amount. If it does not, the tweak will still succeed but this might result
+  -- in negative portions in the value paid to the attacker.
+  (VScript -> Api.TokenName -> Integer -> Integer) ->
+  -- | The target of the extra tokens. Any additional tokens that are minted by
+  -- the modified transaction but were not minted by the original transaction
+  -- are paid to this wallet.
+  o ->
+  m Api.Value
+dupTokenAttack change attacker = do
+  mints <- viewTweak txSkelMintsL
+  res <-
+    addTokenAttack
+      ( \s ->
+          maybe
+            []
+            (\(_, subMap) -> [(tk, change s tk n - n) | (tk, NonZero n) <- NEList.toList $ NEMap.toList subMap])
+            (s `Map.lookup` mints)
+      )
+      attacker
+  removeLabelTweak AddTokenLbl
+  addLabelTweak DupTokenLbl
+  return res
+
 -- | A label that is added to a 'TxSkel' that has successfully been modified by
 -- 'addTokenAttack'
 data AddTokenLbl = AddTokenLbl deriving (Show, Eq, Ord)
 
 instance PrettyCooked AddTokenLbl where
   prettyCooked = PP.viaShow
+
+-- | A label that is added to a 'TxSkel' that has successfully been modified by
+-- the 'dupTokenAttack'
+data DupTokenLbl = DupTokenLbl
+  deriving (Eq, Show, Ord)
+
+instance PrettyCooked DupTokenLbl where
+  prettyCooked _ = "DupToken"