-- | This module exposes the generation of a transaction minted value
module Cooked.MockChain.GenerateTx.Mint (toMintValue) where

import Cardano.Api qualified as Cardano
import Control.Monad
import Cooked.MockChain.Error
import Cooked.MockChain.GenerateTx.Witness
import Cooked.MockChain.Read
import Cooked.Skeleton.Mint
import Cooked.Skeleton.User
import Data.Map qualified as Map
import Data.Map.Strict qualified as SMap
import GHC.Exts (fromList)
import Ledger.Tx.CardanoAPI qualified as Ledger
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V3 qualified as Api
import PlutusTx.Builtins.Internal qualified as PlutusTx
import Polysemy
import Polysemy.Error

-- | Converts a 'TxSkelMints' into a 'Cardano.TxMintValue'
toMintValue ::
  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
  TxSkelMints ->
  Sem effs (Cardano.TxMintValue Cardano.BuildTx Cardano.ConwayEra)
toMintValue :: forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError]
  effs =>
TxSkelMints -> Sem effs (TxMintValue BuildTx ConwayEra)
toMintValue TxSkelMints
txSkelMints | TxSkelMints
txSkelMints TxSkelMints -> TxSkelMints -> Bool
forall a. Eq a => a -> a -> Bool
== TxSkelMints
forall a. Monoid a => a
mempty = TxMintValue BuildTx ConwayEra
-> Sem effs (TxMintValue BuildTx ConwayEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return TxMintValue BuildTx ConwayEra
forall build era. TxMintValue build era
Cardano.TxMintNone
toMintValue (TxSkelMints
-> Map
     ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
unTxSkelMints -> Map ScriptHash (User 'IsScript 'Redemption, Map TokenName Integer)
mints) = ([(PolicyId,
   (PolicyAssets,
    BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))]
 -> TxMintValue BuildTx ConwayEra)
-> Sem
     effs
     [(PolicyId,
       (PolicyAssets,
        BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))]
-> Sem effs (TxMintValue BuildTx ConwayEra)
forall a b. (a -> b) -> Sem effs a -> Sem effs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MaryEraOnwards ConwayEra
-> Map
     PolicyId
     (PolicyAssets,
      BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra))
-> TxMintValue BuildTx ConwayEra
forall era build.
MaryEraOnwards era
-> Map
     PolicyId
     (PolicyAssets, BuildTxWith build (ScriptWitness WitCtxMint era))
-> TxMintValue build era
Cardano.TxMintValue MaryEraOnwards ConwayEra
Cardano.MaryEraOnwardsConway (Map
   PolicyId
   (PolicyAssets,
    BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra))
 -> TxMintValue BuildTx ConwayEra)
-> ([(PolicyId,
      (PolicyAssets,
       BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))]
    -> Map
         PolicyId
         (PolicyAssets,
          BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))
-> [(PolicyId,
     (PolicyAssets,
      BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))]
-> TxMintValue BuildTx ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PolicyId,
  (PolicyAssets,
   BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))]
-> Map
     PolicyId
     (PolicyAssets,
      BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra))
forall k a. Ord k => [(k, a)] -> Map k a
SMap.fromList) (Sem
   effs
   [(PolicyId,
     (PolicyAssets,
      BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))]
 -> Sem effs (TxMintValue BuildTx ConwayEra))
-> Sem
     effs
     [(PolicyId,
       (PolicyAssets,
        BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))]
-> Sem effs (TxMintValue BuildTx ConwayEra)
forall a b. (a -> b) -> a -> b
$
  [(ScriptHash, (User 'IsScript 'Redemption, Map TokenName Integer))]
-> ((ScriptHash,
     (User 'IsScript 'Redemption, Map TokenName Integer))
    -> Sem
         effs
         (PolicyId,
          (PolicyAssets,
           BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra))))
-> Sem
     effs
     [(PolicyId,
       (PolicyAssets,
        BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (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)
mints) (((ScriptHash, (User 'IsScript 'Redemption, Map TokenName Integer))
  -> Sem
       effs
       (PolicyId,
        (PolicyAssets,
         BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra))))
 -> Sem
      effs
      [(PolicyId,
        (PolicyAssets,
         BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))])
-> ((ScriptHash,
     (User 'IsScript 'Redemption, Map TokenName Integer))
    -> Sem
         effs
         (PolicyId,
          (PolicyAssets,
           BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra))))
-> Sem
     effs
     [(PolicyId,
       (PolicyAssets,
        BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))]
forall a b. (a -> b) -> a -> b
$ \(ScriptHash
policyHash, (UserRedeemedScript script
policy TxSkelRedeemer
red, Map TokenName Integer -> [(TokenName, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList -> [(TokenName, Integer)]
assets)) -> do
    PolicyId
policyId <- Either ToCardanoError PolicyId -> Sem effs PolicyId
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either ToCardanoError PolicyId -> Sem effs PolicyId)
-> Either ToCardanoError PolicyId -> Sem effs PolicyId
forall a b. (a -> b) -> a -> b
$ MintingPolicyHash -> Either ToCardanoError PolicyId
Ledger.toCardanoPolicyId (MintingPolicyHash -> Either ToCardanoError PolicyId)
-> MintingPolicyHash -> Either ToCardanoError PolicyId
forall a b. (a -> b) -> a -> b
$ ScriptHash -> MintingPolicyHash
forall a. ToMintingPolicyHash a => a -> MintingPolicyHash
Script.toMintingPolicyHash ScriptHash
policyHash
    BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)
mintWitness <- ScriptWitness WitCtxMint ConwayEra
-> BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith (ScriptWitness WitCtxMint ConwayEra
 -> BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra))
-> Sem effs (ScriptWitness WitCtxMint ConwayEra)
-> Sem
     effs (BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> script
-> TxSkelRedeemer
-> ScriptDatum WitCtxMint
-> Sem effs (ScriptWitness WitCtxMint ConwayEra)
forall (effs :: EffectRow) a b.
(Members
   '[MockChainRead, Error MockChainError, Error ToCardanoError] effs,
 ToVScript a) =>
a
-> TxSkelRedeemer
-> ScriptDatum b
-> Sem effs (ScriptWitness b ConwayEra)
toScriptWitness script
policy TxSkelRedeemer
red ScriptDatum WitCtxMint
Cardano.NoScriptDatumForMint
    (PolicyId,
 (PolicyAssets,
  BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))
-> Sem
     effs
     (PolicyId,
      (PolicyAssets,
       BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return
      ( PolicyId
policyId,
        ( [Item PolicyAssets] -> PolicyAssets
forall l. IsList l => [Item l] -> l
fromList
            [ (ByteString -> AssetName
Cardano.UnsafeAssetName ByteString
name, Integer -> Quantity
Cardano.Quantity Integer
quantity)
            | (Api.TokenName (PlutusTx.BuiltinByteString ByteString
name), Integer
quantity) <- [(TokenName, Integer)]
assets
            ],
          BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)
mintWitness
        )
      )