it compiles

src/Cooked/InitialDistribution.hs

@@ -8,8 +8,8 @@ module Cooked.InitialDistribution
 where
 
 import Cooked.Skeleton
-import Cooked.ValueUtils
 import Cooked.Wallet
+import Cooked.Wrappers
 import Data.Default
 import Data.List
 import PlutusLedgerApi.V3 qualified as Api
@@ -36,7 +36,7 @@ newtype InitialDistribution = InitialDistribution {unInitialDistribution :: [TxS
 
 -- | 5 UTxOs with 100 Ada each, for each of the 'knownWallets'
 instance Default InitialDistribution where
-  def = distributionFromList . zip knownWallets . repeat . replicate 5 $ ada 100
+  def = distributionFromList . zip knownWallets . repeat . replicate 5 $ toValue @Integer 100
 
 instance Semigroup InitialDistribution where
   i <> j = InitialDistribution $ unInitialDistribution i <> unInitialDistribution j
@@ -46,4 +46,4 @@ instance Monoid InitialDistribution where
 
 -- | Creating a initial distribution with simple values assigned to wallets
 distributionFromList :: [(Wallet, [Api.Value])] -> InitialDistribution
-distributionFromList = InitialDistribution . foldl' (\x (user, values) -> x <> map (paysPK (walletPKHash user)) values) []
+distributionFromList = InitialDistribution . foldl' (\x (user, values) -> x <> map (paysPK user) values) []

src/Cooked/MockChain/UtxoSearch.hs

@@ -6,9 +6,9 @@ module Cooked.MockChain.UtxoSearch where
 import Control.Monad
 import Control.Monad.Trans
 import Control.Monad.Trans.Maybe
-import Cooked.Classes
 import Cooked.MockChain.BlockChain
 import Cooked.Output
+import Cooked.Wrappers
 import Data.Maybe
 import Ledger.Tx qualified as Ledger
 import ListT (ListT (..))
@@ -99,12 +99,12 @@ negateF f a = maybe (Just a) (const Nothing) <$> f a
 
 -- | Search all 'TxOutRef's at a certain address, together with their
 -- 'TxInfo'-'TxOut'.
-utxosAtSearch :: (MonadBlockChainBalancing m, HasAddress addr) => addr -> UtxoSearch m Api.TxOut
+utxosAtSearch :: (MonadBlockChainBalancing m, ToAddress addr) => addr -> UtxoSearch m Api.TxOut
 utxosAtSearch = lift . (utxosAt >=> ListT.fromFoldable) . toAddress
 
 -- | Like 'utxosAtSearch', but returns a Ledger-level representation of the
 -- transaction outputs, which might contain more information.
-utxosAtLedgerSearch :: (MonadBlockChainBalancing m, HasAddress addr) => addr -> UtxoSearch m Ledger.TxOut
+utxosAtLedgerSearch :: (MonadBlockChainBalancing m, ToAddress addr) => addr -> UtxoSearch m Ledger.TxOut
 utxosAtLedgerSearch = lift . (utxosAtLedger >=> ListT.fromFoldable) . toAddress
 
 -- | Search all currently known 'TxOutRef's together with their corresponding
@@ -152,7 +152,7 @@ vanillaUtxosSearch =
     *+* pureFilter isOutputWithoutDatum
     *+* pureBoolFilter (isNothing . view outputReferenceScriptL)
 
-vanillaUtxosAtSearch :: (MonadBlockChainBalancing m, HasAddress addr) => addr -> UtxoSearch m (ConcreteOutput Api.Credential () Script.Ada Api.ScriptHash)
+vanillaUtxosAtSearch :: (MonadBlockChainBalancing m, ToAddress addr) => addr -> UtxoSearch m (ConcreteOutput Api.Credential () Script.Ada Api.ScriptHash)
 vanillaUtxosAtSearch addr =
   utxosAtSearch addr
     *+* pureAlwaysFilter fromAbstractOutput

src/Cooked/Output.hs

@@ -24,7 +24,7 @@ module Cooked.Output
     outputValue,
     outputReferenceScriptHash,
     outputTxOut,
-    ConcreteOutput (ConcreteOutput),
+    ConcreteOutput (..),
     toOutputWithReferenceScriptHash,
     isOutputWithoutDatum,
     isOutputWithInlineDatum,
@@ -37,7 +37,7 @@ module Cooked.Output
   )
 where
 
-import Cooked.Classes
+import Cooked.Wrappers
 import Optics.Core
 import Plutus.Script.Utils.Ada qualified as Script
 import Plutus.Script.Utils.Typed qualified as Script hiding (validatorHash)

src/Cooked/Skeleton.hs

@@ -79,11 +79,11 @@ where
 import Cardano.Api qualified as Cardano
 import Cardano.Node.Emulator qualified as Emulator
 import Control.Monad
-import Cooked.Classes
 import Cooked.Output
 import Cooked.Pretty.Class
 import Cooked.ValueUtils
 import Cooked.Wallet
+import Cooked.Wrappers
 import Data.Default
 import Data.Either.Combinators
 import Data.Function
@@ -617,14 +617,14 @@ txSkelOutTypedDatum = Api.fromBuiltinData . Api.getDatum <=< txSkelOutUntypedDat
 -- ** Smart constructors for transaction outputs
 
 -- | Pay a certain value to a public key.
-paysPK :: (HasPubKeyHash a) => a -> Api.Value -> TxSkelOut
-paysPK a value =
+paysPK :: (ToPubKeyHash a, ToValue v) => a -> v -> TxSkelOut
+paysPK pkh value =
   Pays
     ( ConcreteOutput
-        (toPubKeyHash a)
+        (toPubKeyHash pkh)
         Nothing
         TxSkelOutNoDatum
-        value
+        (toValue value)
         (Nothing @(Script.Versioned Script.Script))
     )
 
@@ -636,19 +636,20 @@ paysScript ::
     Typeable (Script.DatumType a),
     PlutusTx.Eq (Script.DatumType a),
     PrettyCooked (Script.DatumType a),
-    Typeable a
+    Typeable a,
+    ToValue value
   ) =>
   Script.TypedValidator a ->
   Script.DatumType a ->
-  Api.Value ->
+  value ->
   TxSkelOut
 paysScript validator datum value =
   Pays
     ( ConcreteOutput
         validator
         Nothing
         (TxSkelOutDatum datum)
-        value
+        (toValue value)
         (Nothing @(Script.Versioned Script.Script))
     )
 
@@ -659,19 +660,20 @@ paysScriptInlineDatum ::
     Typeable (Script.DatumType a),
     PlutusTx.Eq (Script.DatumType a),
     PrettyCooked (Script.DatumType a),
-    Typeable a
+    Typeable a,
+    ToValue value
   ) =>
   Script.TypedValidator a ->
   Script.DatumType a ->
-  Api.Value ->
+  value ->
   TxSkelOut
 paysScriptInlineDatum validator datum value =
   Pays
     ( ConcreteOutput
         validator
         Nothing
         (TxSkelOutInlineDatum datum)
-        value
+        (toValue value)
         (Nothing @(Script.Versioned Script.Script))
     )
 
@@ -683,131 +685,62 @@ paysScriptDatumHash ::
     Typeable (Script.DatumType a),
     PlutusTx.Eq (Script.DatumType a),
     PrettyCooked (Script.DatumType a),
-    Typeable a
+    Typeable a,
+    ToValue value
   ) =>
   Script.TypedValidator a ->
   Script.DatumType a ->
-  Api.Value ->
+  value ->
   TxSkelOut
 paysScriptDatumHash validator datum value =
   Pays
     ( ConcreteOutput
         validator
         Nothing
         (TxSkelOutDatumHash datum)
-        value
+        (toValue value)
         (Nothing @(Script.Versioned Script.Script))
     )
 
 -- | Pays a script a certain value without any datum. Intended to be used with
 -- 'withDatum', 'withDatumHash', or 'withInlineDatum' to try a datum whose type
 -- does not match the validator's.
-paysScriptNoDatum :: (Typeable a) => Script.TypedValidator a -> Api.Value -> TxSkelOut
+paysScriptNoDatum :: (Typeable a, ToValue value) => Script.TypedValidator a -> value -> TxSkelOut
 paysScriptNoDatum validator value =
   Pays
     ( ConcreteOutput
         validator
         Nothing
         TxSkelOutNoDatum
-        value
+        (toValue value)
         (Nothing @(Script.Versioned Script.Script))
     )
 
 -- | Set the datum in a payment to the given datum (whose type may not fit the
 -- typed validator in case of a script).
-withDatum ::
-  ( Api.ToData a,
-    Show a,
-    Typeable a,
-    PlutusTx.Eq a,
-    PrettyCooked a
-  ) =>
-  TxSkelOut ->
-  a ->
-  TxSkelOut
-withDatum (Pays output) datum =
-  Pays $
-    ConcreteOutput
-      (output ^. outputOwnerL)
-      (output ^. outputStakingCredentialL)
-      (TxSkelOutDatum datum)
-      (output ^. outputValueL)
-      (output ^. outputReferenceScriptL)
+withDatum :: (Api.ToData a, Show a, Typeable a, PlutusTx.Eq a, PrettyCooked a) => TxSkelOut -> a -> TxSkelOut
+withDatum (Pays output) datum = Pays $ (fromAbstractOutput output) {concreteOutputDatum = TxSkelOutDatum datum}
 
 -- | Set the datum in a payment to the given inlined datum (whose type may not
 -- fit the typed validator in case of a script).
-withInlineDatum ::
-  ( Api.ToData a,
-    Show a,
-    Typeable a,
-    PlutusTx.Eq a,
-    PrettyCooked a
-  ) =>
-  TxSkelOut ->
-  a ->
-  TxSkelOut
-withInlineDatum (Pays output) datum =
-  Pays $
-    ConcreteOutput
-      (output ^. outputOwnerL)
-      (output ^. outputStakingCredentialL)
-      (TxSkelOutInlineDatum datum)
-      (output ^. outputValueL)
-      (output ^. outputReferenceScriptL)
+withInlineDatum :: (Api.ToData a, Show a, Typeable a, PlutusTx.Eq a, PrettyCooked a) => TxSkelOut -> a -> TxSkelOut
+withInlineDatum (Pays output) datum = Pays $ (fromAbstractOutput output) {concreteOutputDatum = TxSkelOutInlineDatum datum}
 
 -- | Set the datum in a payment to the given hashed (not resolved in the
 -- transaction) datum (whose type may not fit the typed validator in case of a
 -- script).
-withDatumHash ::
-  ( Api.ToData a,
-    Show a,
-    Typeable a,
-    PlutusTx.Eq a,
-    PrettyCooked a
-  ) =>
-  TxSkelOut ->
-  a ->
-  TxSkelOut
-withDatumHash (Pays output) datum =
-  Pays $
-    ConcreteOutput
-      (output ^. outputOwnerL)
-      (output ^. outputStakingCredentialL)
-      (TxSkelOutDatumHash datum)
-      (output ^. outputValueL)
-      (output ^. outputReferenceScriptL)
+withDatumHash :: (Api.ToData a, Show a, Typeable a, PlutusTx.Eq a, PrettyCooked a) => TxSkelOut -> a -> TxSkelOut
+withDatumHash (Pays output) datum = Pays $ (fromAbstractOutput output) {concreteOutputDatum = TxSkelOutDatumHash datum}
 
 -- | Add a reference script to a transaction output (or replace it if there is
 -- already one)
-withReferenceScript ::
-  ( Show script,
-    ToScript script,
-    Typeable script,
-    ToScriptHash script
-  ) =>
-  TxSkelOut ->
-  script ->
-  TxSkelOut
-withReferenceScript (Pays output) script =
-  Pays $
-    ConcreteOutput
-      (output ^. outputOwnerL)
-      (output ^. outputStakingCredentialL)
-      (output ^. outputDatumL)
-      (output ^. outputValueL)
-      (Just script)
+withReferenceScript :: (Show script, ToScript script, Typeable script, ToScriptHash script) => TxSkelOut -> script -> TxSkelOut
+withReferenceScript (Pays output) script = Pays $ (fromAbstractOutput output) {concreteOutputReferenceScript = Just script}
 
 -- | Add a staking credential to a transaction output (or replace it if there is
 -- already one)
 withStakingCredential :: TxSkelOut -> Api.StakingCredential -> TxSkelOut
-withStakingCredential (Pays output) stakingCredential =
-  Pays $
-    ConcreteOutput
-      (output ^. outputOwnerL)
-      (Just stakingCredential)
-      (output ^. outputDatumL)
-      (output ^. outputValueL)
-      (output ^. outputReferenceScriptL)
+withStakingCredential (Pays output) stakingCredential = Pays $ (fromAbstractOutput output) {concreteOutputStakingCredential = Just stakingCredential}
 
 -- * Redeemers for transaction inputs
 

src/Cooked/ValueUtils.hs

@@ -4,8 +4,6 @@ module Cooked.ValueUtils
     positivePart,
     negativePart,
     adaL,
-    lovelace,
-    ada,
   )
 where
 
@@ -52,14 +50,4 @@ adaL =
   where
     insertAssocList :: (Eq a) => [(a, b)] -> a -> b -> [(a, b)]
     insertAssocList l a b = (a, b) : filter ((/= a) . fst) l
-
--- * Helpers for manipulating ada and lovelace
-
-adaAssetClass :: Script.AssetClass
-adaAssetClass = Script.assetClass Script.adaSymbol Script.adaToken
-
-lovelace :: Integer -> Api.Value
-lovelace = Script.assetClassValue adaAssetClass
-
-ada :: Integer -> Api.Value
-ada = lovelace . (* 1_000_000)
+    adaAssetClass = Script.assetClass Script.adaSymbol Script.adaToken

src/Cooked/Wrappers.hs

@@ -3,7 +3,7 @@
 -- the use of the rest of cooked-validators. For instance, when paying
 -- to a wallet, all we need is its address. Retrieving it will
 -- walletAddress is inconvenient as we know a wallet possess an
--- address. By creating a type class `HasAddress` we overcome this
+-- address. By creating a type class `ToAddress` we overcome this
 -- limitation and allow payments directly both to addresses or
 -- wallets.
 module Cooked.Wrappers where
@@ -15,26 +15,26 @@ import Plutus.Script.Utils.Typed qualified as Script
 import PlutusLedgerApi.V3 qualified as Api
 
 -- | Objects from which and address can be extracted
-class HasAddress a where
+class ToAddress a where
   toAddress :: a -> Api.Address
 
-instance HasAddress Wallet where
+instance ToAddress Wallet where
   toAddress = walletAddress
 
-instance HasAddress Api.Address where
+instance ToAddress Api.Address where
   toAddress = id
 
-instance HasAddress (Script.TypedValidator a) where
+instance ToAddress (Script.TypedValidator a) where
   toAddress = Script.validatorAddress
 
 -- | Objects from which a public key hash can be extracted
-class HasPubKeyHash a where
+class ToPubKeyHash a where
   toPubKeyHash :: a -> Api.PubKeyHash
 
-instance HasPubKeyHash Api.PubKeyHash where
+instance ToPubKeyHash Api.PubKeyHash where
   toPubKeyHash = id
 
-instance HasPubKeyHash Wallet where
+instance ToPubKeyHash Wallet where
   toPubKeyHash = walletPKHash
 
 -- | Objects from which a credential can be extracted
@@ -79,6 +79,9 @@ instance ToValue Api.Value where
 instance ToValue Script.Ada where
   toValue = Script.toValue
 
+instance ToValue Integer where
+  toValue = toValue . Script.Lovelace . (* 1_000_000)
+
 -- | Objects from which a versioned script can be extracted
 class ToScript a where
   toScript :: a -> Script.Versioned Script.Script

tests/Cooked/Attack/DatumHijackingSpec.hs

@@ -57,7 +57,7 @@ lockTxSkel o v =
   txSkelTemplate
     { txSkelOpts = def {txOptEnsureMinAda = True},
       txSkelIns = Map.singleton o TxSkelNoRedeemerForPK,
-      txSkelOuts = [paysScriptInlineDatum v FirstLock lockValue],
+      txSkelOuts = [paysScriptInlineDatum @_ v FirstLock lockValue],
       txSkelSigners = [wallet 1]
     }