-- | This module provide primitives to transform certificates from our skeleton
-- to certificate in Cardano transaction bodies.
module Cooked.MockChain.GenerateTx.Certificate (toCertificates) where

import Cardano.Api qualified as Cardano
import Cardano.Ledger.Conway.TxCert qualified as Conway
import Cardano.Ledger.DRep qualified as Ledger
import Cardano.Ledger.PoolParams qualified as Ledger
import Cardano.Ledger.Shelley.TxCert qualified as Shelley
import Cardano.Node.Emulator.Internal.Node qualified as Emulator
import Cooked.MockChain.Error
import Cooked.MockChain.GenerateTx.Credential
import Cooked.MockChain.GenerateTx.Witness
import Cooked.MockChain.Read
import Cooked.Skeleton.Certificate
import Cooked.Skeleton.User
import Data.Default
import Data.Maybe.Strict
import Ledger.Tx qualified as Ledger
import Optics.Core
import Plutus.Script.Utils.Address qualified as Script
import PlutusLedgerApi.V3 qualified as Api
import Polysemy
import Polysemy.Error
import Polysemy.Fail

toDRep ::
  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
  Api.DRep ->
  Sem effs Ledger.DRep
toDRep :: forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
DRep -> Sem effs DRep
toDRep DRep
Api.DRepAlwaysAbstain = DRep -> Sem effs DRep
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return DRep
Ledger.DRepAlwaysAbstain
toDRep DRep
Api.DRepAlwaysNoConfidence = DRep -> Sem effs DRep
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return DRep
Ledger.DRepAlwaysNoConfidence
toDRep (Api.DRep (Api.DRepCredential Credential
cred)) = Credential 'DRepRole -> DRep
Ledger.DRepCredential (Credential 'DRepRole -> DRep)
-> Sem effs (Credential 'DRepRole) -> Sem effs DRep
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential -> Sem effs (Credential 'DRepRole)
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs (Credential 'DRepRole)
toDRepCredential Credential
cred

toDelegatee ::
  (Members '[MockChainRead, Error Ledger.ToCardanoError] effs) =>
  Api.Delegatee ->
  Sem effs Conway.Delegatee
toDelegatee :: forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
Delegatee -> Sem effs Delegatee
toDelegatee (Api.DelegStake PubKeyHash
pkh) = KeyHash 'StakePool -> Delegatee
Conway.DelegStake (KeyHash 'StakePool -> Delegatee)
-> Sem effs (KeyHash 'StakePool) -> Sem effs Delegatee
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PubKeyHash -> Sem effs (KeyHash 'StakePool)
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
PubKeyHash -> Sem effs (KeyHash 'StakePool)
toStakePoolKeyHash PubKeyHash
pkh
toDelegatee (Api.DelegVote DRep
dRep) = DRep -> Delegatee
Conway.DelegVote (DRep -> Delegatee) -> Sem effs DRep -> Sem effs Delegatee
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DRep -> Sem effs DRep
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
DRep -> Sem effs DRep
toDRep DRep
dRep
toDelegatee (Api.DelegStakeVote PubKeyHash
pkh DRep
dRep) = (KeyHash 'StakePool -> DRep -> Delegatee)
-> Sem effs (KeyHash 'StakePool)
-> Sem effs DRep
-> Sem effs Delegatee
forall a b c.
(a -> b -> c) -> Sem effs a -> Sem effs b -> Sem effs c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 KeyHash 'StakePool -> DRep -> Delegatee
Conway.DelegStakeVote (PubKeyHash -> Sem effs (KeyHash 'StakePool)
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
PubKeyHash -> Sem effs (KeyHash 'StakePool)
toStakePoolKeyHash PubKeyHash
pkh) (DRep -> Sem effs DRep
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
DRep -> Sem effs DRep
toDRep DRep
dRep)

toCertificate ::
  (Members '[MockChainRead, Error Ledger.ToCardanoError, Fail] effs) =>
  TxSkelCertificate ->
  Sem effs (Cardano.Certificate Cardano.ConwayEra)
toCertificate :: forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError, Fail] effs =>
TxSkelCertificate -> Sem effs (Certificate ConwayEra)
toCertificate TxSkelCertificate
txSkelCert =
  do
    Coin
depositStake <- Integer -> Coin
Cardano.Coin (Integer -> Coin) -> (Lovelace -> Integer) -> Lovelace -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Integer
Api.getLovelace (Lovelace -> Coin) -> Sem effs Lovelace -> Sem effs Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem effs Lovelace
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Lovelace
stakeAddressDeposit
    Coin
depositDRep <- Integer -> Coin
Cardano.Coin (Integer -> Coin) -> (Lovelace -> Integer) -> Lovelace -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lovelace -> Integer
Api.getLovelace (Lovelace -> Coin) -> Sem effs Lovelace -> Sem effs Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem effs Lovelace
forall (effs :: EffectRow).
Member MockChainRead effs =>
Sem effs Lovelace
dRepDeposit
    ConwayEraOnwards ConwayEra
-> ConwayTxCert (ShelleyLedgerEra ConwayEra)
-> Certificate ConwayEra
forall era.
Typeable era =>
ConwayEraOnwards era
-> ConwayTxCert (ShelleyLedgerEra era) -> Certificate era
Cardano.ConwayCertificate ConwayEraOnwards ConwayEra
Cardano.ConwayEraOnwardsConway (ConwayTxCert ConwayEra -> Certificate ConwayEra)
-> Sem effs (ConwayTxCert ConwayEra)
-> Sem effs (Certificate ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case TxSkelCertificate
txSkelCert of
      TxSkelCertificate (User kind 'Redemption -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) CertificateAction kind
StakingRegister ->
        ConwayDelegCert -> ConwayTxCert ConwayEra
forall era. ConwayDelegCert -> ConwayTxCert era
Conway.ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert ConwayEra)
-> (StakeCredential -> ConwayDelegCert)
-> StakeCredential
-> ConwayTxCert ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StakeCredential -> StrictMaybe Coin -> ConwayDelegCert
`Conway.ConwayRegCert` Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust Coin
depositStake) (StakeCredential -> ConwayTxCert ConwayEra)
-> Sem effs StakeCredential -> Sem effs (ConwayTxCert ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential -> Sem effs StakeCredential
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs StakeCredential
toStakeCredential Credential
cred
      TxSkelCertificate (User kind 'Redemption -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) CertificateAction kind
StakingUnRegister ->
        ConwayDelegCert -> ConwayTxCert ConwayEra
forall era. ConwayDelegCert -> ConwayTxCert era
Conway.ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert ConwayEra)
-> (StakeCredential -> ConwayDelegCert)
-> StakeCredential
-> ConwayTxCert ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StakeCredential -> StrictMaybe Coin -> ConwayDelegCert
`Conway.ConwayUnRegCert` Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust Coin
depositStake) (StakeCredential -> ConwayTxCert ConwayEra)
-> Sem effs StakeCredential -> Sem effs (ConwayTxCert ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential -> Sem effs StakeCredential
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs StakeCredential
toStakeCredential Credential
cred
      TxSkelCertificate (User kind 'Redemption -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) (StakingDelegate Delegatee
delegatee) ->
        ConwayDelegCert -> ConwayTxCert ConwayEra
forall era. ConwayDelegCert -> ConwayTxCert era
Conway.ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert ConwayEra)
-> Sem effs ConwayDelegCert -> Sem effs (ConwayTxCert ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StakeCredential -> Delegatee -> ConwayDelegCert)
-> Sem effs StakeCredential
-> Sem effs Delegatee
-> Sem effs ConwayDelegCert
forall a b c.
(a -> b -> c) -> Sem effs a -> Sem effs b -> Sem effs c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 StakeCredential -> Delegatee -> ConwayDelegCert
Conway.ConwayDelegCert (Credential -> Sem effs StakeCredential
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs StakeCredential
toStakeCredential Credential
cred) (Delegatee -> Sem effs Delegatee
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
Delegatee -> Sem effs Delegatee
toDelegatee Delegatee
delegatee)
      TxSkelCertificate (User kind 'Redemption -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) (StakingRegisterDelegate Delegatee
delegatee) ->
        ConwayDelegCert -> ConwayTxCert ConwayEra
forall era. ConwayDelegCert -> ConwayTxCert era
Conway.ConwayTxCertDeleg (ConwayDelegCert -> ConwayTxCert ConwayEra)
-> ((Coin -> ConwayDelegCert) -> ConwayDelegCert)
-> (Coin -> ConwayDelegCert)
-> ConwayTxCert ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin
depositStake Coin -> (Coin -> ConwayDelegCert) -> ConwayDelegCert
forall a b. a -> (a -> b) -> b
&) ((Coin -> ConwayDelegCert) -> ConwayTxCert ConwayEra)
-> Sem effs (Coin -> ConwayDelegCert)
-> Sem effs (ConwayTxCert ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StakeCredential -> Delegatee -> Coin -> ConwayDelegCert)
-> Sem effs StakeCredential
-> Sem effs Delegatee
-> Sem effs (Coin -> ConwayDelegCert)
forall a b c.
(a -> b -> c) -> Sem effs a -> Sem effs b -> Sem effs c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 StakeCredential -> Delegatee -> Coin -> ConwayDelegCert
Conway.ConwayRegDelegCert (Credential -> Sem effs StakeCredential
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs StakeCredential
toStakeCredential Credential
cred) (Delegatee -> Sem effs Delegatee
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError] effs =>
Delegatee -> Sem effs Delegatee
toDelegatee Delegatee
delegatee)
      TxSkelCertificate (User kind 'Redemption -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) CertificateAction kind
DRepRegister ->
        ConwayGovCert -> ConwayTxCert ConwayEra
forall era. ConwayGovCert -> ConwayTxCert era
Conway.ConwayTxCertGov (ConwayGovCert -> ConwayTxCert ConwayEra)
-> (Credential 'DRepRole -> ConwayGovCert)
-> Credential 'DRepRole
-> ConwayTxCert ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Credential 'DRepRole
c -> Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> ConwayGovCert
Conway.ConwayRegDRep Credential 'DRepRole
c Coin
depositDRep StrictMaybe Anchor
forall a. StrictMaybe a
SNothing) (Credential 'DRepRole -> ConwayTxCert ConwayEra)
-> Sem effs (Credential 'DRepRole)
-> Sem effs (ConwayTxCert ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential -> Sem effs (Credential 'DRepRole)
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs (Credential 'DRepRole)
toDRepCredential Credential
cred
      TxSkelCertificate (User kind 'Redemption -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) CertificateAction kind
DRepUpdate ->
        ConwayGovCert -> ConwayTxCert ConwayEra
forall era. ConwayGovCert -> ConwayTxCert era
Conway.ConwayTxCertGov (ConwayGovCert -> ConwayTxCert ConwayEra)
-> (Credential 'DRepRole -> ConwayGovCert)
-> Credential 'DRepRole
-> ConwayTxCert ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Credential 'DRepRole -> StrictMaybe Anchor -> ConwayGovCert
`Conway.ConwayUpdateDRep` StrictMaybe Anchor
forall a. StrictMaybe a
SNothing) (Credential 'DRepRole -> ConwayTxCert ConwayEra)
-> Sem effs (Credential 'DRepRole)
-> Sem effs (ConwayTxCert ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential -> Sem effs (Credential 'DRepRole)
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs (Credential 'DRepRole)
toDRepCredential Credential
cred
      TxSkelCertificate (User kind 'Redemption -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) CertificateAction kind
DRepUnRegister ->
        ConwayGovCert -> ConwayTxCert ConwayEra
forall era. ConwayGovCert -> ConwayTxCert era
Conway.ConwayTxCertGov (ConwayGovCert -> ConwayTxCert ConwayEra)
-> (Credential 'DRepRole -> ConwayGovCert)
-> Credential 'DRepRole
-> ConwayTxCert ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Credential 'DRepRole -> Coin -> ConwayGovCert
`Conway.ConwayUnRegDRep` Coin
depositDRep) (Credential 'DRepRole -> ConwayTxCert ConwayEra)
-> Sem effs (Credential 'DRepRole)
-> Sem effs (ConwayTxCert ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential -> Sem effs (Credential 'DRepRole)
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs (Credential 'DRepRole)
toDRepCredential Credential
cred
      -- TODO: For now, when registering a new pool we use the default parameters
      -- excepct for the pool id and pool vrf. We could change it later on.
      TxSkelCertificate (UserPubKey (pkh -> PubKeyHash
forall a. ToPubKeyHash a => a -> PubKeyHash
Script.toPubKeyHash -> PubKeyHash
poolHash)) (PoolRegister PubKeyHash
poolVrf) ->
        PoolCert -> ConwayTxCert ConwayEra
forall era. PoolCert -> ConwayTxCert era
Conway.ConwayTxCertPool (PoolCert -> ConwayTxCert ConwayEra)
-> (PoolParams -> PoolCert) -> PoolParams -> ConwayTxCert ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolParams -> PoolCert
Shelley.RegPool
          (PoolParams -> ConwayTxCert ConwayEra)
-> Sem effs PoolParams -> Sem effs (ConwayTxCert ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyHash 'StakePool -> VRFVerKeyHash 'StakePoolVRF -> PoolParams)
-> Sem effs (KeyHash 'StakePool)
-> Sem effs (VRFVerKeyHash 'StakePoolVRF)
-> Sem effs PoolParams
forall a b c.
(a -> b -> c) -> Sem effs a -> Sem effs b -> Sem effs c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
            (\KeyHash 'StakePool
pId VRFVerKeyHash 'StakePoolVRF
pVrf -> PoolParams
forall a. Default a => a
def {Ledger.ppId = pId, Ledger.ppVrf = pVrf})
            (PubKeyHash -> Sem effs (KeyHash 'StakePool)
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
PubKeyHash -> Sem effs (KeyHash 'StakePool)
toStakePoolKeyHash PubKeyHash
poolHash)
            (PubKeyHash -> Sem effs (VRFVerKeyHash 'StakePoolVRF)
forall (effs :: EffectRow) (a :: KeyRoleVRF).
Member (Error ToCardanoError) effs =>
PubKeyHash -> Sem effs (VRFVerKeyHash a)
toVRFVerKeyHash PubKeyHash
poolVrf)
      TxSkelCertificate (UserPubKey (pkh -> PubKeyHash
forall a. ToPubKeyHash a => a -> PubKeyHash
Script.toPubKeyHash -> PubKeyHash
poolHash)) (PoolRetire Slot
slot) ->
        PoolCert -> ConwayTxCert ConwayEra
forall era. PoolCert -> ConwayTxCert era
Conway.ConwayTxCertPool
          (PoolCert -> ConwayTxCert ConwayEra)
-> Sem effs PoolCert -> Sem effs (ConwayTxCert ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyHash 'StakePool -> EpochNo -> PoolCert)
-> Sem effs (KeyHash 'StakePool)
-> Sem effs EpochNo
-> Sem effs PoolCert
forall a b c.
(a -> b -> c) -> Sem effs a -> Sem effs b -> Sem effs c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
            KeyHash 'StakePool -> EpochNo -> PoolCert
Shelley.RetirePool
            (PubKeyHash -> Sem effs (KeyHash 'StakePool)
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
PubKeyHash -> Sem effs (KeyHash 'StakePool)
toStakePoolKeyHash PubKeyHash
poolHash)
            ( do
                EraHistory
eeh <- Params -> EraHistory
Emulator.emulatorEraHistory (Params -> EraHistory) -> Sem effs Params -> Sem effs EraHistory
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
                case SlotNo
-> EraHistory
-> Either
     PastHorizonException (EpochNo, SlotsInEpoch, SlotsToEpochEnd)
Cardano.slotToEpoch (Slot -> SlotNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral Slot
slot) EraHistory
eeh of
                  -- TODO: we could have a dedicated error for this case if the
                  -- can occur at several places in the codebase
                  Left PastHorizonException
_ -> String -> Sem effs EpochNo
forall a. String -> Sem effs a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Too far away in the future"
                  Right (EpochNo
epoch, SlotsInEpoch
_, SlotsToEpochEnd
_) -> EpochNo -> Sem effs EpochNo
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return EpochNo
epoch
            )
      TxSkelCertificate (User kind 'Redemption -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
coldCred) (CommitteeRegisterHot Credential
hotCred) ->
        ConwayGovCert -> ConwayTxCert ConwayEra
forall era. ConwayGovCert -> ConwayTxCert era
Conway.ConwayTxCertGov (ConwayGovCert -> ConwayTxCert ConwayEra)
-> Sem effs ConwayGovCert -> Sem effs (ConwayTxCert ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Credential 'ColdCommitteeRole
 -> Credential 'HotCommitteeRole -> ConwayGovCert)
-> Sem effs (Credential 'ColdCommitteeRole)
-> Sem effs (Credential 'HotCommitteeRole)
-> Sem effs ConwayGovCert
forall a b c.
(a -> b -> c) -> Sem effs a -> Sem effs b -> Sem effs c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> ConwayGovCert
Conway.ConwayAuthCommitteeHotKey (Credential -> Sem effs (Credential 'ColdCommitteeRole)
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs (Credential 'ColdCommitteeRole)
toColdCredential Credential
coldCred) (Credential -> Sem effs (Credential 'HotCommitteeRole)
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs (Credential 'HotCommitteeRole)
toHotCredential Credential
hotCred)
      TxSkelCertificate (User kind 'Redemption -> Credential
forall a. ToCredential a => a -> Credential
Script.toCredential -> Credential
cred) CertificateAction kind
CommitteeResign ->
        ConwayGovCert -> ConwayTxCert ConwayEra
forall era. ConwayGovCert -> ConwayTxCert era
Conway.ConwayTxCertGov (ConwayGovCert -> ConwayTxCert ConwayEra)
-> (Credential 'ColdCommitteeRole -> ConwayGovCert)
-> Credential 'ColdCommitteeRole
-> ConwayTxCert ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Credential 'ColdCommitteeRole
-> StrictMaybe Anchor -> ConwayGovCert
`Conway.ConwayResignCommitteeColdKey` StrictMaybe Anchor
forall a. StrictMaybe a
SNothing) (Credential 'ColdCommitteeRole -> ConwayTxCert ConwayEra)
-> Sem effs (Credential 'ColdCommitteeRole)
-> Sem effs (ConwayTxCert ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential -> Sem effs (Credential 'ColdCommitteeRole)
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs (Credential 'ColdCommitteeRole)
toColdCredential Credential
cred

toCertificateWitness ::
  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError] effs) =>
  TxSkelCertificate ->
  Sem effs (Maybe (Cardano.ScriptWitness Cardano.WitCtxStake Cardano.ConwayEra))
toCertificateWitness :: forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError]
  effs =>
TxSkelCertificate
-> Sem effs (Maybe (ScriptWitness WitCtxStake ConwayEra))
toCertificateWitness =
  Sem effs (Maybe (ScriptWitness WitCtxStake ConwayEra))
-> (User 'IsEither 'Redemption
    -> Sem effs (Maybe (ScriptWitness WitCtxStake ConwayEra)))
-> Maybe (User 'IsEither 'Redemption)
-> Sem effs (Maybe (ScriptWitness WitCtxStake ConwayEra))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (Maybe (ScriptWitness WitCtxStake ConwayEra)
-> Sem effs (Maybe (ScriptWitness WitCtxStake ConwayEra))
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ScriptWitness WitCtxStake ConwayEra)
forall a. Maybe a
Nothing)
    ( \case
        (UserRedeemedScript script
s TxSkelRedeemer
red) -> ScriptWitness WitCtxStake ConwayEra
-> Maybe (ScriptWitness WitCtxStake ConwayEra)
forall a. a -> Maybe a
Just (ScriptWitness WitCtxStake ConwayEra
 -> Maybe (ScriptWitness WitCtxStake ConwayEra))
-> Sem effs (ScriptWitness WitCtxStake ConwayEra)
-> Sem effs (Maybe (ScriptWitness WitCtxStake ConwayEra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> script
-> 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 script
s TxSkelRedeemer
red ScriptDatum WitCtxStake
Cardano.NoScriptDatumForStake
        User 'IsEither 'Redemption
_ -> Maybe (ScriptWitness WitCtxStake ConwayEra)
-> Sem effs (Maybe (ScriptWitness WitCtxStake ConwayEra))
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ScriptWitness WitCtxStake ConwayEra)
forall a. Maybe a
Nothing
    )
    (Maybe (User 'IsEither 'Redemption)
 -> Sem effs (Maybe (ScriptWitness WitCtxStake ConwayEra)))
-> (TxSkelCertificate -> Maybe (User 'IsEither 'Redemption))
-> TxSkelCertificate
-> Sem effs (Maybe (ScriptWitness WitCtxStake ConwayEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic'
  An_AffineTraversal
  NoIx
  TxSkelCertificate
  (User 'IsEither 'Redemption)
-> TxSkelCertificate -> Maybe (User 'IsEither 'Redemption)
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall (user :: UserKind).
Typeable user =>
AffineTraversal' TxSkelCertificate (User user 'Redemption)
txSkelCertificateOwnerAT @IsEither)

-- | Builds a 'Cardano.TxCertificates' from a list of 'TxSkelCertificate'
toCertificates ::
  (Members '[MockChainRead, Error MockChainError, Error Ledger.ToCardanoError, Fail] effs) =>
  [TxSkelCertificate] ->
  Sem effs (Cardano.TxCertificates Cardano.BuildTx Cardano.ConwayEra)
toCertificates :: forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError, Fail]
  effs =>
[TxSkelCertificate] -> Sem effs (TxCertificates BuildTx ConwayEra)
toCertificates =
  ([(Certificate ConwayEra,
   Maybe (ScriptWitness WitCtxStake ConwayEra))]
 -> TxCertificates BuildTx ConwayEra)
-> Sem
     effs
     [(Certificate ConwayEra,
       Maybe (ScriptWitness WitCtxStake ConwayEra))]
-> Sem effs (TxCertificates BuildTx ConwayEra)
forall a b. (a -> b) -> Sem effs a -> Sem effs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShelleyBasedEra ConwayEra
-> [(Certificate ConwayEra,
     Maybe (ScriptWitness WitCtxStake ConwayEra))]
-> TxCertificates BuildTx ConwayEra
forall build era.
Applicative (BuildTxWith build) =>
ShelleyBasedEra era
-> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
-> TxCertificates build era
Cardano.mkTxCertificates ShelleyBasedEra ConwayEra
Cardano.ShelleyBasedEraConway)
    (Sem
   effs
   [(Certificate ConwayEra,
     Maybe (ScriptWitness WitCtxStake ConwayEra))]
 -> Sem effs (TxCertificates BuildTx ConwayEra))
-> ([TxSkelCertificate]
    -> Sem
         effs
         [(Certificate ConwayEra,
           Maybe (ScriptWitness WitCtxStake ConwayEra))])
-> [TxSkelCertificate]
-> Sem effs (TxCertificates BuildTx ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxSkelCertificate
 -> Sem
      effs
      (Certificate ConwayEra,
       Maybe (ScriptWitness WitCtxStake ConwayEra)))
-> [TxSkelCertificate]
-> Sem
     effs
     [(Certificate ConwayEra,
       Maybe (ScriptWitness WitCtxStake ConwayEra))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\TxSkelCertificate
txSkelCert -> (Certificate ConwayEra
 -> Maybe (ScriptWitness WitCtxStake ConwayEra)
 -> (Certificate ConwayEra,
     Maybe (ScriptWitness WitCtxStake ConwayEra)))
-> Sem effs (Certificate ConwayEra)
-> Sem effs (Maybe (ScriptWitness WitCtxStake ConwayEra))
-> Sem
     effs
     (Certificate ConwayEra,
      Maybe (ScriptWitness WitCtxStake ConwayEra))
forall a b c.
(a -> b -> c) -> Sem effs a -> Sem effs b -> Sem effs c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (TxSkelCertificate -> Sem effs (Certificate ConwayEra)
forall (effs :: EffectRow).
Members '[MockChainRead, Error ToCardanoError, Fail] effs =>
TxSkelCertificate -> Sem effs (Certificate ConwayEra)
toCertificate TxSkelCertificate
txSkelCert) (TxSkelCertificate
-> Sem effs (Maybe (ScriptWitness WitCtxStake ConwayEra))
forall (effs :: EffectRow).
Members
  '[MockChainRead, Error MockChainError, Error ToCardanoError]
  effs =>
TxSkelCertificate
-> Sem effs (Maybe (ScriptWitness WitCtxStake ConwayEra))
toCertificateWitness TxSkelCertificate
txSkelCert))