-- | This modules exposes the generation of withdrawals
module Cooked.MockChain.GenerateTx.Withdrawals (toWithdrawals) where

import Cardano.Api qualified as Cardano
import Cardano.Node.Emulator.Internal.Node.Params qualified as Emulator
import Control.Monad
import Cooked.MockChain.BlockChain
import Cooked.MockChain.GenerateTx.Common
import Cooked.MockChain.GenerateTx.Witness
import Cooked.Skeleton
import Data.Coerce
import Ledger.Tx.CardanoAPI qualified as Ledger
import Optics.Core
import Plutus.Script.Utils.Address qualified as Script
import Plutus.Script.Utils.Scripts qualified as Script
import PlutusLedgerApi.V1.Value qualified as Api

-- | Takes a 'TxSkelWithdrawals' and transforms it into a 'Cardano.TxWithdrawals'
toWithdrawals :: (MonadBlockChainBalancing m) => TxSkelWithdrawals -> m (Cardano.TxWithdrawals Cardano.BuildTx Cardano.ConwayEra)
toWithdrawals :: forall (m :: * -> *).
MonadBlockChainBalancing m =>
TxSkelWithdrawals -> m (TxWithdrawals BuildTx ConwayEra)
toWithdrawals TxSkelWithdrawals
withdrawals | TxSkelWithdrawals
withdrawals TxSkelWithdrawals -> TxSkelWithdrawals -> Bool
forall a. Eq a => a -> a -> Bool
== TxSkelWithdrawals
forall a. Monoid a => a
mempty = TxWithdrawals BuildTx ConwayEra
-> m (TxWithdrawals BuildTx ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return TxWithdrawals BuildTx ConwayEra
forall build era. TxWithdrawals build era
Cardano.TxWithdrawalsNone
toWithdrawals (Optic' An_Iso NoIx TxSkelWithdrawals [Withdrawal]
-> TxSkelWithdrawals -> [Withdrawal]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' An_Iso NoIx TxSkelWithdrawals [Withdrawal]
txSkelWithdrawalsListI -> [Withdrawal]
withdrawals) = do
  NetworkId
networkId <- Params -> NetworkId
Emulator.pNetworkId (Params -> NetworkId) -> m Params -> m NetworkId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Params
forall (m :: * -> *). MonadBlockChainBalancing m => m Params
getParams
  [(StakeAddress, Coin,
  BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
cardanoWithdrawals <- [Withdrawal]
-> (Withdrawal
    -> m (StakeAddress, Coin,
          BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)))
-> m [(StakeAddress, Coin,
       BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Withdrawal]
withdrawals ((Withdrawal
  -> m (StakeAddress, Coin,
        BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)))
 -> m [(StakeAddress, Coin,
        BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))])
-> (Withdrawal
    -> m (StakeAddress, Coin,
          BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)))
-> m [(StakeAddress, Coin,
       BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
forall a b. (a -> b) -> a -> b
$ \(Withdrawal User 'IsEither 'Redemption
user Maybe Lovelace
amount) -> do
    let coinAmount :: Coin
coinAmount = Coin -> (Lovelace -> Coin) -> Maybe Lovelace -> Coin
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Integer -> Coin
Cardano.Coin Integer
0) Lovelace -> Coin
forall a b. Coercible a b => a -> b
coerce Maybe Lovelace
amount
    (StakeCredential
sCred, Witness WitCtxStake ConwayEra
witness) <- case User 'IsEither 'Redemption
user of
      UserPubKey (pkh -> PubKeyHash
forall a. ToPubKeyHash a => a -> PubKeyHash
Script.toPubKeyHash -> PubKeyHash
pkh) -> do
        StakeCredential
sCred <-
          String
-> Either ToCardanoError StakeCredential -> m StakeCredential
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Either ToCardanoError a -> m a
throwOnToCardanoError String
"toWithdrawals: unable to translate pkh stake credential" (Either ToCardanoError StakeCredential -> m StakeCredential)
-> Either ToCardanoError StakeCredential -> m StakeCredential
forall a b. (a -> b) -> a -> b
$
            Hash StakeKey -> StakeCredential
Cardano.StakeCredentialByKey (Hash StakeKey -> StakeCredential)
-> Either ToCardanoError (Hash StakeKey)
-> Either ToCardanoError StakeCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PubKeyHash -> Either ToCardanoError (Hash StakeKey)
Ledger.toCardanoStakeKeyHash PubKeyHash
pkh
        (StakeCredential, Witness WitCtxStake ConwayEra)
-> m (StakeCredential, Witness WitCtxStake ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeCredential
sCred, KeyWitnessInCtx WitCtxStake -> Witness WitCtxStake ConwayEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
Cardano.KeyWitness KeyWitnessInCtx WitCtxStake
Cardano.KeyWitnessForStakeAddr)
      UserRedeemedScript (script -> VScript
forall script. ToVScript script => script -> VScript
toVScript -> VScript
vScript) TxSkelRedeemer
red -> do
        Witness WitCtxStake ConwayEra
witness <-
          ScriptWitnessInCtx WitCtxStake
-> ScriptWitness WitCtxStake ConwayEra
-> Witness WitCtxStake ConwayEra
forall witctx era.
ScriptWitnessInCtx witctx
-> ScriptWitness witctx era -> Witness witctx era
Cardano.ScriptWitness ScriptWitnessInCtx WitCtxStake
Cardano.ScriptWitnessForStakeAddr
            (ScriptWitness WitCtxStake ConwayEra
 -> Witness WitCtxStake ConwayEra)
-> m (ScriptWitness WitCtxStake ConwayEra)
-> m (Witness WitCtxStake ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VScript
-> TxSkelRedeemer
-> ScriptDatum WitCtxStake
-> m (ScriptWitness WitCtxStake ConwayEra)
forall (m :: * -> *) a b.
(MonadBlockChainBalancing m, ToVScript a) =>
a
-> TxSkelRedeemer -> ScriptDatum b -> m (ScriptWitness b ConwayEra)
toScriptWitness VScript
vScript TxSkelRedeemer
red ScriptDatum WitCtxStake
Cardano.NoScriptDatumForStake
        StakeCredential
sCred <-
          String
-> Either ToCardanoError StakeCredential -> m StakeCredential
forall (m :: * -> *) a.
MonadError MockChainError m =>
String -> Either ToCardanoError a -> m a
throwOnToCardanoError String
"toWithdrawals: unable to translate script stake credential" (Either ToCardanoError StakeCredential -> m StakeCredential)
-> Either ToCardanoError StakeCredential -> m StakeCredential
forall a b. (a -> b) -> a -> b
$
            ScriptHash -> StakeCredential
Cardano.StakeCredentialByScript (ScriptHash -> StakeCredential)
-> Either ToCardanoError ScriptHash
-> Either ToCardanoError StakeCredential
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptHash -> Either ToCardanoError ScriptHash
Ledger.toCardanoScriptHash (VScript -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash VScript
vScript)
        (StakeCredential, Witness WitCtxStake ConwayEra)
-> m (StakeCredential, Witness WitCtxStake ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeCredential
sCred, Witness WitCtxStake ConwayEra
witness)
    (StakeAddress, Coin,
 BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))
-> m (StakeAddress, Coin,
      BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (NetworkId -> StakeCredential -> StakeAddress
Cardano.makeStakeAddress NetworkId
networkId StakeCredential
sCred, Coin
coinAmount, Witness WitCtxStake ConwayEra
-> BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith Witness WitCtxStake ConwayEra
witness)
  TxWithdrawals BuildTx ConwayEra
-> m (TxWithdrawals BuildTx ConwayEra)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxWithdrawals BuildTx ConwayEra
 -> m (TxWithdrawals BuildTx ConwayEra))
-> TxWithdrawals BuildTx ConwayEra
-> m (TxWithdrawals BuildTx ConwayEra)
forall a b. (a -> b) -> a -> b
$ ShelleyBasedEra ConwayEra
-> [(StakeAddress, Coin,
     BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
-> TxWithdrawals BuildTx ConwayEra
forall era build.
ShelleyBasedEra era
-> [(StakeAddress, Coin,
     BuildTxWith build (Witness WitCtxStake era))]
-> TxWithdrawals build era
Cardano.TxWithdrawals ShelleyBasedEra ConwayEra
Cardano.ShelleyBasedEraConway [(StakeAddress, Coin,
  BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
cardanoWithdrawals