module Cooked.MockChain.GenerateTx.Withdrawals
  ( WithdrawalsContext (..),
    toWithdrawals,
  )
where

import Cardano.Api qualified as Cardano
import Cardano.Api.Ledger qualified as Cardano
import Cardano.Api.Shelley qualified as Cardano
import Control.Monad
import Control.Monad.Reader
import Cooked.Conversion
import Cooked.MockChain.GenerateTx.Common
import Cooked.MockChain.GenerateTx.Witness
import Cooked.Skeleton
import Data.Map (Map)
import Data.Map qualified as Map
import Ledger.Tx.CardanoAPI qualified as Ledger
import Plutus.Script.Utils.Ada qualified as Script
import PlutusLedgerApi.V3 qualified as Api

data WithdrawalsContext where
  WithdrawalsContext ::
    { WithdrawalsContext -> Map TxOutRef TxOut
managedTxOuts :: Map Api.TxOutRef Api.TxOut,
      WithdrawalsContext -> NetworkId
networkId :: Cardano.NetworkId
    } ->
    WithdrawalsContext

instance Transform WithdrawalsContext (Map Api.TxOutRef Api.TxOut) where
  transform :: WithdrawalsContext -> Map TxOutRef TxOut
transform = WithdrawalsContext -> Map TxOutRef TxOut
managedTxOuts

type WithdrawalsGen a = TxGen WithdrawalsContext a

toWithdrawals :: TxSkelWithdrawals -> WithdrawalsGen (Cardano.TxWithdrawals Cardano.BuildTx Cardano.ConwayEra)
toWithdrawals :: TxSkelWithdrawals
-> WithdrawalsGen (TxWithdrawals BuildTx ConwayEra)
toWithdrawals (TxSkelWithdrawals
-> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))]
forall k a. Map k a -> [(k, a)]
Map.toList -> []) = TxWithdrawals BuildTx ConwayEra
-> WithdrawalsGen (TxWithdrawals BuildTx ConwayEra)
forall a.
a -> ReaderT WithdrawalsContext (Either GenerateTxError) 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, Ada))]
forall k a. Map k a -> [(k, a)]
Map.toList -> [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))]
withdrawals) =
  ([(StakeAddress, Coin,
   BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
 -> TxWithdrawals BuildTx ConwayEra)
-> ReaderT
     WithdrawalsContext
     (Either GenerateTxError)
     [(StakeAddress, Coin,
       BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
-> WithdrawalsGen (TxWithdrawals BuildTx ConwayEra)
forall a b.
(a -> b)
-> ReaderT WithdrawalsContext (Either GenerateTxError) a
-> ReaderT WithdrawalsContext (Either GenerateTxError) 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)
    (ReaderT
   WithdrawalsContext
   (Either GenerateTxError)
   [(StakeAddress, Coin,
     BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
 -> WithdrawalsGen (TxWithdrawals BuildTx ConwayEra))
-> ReaderT
     WithdrawalsContext
     (Either GenerateTxError)
     [(StakeAddress, Coin,
       BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
-> WithdrawalsGen (TxWithdrawals BuildTx ConwayEra)
forall a b. (a -> b) -> a -> b
$ [(Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))]
-> ((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))
    -> ReaderT
         WithdrawalsContext
         (Either GenerateTxError)
         (StakeAddress, Coin,
          BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)))
-> ReaderT
     WithdrawalsContext
     (Either GenerateTxError)
     [(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, Ada))]
withdrawals
    (((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))
  -> ReaderT
       WithdrawalsContext
       (Either GenerateTxError)
       (StakeAddress, Coin,
        BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)))
 -> ReaderT
      WithdrawalsContext
      (Either GenerateTxError)
      [(StakeAddress, Coin,
        BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))])
-> ((Either (Versioned Script) PubKeyHash, (TxSkelRedeemer, Ada))
    -> ReaderT
         WithdrawalsContext
         (Either GenerateTxError)
         (StakeAddress, Coin,
          BuildTxWith BuildTx (Witness WitCtxStake ConwayEra)))
-> ReaderT
     WithdrawalsContext
     (Either GenerateTxError)
     [(StakeAddress, Coin,
       BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))]
forall a b. (a -> b) -> a -> b
$ \(Either (Versioned Script) PubKeyHash
staker, (TxSkelRedeemer
red, Script.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
-> TxGen WithdrawalsContext StakeCredential
forall a context.
String -> Either ToCardanoError a -> TxGen context a
throwOnToCardanoError String
"toWithdrawals: unable to translate pkh stake credential" (Either ToCardanoError StakeCredential
 -> TxGen WithdrawalsContext StakeCredential)
-> Either ToCardanoError StakeCredential
-> TxGen WithdrawalsContext 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)
-> ReaderT
     WithdrawalsContext
     (Either GenerateTxError)
     (Witness WitCtxStake ConwayEra, StakeCredential)
forall a.
a -> ReaderT WithdrawalsContext (Either GenerateTxError) 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)
-> ReaderT
     WithdrawalsContext
     (Either GenerateTxError)
     (ScriptWitness WitCtxStake ConwayEra)
-> ReaderT
     WithdrawalsContext
     (Either GenerateTxError)
     (Witness WitCtxStake ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxGen (Map TxOutRef TxOut) (ScriptWitness WitCtxStake ConwayEra)
-> ReaderT
     WithdrawalsContext
     (Either GenerateTxError)
     (ScriptWitness WitCtxStake ConwayEra)
forall context' context a.
Transform context' context =>
TxGen context a -> TxGen context' a
liftTxGen (Versioned Script
-> TxSkelRedeemer
-> ScriptDatum WitCtxStake
-> TxGen (Map TxOutRef TxOut) (ScriptWitness WitCtxStake ConwayEra)
forall a b.
ToVersionedScript a =>
a
-> TxSkelRedeemer
-> ScriptDatum b
-> WitnessGen (ScriptWitness b ConwayEra)
toScriptWitness Versioned Script
script TxSkelRedeemer
red ScriptDatum WitCtxStake
Cardano.NoScriptDatumForStake)
              StakeCredential
sCred <-
                String
-> Either ToCardanoError StakeCredential
-> TxGen WithdrawalsContext StakeCredential
forall a context.
String -> Either ToCardanoError a -> TxGen context a
throwOnToCardanoError String
"toWithdrawals: unable to translate script stake credential" (Either ToCardanoError StakeCredential
 -> TxGen WithdrawalsContext StakeCredential)
-> Either ToCardanoError StakeCredential
-> TxGen WithdrawalsContext 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
toScriptHash Versioned Script
script)
              (Witness WitCtxStake ConwayEra, StakeCredential)
-> ReaderT
     WithdrawalsContext
     (Either GenerateTxError)
     (Witness WitCtxStake ConwayEra, StakeCredential)
forall a.
a -> ReaderT WithdrawalsContext (Either GenerateTxError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Witness WitCtxStake ConwayEra
witness, StakeCredential
sCred)
        NetworkId
networkId <- (WithdrawalsContext -> NetworkId)
-> ReaderT WithdrawalsContext (Either GenerateTxError) NetworkId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks WithdrawalsContext -> NetworkId
networkId
        (StakeAddress, Coin,
 BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))
-> ReaderT
     WithdrawalsContext
     (Either GenerateTxError)
     (StakeAddress, Coin,
      BuildTxWith BuildTx (Witness WitCtxStake ConwayEra))
forall a.
a -> ReaderT WithdrawalsContext (Either GenerateTxError) 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)