-- | 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.BlockChain
import Cooked.MockChain.GenerateTx.Common
import Cooked.MockChain.GenerateTx.Witness
import Cooked.Skeleton
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

-- | Converts a 'TxSkelMints' into a 'Cardano.TxMintValue'
toMintValue :: (MonadBlockChainBalancing m) => TxSkelMints -> m (Cardano.TxMintValue Cardano.BuildTx Cardano.ConwayEra)
toMintValue :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelMints -> m (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 -> m (TxMintValue BuildTx ConwayEra)
forall a. a -> m 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)
-> m [(PolicyId,
       (PolicyAssets,
        BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))]
-> m (TxMintValue BuildTx ConwayEra)
forall a b. (a -> b) -> m a -> m 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) (m [(PolicyId,
     (PolicyAssets,
      BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))]
 -> m (TxMintValue BuildTx ConwayEra))
-> m [(PolicyId,
       (PolicyAssets,
        BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))]
-> m (TxMintValue BuildTx ConwayEra)
forall a b. (a -> b) -> a -> b
$
  [(ScriptHash, (User 'IsScript 'Redemption, Map TokenName Integer))]
-> ((ScriptHash,
     (User 'IsScript 'Redemption, Map TokenName Integer))
    -> m (PolicyId,
          (PolicyAssets,
           BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra))))
-> m [(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))
  -> m (PolicyId,
        (PolicyAssets,
         BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra))))
 -> m [(PolicyId,
        (PolicyAssets,
         BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))])
-> ((ScriptHash,
     (User 'IsScript 'Redemption, Map TokenName Integer))
    -> m (PolicyId,
          (PolicyAssets,
           BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra))))
-> m [(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 <-
      String -> Either ToCardanoError PolicyId -> m PolicyId
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Either ToCardanoError a -> m a
throwOnToCardanoError
        String
"toMintValue: Unable to translate minting policy hash"
        (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))
-> m (ScriptWitness WitCtxMint ConwayEra)
-> m (BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> script
-> TxSkelRedeemer
-> ScriptDatum WitCtxMint
-> m (ScriptWitness WitCtxMint ConwayEra)
forall (m :: * -> *) a b.
(MonadBlockChainBalancing m, ToVScript a) =>
a
-> TxSkelRedeemer -> ScriptDatum b -> m (ScriptWitness b ConwayEra)
toScriptWitness script
policy TxSkelRedeemer
red ScriptDatum WitCtxMint
Cardano.NoScriptDatumForMint
    (PolicyId,
 (PolicyAssets,
  BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))
-> m (PolicyId,
      (PolicyAssets,
       BuildTxWith BuildTx (ScriptWitness WitCtxMint ConwayEra)))
forall a. a -> m 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
        )
      )