{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Babbage.TxCert () where

import Cardano.Ledger.Babbage.Era
import Cardano.Ledger.Babbage.PParams ()
import Cardano.Ledger.Crypto
import Cardano.Ledger.Shelley.TxCert

instance Crypto c => EraTxCert (BabbageEra c) where
  {-# SPECIALIZE instance EraTxCert (BabbageEra StandardCrypto) #-}

  type TxCert (BabbageEra c) = ShelleyTxCert (BabbageEra c)

  upgradeTxCert :: EraTxCert (PreviousEra (BabbageEra c)) =>
TxCert (PreviousEra (BabbageEra c))
-> Either
     (TxCertUpgradeError (BabbageEra c)) (TxCert (BabbageEra c))
upgradeTxCert = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era1 era2.
(EraCrypto era1 ~ EraCrypto era2) =>
ShelleyTxCert era1 -> ShelleyTxCert era2
upgradeShelleyTxCert

  getVKeyWitnessTxCert :: TxCert (BabbageEra c)
-> Maybe (KeyHash 'Witness (EraCrypto (BabbageEra c)))
getVKeyWitnessTxCert = forall era.
ShelleyTxCert era -> Maybe (KeyHash 'Witness (EraCrypto era))
getVKeyWitnessShelleyTxCert

  getScriptWitnessTxCert :: TxCert (BabbageEra c)
-> Maybe (ScriptHash (EraCrypto (BabbageEra c)))
getScriptWitnessTxCert = forall era. ShelleyTxCert era -> Maybe (ScriptHash (EraCrypto era))
getScriptWitnessShelleyTxCert

  mkRegPoolTxCert :: PoolParams (EraCrypto (BabbageEra c)) -> TxCert (BabbageEra c)
mkRegPoolTxCert = forall era. PoolCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertPool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. PoolParams c -> PoolCert c
RegPool

  getRegPoolTxCert :: TxCert (BabbageEra c)
-> Maybe (PoolParams (EraCrypto (BabbageEra c)))
getRegPoolTxCert (ShelleyTxCertPool (RegPool PoolParams (EraCrypto (BabbageEra c))
poolParams)) = forall a. a -> Maybe a
Just PoolParams (EraCrypto (BabbageEra c))
poolParams
  getRegPoolTxCert TxCert (BabbageEra c)
_ = forall a. Maybe a
Nothing

  mkRetirePoolTxCert :: KeyHash 'StakePool (EraCrypto (BabbageEra c))
-> EpochNo -> TxCert (BabbageEra c)
mkRetirePoolTxCert KeyHash 'StakePool (EraCrypto (BabbageEra c))
poolId EpochNo
epochNo = forall era. PoolCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertPool forall a b. (a -> b) -> a -> b
$ forall c. KeyHash 'StakePool c -> EpochNo -> PoolCert c
RetirePool KeyHash 'StakePool (EraCrypto (BabbageEra c))
poolId EpochNo
epochNo

  getRetirePoolTxCert :: TxCert (BabbageEra c)
-> Maybe (KeyHash 'StakePool (EraCrypto (BabbageEra c)), EpochNo)
getRetirePoolTxCert (ShelleyTxCertPool (RetirePool KeyHash 'StakePool (EraCrypto (BabbageEra c))
poolId EpochNo
epochNo)) = forall a. a -> Maybe a
Just (KeyHash 'StakePool (EraCrypto (BabbageEra c))
poolId, EpochNo
epochNo)
  getRetirePoolTxCert TxCert (BabbageEra c)
_ = forall a. Maybe a
Nothing

  lookupRegStakeTxCert :: TxCert (BabbageEra c)
-> Maybe (Credential 'Staking (EraCrypto (BabbageEra c)))
lookupRegStakeTxCert = \case
    RegTxCert Credential 'Staking (EraCrypto (BabbageEra c))
c -> forall a. a -> Maybe a
Just Credential 'Staking (EraCrypto (BabbageEra c))
c
    TxCert (BabbageEra c)
_ -> forall a. Maybe a
Nothing
  lookupUnRegStakeTxCert :: TxCert (BabbageEra c)
-> Maybe (Credential 'Staking (EraCrypto (BabbageEra c)))
lookupUnRegStakeTxCert = \case
    UnRegTxCert Credential 'Staking (EraCrypto (BabbageEra c))
c -> forall a. a -> Maybe a
Just Credential 'Staking (EraCrypto (BabbageEra c))
c
    TxCert (BabbageEra c)
_ -> forall a. Maybe a
Nothing

  getTotalDepositsTxCerts :: forall (f :: * -> *).
Foldable f =>
PParams (BabbageEra c)
-> (KeyHash 'StakePool (EraCrypto (BabbageEra c)) -> Bool)
-> f (TxCert (BabbageEra c))
-> Coin
getTotalDepositsTxCerts = forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (KeyHash 'StakePool (EraCrypto era) -> Bool)
-> f (TxCert era)
-> Coin
shelleyTotalDepositsTxCerts

  getTotalRefundsTxCerts :: forall (f :: * -> *).
Foldable f =>
PParams (BabbageEra c)
-> (Credential 'Staking (EraCrypto (BabbageEra c)) -> Maybe Coin)
-> (Credential 'DRepRole (EraCrypto (BabbageEra c)) -> Maybe Coin)
-> f (TxCert (BabbageEra c))
-> Coin
getTotalRefundsTxCerts PParams (BabbageEra c)
pp Credential 'Staking (EraCrypto (BabbageEra c)) -> Maybe Coin
lookupStakeDeposit Credential 'DRepRole (EraCrypto (BabbageEra c)) -> Maybe Coin
_ = forall era (f :: * -> *).
(EraPParams era, Foldable f, EraTxCert era) =>
PParams era
-> (StakeCredential (EraCrypto era) -> Maybe Coin)
-> f (TxCert era)
-> Coin
shelleyTotalRefundsTxCerts PParams (BabbageEra c)
pp Credential 'Staking (EraCrypto (BabbageEra c)) -> Maybe Coin
lookupStakeDeposit

instance Crypto c => ShelleyEraTxCert (BabbageEra c) where
  {-# SPECIALIZE instance ShelleyEraTxCert (BabbageEra StandardCrypto) #-}

  mkRegTxCert :: StakeCredential (EraCrypto (BabbageEra c)) -> TxCert (BabbageEra c)
mkRegTxCert = forall era. ShelleyDelegCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertDelegCert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. StakeCredential c -> ShelleyDelegCert c
ShelleyRegCert

  getRegTxCert :: TxCert (BabbageEra c)
-> Maybe (StakeCredential (EraCrypto (BabbageEra c)))
getRegTxCert (ShelleyTxCertDelegCert (ShelleyRegCert StakeCredential (EraCrypto (BabbageEra c))
c)) = forall a. a -> Maybe a
Just StakeCredential (EraCrypto (BabbageEra c))
c
  getRegTxCert TxCert (BabbageEra c)
_ = forall a. Maybe a
Nothing

  mkUnRegTxCert :: StakeCredential (EraCrypto (BabbageEra c)) -> TxCert (BabbageEra c)
mkUnRegTxCert = forall era. ShelleyDelegCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertDelegCert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. StakeCredential c -> ShelleyDelegCert c
ShelleyUnRegCert

  getUnRegTxCert :: TxCert (BabbageEra c)
-> Maybe (StakeCredential (EraCrypto (BabbageEra c)))
getUnRegTxCert (ShelleyTxCertDelegCert (ShelleyUnRegCert StakeCredential (EraCrypto (BabbageEra c))
c)) = forall a. a -> Maybe a
Just StakeCredential (EraCrypto (BabbageEra c))
c
  getUnRegTxCert TxCert (BabbageEra c)
_ = forall a. Maybe a
Nothing

  mkDelegStakeTxCert :: StakeCredential (EraCrypto (BabbageEra c))
-> KeyHash 'StakePool (EraCrypto (BabbageEra c))
-> TxCert (BabbageEra c)
mkDelegStakeTxCert StakeCredential (EraCrypto (BabbageEra c))
c KeyHash 'StakePool (EraCrypto (BabbageEra c))
kh = forall era. ShelleyDelegCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertDelegCert forall a b. (a -> b) -> a -> b
$ forall c.
StakeCredential c -> KeyHash 'StakePool c -> ShelleyDelegCert c
ShelleyDelegCert StakeCredential (EraCrypto (BabbageEra c))
c KeyHash 'StakePool (EraCrypto (BabbageEra c))
kh

  getDelegStakeTxCert :: TxCert (BabbageEra c)
-> Maybe
     (StakeCredential (EraCrypto (BabbageEra c)),
      KeyHash 'StakePool (EraCrypto (BabbageEra c)))
getDelegStakeTxCert (ShelleyTxCertDelegCert (ShelleyDelegCert StakeCredential (EraCrypto (BabbageEra c))
c KeyHash 'StakePool (EraCrypto (BabbageEra c))
kh)) = forall a. a -> Maybe a
Just (StakeCredential (EraCrypto (BabbageEra c))
c, KeyHash 'StakePool (EraCrypto (BabbageEra c))
kh)
  getDelegStakeTxCert TxCert (BabbageEra c)
_ = forall a. Maybe a
Nothing

  mkGenesisDelegTxCert :: ProtVerAtMost (BabbageEra c) 8 =>
GenesisDelegCert (EraCrypto (BabbageEra c))
-> TxCert (BabbageEra c)
mkGenesisDelegTxCert = forall era. GenesisDelegCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertGenesisDeleg

  getGenesisDelegTxCert :: ProtVerAtMost (BabbageEra c) 8 =>
TxCert (BabbageEra c)
-> Maybe (GenesisDelegCert (EraCrypto (BabbageEra c)))
getGenesisDelegTxCert (ShelleyTxCertGenesisDeleg GenesisDelegCert (EraCrypto (BabbageEra c))
c) = forall a. a -> Maybe a
Just GenesisDelegCert (EraCrypto (BabbageEra c))
c
  getGenesisDelegTxCert TxCert (BabbageEra c)
_ = forall a. Maybe a
Nothing

  mkMirTxCert :: ProtVerAtMost (BabbageEra c) 8 =>
MIRCert (EraCrypto (BabbageEra c)) -> TxCert (BabbageEra c)
mkMirTxCert = forall era. MIRCert (EraCrypto era) -> ShelleyTxCert era
ShelleyTxCertMir

  getMirTxCert :: ProtVerAtMost (BabbageEra c) 8 =>
TxCert (BabbageEra c) -> Maybe (MIRCert (EraCrypto (BabbageEra c)))
getMirTxCert (ShelleyTxCertMir MIRCert (EraCrypto (BabbageEra c))
c) = forall a. a -> Maybe a
Just MIRCert (EraCrypto (BabbageEra c))
c
  getMirTxCert TxCert (BabbageEra c)
_ = forall a. Maybe a
Nothing