{-# LANGUAGE NumericUnderscores #-}
{-| Conveniences for balancing transactions and selecting coins
on the mockchain
-}
module Convex.MockChain.CoinSelection(
  balanceAndSubmit,
  balanceAndSubmitReturn,
  paymentTo
) where

import           Cardano.Api.Shelley       (BabbageEra, BuildTx, TxBodyContent)
import qualified Cardano.Api.Shelley       as C
import           Convex.BuildTx            (execBuildTx, payToAddress)
import           Convex.Class              (MonadBlockchain (..),
                                            MonadMockchain)
import qualified Convex.CoinSelection      as CoinSelection
import           Convex.Lenses             (emptyTx, emptyTxOut)
import qualified Convex.MockChain          as MockChain
import qualified Convex.MockChain.Defaults as Defaults
import           Convex.Wallet             (Wallet)
import qualified Convex.Wallet             as Wallet

{-| Balance and submit a transaction using the wallet's UTXOs
on the mockchain, using the default network ID
-}
balanceAndSubmit :: (MonadMockchain m, MonadFail m) => Wallet -> TxBodyContent BuildTx BabbageEra -> m (C.Tx CoinSelection.ERA)
balanceAndSubmit :: forall (m :: * -> *).
(MonadMockchain m, MonadFail m) =>
Wallet -> TxBodyContent BuildTx BabbageEra -> m (Tx BabbageEra)
balanceAndSubmit Wallet
wallet TxBodyContent BuildTx BabbageEra
tx = do
  NetworkId
n <- forall (m :: * -> *). MonadBlockchain m => m NetworkId
networkId
  let walletAddress :: AddressInEra BabbageEra
walletAddress = forall era.
IsShelleyBasedEra era =>
NetworkId -> Wallet -> AddressInEra era
Wallet.addressInEra NetworkId
n Wallet
wallet
      txOut :: TxOut CtxTx BabbageEra
txOut = AddressInEra BabbageEra -> TxOut CtxTx BabbageEra
emptyTxOut AddressInEra BabbageEra
walletAddress
  forall (m :: * -> *).
(MonadMockchain m, MonadFail m) =>
Wallet
-> TxOut CtxTx BabbageEra
-> TxBodyContent BuildTx BabbageEra
-> m (Tx BabbageEra)
balanceAndSubmitReturn Wallet
wallet TxOut CtxTx BabbageEra
txOut TxBodyContent BuildTx BabbageEra
tx

{-| Balance and submit a transaction using the given return output and the wallet's UTXOs
on the mockchain, using the default network ID
-}
balanceAndSubmitReturn :: (MonadMockchain m, MonadFail m) => Wallet -> C.TxOut C.CtxTx C.BabbageEra -> TxBodyContent BuildTx BabbageEra -> m (C.Tx CoinSelection.ERA)
balanceAndSubmitReturn :: forall (m :: * -> *).
(MonadMockchain m, MonadFail m) =>
Wallet
-> TxOut CtxTx BabbageEra
-> TxBodyContent BuildTx BabbageEra
-> m (Tx BabbageEra)
balanceAndSubmitReturn Wallet
wallet TxOut CtxTx BabbageEra
returnOutput TxBodyContent BuildTx BabbageEra
tx = do
  UtxoSet CtxUTxO ()
u <- forall (m :: * -> *).
MonadMockchain m =>
Wallet -> m (UtxoSet CtxUTxO ())
MockChain.walletUtxo Wallet
wallet
  (Tx BabbageEra
tx', BalanceChanges
_) <- forall (m :: * -> *) a.
(MonadBlockchain m, MonadFail m) =>
Wallet
-> UtxoSet CtxUTxO a
-> TxOut CtxTx BabbageEra
-> TxBodyContent BuildTx BabbageEra
-> m (Tx BabbageEra, BalanceChanges)
CoinSelection.balanceForWalletReturn Wallet
wallet UtxoSet CtxUTxO ()
u TxOut CtxTx BabbageEra
returnOutput TxBodyContent BuildTx BabbageEra
tx
  TxId
_ <- forall (m :: * -> *). MonadBlockchain m => Tx BabbageEra -> m TxId
sendTx Tx BabbageEra
tx'
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx BabbageEra
tx'

{-| Pay ten Ada from one wallet to another
-}
paymentTo :: (MonadMockchain m, MonadFail m) => Wallet -> Wallet -> m (C.Tx CoinSelection.ERA)
paymentTo :: forall (m :: * -> *).
(MonadMockchain m, MonadFail m) =>
Wallet -> Wallet -> m (Tx BabbageEra)
paymentTo Wallet
wFrom Wallet
wTo = do
  let tx :: TxBodyContent BuildTx BabbageEra
tx = forall a. BuildTxT Identity a -> TxBuild
execBuildTx (forall (m :: * -> *).
MonadBuildTx m =>
AddressInEra BabbageEra -> Value -> m ()
payToAddress (forall era.
IsShelleyBasedEra era =>
NetworkId -> Wallet -> AddressInEra era
Wallet.addressInEra NetworkId
Defaults.networkId Wallet
wTo) (Lovelace -> Value
C.lovelaceToValue Lovelace
10_000_000)) TxBodyContent BuildTx BabbageEra
emptyTx
  forall (m :: * -> *).
(MonadMockchain m, MonadFail m) =>
Wallet -> TxBodyContent BuildTx BabbageEra -> m (Tx BabbageEra)
balanceAndSubmit Wallet
wFrom TxBodyContent BuildTx BabbageEra
tx