Audit changes

cooked-validators.cabal

@@ -1,6 +1,6 @@
 cabal-version: 3.4
 
--- This file has been generated from package.yaml by hpack version 0.36.1.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 

src/Cooked/MockChain/GenerateTx/Withdrawals.hs

@@ -37,7 +37,7 @@ toWithdrawals (Map.toList -> withdrawals) =
   fmap
     (Cardano.TxWithdrawals Cardano.ShelleyBasedEraConway)
     $ forM withdrawals
-    $ \(staker, Script.Lovelace n) ->
+    $ \(staker, (red, Script.Lovelace n)) ->
       do
         (witness, sCred) <-
           case staker of
@@ -46,7 +46,7 @@ toWithdrawals (Map.toList -> withdrawals) =
                 throwOnToCardanoError "toWithdrawals: unable to translate pkh stake credential" $
                   Cardano.StakeCredentialByKey <$> Ledger.toCardanoStakeKeyHash pkh
               return (Cardano.KeyWitness Cardano.KeyWitnessForStakeAddr, sCred)
-            Left (script, red) -> do
+            Left script -> do
               witness <-
                 Cardano.ScriptWitness Cardano.ScriptWitnessForStakeAddr
                   <$> liftTxGen (toScriptWitness script red Cardano.NoScriptDatumForStake)

src/Cooked/Pretty/Cooked.hs

@@ -186,11 +186,11 @@ prettyWithdrawals :: PrettyCookedOpts -> TxSkelWithdrawals -> Maybe DocCooked
 prettyWithdrawals pcOpts withdrawals =
   prettyItemizeNonEmpty "Withdrawals:" "-" $ prettyWithdrawal <$> Map.toList withdrawals
   where
-    prettyWithdrawal :: (Either (Script.Versioned Script.Script, TxSkelRedeemer) Api.PubKeyHash, Script.Ada) -> DocCooked
-    prettyWithdrawal (cred, ada) =
+    prettyWithdrawal :: (Either (Script.Versioned Script.Script) Api.PubKeyHash, (TxSkelRedeemer, Script.Ada)) -> DocCooked
+    prettyWithdrawal (cred, (red, ada)) =
       prettyItemizeNoTitle "-" $
         ( case cred of
-            Left (script, red) -> prettyCookedOpt pcOpts script : prettyTxSkelRedeemer pcOpts red
+            Left script -> prettyCookedOpt pcOpts script : prettyTxSkelRedeemer pcOpts red
             Right pkh -> [prettyCookedOpt pcOpts pkh]
         )
           ++ [prettyCookedOpt pcOpts (toValue ada)]

src/Cooked/Skeleton.hs

@@ -70,6 +70,8 @@ module Cooked.Skeleton
     TxSkelWithdrawals,
     txSkelWithdrawnValue,
     txSkelWithdrawalsScripts,
+    pkWithdrawal,
+    scriptWithdrawal,
     TxSkel (..),
     txSkelLabelL,
     txSkelOptsL,
@@ -590,16 +592,25 @@ withAnchor prop url = prop {txSkelProposalAnchor = Just url}
 
 -- * Description of the Withdrawals
 
+-- | Withdrawals associate either a script or a private key with a redeemer and
+-- a certain amount of ada. Note that the redeemer will be ignored in the case
+-- of a private key.
 type TxSkelWithdrawals =
   Map
-    (Either (Script.Versioned Script.Script, TxSkelRedeemer) Api.PubKeyHash)
-    Script.Ada
+    (Either (Script.Versioned Script.Script) Api.PubKeyHash)
+    (TxSkelRedeemer, Script.Ada)
 
 txSkelWithdrawnValue :: TxSkel -> Api.Value
-txSkelWithdrawnValue = mconcat . (toValue . snd <$>) . Map.toList . txSkelWithdrawals
+txSkelWithdrawnValue = mconcat . (toValue . snd . snd <$>) . Map.toList . txSkelWithdrawals
 
 txSkelWithdrawalsScripts :: TxSkel -> [Script.Versioned Script.Script]
-txSkelWithdrawalsScripts = (fst <$>) . fst . partitionEithers . (fst <$>) . Map.toList . txSkelWithdrawals
+txSkelWithdrawalsScripts = fst . partitionEithers . (fst <$>) . Map.toList . txSkelWithdrawals
+
+pkWithdrawal :: (ToPubKeyHash pkh) => pkh -> Script.Ada -> TxSkelWithdrawals
+pkWithdrawal pkh amount = Map.singleton (Right $ toPubKeyHash pkh) (txSkelEmptyRedeemer, amount)
+
+scriptWithdrawal :: (ToScript script) => script -> TxSkelRedeemer -> Script.Ada -> TxSkelWithdrawals
+scriptWithdrawal script red amount = Map.singleton (Left $ toScript script) (red, amount)
 
 -- * Description of the Minting
 

tests/Cooked/WithdrawalsSpec.hs

@@ -3,7 +3,6 @@ module Cooked.WithdrawalsSpec where
 import Control.Monad
 import Cooked
 import Data.Default
-import Data.Map qualified as Map
 import Plutus.Script.Utils.Ada qualified as Script
 import Plutus.Script.Utils.Scripts qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
@@ -40,10 +39,7 @@ testWithdrawingScript n1 n2 =
     validateTxSkel $
       txSkelTemplate
         { txSkelSigners = [wallet 1],
-          txSkelWithdrawals =
-            Map.singleton
-              (Left (checkWithdrawalVersionedScript, txSkelSomeRedeemer (n1 * 1_000 :: Integer)))
-              (Script.Lovelace $ n2 * 1_000)
+          txSkelWithdrawals = scriptWithdrawal checkWithdrawalVersionedScript (txSkelSomeRedeemer (n1 * 1_000 :: Integer)) $ Script.Lovelace $ n2 * 1_000
         }
 
 tests :: TestTree