From 0debd9c7593c8bfb758797f995e2b0613a326ca8 Mon Sep 17 00:00:00 2001 From: mmontin Date: Mon, 25 Mar 2024 13:50:35 +0100 Subject: [PATCH] updating Currencies.hs --- src/Cooked/Currencies.hs | 97 +++++++++++++++++++--------------------- 1 file changed, 46 insertions(+), 51 deletions(-) diff --git a/src/Cooked/Currencies.hs b/src/Cooked/Currencies.hs index fa53694c6..439744b5f 100644 --- a/src/Cooked/Currencies.hs +++ b/src/Cooked/Currencies.hs @@ -1,32 +1,24 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE NoImplicitPrelude #-} --- | This module introduces currencies (namely the /quick values/ and the --- /permanent values/) which make it convenient to manipulate assets that are --- already supposed to exist when running a mock chain. For example, a market --- maker would exchange Ada against other assets. Yet, when writing traces for --- such a contract we would need to define a minting policy for those tokens, --- which is tedious. Moreover, we often want wallets to have some of such --- tokens from the start (see 'initialDistributions' in "Cooked.Wallet"). +-- | This module introduces currencies (namely the /quick values/ and +-- the /permanent values/) which make it convenient to manipulate +-- assets that are already supposed to exist when running a mock +-- chain. For example, a market maker would exchange Ada against other +-- assets. Yet, when writing traces for such a contract we would need +-- to define a minting policy for those tokens, which is +-- tedious. Moreover, we often want wallets to have some of such +-- tokens from the start (see "Cooked.InitialDistribution"). -- --- The @quick@ prefixed functions provide access to tokens from the @const --- (const True)@ minting policy. That is, these can be minted and burnt at --- will, at any point in time. +-- The @quick@ prefixed functions provide access to tokens from the +-- @const (const True)@ minting policy. That is, these can be minted +-- and burnt at will, at any point in time. -- --- The @permanent@ prefixed functions provide access to tokens from the @const --- (const False)@ minting policy. That is, these /cannot/ ever be minted or --- burnt and must be present in an initial distribution (see --- 'initialDistribution') to be useful. +-- The @permanent@ prefixed functions provide access to tokens from +-- the @const (const False)@ minting policy. That is, these /cannot/ +-- ever be minted or burnt and must be present in an initial +-- distribution. module Cooked.Currencies ( quickTokenName, quickAssetClass, @@ -38,67 +30,70 @@ module Cooked.Currencies quickCurrencySymbol, permanentCurrencyPolicy, permanentCurrencySymbol, + currencySymbolFromLanguageAndMP, ) where -import qualified Ledger.Typed.Scripts as Scripts -import qualified Plutus.Script.Utils.V2.Scripts as Validation +import qualified Plutus.Script.Utils.Scripts as Pl +import qualified Plutus.Script.Utils.Typed as Pl import qualified Plutus.Script.Utils.Value as Pl -import qualified Plutus.V2.Ledger.Api as Pl +import qualified PlutusLedgerApi.V3 as Pl import qualified PlutusTx -import qualified PlutusTx.Builtins.Class as Pl -import PlutusTx.Prelude hiding (Applicative (..)) -import qualified Prelude as Haskell +import qualified PlutusTx.Builtins.Class as PlutusTx +import PlutusTx.Prelude (Bool (..), Integer, flip, (.)) +import Prelude (String) + +-- | Takes a minting policy and a language version and returns the +-- associated currency symbol +currencySymbolFromLanguageAndMP :: Pl.Language -> Pl.MintingPolicy -> Pl.CurrencySymbol +currencySymbolFromLanguageAndMP lang = Pl.scriptCurrencySymbol . flip Pl.Versioned lang -- * Quick Values --- | Token name of a /quick/ asset class; prefixes the name with a @'q'@ to --- make it easy to distinguish between quick and permanent tokens. -quickTokenName :: Haskell.String -> Pl.TokenName -quickTokenName = Pl.TokenName . Pl.stringToBuiltinByteString +-- | Token name of a /quick/ asset class; prefixes the name with a +-- @'q'@ to make it easy to distinguish between quick and permanent +-- tokens. +quickTokenName :: String -> Pl.TokenName +quickTokenName = Pl.TokenName . PlutusTx.stringToBuiltinByteString -- | /Quick/ asset class from a token name -quickAssetClass :: Haskell.String -> Pl.AssetClass -quickAssetClass = curry Pl.AssetClass quickCurrencySymbol . quickTokenName +quickAssetClass :: String -> Pl.AssetClass +quickAssetClass = Pl.assetClass quickCurrencySymbol . quickTokenName -- | Constructor for /quick/ values from token name and amount -quickValue :: Haskell.String -> Integer -> Pl.Value +quickValue :: String -> Integer -> Pl.Value quickValue = Pl.assetClassValue . quickAssetClass {-# INLINEABLE mkQuickCurrencyPolicy #-} mkQuickCurrencyPolicy :: () -> Pl.ScriptContext -> Bool mkQuickCurrencyPolicy _ _ = True -quickCurrencyPolicy :: Scripts.MintingPolicy -quickCurrencyPolicy = - Pl.mkMintingPolicyScript - $$(PlutusTx.compile [||Scripts.mkUntypedMintingPolicy mkQuickCurrencyPolicy||]) +quickCurrencyPolicy :: Pl.MintingPolicy +quickCurrencyPolicy = Pl.mkMintingPolicyScript $$(PlutusTx.compile [||Pl.mkUntypedMintingPolicy mkQuickCurrencyPolicy||]) quickCurrencySymbol :: Pl.CurrencySymbol -quickCurrencySymbol = Validation.scriptCurrencySymbol quickCurrencyPolicy +quickCurrencySymbol = currencySymbolFromLanguageAndMP Pl.PlutusV3 quickCurrencyPolicy -- * Permanent values -- | Token name of a /permanent/ asset class -permanentTokenName :: Haskell.String -> Pl.TokenName -permanentTokenName = Pl.TokenName . Pl.stringToBuiltinByteString +permanentTokenName :: String -> Pl.TokenName +permanentTokenName = Pl.TokenName . PlutusTx.stringToBuiltinByteString -- | /Permanent/ asset class from a token name -permanentAssetClass :: Haskell.String -> Pl.AssetClass -permanentAssetClass = curry Pl.AssetClass permanentCurrencySymbol . permanentTokenName +permanentAssetClass :: String -> Pl.AssetClass +permanentAssetClass = Pl.assetClass permanentCurrencySymbol . permanentTokenName -- | Constructor for /Permanent/ values from token name and amount -permanentValue :: Haskell.String -> Integer -> Pl.Value +permanentValue :: String -> Integer -> Pl.Value permanentValue = Pl.assetClassValue . permanentAssetClass {-# INLINEABLE mkPermanentCurrencyPolicy #-} mkPermanentCurrencyPolicy :: () -> Pl.ScriptContext -> Bool mkPermanentCurrencyPolicy _ _ = False -permanentCurrencyPolicy :: Scripts.MintingPolicy -permanentCurrencyPolicy = - Pl.mkMintingPolicyScript - $$(PlutusTx.compile [||Scripts.mkUntypedMintingPolicy mkPermanentCurrencyPolicy||]) +permanentCurrencyPolicy :: Pl.MintingPolicy +permanentCurrencyPolicy = Pl.mkMintingPolicyScript $$(PlutusTx.compile [||Pl.mkUntypedMintingPolicy mkPermanentCurrencyPolicy||]) permanentCurrencySymbol :: Pl.CurrencySymbol -permanentCurrencySymbol = Validation.scriptCurrencySymbol permanentCurrencyPolicy +permanentCurrencySymbol = currencySymbolFromLanguageAndMP Pl.PlutusV3 permanentCurrencyPolicy