{-# OPTIONS_GHC -Wno-orphans #-}

-- | This module exposes the minting constructs used in a
-- 'Cooked.Skeleton.TxSkel' and their associated utilities.
module Cooked.Skeleton.Mint
  ( TxSkelMints,
    Mint (..),
    mint,
    burn,
    addMint,
    addMints,
    txSkelMintsToList,
    txSkelMintsFromList,
    txSkelMintsValue,
  )
where

import Cooked.Skeleton.Redeemer as X
import Data.Bifunctor
import Data.List.NonEmpty qualified as NEList
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Map.NonEmpty (NEMap)
import Data.Map.NonEmpty qualified as NEMap
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V1.Value qualified as Api
import PlutusTx.AssocMap qualified as PMap
import Test.QuickCheck (NonZero (..))

-- | 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.
--
-- You'll probably not construct this by hand, but use 'txSkelMintsFromList'.
type TxSkelMints =
  Map
    (Script.Versioned Script.MintingPolicy)
    (TxSkelRedeemer, NEMap Api.TokenName (NonZero Integer))

-- | 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 ::
    (Script.ToVersioned Script.MintingPolicy a) =>
    { ()
txSkelMintMintingPolicy :: a,
      Mint -> TxSkelRedeemer
txSkelMintRedeemer :: TxSkelRedeemer,
      Mint -> [(TokenName, Integer)]
txSkelMintTokens :: [(Api.TokenName, Integer)]
    } ->
    Mint

-- | Additional helper to build some 'Mint' in the usual minting case where a
-- single type of token is minted for a given MP
mint :: (Script.ToVersioned Script.MintingPolicy a) => a -> TxSkelRedeemer -> Api.TokenName -> Integer -> Mint
mint :: forall a.
ToVersioned MintingPolicy a =>
a -> TxSkelRedeemer -> TokenName -> Integer -> Mint
mint a
mp TxSkelRedeemer
red TokenName
tn Integer
n = a -> TxSkelRedeemer -> [(TokenName, Integer)] -> Mint
forall a.
ToVersioned MintingPolicy a =>
a -> TxSkelRedeemer -> [(TokenName, Integer)] -> Mint
Mint a
mp TxSkelRedeemer
red [(TokenName
tn, Integer
n)]

-- | Similar to 'mint' but deducing the tokens instead
burn :: (Script.ToVersioned Script.MintingPolicy a) => a -> TxSkelRedeemer -> Api.TokenName -> Integer -> Mint
burn :: forall a.
ToVersioned MintingPolicy a =>
a -> TxSkelRedeemer -> TokenName -> Integer -> Mint
burn a
mp TxSkelRedeemer
red TokenName
tn Integer
n = a -> TxSkelRedeemer -> TokenName -> Integer -> Mint
forall a.
ToVersioned MintingPolicy a =>
a -> TxSkelRedeemer -> TokenName -> Integer -> Mint
mint a
mp TxSkelRedeemer
red TokenName
tn (-Integer
n)

-- | For each pair (tokenName, amount) in the input list, either:
--
-- - adds this new entry in the map if tokenName was not already a key
--
-- - updates the existing number of tokens associated with tokenName by adding
-- amount. Since amount can be negative, this addition can result in lowering
-- the amount of tokens present in the map. If it reaches exactly 0, the entry
-- is removed. As a consequences, if all inputs happen to cancel the existing
-- number of tokens for each tokenName, this will remove all entries in the map,
-- which is why the return value is wrapped in 'Maybe'.
addTokens :: [(Api.TokenName, Integer)] -> NEMap Api.TokenName (NonZero Integer) -> Maybe (NEMap Api.TokenName (NonZero Integer))
addTokens :: [(TokenName, Integer)]
-> NEMap TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
addTokens [] NEMap TokenName (NonZero Integer)
neMap = NEMap TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
forall a. a -> Maybe a
Just NEMap TokenName (NonZero Integer)
neMap
addTokens ((TokenName
_, Integer
n) : [(TokenName, Integer)]
l) NEMap TokenName (NonZero Integer)
neMap | Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = [(TokenName, Integer)]
-> NEMap TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
addTokens [(TokenName, Integer)]
l NEMap TokenName (NonZero Integer)
neMap
addTokens ((TokenName
tn, Integer
n) : [(TokenName, Integer)]
l) NEMap TokenName (NonZero Integer)
neMap = case [(TokenName, Integer)]
-> NEMap TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
addTokens [(TokenName, Integer)]
l NEMap TokenName (NonZero Integer)
neMap of
  Maybe (NEMap TokenName (NonZero Integer))
Nothing -> NEMap TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
forall a. a -> Maybe a
Just (NEMap TokenName (NonZero Integer)
 -> Maybe (NEMap TokenName (NonZero Integer)))
-> NEMap TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
forall a b. (a -> b) -> a -> b
$ TokenName -> NonZero Integer -> NEMap TokenName (NonZero Integer)
forall k a. k -> a -> NEMap k a
NEMap.singleton TokenName
tn (Integer -> NonZero Integer
forall a. a -> NonZero a
NonZero Integer
n)
  Just NEMap TokenName (NonZero Integer)
neMap' -> case TokenName
-> NEMap TokenName (NonZero Integer) -> Maybe (NonZero Integer)
forall k a. Ord k => k -> NEMap k a -> Maybe a
NEMap.lookup TokenName
tn NEMap TokenName (NonZero Integer)
neMap' of
    Maybe (NonZero Integer)
Nothing -> NEMap TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
forall a. a -> Maybe a
Just (NEMap TokenName (NonZero Integer)
 -> Maybe (NEMap TokenName (NonZero Integer)))
-> NEMap TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
forall a b. (a -> b) -> a -> b
$ TokenName
-> NonZero Integer
-> NEMap TokenName (NonZero Integer)
-> NEMap TokenName (NonZero Integer)
forall k a. Ord k => k -> a -> NEMap k a -> NEMap k a
NEMap.insert TokenName
tn (Integer -> NonZero Integer
forall a. a -> NonZero a
NonZero Integer
n) NEMap TokenName (NonZero Integer)
neMap'
    Just (NonZero Integer
n') | Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
n' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -> Map TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
forall k a. Map k a -> Maybe (NEMap k a)
NEMap.nonEmptyMap (Map TokenName (NonZero Integer)
 -> Maybe (NEMap TokenName (NonZero Integer)))
-> Map TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
forall a b. (a -> b) -> a -> b
$ TokenName
-> NEMap TokenName (NonZero Integer)
-> Map TokenName (NonZero Integer)
forall k a. Ord k => k -> NEMap k a -> Map k a
NEMap.delete TokenName
tn NEMap TokenName (NonZero Integer)
neMap'
    Just (NonZero Integer
n') -> NEMap TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
forall a. a -> Maybe a
Just (NEMap TokenName (NonZero Integer)
 -> Maybe (NEMap TokenName (NonZero Integer)))
-> NEMap TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
forall a b. (a -> b) -> a -> b
$ TokenName
-> NonZero Integer
-> NEMap TokenName (NonZero Integer)
-> NEMap TokenName (NonZero Integer)
forall k a. Ord k => k -> a -> NEMap k a -> NEMap k a
NEMap.insert TokenName
tn (Integer -> NonZero Integer
forall a. a -> NonZero a
NonZero (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n')) NEMap TokenName (NonZero Integer)
neMap'

-- | Add a new entry to a 'TxSkelMints'. There are a few wrinkles:
--
-- (1) If for a given policy, redeemer, and token name, there are @n@ tokens in
-- the argument 'TxSkelMints', and you add @-n@ tokens, the corresponding entry
-- in the "inner map" of the policy will disappear (obviously, because all of
-- its values have to be non-zero). If that also means that the inner map
-- becomes empty, the policy will disappear from the 'TxSkelMints' altogether.
--
-- (2) If a policy is already present on the argument 'TxSkelMints' with a
-- redeemer @a@, and you add a mint with a different redeemer @b@, the old
-- redeemer is thrown away. The values associated with the token names of that
-- policy are added as described above, though. This means that any pre-existing
-- values will be minted with a new redeemer.
addMint :: TxSkelMints -> Mint -> TxSkelMints
addMint :: TxSkelMints -> Mint -> TxSkelMints
addMint TxSkelMints
txSkelMints (Mint a
_ TxSkelRedeemer
_ []) = TxSkelMints
txSkelMints
addMint TxSkelMints
txSkelMints (Mint (a -> Versioned MintingPolicy
forall s a. ToVersioned s a => a -> Versioned s
Script.toVersioned -> Versioned MintingPolicy
mp) TxSkelRedeemer
red tks :: [(TokenName, Integer)]
tks@((TokenName
tn, Integer -> NonZero Integer
forall a. a -> NonZero a
NonZero -> NonZero Integer
n) : [(TokenName, Integer)]
tkxs)) =
  case Versioned MintingPolicy
-> TxSkelMints
-> Maybe (TxSkelRedeemer, NEMap TokenName (NonZero Integer))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Versioned MintingPolicy
mp TxSkelMints
txSkelMints of
    Maybe (TxSkelRedeemer, NEMap TokenName (NonZero Integer))
Nothing -> case [(TokenName, Integer)]
-> NEMap TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
addTokens [(TokenName, Integer)]
tkxs (TokenName -> NonZero Integer -> NEMap TokenName (NonZero Integer)
forall k a. k -> a -> NEMap k a
NEMap.singleton TokenName
tn NonZero Integer
n) of
      Maybe (NEMap TokenName (NonZero Integer))
Nothing -> TxSkelMints
txSkelMints
      Just NEMap TokenName (NonZero Integer)
newSubmap -> Versioned MintingPolicy
-> (TxSkelRedeemer, NEMap TokenName (NonZero Integer))
-> TxSkelMints
-> TxSkelMints
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Versioned MintingPolicy
mp (TxSkelRedeemer
red, NEMap TokenName (NonZero Integer)
newSubmap) TxSkelMints
txSkelMints
    Just (TxSkelRedeemer
_, NEMap TokenName (NonZero Integer)
subMap) -> case [(TokenName, Integer)]
-> NEMap TokenName (NonZero Integer)
-> Maybe (NEMap TokenName (NonZero Integer))
addTokens [(TokenName, Integer)]
tks NEMap TokenName (NonZero Integer)
subMap of
      Maybe (NEMap TokenName (NonZero Integer))
Nothing -> Versioned MintingPolicy -> TxSkelMints -> TxSkelMints
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Versioned MintingPolicy
mp TxSkelMints
txSkelMints
      Just NEMap TokenName (NonZero Integer)
newSubmap -> Versioned MintingPolicy
-> (TxSkelRedeemer, NEMap TokenName (NonZero Integer))
-> TxSkelMints
-> TxSkelMints
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Versioned MintingPolicy
mp (TxSkelRedeemer
red, NEMap TokenName (NonZero Integer)
newSubmap) TxSkelMints
txSkelMints

-- | Adds a list of 'Mint' to a 'TxSkelMints', by iterating over the list
-- and using 'addMint'
addMints :: TxSkelMints -> [Mint] -> TxSkelMints
addMints :: TxSkelMints -> [Mint] -> TxSkelMints
addMints = (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 -> Mint -> TxSkelMints
addMint

-- | 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' (and similar examples, where
-- the values add up to zero, see the comment at the definition of
-- 'addMint').
--
-- 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 {-# OVERLAPPING #-} Semigroup TxSkelMints where
  TxSkelMints
a <> :: TxSkelMints -> TxSkelMints -> TxSkelMints
<> TxSkelMints
b = TxSkelMints -> [Mint] -> TxSkelMints
addMints TxSkelMints
a (TxSkelMints -> [Mint]
txSkelMintsToList TxSkelMints
b)

instance {-# OVERLAPPING #-} Monoid TxSkelMints where
  mempty :: TxSkelMints
mempty = TxSkelMints
forall k a. Map k a
Map.empty

-- | Convert from 'TxSkelMints' to a list of 'Mint'
txSkelMintsToList :: TxSkelMints -> [Mint]
txSkelMintsToList :: TxSkelMints -> [Mint]
txSkelMintsToList =
  ((Versioned MintingPolicy,
  (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))
 -> Mint)
-> [(Versioned MintingPolicy,
     (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))]
-> [Mint]
forall a b. (a -> b) -> [a] -> [b]
map (\(Versioned MintingPolicy
p, (TxSkelRedeemer
r, NEMap TokenName (NonZero Integer)
m)) -> Versioned MintingPolicy
-> TxSkelRedeemer -> [(TokenName, Integer)] -> Mint
forall a.
ToVersioned MintingPolicy a =>
a -> TxSkelRedeemer -> [(TokenName, Integer)] -> Mint
Mint Versioned MintingPolicy
p TxSkelRedeemer
r ([(TokenName, Integer)] -> Mint) -> [(TokenName, Integer)] -> Mint
forall a b. (a -> b) -> a -> b
$ (NonZero Integer -> Integer)
-> (TokenName, NonZero Integer) -> (TokenName, Integer)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second NonZero Integer -> Integer
forall a. NonZero a -> a
getNonZero ((TokenName, NonZero Integer) -> (TokenName, Integer))
-> [(TokenName, NonZero Integer)] -> [(TokenName, Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (TokenName, NonZero Integer)
-> [(TokenName, NonZero Integer)]
forall a. NonEmpty a -> [a]
NEList.toList (NEMap TokenName (NonZero Integer)
-> NonEmpty (TokenName, NonZero Integer)
forall k a. NEMap k a -> NonEmpty (k, a)
NEMap.toList NEMap TokenName (NonZero Integer)
m)) ([(Versioned MintingPolicy,
   (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))]
 -> [Mint])
-> (TxSkelMints
    -> [(Versioned MintingPolicy,
         (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))])
-> TxSkelMints
-> [Mint]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSkelMints
-> [(Versioned MintingPolicy,
     (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))]
forall k a. Map k a -> [(k, a)]
Map.toList

-- | A smart constructor for 'TxSkelMints'
txSkelMintsFromList :: [Mint] -> TxSkelMints
txSkelMintsFromList :: [Mint] -> TxSkelMints
txSkelMintsFromList = TxSkelMints -> [Mint] -> TxSkelMints
addMints TxSkelMints
forall a. Monoid a => a
mempty

-- | The value described by a 'TxSkelMints'
txSkelMintsValue :: TxSkelMints -> Api.Value
txSkelMintsValue :: TxSkelMints -> Value
txSkelMintsValue TxSkelMints
txSkelMints =
  Map CurrencySymbol (Map TokenName Integer) -> Value
Api.Value (Map CurrencySymbol (Map TokenName Integer) -> Value)
-> Map CurrencySymbol (Map TokenName Integer) -> Value
forall a b. (a -> b) -> a -> b
$
    [(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))
-> [(CurrencySymbol, Map TokenName Integer)]
-> Map CurrencySymbol (Map TokenName Integer)
forall a b. (a -> b) -> a -> b
$
      ( \(Versioned MintingPolicy
mp, (TxSkelRedeemer
_, NEMap TokenName (NonZero Integer)
tks)) ->
          ( Versioned MintingPolicy -> CurrencySymbol
forall script.
ToMintingPolicyHash script =>
script -> CurrencySymbol
Script.toCurrencySymbol Versioned MintingPolicy
mp,
            [(TokenName, Integer)] -> Map TokenName Integer
forall k v. [(k, v)] -> Map k v
PMap.unsafeFromList ([(TokenName, Integer)] -> Map TokenName Integer)
-> [(TokenName, Integer)] -> Map TokenName Integer
forall a b. (a -> b) -> a -> b
$
              (\(TokenName
t, NonZero Integer
n) -> (TokenName
t, Integer
n))
                ((TokenName, NonZero Integer) -> (TokenName, Integer))
-> [(TokenName, NonZero Integer)] -> [(TokenName, Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (TokenName, NonZero Integer)
-> [(TokenName, NonZero Integer)]
forall a. NonEmpty a -> [a]
NEList.toList (NEMap TokenName (NonZero Integer)
-> NonEmpty (TokenName, NonZero Integer)
forall k a. NEMap k a -> NonEmpty (k, a)
NEMap.toList NEMap TokenName (NonZero Integer)
tks)
          )
      )
        ((Versioned MintingPolicy,
  (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))
 -> (CurrencySymbol, Map TokenName Integer))
-> [(Versioned MintingPolicy,
     (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))]
-> [(CurrencySymbol, Map TokenName Integer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxSkelMints
-> [(Versioned MintingPolicy,
     (TxSkelRedeemer, NEMap TokenName (NonZero Integer)))]
forall k a. Map k a -> [(k, a)]
Map.toList TxSkelMints
txSkelMints