diff --git a/plutus-ledger/src/Ledger/CardanoWallet.hs b/plutus-ledger/src/Ledger/CardanoWallet.hs index 02210b3..417cc50 100644 --- a/plutus-ledger/src/Ledger/CardanoWallet.hs +++ b/plutus-ledger/src/Ledger/CardanoWallet.hs @@ -29,6 +29,7 @@ module Ledger.CardanoWallet ( stakingCredential, stakePubKeyHash, stakePubKey, + stakePrivateKey, knownAddresses, knownPaymentKeys, knownPaymentPublicKeys, @@ -55,6 +56,7 @@ import Ledger.Address ( PaymentPrivateKey (PaymentPrivateKey, unPaymentPrivateKey), PaymentPubKey (PaymentPubKey, unPaymentPubKey), PaymentPubKeyHash (PaymentPubKeyHash, unPaymentPubKeyHash), + StakePrivateKey (StakePrivateKey, unStakePrivateKey), StakePubKey (StakePubKey, unStakePubKey), StakePubKeyHash (StakePubKeyHash, unStakePubKeyHash), stakePubKeyHashCredential, @@ -177,7 +179,11 @@ stakePubKeyHash w = StakePubKeyHash . Crypto.pubKeyHash . unStakePubKey <$> stak -- | The mock wallet's stake public key stakePubKey :: MockWallet -> Maybe StakePubKey -stakePubKey w = StakePubKey . Crypto.toPublicKey . unMockPrivateKey <$> mwStakeKey w +stakePubKey w = StakePubKey . Crypto.toPublicKey . unStakePrivateKey <$> stakePrivateKey w + +-- | The mock wallet's stake private key +stakePrivateKey :: MockWallet -> Maybe StakePrivateKey +stakePrivateKey w = StakePrivateKey . unMockPrivateKey <$> mwStakeKey w -- | The mock wallet's staking credentials stakingCredential :: MockWallet -> Maybe StakingCredential diff --git a/plutus-script-utils/plutus-script-utils.cabal b/plutus-script-utils/plutus-script-utils.cabal index 899bd61..85d4a6e 100644 --- a/plutus-script-utils/plutus-script-utils.cabal +++ b/plutus-script-utils/plutus-script-utils.cabal @@ -118,6 +118,7 @@ library , base >=4.9 && <5 , bytestring , mtl + , optics-core , prettyprinter , serialise , tagged diff --git a/plutus-script-utils/src/Plutus/Script/Utils/Value.hs b/plutus-script-utils/src/Plutus/Script/Utils/Value.hs index 3ae7a6b..f24d3f1 100644 --- a/plutus-script-utils/src/Plutus/Script/Utils/Value.hs +++ b/plutus-script-utils/src/Plutus/Script/Utils/Value.hs @@ -1,15 +1,23 @@ +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE NoImplicitPrelude #-} module Plutus.Script.Utils.Value ( module Export, + adaAssetClass, + lovelace, + ada, noAdaValue, adaOnlyValue, isAdaOnlyValue, currencyValueOf, mpsSymbol, currencyMPSHash, -) where + adaL, + flattenValueI, +) +where +import Optics.Core (Iso', Lens', iso, lens, over) import Plutus.Script.Utils.Ada qualified as Ada import Plutus.Script.Utils.Scripts (MintingPolicyHash (MintingPolicyHash)) import PlutusLedgerApi.V1.Value as Export ( @@ -39,7 +47,40 @@ import PlutusLedgerApi.V1.Value as Export ( valueOf, ) import PlutusTx.AssocMap qualified as Map -import PlutusTx.Prelude (Bool, Eq ((==)), Maybe (Just, Nothing), mempty, (-)) +import PlutusTx.Prelude ( + Bool, + Eq ((==)), + Integer, + Maybe (Just, Nothing), + filter, + foldl, + fst, + map, + mempty, + (*), + (-), + (.), + (/=), + (<>), + ) + +{-# INLINEABLE adaAssetClass #-} + +-- | Ada asset class +adaAssetClass :: AssetClass +adaAssetClass = assetClass adaSymbol adaToken + +{-# INLINEABLE lovelace #-} + +-- | Create a value from a certain amount of lovelace +lovelace :: Integer -> Value +lovelace = Ada.toValue . Ada.Lovelace + +{-# INLINEABLE ada #-} + +-- | Create a value from a certain amount of ada +ada :: Integer -> Value +ada = lovelace . (* 1_000_000) {-# INLINEABLE noAdaValue #-} @@ -54,6 +95,8 @@ adaOnlyValue :: Value -> Value adaOnlyValue v = Ada.toValue (Ada.fromValue v) {-# INLINEABLE isAdaOnlyValue #-} + +-- | Check if a value only contains ada isAdaOnlyValue :: Value -> Bool isAdaOnlyValue v = adaOnlyValue v == v @@ -79,3 +122,26 @@ mpsSymbol (MintingPolicyHash h) = CurrencySymbol h -- | The minting policy hash of a currency symbol currencyMPSHash :: CurrencySymbol -> MintingPolicyHash currencyMPSHash (CurrencySymbol h) = MintingPolicyHash h + +{-# INLINEABLE flattenValueI #-} + +-- | Isomorphism between values and lists of pairs AssetClass and Integers +flattenValueI :: Iso' Value [(AssetClass, Integer)] +flattenValueI = + iso + (map (\(cSymbol, tName, amount) -> (assetClass cSymbol tName, amount)) . flattenValue) + (foldl (\v (ac, amount) -> v <> assetClassValue ac amount) mempty) + +{-# INLINEABLE adaL #-} + +-- | Focus the Ada part in a value. +adaL :: Lens' Value Ada.Ada +adaL = + lens + Ada.fromValue + ( \value (Ada.Lovelace amount) -> + over flattenValueI (insertAssocList adaAssetClass amount) value + ) + where + insertAssocList :: (Eq a) => a -> b -> [(a, b)] -> [(a, b)] + insertAssocList a b l = (a, b) : filter ((/= a) . fst) l