{-# OPTIONS_GHC -Wno-orphans #-}

-- | This module exposes the minting constructs used in a
-- 'Cooked.Skeleton.TxSkel' and their associated utilities. To mint or burn
-- tokens in a skeleton, the usual way is to invoke @txSkelMints =
-- txSkelMintsFromList [mint script redeemer token quantity, burn ...]@
module Cooked.Skeleton.Mint
  ( -- * Data types
    Mint (..),
    TxSkelMints (unTxSkelMints),

    -- * Optics
    mintRedeemedScriptL,
    mintTokensL,
    mintCurrencySymbolG,
    txSkelMintsListI,
    txSkelMintsAssetClassAmountL,
    txSkelMintsAssetClassesG,
    txSkelMintsPolicyTokensL,

    -- * Smart constructors
    mint,
    burn,
    txSkelMintsFromList,
  )
where

import Cooked.Skeleton.Redeemer
import Cooked.Skeleton.User
import Data.Bifunctor
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe
import Data.String (IsString (fromString))
import Data.Typeable
import Optics.Core
import Optics.TH
import Plutus.Script.Utils.Scripts qualified as Script
import Plutus.Script.Utils.Value qualified as Script
import PlutusLedgerApi.V1.Value qualified as Api
import PlutusLedgerApi.V3 qualified as Api
import PlutusTx.AssocMap qualified as PMap

-- * Describing single mint entries

-- | A description of a new entry to be added in a 'TxSkelMints'. The users
-- should be using lists of those (using @txSkelMintsFromList@) instead of
-- building a 'TxSkelMints' directly.
data Mint where
  Mint ::
    { Mint -> User 'IsScript 'Redemption
mintRedeemedScript :: User IsScript Redemption,
      Mint -> [(TokenName, Integer)]
mintTokens :: [(Api.TokenName, Integer)]
    } ->
    Mint

-- * Extra builders for single mint entries

-- | Conveniency instance to be able to use Strings as 'Api.TokenName', which
-- used to be present in plutus-ledger-api.
instance IsString Api.TokenName where
  fromString :: String -> TokenName
fromString = BuiltinByteString -> TokenName
Api.TokenName (BuiltinByteString -> TokenName)
-> (String -> BuiltinByteString) -> String -> TokenName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BuiltinByteString
forall a. IsString a => String -> a
fromString

-- | Builds some 'Mint' when a single type of token is minted for a given MP
mint :: (ToVScript script, Typeable script, RedeemerConstrs red) => script -> red -> Api.TokenName -> Integer -> Mint
mint :: forall script red.
(ToVScript script, Typeable script, RedeemerConstrs red) =>
script -> red -> TokenName -> Integer -> Mint
mint script
mp red
red TokenName
tn Integer
n = User 'IsScript 'Redemption -> [(TokenName, Integer)] -> Mint
Mint (script -> TxSkelRedeemer -> User 'IsScript 'Redemption
forall script (a :: UserKind).
(a ∈ '[ 'IsScript, 'IsEither], ToVScript script,
 Typeable script) =>
script -> TxSkelRedeemer -> User a 'Redemption
UserRedeemedScript script
mp (red -> TxSkelRedeemer
forall redeemer.
RedeemerConstrs redeemer =>
redeemer -> TxSkelRedeemer
someTxSkelRedeemer red
red)) [(TokenName
tn, Integer
n)]

-- | Similar to 'mint' but deducing the tokens instead
burn :: (ToVScript script, Typeable script, RedeemerConstrs red) => script -> red -> Api.TokenName -> Integer -> Mint
burn :: forall script red.
(ToVScript script, Typeable script, RedeemerConstrs red) =>
script -> red -> TokenName -> Integer -> Mint
burn script
mp red
red TokenName
tn Integer
n = script -> red -> TokenName -> Integer -> Mint
forall script red.
(ToVScript script, Typeable script, RedeemerConstrs red) =>
script -> red -> TokenName -> Integer -> Mint
mint script
mp red
red TokenName
tn (-Integer
n)

-- * Optics to manipulate elements of 'Mint'

-- | A lens to set or get the redeemer of a 'Mint'
makeLensesFor [("mintRedeemedScript", "mintRedeemedScriptL")] ''Mint

-- | A lens to set or get the token list of a 'Mint'
makeLensesFor [("mintTokens", "mintTokensL")] ''Mint

-- | Returns the currency symbol associated with a `Mint`
mintCurrencySymbolG :: Getter Mint Api.CurrencySymbol
mintCurrencySymbolG :: Getter Mint CurrencySymbol
mintCurrencySymbolG =
  Lens' Mint (User 'IsScript 'Redemption)
mintRedeemedScriptL
    Lens' Mint (User 'IsScript 'Redemption)
-> Optic
     A_Lens
     NoIx
     (User 'IsScript 'Redemption)
     (User 'IsScript 'Redemption)
     VScript
     VScript
-> Optic A_Lens NoIx Mint Mint VScript VScript
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (User 'IsScript 'Redemption)
  (User 'IsScript 'Redemption)
  VScript
  VScript
forall (mode :: UserMode). Lens' (User 'IsScript mode) VScript
userVScriptL
    Optic A_Lens NoIx Mint Mint VScript VScript
-> Optic
     A_Getter NoIx VScript VScript CurrencySymbol CurrencySymbol
-> Getter Mint CurrencySymbol
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (VScript -> CurrencySymbol)
-> Optic
     A_Getter NoIx VScript VScript CurrencySymbol CurrencySymbol
forall s a. (s -> a) -> Getter s a
to
      ( ScriptHash -> CurrencySymbol
forall script.
ToMintingPolicyHash script =>
script -> CurrencySymbol
Script.toCurrencySymbol
          (ScriptHash -> CurrencySymbol)
-> (VScript -> ScriptHash) -> VScript -> CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VScript -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash
          (VScript -> ScriptHash)
-> (VScript -> VScript) -> VScript -> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VScript -> VScript
forall script. ToVScript script => script -> VScript
toVScript
      )

-- * Describing full minted values with associated redeemers

-- | A description of what a transaction mints. For every policy, there can only
-- be one 'TxSkelRedeemer', and if there is, there must be some token names, each
-- with a non-zero amount of tokens. This invariant is guaranteed because the
-- raw constructor is not exposed, and functions working around it preserve it.
-- To build a 'TxSkelMints', use 'txSkelMintsFromList'.
newtype TxSkelMints = TxSkelMints {TxSkelMints
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
unTxSkelMints :: Map Api.ScriptHash (User 'IsScript 'Redemption, Map Api.TokenName Integer)}
  deriving (Int -> TxSkelMints -> ShowS
[TxSkelMints] -> ShowS
TxSkelMints -> String
(Int -> TxSkelMints -> ShowS)
-> (TxSkelMints -> String)
-> ([TxSkelMints] -> ShowS)
-> Show TxSkelMints
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSkelMints -> ShowS
showsPrec :: Int -> TxSkelMints -> ShowS
$cshow :: TxSkelMints -> String
show :: TxSkelMints -> String
$cshowList :: [TxSkelMints] -> ShowS
showList :: [TxSkelMints] -> ShowS
Show, TxSkelMints -> TxSkelMints -> Bool
(TxSkelMints -> TxSkelMints -> Bool)
-> (TxSkelMints -> TxSkelMints -> Bool) -> Eq TxSkelMints
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSkelMints -> TxSkelMints -> Bool
== :: TxSkelMints -> TxSkelMints -> Bool
$c/= :: TxSkelMints -> TxSkelMints -> Bool
/= :: TxSkelMints -> TxSkelMints -> Bool
Eq)

-- * Optics to manipulate components of 'TxSkelMints' bind it to 'Mint'

-- | Sets or gets the amount of tokens minted for a certain asset class,
-- represented by a token name and a versioned minting policy. This removes the
-- appropriate entries (the token entry, and possible the mp entry if it would
-- leave it empty) when setting the amount to 0. This function is very similar
-- to 'Cooked.Skeleton.Value.valueAssetClassAmountL' but it also involves the
-- 'TxSkelRedeemer' associated with the minting policy.
--
-- This Lens is quite involved and is the main way to build 'TxSkelMints'
-- iteratively from a list of 'Mint' (see 'txSkelMintsListI'). If you're looking
-- for simpler optics working in a 'TxSkelMints', consider using @ix mp % _1@
-- for instance to modify an existing redeemer, or @ix mp % _2 % ix tk@ to
-- modify a token amount. Another option is to use the optics working on 'Mint'
-- and combining them with 'txSkelMintsListI'.
txSkelMintsAssetClassAmountL :: (ToVScript mp, Typeable mp) => mp -> Api.TokenName -> Lens' TxSkelMints (Maybe TxSkelRedeemer, Integer)
txSkelMintsAssetClassAmountL :: forall mp.
(ToVScript mp, Typeable mp) =>
mp
-> TokenName -> Lens' TxSkelMints (Maybe TxSkelRedeemer, Integer)
txSkelMintsAssetClassAmountL mp :: mp
mp@(VScript -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash (VScript -> ScriptHash) -> (mp -> VScript) -> mp -> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. mp -> VScript
forall script. ToVScript script => script -> VScript
toVScript -> ScriptHash
mph) TokenName
tk =
  (TxSkelMints -> (Maybe TxSkelRedeemer, Integer))
-> (TxSkelMints -> (Maybe TxSkelRedeemer, Integer) -> TxSkelMints)
-> Lens' TxSkelMints (Maybe TxSkelRedeemer, Integer)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    -- We return (Nothing, 0) when the mp is not in the map, (Just red, 0) when
    -- the mp is present but not the token, and (Just red, n) otherwise.
    ((Maybe TxSkelRedeemer, Integer)
-> ((User 'IsScript 'Redemption, Map TokenName Integer)
    -> (Maybe TxSkelRedeemer, Integer))
-> Maybe (User 'IsScript 'Redemption, Map TokenName Integer)
-> (Maybe TxSkelRedeemer, Integer)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe TxSkelRedeemer
forall a. Maybe a
Nothing, Integer
0) ((User 'IsScript 'Redemption -> Maybe TxSkelRedeemer)
-> (Map TokenName Integer -> Integer)
-> (User 'IsScript 'Redemption, Map TokenName Integer)
-> (Maybe TxSkelRedeemer, Integer)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (TxSkelRedeemer -> Maybe TxSkelRedeemer
forall a. a -> Maybe a
Just (TxSkelRedeemer -> Maybe TxSkelRedeemer)
-> (User 'IsScript 'Redemption -> TxSkelRedeemer)
-> User 'IsScript 'Redemption
-> Maybe TxSkelRedeemer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens NoIx (User 'IsScript 'Redemption) TxSkelRedeemer
-> User 'IsScript 'Redemption -> TxSkelRedeemer
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx (User 'IsScript 'Redemption) TxSkelRedeemer
userTxSkelRedeemerL) (Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer)
-> (Map TokenName Integer -> Maybe Integer)
-> Map TokenName Integer
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenName -> Map TokenName Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TokenName
tk)) (Maybe (User 'IsScript 'Redemption, Map TokenName Integer)
 -> (Maybe TxSkelRedeemer, Integer))
-> (TxSkelMints
    -> Maybe (User 'IsScript 'Redemption, Map TokenName Integer))
-> TxSkelMints
-> (Maybe TxSkelRedeemer, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
-> Maybe (User 'IsScript 'Redemption, Map TokenName Integer)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash
mph (Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
 -> Maybe (User 'IsScript 'Redemption, Map TokenName Integer))
-> (TxSkelMints
    -> Map
         ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
-> TxSkelMints
-> Maybe (User 'IsScript 'Redemption, Map TokenName Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelMints
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
unTxSkelMints)
    ( \(TxSkelMints Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
mints) (Maybe TxSkelRedeemer
newRed, Integer
i) -> Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
-> TxSkelMints
TxSkelMints (Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
 -> TxSkelMints)
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
-> TxSkelMints
forall a b. (a -> b) -> a -> b
$ case ScriptHash
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
-> Maybe (User 'IsScript 'Redemption, Map TokenName Integer)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ScriptHash
mph Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
mints of
        -- No previous mp entry and nothing to add
        Maybe (User 'IsScript 'Redemption, Map TokenName Integer)
Nothing | Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
mints
        -- No previous mp entry and something to add but no redeemer to attach
        Maybe (User 'IsScript 'Redemption, Map TokenName Integer)
Nothing | Maybe TxSkelRedeemer
Nothing <- Maybe TxSkelRedeemer
newRed -> Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
mints
        -- No previous mp entry, something to add and a redeemer to attach
        Maybe (User 'IsScript 'Redemption, Map TokenName Integer)
Nothing | Just TxSkelRedeemer
newRed' <- Maybe TxSkelRedeemer
newRed -> ScriptHash
-> (User 'IsScript 'Redemption, Map TokenName Integer)
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ScriptHash
mph (mp -> TxSkelRedeemer -> User 'IsScript 'Redemption
forall script (a :: UserKind).
(a ∈ '[ 'IsScript, 'IsEither], ToVScript script,
 Typeable script) =>
script -> TxSkelRedeemer -> User a 'Redemption
UserRedeemedScript mp
mp TxSkelRedeemer
newRed', TokenName -> Integer -> Map TokenName Integer
forall k a. k -> a -> Map k a
Map.singleton TokenName
tk Integer
i) Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
mints
        -- A previous mp and tk entry, which needs to be removed and the whole
        -- mp entry as well because it only contains this tk.
        Just (TokenName -> Map TokenName Integer -> Map TokenName Integer
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete TokenName
tk (Map TokenName Integer -> Map TokenName Integer)
-> ((User 'IsScript 'Redemption, Map TokenName Integer)
    -> Map TokenName Integer)
-> (User 'IsScript 'Redemption, Map TokenName Integer)
-> Map TokenName Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (User 'IsScript 'Redemption, Map TokenName Integer)
-> Map TokenName Integer
forall a b. (a, b) -> b
snd -> Map TokenName Integer
subMap) | Map TokenName Integer
subMap Map TokenName Integer -> Map TokenName Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Map TokenName Integer
forall a. Monoid a => a
mempty, Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> ScriptHash
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete ScriptHash
mph Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
mints
        -- A prevous mp and tk entry, which either needs to be removed in case
        -- of i == 0, or updated otherwise.
        Just (User 'IsScript 'Redemption
prevUser, if Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then TokenName -> Map TokenName Integer -> Map TokenName Integer
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete TokenName
tk else TokenName
-> Integer -> Map TokenName Integer -> Map TokenName Integer
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TokenName
tk Integer
i -> Map TokenName Integer
subMap)
          | User 'IsScript 'Redemption
newUser <- User 'IsScript 'Redemption
-> (TxSkelRedeemer -> User 'IsScript 'Redemption)
-> Maybe TxSkelRedeemer
-> User 'IsScript 'Redemption
forall b a. b -> (a -> b) -> Maybe a -> b
maybe User 'IsScript 'Redemption
prevUser ((TxSkelRedeemer
 -> User 'IsScript 'Redemption -> User 'IsScript 'Redemption)
-> User 'IsScript 'Redemption
-> TxSkelRedeemer
-> User 'IsScript 'Redemption
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Optic' A_Lens NoIx (User 'IsScript 'Redemption) TxSkelRedeemer
-> TxSkelRedeemer
-> User 'IsScript 'Redemption
-> User 'IsScript 'Redemption
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic' A_Lens NoIx (User 'IsScript 'Redemption) TxSkelRedeemer
userTxSkelRedeemerL) User 'IsScript 'Redemption
prevUser) Maybe TxSkelRedeemer
newRed -> ScriptHash
-> (User 'IsScript 'Redemption, Map TokenName Integer)
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ScriptHash
mph (User 'IsScript 'Redemption
newUser, Map TokenName Integer
subMap) Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
mints
    )

-- | Focuses on the submap for a given minting policy, following the same rules
-- as 'txSkelMintsAssetClassAmountL' when setting a new submap.
txSkelMintsPolicyTokensL :: (ToVScript mp, Typeable mp) => mp -> Lens' TxSkelMints (Maybe (TxSkelRedeemer, Map Api.TokenName Integer))
txSkelMintsPolicyTokensL :: forall mp.
(ToVScript mp, Typeable mp) =>
mp
-> Lens'
     TxSkelMints (Maybe (TxSkelRedeemer, Map TokenName Integer))
txSkelMintsPolicyTokensL mp :: mp
mp@(VScript -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash (VScript -> ScriptHash) -> (mp -> VScript) -> mp -> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. mp -> VScript
forall script. ToVScript script => script -> VScript
toVScript -> ScriptHash
mph) =
  (TxSkelMints -> Maybe (TxSkelRedeemer, Map TokenName Integer))
-> (TxSkelMints
    -> Maybe (TxSkelRedeemer, Map TokenName Integer) -> TxSkelMints)
-> Lens'
     TxSkelMints (Maybe (TxSkelRedeemer, Map TokenName Integer))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (((User 'IsScript 'Redemption, Map TokenName Integer)
 -> (TxSkelRedeemer, Map TokenName Integer))
-> Maybe (User 'IsScript 'Redemption, Map TokenName Integer)
-> Maybe (TxSkelRedeemer, Map TokenName Integer)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((User 'IsScript 'Redemption -> TxSkelRedeemer)
-> (User 'IsScript 'Redemption, Map TokenName Integer)
-> (TxSkelRedeemer, Map TokenName Integer)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Optic' A_Lens NoIx (User 'IsScript 'Redemption) TxSkelRedeemer
-> User 'IsScript 'Redemption -> TxSkelRedeemer
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx (User 'IsScript 'Redemption) TxSkelRedeemer
userTxSkelRedeemerL)) (Maybe (User 'IsScript 'Redemption, Map TokenName Integer)
 -> Maybe (TxSkelRedeemer, Map TokenName Integer))
-> (TxSkelMints
    -> Maybe (User 'IsScript 'Redemption, Map TokenName Integer))
-> TxSkelMints
-> Maybe (TxSkelRedeemer, Map TokenName Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic'
  A_Getter
  NoIx
  TxSkelMints
  (Maybe (User 'IsScript 'Redemption, Map TokenName Integer))
-> TxSkelMints
-> Maybe (User 'IsScript 'Redemption, Map TokenName Integer)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view ((TxSkelMints
 -> Map
      ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
-> Getter
     TxSkelMints
     (Map
        ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
forall s a. (s -> a) -> Getter s a
to TxSkelMints
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
unTxSkelMints Getter
  TxSkelMints
  (Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
-> Optic
     A_Lens
     NoIx
     (Map
        ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
     (Map
        ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
     (Maybe (User 'IsScript 'Redemption, Map TokenName Integer))
     (Maybe (User 'IsScript 'Redemption, Map TokenName Integer))
-> Optic'
     A_Getter
     NoIx
     TxSkelMints
     (Maybe (User 'IsScript 'Redemption, Map TokenName Integer))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index
  (Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
-> Lens'
     (Map
        ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
     (Maybe
        (IxValue
           (Map
              ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index
  (Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
ScriptHash
mph))
    ( \TxSkelMints
mints -> \case
        Maybe (TxSkelRedeemer, Map TokenName Integer)
Nothing -> Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
-> TxSkelMints
TxSkelMints (Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
 -> TxSkelMints)
-> (TxSkelMints
    -> Map
         ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
-> TxSkelMints
-> TxSkelMints
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete ScriptHash
mph (Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
 -> Map
      ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
-> (TxSkelMints
    -> Map
         ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
-> TxSkelMints
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelMints
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
unTxSkelMints (TxSkelMints -> TxSkelMints) -> TxSkelMints -> TxSkelMints
forall a b. (a -> b) -> a -> b
$ TxSkelMints
mints
        Just (TxSkelRedeemer
red, Map TokenName Integer -> [(TokenName, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList -> [(TokenName, Integer)]
tokens) -> (TxSkelMints -> (TokenName, Integer) -> TxSkelMints)
-> TxSkelMints -> [(TokenName, Integer)] -> TxSkelMints
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((TokenName, Integer) -> TxSkelMints -> TxSkelMints)
-> TxSkelMints -> (TokenName, Integer) -> TxSkelMints
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((TokenName, Integer) -> TxSkelMints -> TxSkelMints)
 -> TxSkelMints -> (TokenName, Integer) -> TxSkelMints)
-> ((TokenName, Integer) -> TxSkelMints -> TxSkelMints)
-> TxSkelMints
-> (TokenName, Integer)
-> TxSkelMints
forall a b. (a -> b) -> a -> b
$ \(TokenName
tk, Integer
n) -> Lens' TxSkelMints (Maybe TxSkelRedeemer, Integer)
-> (Maybe TxSkelRedeemer, Integer) -> TxSkelMints -> TxSkelMints
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (mp
-> TokenName -> Lens' TxSkelMints (Maybe TxSkelRedeemer, Integer)
forall mp.
(ToVScript mp, Typeable mp) =>
mp
-> TokenName -> Lens' TxSkelMints (Maybe TxSkelRedeemer, Integer)
txSkelMintsAssetClassAmountL mp
mp TokenName
tk) (TxSkelRedeemer -> Maybe TxSkelRedeemer
forall a. a -> Maybe a
Just TxSkelRedeemer
red, Integer
n)) TxSkelMints
mints [(TokenName, Integer)]
tokens
    )

instance Script.ToValue TxSkelMints where
  toValue :: TxSkelMints -> Value
toValue =
    Map CurrencySymbol (Map TokenName Integer) -> Value
Api.Value
      (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> (TxSkelMints -> Map CurrencySymbol (Map TokenName Integer))
-> TxSkelMints
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CurrencySymbol, Map TokenName Integer)]
-> Map CurrencySymbol (Map TokenName Integer)
forall k v. [(k, v)] -> Map k v
PMap.unsafeFromList
      ([(CurrencySymbol, Map TokenName Integer)]
 -> Map CurrencySymbol (Map TokenName Integer))
-> (TxSkelMints -> [(CurrencySymbol, Map TokenName Integer)])
-> TxSkelMints
-> Map CurrencySymbol (Map TokenName Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ScriptHash, (User 'IsScript 'Redemption, Map TokenName Integer))
 -> (CurrencySymbol, Map TokenName Integer))
-> [(ScriptHash,
     (User 'IsScript 'Redemption, Map TokenName Integer))]
-> [(CurrencySymbol, Map TokenName Integer)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ( (ScriptHash -> CurrencySymbol)
-> ((User 'IsScript 'Redemption, Map TokenName Integer)
    -> Map TokenName Integer)
-> (ScriptHash,
    (User 'IsScript 'Redemption, Map TokenName Integer))
-> (CurrencySymbol, Map TokenName Integer)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
            ScriptHash -> CurrencySymbol
forall script.
ToMintingPolicyHash script =>
script -> CurrencySymbol
Script.toCurrencySymbol
            ([(TokenName, Integer)] -> Map TokenName Integer
forall k v. [(k, v)] -> Map k v
PMap.unsafeFromList ([(TokenName, Integer)] -> Map TokenName Integer)
-> ((User 'IsScript 'Redemption, Map TokenName Integer)
    -> [(TokenName, Integer)])
-> (User 'IsScript 'Redemption, Map TokenName Integer)
-> Map TokenName Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TokenName Integer -> [(TokenName, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TokenName Integer -> [(TokenName, Integer)])
-> ((User 'IsScript 'Redemption, Map TokenName Integer)
    -> Map TokenName Integer)
-> (User 'IsScript 'Redemption, Map TokenName Integer)
-> [(TokenName, Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (User 'IsScript 'Redemption, Map TokenName Integer)
-> Map TokenName Integer
forall a b. (a, b) -> b
snd)
        )
      ([(ScriptHash,
   (User 'IsScript 'Redemption, Map TokenName Integer))]
 -> [(CurrencySymbol, Map TokenName Integer)])
-> (TxSkelMints
    -> [(ScriptHash,
         (User 'IsScript 'Redemption, Map TokenName Integer))])
-> TxSkelMints
-> [(CurrencySymbol, Map TokenName Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
-> [(ScriptHash,
     (User 'IsScript 'Redemption, Map TokenName Integer))]
forall k a. Map k a -> [(k, a)]
Map.toList
      (Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
 -> [(ScriptHash,
      (User 'IsScript 'Redemption, Map TokenName Integer))])
-> (TxSkelMints
    -> Map
         ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
-> TxSkelMints
-> [(ScriptHash,
     (User 'IsScript 'Redemption, Map TokenName Integer))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelMints
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
unTxSkelMints

-- | The list of assets classes contained in this 'TxSkelMints'
txSkelMintsAssetClassesG :: Getter TxSkelMints [(VScript, Api.TokenName)]
txSkelMintsAssetClassesG :: Getter TxSkelMints [(VScript, TokenName)]
txSkelMintsAssetClassesG = Iso' TxSkelMints [Mint]
txSkelMintsListI Iso' TxSkelMints [Mint]
-> Optic
     A_Getter
     NoIx
     [Mint]
     [Mint]
     [(VScript, TokenName)]
     [(VScript, TokenName)]
-> Getter TxSkelMints [(VScript, TokenName)]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% ([Mint] -> [(VScript, TokenName)])
-> Optic
     A_Getter
     NoIx
     [Mint]
     [Mint]
     [(VScript, TokenName)]
     [(VScript, TokenName)]
forall s a. (s -> a) -> Getter s a
to (\[Mint]
l -> [(script -> VScript
forall script. ToVScript script => script -> VScript
toVScript script
mp, TokenName
tk) | Mint (UserRedeemedScript script
mp TxSkelRedeemer
_) [(TokenName, Integer)]
tks <- [Mint]
l, (TokenName
tk, Integer
_) <- [(TokenName, Integer)]
tks])

-- | Seeing a 'TxSkelMints' as a list of 'Mint'
txSkelMintsListI :: Iso' TxSkelMints [Mint]
txSkelMintsListI :: Iso' TxSkelMints [Mint]
txSkelMintsListI =
  (TxSkelMints -> [Mint])
-> ([Mint] -> TxSkelMints) -> Iso' TxSkelMints [Mint]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (((User 'IsScript 'Redemption, Map TokenName Integer) -> Mint)
-> [(User 'IsScript 'Redemption, Map TokenName Integer)] -> [Mint]
forall a b. (a -> b) -> [a] -> [b]
map (\(User 'IsScript 'Redemption
user, Map TokenName Integer
m) -> User 'IsScript 'Redemption -> [(TokenName, Integer)] -> Mint
Mint User 'IsScript 'Redemption
user (Map TokenName Integer -> [(TokenName, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TokenName Integer
m)) ([(User 'IsScript 'Redemption, Map TokenName Integer)] -> [Mint])
-> (TxSkelMints
    -> [(User 'IsScript 'Redemption, Map TokenName Integer)])
-> TxSkelMints
-> [Mint]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
-> [(User 'IsScript 'Redemption, Map TokenName Integer)]
forall k a. Map k a -> [a]
Map.elems (Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
 -> [(User 'IsScript 'Redemption, Map TokenName Integer)])
-> (TxSkelMints
    -> Map
         ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer))
-> TxSkelMints
-> [(User 'IsScript 'Redemption, Map TokenName Integer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelMints
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
unTxSkelMints)
    ( (TxSkelMints -> Mint -> TxSkelMints)
-> TxSkelMints -> [Mint] -> TxSkelMints
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
        ( \TxSkelMints
mints (Mint (UserRedeemedScript script
mp TxSkelRedeemer
red) [(TokenName, Integer)]
tks) ->
            (TxSkelMints -> (TokenName, Integer) -> TxSkelMints)
-> TxSkelMints -> [(TokenName, Integer)] -> TxSkelMints
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
              (\TxSkelMints
mints' (TokenName
tk, Integer
n) -> TxSkelMints
mints' TxSkelMints -> (TxSkelMints -> TxSkelMints) -> TxSkelMints
forall a b. a -> (a -> b) -> b
& script
-> TokenName -> Lens' TxSkelMints (Maybe TxSkelRedeemer, Integer)
forall mp.
(ToVScript mp, Typeable mp) =>
mp
-> TokenName -> Lens' TxSkelMints (Maybe TxSkelRedeemer, Integer)
txSkelMintsAssetClassAmountL script
mp TokenName
tk Lens' TxSkelMints (Maybe TxSkelRedeemer, Integer)
-> ((Maybe TxSkelRedeemer, Integer)
    -> (Maybe TxSkelRedeemer, Integer))
-> TxSkelMints
-> TxSkelMints
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ (\(Maybe TxSkelRedeemer
_, Integer
n') -> (TxSkelRedeemer -> Maybe TxSkelRedeemer
forall a. a -> Maybe a
Just TxSkelRedeemer
red, Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n')))
              TxSkelMints
mints
              [(TokenName, Integer)]
tks
        )
        TxSkelMints
forall a. Monoid a => a
mempty
    )

-- | Builds a 'TxSkelMints' from a list of 'Mint'. This is equivalent to calling
-- @review txSkelMintsListI@
txSkelMintsFromList :: [Mint] -> TxSkelMints
txSkelMintsFromList :: [Mint] -> TxSkelMints
txSkelMintsFromList = Iso' TxSkelMints [Mint] -> [Mint] -> TxSkelMints
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Iso' TxSkelMints [Mint]
txSkelMintsListI

-- * Additional instances an useful helpers

-- | Combining 'TxSkelMints' in a sensible way. In particular, this means that
--
-- > Map.fromList [(pol, (red, NEMap.fromList [(tName, 1)]))]
--
-- and
--
-- > Map.fromList [(pol, (red', NEMap.fromList [(tName, -1)]))]
--
-- will combine to become the empty 'TxSkelMints'
--
-- In every case, if you add mints with a different redeemer for the same
-- policy, the redeemer used in the right argument takes precedence.
instance Semigroup TxSkelMints where
  TxSkelMints
txSkelM <> :: TxSkelMints -> TxSkelMints -> TxSkelMints
<> TxSkelMints
txSkelM' =
    Iso' TxSkelMints [Mint] -> [Mint] -> TxSkelMints
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
review Iso' TxSkelMints [Mint]
txSkelMintsListI ([Mint] -> TxSkelMints) -> [Mint] -> TxSkelMints
forall a b. (a -> b) -> a -> b
$
      Iso' TxSkelMints [Mint] -> TxSkelMints -> [Mint]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Iso' TxSkelMints [Mint]
txSkelMintsListI TxSkelMints
txSkelM
        [Mint] -> [Mint] -> [Mint]
forall a. Semigroup a => a -> a -> a
<> Iso' TxSkelMints [Mint] -> TxSkelMints -> [Mint]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Iso' TxSkelMints [Mint]
txSkelMintsListI TxSkelMints
txSkelM'

instance Monoid TxSkelMints where
  mempty :: TxSkelMints
mempty = Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
-> TxSkelMints
TxSkelMints Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
forall k a. Map k a
Map.empty