{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE MonoLocalBinds     #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE NoImplicitPrelude  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeApplications   #-}
{-# LANGUAGE TypeOperators      #-}
{-# LANGUAGE ViewPatterns       #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
-- | Implements a custom currency with a minting policy that allows
--   the minting of a fixed amount of units.
module Plutus.Contracts.Currency(
      OneShotCurrency(..)
    , CurrencySchema
    , CurrencyError(..)
    , AsCurrencyError(..)
    , curPolicy
    -- * Actions etc
    , mintContract
    , mintedValue
    , currencySymbol
    , currencyPolicyId
    -- * Simple minting policy currency
    , SimpleMPS(..)
    , mintCurrency
    ) where

import Control.Lens
import Control.Monad (void)
import Data.Aeson (FromJSON, ToJSON)
import Data.Semigroup (Last (..))
import GHC.Generics (Generic)
import Plutus.V2.Ledger.Contexts qualified as V2
import PlutusTx qualified
import PlutusTx.AssocMap qualified as AssocMap
import PlutusTx.Prelude hiding (Monoid (..), Semigroup (..))

import Ledger (CardanoAddress, TxOutRef (..), getCardanoTxId)
import Ledger.Scripts
import Ledger.Tx.Constraints qualified as Constraints
import Ledger.Typed.Scripts qualified as Scripts
import Ledger.Value.CardanoAPI qualified as CValue
import Plutus.Contract as Contract
import Plutus.Contract.Request (getUnspentOutput)
import Plutus.Script.Utils.V2.Scripts qualified as V2
import Plutus.Script.Utils.Value (CurrencySymbol, TokenName, Value)
import Plutus.Script.Utils.Value qualified as Value
import Plutus.V2.Ledger.Api qualified as V2

import Prelude (Semigroup (..))
import Prelude qualified as Haskell

{- HLINT ignore "Use uncurry" -}

-- | A currency that can be created exactly once
data OneShotCurrency = OneShotCurrency
  { OneShotCurrency -> (TxId, Integer)
curRefTransactionOutput :: (V2.TxId, Integer)
  -- ^ Transaction input that must be spent when
  --   the currency is minted.
  , OneShotCurrency -> Map TokenName Integer
curAmounts              :: AssocMap.Map TokenName Integer
  -- ^ How many units of each 'TokenName' are to
  --   be minted.
  }
  deriving stock ((forall x. OneShotCurrency -> Rep OneShotCurrency x)
-> (forall x. Rep OneShotCurrency x -> OneShotCurrency)
-> Generic OneShotCurrency
forall x. Rep OneShotCurrency x -> OneShotCurrency
forall x. OneShotCurrency -> Rep OneShotCurrency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OneShotCurrency x -> OneShotCurrency
$cfrom :: forall x. OneShotCurrency -> Rep OneShotCurrency x
Generic, Int -> OneShotCurrency -> ShowS
[OneShotCurrency] -> ShowS
OneShotCurrency -> String
(Int -> OneShotCurrency -> ShowS)
-> (OneShotCurrency -> String)
-> ([OneShotCurrency] -> ShowS)
-> Show OneShotCurrency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OneShotCurrency] -> ShowS
$cshowList :: [OneShotCurrency] -> ShowS
show :: OneShotCurrency -> String
$cshow :: OneShotCurrency -> String
showsPrec :: Int -> OneShotCurrency -> ShowS
$cshowsPrec :: Int -> OneShotCurrency -> ShowS
Haskell.Show, OneShotCurrency -> OneShotCurrency -> Bool
(OneShotCurrency -> OneShotCurrency -> Bool)
-> (OneShotCurrency -> OneShotCurrency -> Bool)
-> Eq OneShotCurrency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OneShotCurrency -> OneShotCurrency -> Bool
$c/= :: OneShotCurrency -> OneShotCurrency -> Bool
== :: OneShotCurrency -> OneShotCurrency -> Bool
$c== :: OneShotCurrency -> OneShotCurrency -> Bool
Haskell.Eq)
  deriving anyclass ([OneShotCurrency] -> Encoding
[OneShotCurrency] -> Value
OneShotCurrency -> Encoding
OneShotCurrency -> Value
(OneShotCurrency -> Value)
-> (OneShotCurrency -> Encoding)
-> ([OneShotCurrency] -> Value)
-> ([OneShotCurrency] -> Encoding)
-> ToJSON OneShotCurrency
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [OneShotCurrency] -> Encoding
$ctoEncodingList :: [OneShotCurrency] -> Encoding
toJSONList :: [OneShotCurrency] -> Value
$ctoJSONList :: [OneShotCurrency] -> Value
toEncoding :: OneShotCurrency -> Encoding
$ctoEncoding :: OneShotCurrency -> Encoding
toJSON :: OneShotCurrency -> Value
$ctoJSON :: OneShotCurrency -> Value
ToJSON, Value -> Parser [OneShotCurrency]
Value -> Parser OneShotCurrency
(Value -> Parser OneShotCurrency)
-> (Value -> Parser [OneShotCurrency]) -> FromJSON OneShotCurrency
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [OneShotCurrency]
$cparseJSONList :: Value -> Parser [OneShotCurrency]
parseJSON :: Value -> Parser OneShotCurrency
$cparseJSON :: Value -> Parser OneShotCurrency
FromJSON)

PlutusTx.makeLift ''OneShotCurrency

currencyValue :: CurrencySymbol -> OneShotCurrency -> Value
currencyValue :: CurrencySymbol -> OneShotCurrency -> Value
currencyValue CurrencySymbol
s OneShotCurrency{curAmounts :: OneShotCurrency -> Map TokenName Integer
curAmounts = Map TokenName Integer
amts} =
    let
        values :: [Value]
values = ((TokenName, Integer) -> Value)
-> [(TokenName, Integer)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (\(TokenName
tn, Integer
i) -> CurrencySymbol -> TokenName -> Integer -> Value
Value.singleton CurrencySymbol
s TokenName
tn Integer
i) (Map TokenName Integer -> [(TokenName, Integer)]
forall k v. Map k v -> [(k, v)]
AssocMap.toList Map TokenName Integer
amts)
    in [Value] -> Value
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Value]
values

mkCurrency :: TxOutRef -> [(TokenName, Integer)] -> OneShotCurrency
mkCurrency :: TxOutRef -> [(TokenName, Integer)] -> OneShotCurrency
mkCurrency (TxOutRef TxId
h Integer
i) [(TokenName, Integer)]
amts =
    OneShotCurrency :: (TxId, Integer) -> Map TokenName Integer -> OneShotCurrency
OneShotCurrency
        { curRefTransactionOutput :: (TxId, Integer)
curRefTransactionOutput = (TxId
h, Integer
i)
        , curAmounts :: Map TokenName Integer
curAmounts              = [(TokenName, Integer)] -> Map TokenName Integer
forall k v. [(k, v)] -> Map k v
AssocMap.fromList [(TokenName, Integer)]
amts
        }

checkPolicy :: OneShotCurrency -> () -> V2.ScriptContext -> Bool
checkPolicy :: OneShotCurrency -> () -> ScriptContext -> Bool
checkPolicy c :: OneShotCurrency
c@(OneShotCurrency (TxId
refHash, Integer
refIdx) Map TokenName Integer
_) ()
_ ctx :: ScriptContext
ctx@V2.ScriptContext{scriptContextTxInfo :: ScriptContext -> TxInfo
V2.scriptContextTxInfo=TxInfo
txinfo} =
    let
        -- see note [Obtaining the currency symbol]
        ownSymbol :: CurrencySymbol
ownSymbol = ScriptContext -> CurrencySymbol
V2.ownCurrencySymbol ScriptContext
ctx

        minted :: Value
minted = TxInfo -> Value
V2.txInfoMint TxInfo
txinfo
        expected :: Value
expected = CurrencySymbol -> OneShotCurrency -> Value
currencyValue CurrencySymbol
ownSymbol OneShotCurrency
c

        -- True if the pending transaction mints the amount of
        -- currency that we expect
        mintOK :: Bool
mintOK =
            let v :: Bool
v = Value
expected Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
minted
            in BuiltinString -> Bool -> Bool
traceIfFalse BuiltinString
"C0" {-"Value minted different from expected"-} Bool
v

        -- True if the pending transaction spends the output
        -- identified by @(refHash, refIdx)@
        txOutputSpent :: Bool
txOutputSpent =
            let v :: Bool
v = TxInfo -> TxId -> Integer -> Bool
V2.spendsOutput TxInfo
txinfo TxId
refHash Integer
refIdx
            in  BuiltinString -> Bool -> Bool
traceIfFalse BuiltinString
"C1" {-"Pending transaction does not spend the designated transaction output"-} Bool
v

    in Bool
mintOK Bool -> Bool -> Bool
&& Bool
txOutputSpent

curPolicy :: OneShotCurrency -> MintingPolicy
curPolicy :: OneShotCurrency -> MintingPolicy
curPolicy OneShotCurrency
cur = CompiledCode (BuiltinData -> BuiltinData -> ()) -> MintingPolicy
V2.mkMintingPolicyScript (CompiledCode (BuiltinData -> BuiltinData -> ()) -> MintingPolicy)
-> CompiledCode (BuiltinData -> BuiltinData -> ()) -> MintingPolicy
forall a b. (a -> b) -> a -> b
$
    $$(PlutusTx.compile [|| \c -> Scripts.mkUntypedMintingPolicy (checkPolicy c) ||])
        CompiledCode (OneShotCurrency -> BuiltinData -> BuiltinData -> ())
-> CompiledCodeIn DefaultUni DefaultFun OneShotCurrency
-> CompiledCode (BuiltinData -> BuiltinData -> ())
forall (uni :: * -> *) fun a b.
(Closed uni, Everywhere uni Flat, Flat fun,
 Everywhere uni PrettyConst, GShow uni, Pretty fun) =>
CompiledCodeIn uni fun (a -> b)
-> CompiledCodeIn uni fun a -> CompiledCodeIn uni fun b
`PlutusTx.applyCode`
            OneShotCurrency
-> CompiledCodeIn DefaultUni DefaultFun OneShotCurrency
forall (uni :: * -> *) a fun.
(Lift uni a, Throwable uni fun, Typecheckable uni fun) =>
a -> CompiledCodeIn uni fun a
PlutusTx.liftCode OneShotCurrency
cur

{- note [Obtaining the currency symbol]

The currency symbol is the address (hash) of the validator. That is why
we can use 'Ledger.scriptAddress' here to get the symbol  in off-chain code,
for example in 'mintedValue'.

Inside the validator script (on-chain) we can't use 'Ledger.scriptAddress',
because at that point we don't know the hash of the script yet. That
is why we use 'V2.ownCurrencySymbol', which obtains the hash from the
'PolicyCtx' value.

-}

-- | The 'Value' minted by the 'OneShotCurrency' contract
mintedValue :: OneShotCurrency -> Value
mintedValue :: OneShotCurrency -> Value
mintedValue OneShotCurrency
cur = CurrencySymbol -> OneShotCurrency -> Value
currencyValue (OneShotCurrency -> CurrencySymbol
currencySymbol OneShotCurrency
cur) OneShotCurrency
cur

currencySymbol :: OneShotCurrency -> CurrencySymbol
currencySymbol :: OneShotCurrency -> CurrencySymbol
currencySymbol = MintingPolicy -> CurrencySymbol
V2.scriptCurrencySymbol (MintingPolicy -> CurrencySymbol)
-> (OneShotCurrency -> MintingPolicy)
-> OneShotCurrency
-> CurrencySymbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneShotCurrency -> MintingPolicy
curPolicy

currencyPolicyId :: OneShotCurrency -> CValue.PolicyId
currencyPolicyId :: OneShotCurrency -> PolicyId
currencyPolicyId = Versioned MintingPolicy -> PolicyId
CValue.policyId (Versioned MintingPolicy -> PolicyId)
-> (OneShotCurrency -> Versioned MintingPolicy)
-> OneShotCurrency
-> PolicyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MintingPolicy -> Language -> Versioned MintingPolicy
forall script. script -> Language -> Versioned script
`Versioned` Language
PlutusV2) (MintingPolicy -> Versioned MintingPolicy)
-> (OneShotCurrency -> MintingPolicy)
-> OneShotCurrency
-> Versioned MintingPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneShotCurrency -> MintingPolicy
curPolicy

newtype CurrencyError =
    CurContractError ContractError
    deriving stock (CurrencyError -> CurrencyError -> Bool
(CurrencyError -> CurrencyError -> Bool)
-> (CurrencyError -> CurrencyError -> Bool) -> Eq CurrencyError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CurrencyError -> CurrencyError -> Bool
$c/= :: CurrencyError -> CurrencyError -> Bool
== :: CurrencyError -> CurrencyError -> Bool
$c== :: CurrencyError -> CurrencyError -> Bool
Haskell.Eq, Int -> CurrencyError -> ShowS
[CurrencyError] -> ShowS
CurrencyError -> String
(Int -> CurrencyError -> ShowS)
-> (CurrencyError -> String)
-> ([CurrencyError] -> ShowS)
-> Show CurrencyError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurrencyError] -> ShowS
$cshowList :: [CurrencyError] -> ShowS
show :: CurrencyError -> String
$cshow :: CurrencyError -> String
showsPrec :: Int -> CurrencyError -> ShowS
$cshowsPrec :: Int -> CurrencyError -> ShowS
Haskell.Show, (forall x. CurrencyError -> Rep CurrencyError x)
-> (forall x. Rep CurrencyError x -> CurrencyError)
-> Generic CurrencyError
forall x. Rep CurrencyError x -> CurrencyError
forall x. CurrencyError -> Rep CurrencyError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CurrencyError x -> CurrencyError
$cfrom :: forall x. CurrencyError -> Rep CurrencyError x
Generic)
    deriving anyclass ([CurrencyError] -> Encoding
[CurrencyError] -> Value
CurrencyError -> Encoding
CurrencyError -> Value
(CurrencyError -> Value)
-> (CurrencyError -> Encoding)
-> ([CurrencyError] -> Value)
-> ([CurrencyError] -> Encoding)
-> ToJSON CurrencyError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CurrencyError] -> Encoding
$ctoEncodingList :: [CurrencyError] -> Encoding
toJSONList :: [CurrencyError] -> Value
$ctoJSONList :: [CurrencyError] -> Value
toEncoding :: CurrencyError -> Encoding
$ctoEncoding :: CurrencyError -> Encoding
toJSON :: CurrencyError -> Value
$ctoJSON :: CurrencyError -> Value
ToJSON, Value -> Parser [CurrencyError]
Value -> Parser CurrencyError
(Value -> Parser CurrencyError)
-> (Value -> Parser [CurrencyError]) -> FromJSON CurrencyError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CurrencyError]
$cparseJSONList :: Value -> Parser [CurrencyError]
parseJSON :: Value -> Parser CurrencyError
$cparseJSON :: Value -> Parser CurrencyError
FromJSON)

makeClassyPrisms ''CurrencyError

instance AsContractError CurrencyError where
    _ContractError :: p ContractError (f ContractError)
-> p CurrencyError (f CurrencyError)
_ContractError = p ContractError (f ContractError)
-> p CurrencyError (f CurrencyError)
forall r. AsCurrencyError r => Prism' r ContractError
_CurContractError

-- | @mint [(n1, c1), ..., (n_k, c_k)]@ creates a new currency with
--   @k@ token names, minting @c_i@ units of each token @n_i@.
--   If @k == 0@ then no value is minted. A one-shot minting policy
--   script is used to ensure that no more units of the currency can
--   be minted afterwards.
mintContract
    :: forall w s e.
    ( AsCurrencyError e
    )
    => CardanoAddress
    -> [(TokenName, Integer)]
    -> Contract w s e OneShotCurrency
mintContract :: CardanoAddress
-> [(TokenName, Integer)] -> Contract w s e OneShotCurrency
mintContract CardanoAddress
addr [(TokenName, Integer)]
amounts = (CurrencyError -> e)
-> Contract w s CurrencyError OneShotCurrency
-> Contract w s e OneShotCurrency
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError (AReview e CurrencyError -> CurrencyError -> e
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview e CurrencyError
forall r. AsCurrencyError r => Prism' r CurrencyError
_CurrencyError) (Contract w s CurrencyError OneShotCurrency
 -> Contract w s e OneShotCurrency)
-> Contract w s CurrencyError OneShotCurrency
-> Contract w s e OneShotCurrency
forall a b. (a -> b) -> a -> b
$ do
    TxOutRef
txOutRef <- Contract w s CurrencyError TxOutRef
forall e w (s :: Row *).
AsContractError e =>
Contract w s e TxOutRef
getUnspentOutput
    Map TxOutRef DecoratedTxOut
utxos <- CardanoAddress
-> Contract w s CurrencyError (Map TxOutRef DecoratedTxOut)
forall w (s :: Row *) e.
AsContractError e =>
CardanoAddress -> Contract w s e (Map TxOutRef DecoratedTxOut)
utxosAt CardanoAddress
addr
    let theCurrency :: OneShotCurrency
theCurrency = TxOutRef -> [(TokenName, Integer)] -> OneShotCurrency
mkCurrency TxOutRef
txOutRef [(TokenName, Integer)]
amounts
        curVali :: MintingPolicy
curVali     = OneShotCurrency -> MintingPolicy
curPolicy OneShotCurrency
theCurrency
        lookups :: ScriptLookups Any
lookups     = MintingPolicy -> ScriptLookups Any
forall a. MintingPolicy -> ScriptLookups a
Constraints.plutusV2MintingPolicy MintingPolicy
curVali
                        ScriptLookups Any -> ScriptLookups Any -> ScriptLookups Any
forall a. Semigroup a => a -> a -> a
<> Map TxOutRef DecoratedTxOut -> ScriptLookups Any
forall a. Map TxOutRef DecoratedTxOut -> ScriptLookups a
Constraints.unspentOutputs Map TxOutRef DecoratedTxOut
utxos
        mintTx :: TxConstraints BuiltinData BuiltinData
mintTx      = TxOutRef -> TxConstraints BuiltinData BuiltinData
forall i o. TxOutRef -> TxConstraints i o
Constraints.mustSpendPubKeyOutput TxOutRef
txOutRef
                        TxConstraints BuiltinData BuiltinData
-> TxConstraints BuiltinData BuiltinData
-> TxConstraints BuiltinData BuiltinData
forall a. Semigroup a => a -> a -> a
<> Value -> TxConstraints BuiltinData BuiltinData
forall i o. Value -> TxConstraints i o
Constraints.mustMintValue (OneShotCurrency -> Value
mintedValue OneShotCurrency
theCurrency)
    CardanoTx
tx <- ScriptLookups Any
-> TxConstraints (RedeemerType Any) (DatumType Any)
-> Contract w s CurrencyError CardanoTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e CardanoTx
submitTxConstraintsWith @Scripts.Any ScriptLookups Any
lookups TxConstraints (RedeemerType Any) (DatumType Any)
TxConstraints BuiltinData BuiltinData
mintTx
    Contract w s CurrencyError () -> Contract w s CurrencyError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract w s CurrencyError () -> Contract w s CurrencyError ())
-> Contract w s CurrencyError () -> Contract w s CurrencyError ()
forall a b. (a -> b) -> a -> b
$ TxId -> Contract w s CurrencyError ()
forall w (s :: Row *) e.
AsContractError e =>
TxId -> Contract w s e ()
awaitTxConfirmed (CardanoTx -> TxId
getCardanoTxId CardanoTx
tx)
    OneShotCurrency -> Contract w s CurrencyError OneShotCurrency
forall (f :: * -> *) a. Applicative f => a -> f a
pure OneShotCurrency
theCurrency

-- | Minting policy for a currency that has a fixed amount of tokens issued
--   in one transaction
data SimpleMPS =
    SimpleMPS
        { SimpleMPS -> TokenName
tokenName :: TokenName
        , SimpleMPS -> Integer
amount    :: Integer
        }
        deriving stock (SimpleMPS -> SimpleMPS -> Bool
(SimpleMPS -> SimpleMPS -> Bool)
-> (SimpleMPS -> SimpleMPS -> Bool) -> Eq SimpleMPS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleMPS -> SimpleMPS -> Bool
$c/= :: SimpleMPS -> SimpleMPS -> Bool
== :: SimpleMPS -> SimpleMPS -> Bool
$c== :: SimpleMPS -> SimpleMPS -> Bool
Haskell.Eq, Int -> SimpleMPS -> ShowS
[SimpleMPS] -> ShowS
SimpleMPS -> String
(Int -> SimpleMPS -> ShowS)
-> (SimpleMPS -> String)
-> ([SimpleMPS] -> ShowS)
-> Show SimpleMPS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleMPS] -> ShowS
$cshowList :: [SimpleMPS] -> ShowS
show :: SimpleMPS -> String
$cshow :: SimpleMPS -> String
showsPrec :: Int -> SimpleMPS -> ShowS
$cshowsPrec :: Int -> SimpleMPS -> ShowS
Haskell.Show, (forall x. SimpleMPS -> Rep SimpleMPS x)
-> (forall x. Rep SimpleMPS x -> SimpleMPS) -> Generic SimpleMPS
forall x. Rep SimpleMPS x -> SimpleMPS
forall x. SimpleMPS -> Rep SimpleMPS x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SimpleMPS x -> SimpleMPS
$cfrom :: forall x. SimpleMPS -> Rep SimpleMPS x
Generic)
        deriving anyclass (Value -> Parser [SimpleMPS]
Value -> Parser SimpleMPS
(Value -> Parser SimpleMPS)
-> (Value -> Parser [SimpleMPS]) -> FromJSON SimpleMPS
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SimpleMPS]
$cparseJSONList :: Value -> Parser [SimpleMPS]
parseJSON :: Value -> Parser SimpleMPS
$cparseJSON :: Value -> Parser SimpleMPS
FromJSON, [SimpleMPS] -> Encoding
[SimpleMPS] -> Value
SimpleMPS -> Encoding
SimpleMPS -> Value
(SimpleMPS -> Value)
-> (SimpleMPS -> Encoding)
-> ([SimpleMPS] -> Value)
-> ([SimpleMPS] -> Encoding)
-> ToJSON SimpleMPS
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SimpleMPS] -> Encoding
$ctoEncodingList :: [SimpleMPS] -> Encoding
toJSONList :: [SimpleMPS] -> Value
$ctoJSONList :: [SimpleMPS] -> Value
toEncoding :: SimpleMPS -> Encoding
$ctoEncoding :: SimpleMPS -> Encoding
toJSON :: SimpleMPS -> Value
$ctoJSON :: SimpleMPS -> Value
ToJSON)

type CurrencySchema =
        Endpoint "Create native token" SimpleMPS

-- | Use 'mintContract' to create the currency specified by a 'SimpleMPS'
mintCurrency
    :: Promise (Maybe (Last OneShotCurrency)) CurrencySchema CurrencyError OneShotCurrency
mintCurrency :: Promise
  (Maybe (Last OneShotCurrency))
  CurrencySchema
  CurrencyError
  OneShotCurrency
mintCurrency = forall a w (s :: Row *) e b.
(HasEndpoint "Create native token" a s, AsContractError e,
 FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
forall (l :: Symbol) a w (s :: Row *) e b.
(HasEndpoint l a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
endpoint @"Create native token" ((SimpleMPS
  -> Contract
       (Maybe (Last OneShotCurrency))
       ('R
          '[ "Create native token"
             ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
       CurrencyError
       OneShotCurrency)
 -> Promise
      (Maybe (Last OneShotCurrency))
      ('R
         '[ "Create native token"
            ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
      CurrencyError
      OneShotCurrency)
-> (SimpleMPS
    -> Contract
         (Maybe (Last OneShotCurrency))
         ('R
            '[ "Create native token"
               ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
         CurrencyError
         OneShotCurrency)
-> Promise
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     OneShotCurrency
forall a b. (a -> b) -> a -> b
$ \SimpleMPS{TokenName
tokenName :: TokenName
tokenName :: SimpleMPS -> TokenName
tokenName, Integer
amount :: Integer
amount :: SimpleMPS -> Integer
amount} -> do
    CardanoAddress
ownAddr <- Contract
  (Maybe (Last OneShotCurrency))
  ('R
     '[ "Create native token"
        ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
  CurrencyError
  CardanoAddress
forall w (s :: Row *) e.
AsContractError e =>
Contract w s e CardanoAddress
ownAddress
    OneShotCurrency
cur <- CardanoAddress
-> [(TokenName, Integer)]
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     OneShotCurrency
forall w (s :: Row *) e.
AsCurrencyError e =>
CardanoAddress
-> [(TokenName, Integer)] -> Contract w s e OneShotCurrency
mintContract CardanoAddress
ownAddr [(TokenName
tokenName, Integer
amount)]
    Maybe (Last OneShotCurrency)
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
forall w (s :: Row *) e. w -> Contract w s e ()
tell (Maybe (Last OneShotCurrency)
 -> Contract
      (Maybe (Last OneShotCurrency))
      ('R
         '[ "Create native token"
            ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
      CurrencyError
      ())
-> Maybe (Last OneShotCurrency)
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     ()
forall a b. (a -> b) -> a -> b
$ Last OneShotCurrency -> Maybe (Last OneShotCurrency)
forall a. a -> Maybe a
Just (Last OneShotCurrency -> Maybe (Last OneShotCurrency))
-> Last OneShotCurrency -> Maybe (Last OneShotCurrency)
forall a b. (a -> b) -> a -> b
$ OneShotCurrency -> Last OneShotCurrency
forall a. a -> Last a
Last OneShotCurrency
cur
    OneShotCurrency
-> Contract
     (Maybe (Last OneShotCurrency))
     ('R
        '[ "Create native token"
           ':-> (EndpointValue SimpleMPS, ActiveEndpoint)])
     CurrencyError
     OneShotCurrency
forall (f :: * -> *) a. Applicative f => a -> f a
pure OneShotCurrency
cur