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

import Cardano.Api qualified as Cardano
import Cardano.Api.Ledger qualified as Cardano
import Cardano.Api.Shelley 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.Map qualified as Map
import Ledger.Tx.CardanoAPI qualified as Ledger
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
-> [(Either (Versioned Script) PubKeyHash,
     (TxSkelRedeemer, Lovelace))]
forall k a. Map k a -> [(k, a)]
Map.toList -> []) = 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 (TxSkelWithdrawals
-> [(Either (Versioned Script) PubKeyHash,
     (TxSkelRedeemer, Lovelace))]
forall k a. Map k a -> [(k, a)]
Map.toList -> [(Either (Versioned Script) PubKeyHash,
  (TxSkelRedeemer, Lovelace))]
withdrawals) =
  ([(StakeAddress, Coin,
   BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
 -> TxWithdrawals BuildTx ConwayEra)
-> m [(StakeAddress, Coin,
       BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
-> m (TxWithdrawals BuildTx ConwayEra)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (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)
    (m [(StakeAddress, Coin,
     BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
 -> m (TxWithdrawals BuildTx ConwayEra))
-> m [(StakeAddress, Coin,
       BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
-> m (TxWithdrawals BuildTx ConwayEra)
forall a b. (a -> b) -> a -> b
$ [(Either (Versioned Script) PubKeyHash,
  (TxSkelRedeemer, Lovelace))]
-> ((Either (Versioned Script) PubKeyHash,
     (TxSkelRedeemer, Lovelace))
    -> 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 [(Either (Versioned Script) PubKeyHash,
  (TxSkelRedeemer, Lovelace))]
withdrawals
    (((Either (Versioned Script) PubKeyHash,
   (TxSkelRedeemer, Lovelace))
  -> m (StakeAddress, Coin,
        BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)))
 -> m [(StakeAddress, Coin,
        BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))])
-> ((Either (Versioned Script) PubKeyHash,
     (TxSkelRedeemer, Lovelace))
    -> m (StakeAddress, Coin,
          BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)))
-> m [(StakeAddress, Coin,
       BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
forall a b. (a -> b) -> a -> b
$ \(Either (Versioned Script) PubKeyHash
staker, (TxSkelRedeemer
red, Api.Lovelace Integer
n)) ->
      do
        (Witness WitCtxStake ConwayEra
witness, StakeCredential
sCred) <-
          case Either (Versioned Script) PubKeyHash
staker of
            Right 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
              (Witness WitCtxStake ConwayEra, StakeCredential)
-> m (Witness WitCtxStake ConwayEra, StakeCredential)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyWitnessInCtx WitCtxStake -> Witness WitCtxStake ConwayEra
forall witctx era. KeyWitnessInCtx witctx -> Witness witctx era
Cardano.KeyWitness KeyWitnessInCtx WitCtxStake
Cardano.KeyWitnessForStakeAddr, StakeCredential
sCred)
            Left Versioned Script
script -> 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
<$> Versioned Script
-> TxSkelRedeemer
-> ScriptDatum WitCtxStake
-> m (ScriptWitness WitCtxStake ConwayEra)
forall (m :: * -> *) a b.
(MonadBlockChainBalancing m, ToVersioned Script a) =>
a
-> TxSkelRedeemer -> ScriptDatum b -> m (ScriptWitness b ConwayEra)
toScriptWitness Versioned Script
script 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 (Versioned Script -> ScriptHash
forall a. ToScriptHash a => a -> ScriptHash
Script.toScriptHash Versioned Script
script)
              (Witness WitCtxStake ConwayEra, StakeCredential)
-> m (Witness WitCtxStake ConwayEra, StakeCredential)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Witness WitCtxStake ConwayEra
witness, StakeCredential
sCred)
        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))
-> 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, Integer -> Coin
Cardano.Coin Integer
n, Witness WitCtxStake ConwayEra
-> BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)
forall a. a -> BuildTxWith BuildTx a
Cardano.BuildTxWith Witness WitCtxStake ConwayEra
witness)