-- | 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.Error
import Cooked.MockChain.GenerateTx.Witness
import Cooked.MockChain.Read
import Cooked.Skeleton.User
import Cooked.Skeleton.Withdrawal
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
import Polysemy
import Polysemy.Error

-- | Takes a 'TxSkelWithdrawals' and transforms it into a 'Cardano.TxWithdrawals'
toWithdrawals ::
  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
  TxSkelWithdrawals ->
  Sem effs (Cardano.TxWithdrawals Cardano.BuildTx Cardano.ConwayEra)
toWithdrawals :: forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError]
  effs =>
TxSkelWithdrawals -> Sem effs (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
-> Sem effs (TxWithdrawals BuildTx ConwayEra)
forall a. a -> Sem effs 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) -> Sem effs Params -> Sem effs NetworkId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem effs Params
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Params
getParams
  [(StakeAddress, Coin,
  BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
cardanoWithdrawals <- [Withdrawal]
-> (Withdrawal
    -> Sem
         effs
         (StakeAddress, Coin,
          BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)))
-> Sem
     effs
     [(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
  -> Sem
       effs
       (StakeAddress, Coin,
        BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)))
 -> Sem
      effs
      [(StakeAddress, Coin,
        BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))])
-> (Withdrawal
    -> Sem
         effs
         (StakeAddress, Coin,
          BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)))
-> Sem
     effs
     [(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 <- Either ToCardanoError StakeCredential -> Sem effs StakeCredential
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either ToCardanoError StakeCredential -> Sem effs StakeCredential)
-> Either ToCardanoError StakeCredential
-> Sem effs 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)
-> Sem effs (StakeCredential, Witness WitCtxStake ConwayEra)
forall a. a -> Sem effs 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)
-> Sem effs (ScriptWitness WitCtxStake ConwayEra)
-> Sem effs (Witness WitCtxStake ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VScript
-> TxSkelRedeemer
-> ScriptDatum WitCtxStake
-> Sem effs (ScriptWitness WitCtxStake 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 VScript
vScript TxSkelRedeemer
red ScriptDatum WitCtxStake
Cardano.NoScriptDatumForStake
        StakeCredential
sCred <- Either ToCardanoError StakeCredential -> Sem effs StakeCredential
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either ToCardanoError StakeCredential -> Sem effs StakeCredential)
-> Either ToCardanoError StakeCredential
-> Sem effs 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)
-> Sem effs (StakeCredential, Witness WitCtxStake ConwayEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (StakeCredential
sCred, Witness WitCtxStake ConwayEra
witness)
    (StakeAddress, Coin,
 BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))
-> Sem
     effs
     (StakeAddress, Coin,
      BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))
forall a. a -> Sem effs 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
-> Sem effs (TxWithdrawals BuildTx ConwayEra)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxWithdrawals BuildTx ConwayEra
 -> Sem effs (TxWithdrawals BuildTx ConwayEra))
-> TxWithdrawals BuildTx ConwayEra
-> Sem effs (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