{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.Rules.Cert (
  CERT,
  ConwayCertPredFailure (..),
  ConwayCertEvent (..),
  CertEnv (..),
) where

import Cardano.Ledger.BaseTypes (EpochNo, ShelleyBase, StrictMaybe)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (
  CERT,
  ConwayEra,
  DELEG,
  GOVCERT,
 )
import Cardano.Ledger.Conway.Governance (
  Committee,
  GovActionPurpose (..),
  GovActionState,
  GovPurposeId,
 )
import Cardano.Ledger.Conway.Rules.Deleg (
  ConwayDelegEnv (..),
  ConwayDelegPredFailure (..),
 )
import Cardano.Ledger.Conway.Rules.GovCert (
  ConwayGovCertEnv (..),
  ConwayGovCertPredFailure,
 )
import Cardano.Ledger.Conway.TxCert (
  ConwayDelegCert,
  ConwayGovCert,
  ConwayTxCert (..),
 )
import Cardano.Ledger.Shelley.API (
  PState (..),
  PoolEnv (PoolEnv),
 )
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.State (EraCertState (..))
import Control.DeepSeq (NFData)
import Control.State.Transition.Extended (
  Embed,
  STS (..),
  TRC (TRC),
  TransitionRule,
  judgmentContext,
  trans,
  wrapEvent,
  wrapFailed,
 )
import qualified Data.Map.Strict as Map
import Data.Typeable (Typeable)
import Data.Void (absurd)
import GHC.Generics (Generic)
import Lens.Micro ((&), (.~), (^.))

data CertEnv era = CertEnv
  { forall era. CertEnv era -> PParams era
cePParams :: PParams era
  , forall era. CertEnv era -> EpochNo
ceCurrentEpoch :: EpochNo
  , forall era. CertEnv era -> StrictMaybe (Committee era)
ceCurrentCommittee :: StrictMaybe (Committee era)
  , forall era.
CertEnv era
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
ceCommitteeProposals :: Map.Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
  }
  deriving ((forall x. CertEnv era -> Rep (CertEnv era) x)
-> (forall x. Rep (CertEnv era) x -> CertEnv era)
-> Generic (CertEnv era)
forall x. Rep (CertEnv era) x -> CertEnv era
forall x. CertEnv era -> Rep (CertEnv era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (CertEnv era) x -> CertEnv era
forall era x. CertEnv era -> Rep (CertEnv era) x
$cfrom :: forall era x. CertEnv era -> Rep (CertEnv era) x
from :: forall x. CertEnv era -> Rep (CertEnv era) x
$cto :: forall era x. Rep (CertEnv era) x -> CertEnv era
to :: forall x. Rep (CertEnv era) x -> CertEnv era
Generic)

instance EraPParams era => EncCBOR (CertEnv era) where
  encCBOR :: CertEnv era -> Encoding
encCBOR x :: CertEnv era
x@(CertEnv PParams era
_ EpochNo
_ StrictMaybe (Committee era)
_ Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
_) =
    let CertEnv {Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
StrictMaybe (Committee era)
PParams era
EpochNo
cePParams :: forall era. CertEnv era -> PParams era
ceCurrentEpoch :: forall era. CertEnv era -> EpochNo
ceCurrentCommittee :: forall era. CertEnv era -> StrictMaybe (Committee era)
ceCommitteeProposals :: forall era.
CertEnv era
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
cePParams :: PParams era
ceCurrentEpoch :: EpochNo
ceCurrentCommittee :: StrictMaybe (Committee era)
ceCommitteeProposals :: Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
..} = CertEnv era
x
     in Encode (Closed Dense) (CertEnv era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode (Closed Dense) (CertEnv era) -> Encoding)
-> Encode (Closed Dense) (CertEnv era) -> Encoding
forall a b. (a -> b) -> a -> b
$
          (PParams era
 -> EpochNo
 -> StrictMaybe (Committee era)
 -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
 -> CertEnv era)
-> Encode
     (Closed Dense)
     (PParams era
      -> EpochNo
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
      -> CertEnv era)
forall t. t -> Encode (Closed Dense) t
Rec PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
-> CertEnv era
forall era.
PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
-> CertEnv era
CertEnv
            Encode
  (Closed Dense)
  (PParams era
   -> EpochNo
   -> StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
   -> CertEnv era)
-> Encode (Closed Dense) (PParams era)
-> Encode
     (Closed Dense)
     (EpochNo
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
      -> CertEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> PParams era -> Encode (Closed Dense) (PParams era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To PParams era
cePParams
            Encode
  (Closed Dense)
  (EpochNo
   -> StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
   -> CertEnv era)
-> Encode (Closed Dense) EpochNo
-> Encode
     (Closed Dense)
     (StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
      -> CertEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> EpochNo -> Encode (Closed Dense) EpochNo
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To EpochNo
ceCurrentEpoch
            Encode
  (Closed Dense)
  (StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
   -> CertEnv era)
-> Encode (Closed Dense) (StrictMaybe (Committee era))
-> Encode
     (Closed Dense)
     (Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
      -> CertEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> StrictMaybe (Committee era)
-> Encode (Closed Dense) (StrictMaybe (Committee era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To StrictMaybe (Committee era)
ceCurrentCommittee
            Encode
  (Closed Dense)
  (Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
   -> CertEnv era)
-> Encode
     (Closed Dense)
     (Map (GovPurposeId 'CommitteePurpose) (GovActionState era))
-> Encode (Closed Dense) (CertEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
-> Encode
     (Closed Dense)
     (Map (GovPurposeId 'CommitteePurpose) (GovActionState era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
ceCommitteeProposals

deriving instance EraPParams era => Eq (CertEnv era)

deriving instance EraPParams era => Show (CertEnv era)

instance EraPParams era => NFData (CertEnv era)

data ConwayCertPredFailure era
  = DelegFailure (PredicateFailure (EraRule "DELEG" era))
  | PoolFailure (PredicateFailure (EraRule "POOL" era))
  | GovCertFailure (PredicateFailure (EraRule "GOVCERT" era))
  deriving ((forall x.
 ConwayCertPredFailure era -> Rep (ConwayCertPredFailure era) x)
-> (forall x.
    Rep (ConwayCertPredFailure era) x -> ConwayCertPredFailure era)
-> Generic (ConwayCertPredFailure era)
forall x.
Rep (ConwayCertPredFailure era) x -> ConwayCertPredFailure era
forall x.
ConwayCertPredFailure era -> Rep (ConwayCertPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayCertPredFailure era) x -> ConwayCertPredFailure era
forall era x.
ConwayCertPredFailure era -> Rep (ConwayCertPredFailure era) x
$cfrom :: forall era x.
ConwayCertPredFailure era -> Rep (ConwayCertPredFailure era) x
from :: forall x.
ConwayCertPredFailure era -> Rep (ConwayCertPredFailure era) x
$cto :: forall era x.
Rep (ConwayCertPredFailure era) x -> ConwayCertPredFailure era
to :: forall x.
Rep (ConwayCertPredFailure era) x -> ConwayCertPredFailure era
Generic)

type instance EraRuleFailure "CERT" ConwayEra = ConwayCertPredFailure ConwayEra

type instance EraRuleEvent "CERT" ConwayEra = ConwayCertEvent ConwayEra

instance InjectRuleFailure "CERT" ConwayCertPredFailure ConwayEra

instance InjectRuleFailure "CERT" ConwayDelegPredFailure ConwayEra where
  injectFailure :: ConwayDelegPredFailure ConwayEra -> EraRuleFailure "CERT" ConwayEra
injectFailure = PredicateFailure (EraRule "DELEG" ConwayEra)
-> ConwayCertPredFailure ConwayEra
ConwayDelegPredFailure ConwayEra -> EraRuleFailure "CERT" ConwayEra
forall era.
PredicateFailure (EraRule "DELEG" era) -> ConwayCertPredFailure era
DelegFailure

instance InjectRuleFailure "CERT" Shelley.ShelleyPoolPredFailure ConwayEra where
  injectFailure :: ShelleyPoolPredFailure ConwayEra -> EraRuleFailure "CERT" ConwayEra
injectFailure = PredicateFailure (EraRule "POOL" ConwayEra)
-> ConwayCertPredFailure ConwayEra
ShelleyPoolPredFailure ConwayEra -> EraRuleFailure "CERT" ConwayEra
forall era.
PredicateFailure (EraRule "POOL" era) -> ConwayCertPredFailure era
PoolFailure

instance InjectRuleFailure "CERT" ConwayGovCertPredFailure ConwayEra where
  injectFailure :: ConwayGovCertPredFailure ConwayEra
-> EraRuleFailure "CERT" ConwayEra
injectFailure = PredicateFailure (EraRule "GOVCERT" ConwayEra)
-> ConwayCertPredFailure ConwayEra
ConwayGovCertPredFailure ConwayEra
-> EraRuleFailure "CERT" ConwayEra
forall era.
PredicateFailure (EraRule "GOVCERT" era)
-> ConwayCertPredFailure era
GovCertFailure

deriving stock instance
  ( Show (PredicateFailure (EraRule "DELEG" era))
  , Show (PredicateFailure (EraRule "POOL" era))
  , Show (PredicateFailure (EraRule "GOVCERT" era))
  ) =>
  Show (ConwayCertPredFailure era)

deriving stock instance
  ( Eq (PredicateFailure (EraRule "DELEG" era))
  , Eq (PredicateFailure (EraRule "POOL" era))
  , Eq (PredicateFailure (EraRule "GOVCERT" era))
  ) =>
  Eq (ConwayCertPredFailure era)

instance
  ( NFData (PredicateFailure (EraRule "DELEG" era))
  , NFData (PredicateFailure (EraRule "POOL" era))
  , NFData (PredicateFailure (EraRule "GOVCERT" era))
  ) =>
  NFData (ConwayCertPredFailure era)

data ConwayCertEvent era
  = DelegEvent (Event (EraRule "DELEG" era))
  | PoolEvent (Event (EraRule "POOL" era))
  | GovCertEvent (Event (EraRule "GOVCERT" era))
  deriving ((forall x. ConwayCertEvent era -> Rep (ConwayCertEvent era) x)
-> (forall x. Rep (ConwayCertEvent era) x -> ConwayCertEvent era)
-> Generic (ConwayCertEvent era)
forall x. Rep (ConwayCertEvent era) x -> ConwayCertEvent era
forall x. ConwayCertEvent era -> Rep (ConwayCertEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ConwayCertEvent era) x -> ConwayCertEvent era
forall era x. ConwayCertEvent era -> Rep (ConwayCertEvent era) x
$cfrom :: forall era x. ConwayCertEvent era -> Rep (ConwayCertEvent era) x
from :: forall x. ConwayCertEvent era -> Rep (ConwayCertEvent era) x
$cto :: forall era x. Rep (ConwayCertEvent era) x -> ConwayCertEvent era
to :: forall x. Rep (ConwayCertEvent era) x -> ConwayCertEvent era
Generic)

deriving instance
  ( Eq (Event (EraRule "DELEG" era))
  , Eq (Event (EraRule "GOVCERT" era))
  , Eq (Event (EraRule "POOL" era))
  ) =>
  Eq (ConwayCertEvent era)

instance
  ( NFData (Event (EraRule "DELEG" era))
  , NFData (Event (EraRule "GOVCERT" era))
  , NFData (Event (EraRule "POOL" era))
  ) =>
  NFData (ConwayCertEvent era)

instance
  forall era.
  ( Era era
  , State (EraRule "DELEG" era) ~ CertState era
  , State (EraRule "POOL" era) ~ PState era
  , State (EraRule "GOVCERT" era) ~ CertState era
  , Environment (EraRule "DELEG" era) ~ ConwayDelegEnv era
  , Environment (EraRule "POOL" era) ~ PoolEnv era
  , Environment (EraRule "GOVCERT" era) ~ ConwayGovCertEnv era
  , Signal (EraRule "DELEG" era) ~ ConwayDelegCert
  , Signal (EraRule "POOL" era) ~ PoolCert
  , Signal (EraRule "GOVCERT" era) ~ ConwayGovCert
  , Embed (EraRule "DELEG" era) (CERT era)
  , Embed (EraRule "POOL" era) (CERT era)
  , Embed (EraRule "GOVCERT" era) (CERT era)
  , TxCert era ~ ConwayTxCert era
  , EraCertState era
  ) =>
  STS (CERT era)
  where
  type State (CERT era) = CertState era
  type Signal (CERT era) = TxCert era
  type Environment (CERT era) = CertEnv era
  type BaseM (CERT era) = ShelleyBase
  type PredicateFailure (CERT era) = ConwayCertPredFailure era
  type Event (CERT era) = ConwayCertEvent era

  transitionRules :: [TransitionRule (CERT era)]
transitionRules = [forall era.
(State (EraRule "DELEG" era) ~ CertState era,
 State (EraRule "POOL" era) ~ PState era,
 State (EraRule "GOVCERT" era) ~ CertState era,
 Environment (EraRule "DELEG" era) ~ ConwayDelegEnv era,
 Environment (EraRule "POOL" era) ~ PoolEnv era,
 Environment (EraRule "GOVCERT" era) ~ ConwayGovCertEnv era,
 Signal (EraRule "DELEG" era) ~ ConwayDelegCert,
 Signal (EraRule "POOL" era) ~ PoolCert,
 Signal (EraRule "GOVCERT" era) ~ ConwayGovCert,
 Embed (EraRule "DELEG" era) (CERT era),
 Embed (EraRule "POOL" era) (CERT era),
 Embed (EraRule "GOVCERT" era) (CERT era),
 TxCert era ~ ConwayTxCert era, EraCertState era) =>
TransitionRule (CERT era)
certTransition @era]

certTransition ::
  forall era.
  ( State (EraRule "DELEG" era) ~ CertState era
  , State (EraRule "POOL" era) ~ PState era
  , State (EraRule "GOVCERT" era) ~ CertState era
  , Environment (EraRule "DELEG" era) ~ ConwayDelegEnv era
  , Environment (EraRule "POOL" era) ~ PoolEnv era
  , Environment (EraRule "GOVCERT" era) ~ ConwayGovCertEnv era
  , Signal (EraRule "DELEG" era) ~ ConwayDelegCert
  , Signal (EraRule "POOL" era) ~ PoolCert
  , Signal (EraRule "GOVCERT" era) ~ ConwayGovCert
  , Embed (EraRule "DELEG" era) (CERT era)
  , Embed (EraRule "POOL" era) (CERT era)
  , Embed (EraRule "GOVCERT" era) (CERT era)
  , TxCert era ~ ConwayTxCert era
  , EraCertState era
  ) =>
  TransitionRule (CERT era)
certTransition :: forall era.
(State (EraRule "DELEG" era) ~ CertState era,
 State (EraRule "POOL" era) ~ PState era,
 State (EraRule "GOVCERT" era) ~ CertState era,
 Environment (EraRule "DELEG" era) ~ ConwayDelegEnv era,
 Environment (EraRule "POOL" era) ~ PoolEnv era,
 Environment (EraRule "GOVCERT" era) ~ ConwayGovCertEnv era,
 Signal (EraRule "DELEG" era) ~ ConwayDelegCert,
 Signal (EraRule "POOL" era) ~ PoolCert,
 Signal (EraRule "GOVCERT" era) ~ ConwayGovCert,
 Embed (EraRule "DELEG" era) (CERT era),
 Embed (EraRule "POOL" era) (CERT era),
 Embed (EraRule "GOVCERT" era) (CERT era),
 TxCert era ~ ConwayTxCert era, EraCertState era) =>
TransitionRule (CERT era)
certTransition = do
  TRC (CertEnv pp currentEpoch committee committeeProposals, certState, c) <- Rule (CERT era) 'Transition (RuleContext 'Transition (CERT era))
F (Clause (CERT era) 'Transition) (TRC (CERT era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let
    certPState = CertState era
State (CERT era)
certState CertState era
-> Getting (PState era) (CertState era) (PState era) -> PState era
forall s a. s -> Getting a s a -> a
^. Getting (PState era) (CertState era) (PState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL
    pools = PState era -> Map (KeyHash StakePool) StakePoolState
forall era. PState era -> Map (KeyHash StakePool) StakePoolState
psStakePools PState era
certPState
  case c of
    ConwayTxCertDeleg ConwayDelegCert
delegCert -> do
      forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "DELEG" era) (RuleContext 'Transition (EraRule "DELEG" era)
 -> Rule (CERT era) 'Transition (State (EraRule "DELEG" era)))
-> RuleContext 'Transition (EraRule "DELEG" era)
-> Rule (CERT era) 'Transition (State (EraRule "DELEG" era))
forall a b. (a -> b) -> a -> b
$ (Environment (EraRule "DELEG" era), State (EraRule "DELEG" era),
 Signal (EraRule "DELEG" era))
-> TRC (EraRule "DELEG" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (PParams era
-> Map (KeyHash StakePool) StakePoolState -> ConwayDelegEnv era
forall era.
PParams era
-> Map (KeyHash StakePool) StakePoolState -> ConwayDelegEnv era
ConwayDelegEnv PParams era
pp Map (KeyHash StakePool) StakePoolState
pools, State (EraRule "DELEG" era)
State (CERT era)
certState, Signal (EraRule "DELEG" era)
ConwayDelegCert
delegCert)
    ConwayTxCertPool PoolCert
poolCert -> do
      newPState <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "POOL" era) (RuleContext 'Transition (EraRule "POOL" era)
 -> Rule (CERT era) 'Transition (State (EraRule "POOL" era)))
-> RuleContext 'Transition (EraRule "POOL" era)
-> Rule (CERT era) 'Transition (State (EraRule "POOL" era))
forall a b. (a -> b) -> a -> b
$ (Environment (EraRule "POOL" era), State (EraRule "POOL" era),
 Signal (EraRule "POOL" era))
-> TRC (EraRule "POOL" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (EpochNo -> PParams era -> PoolEnv era
forall era. EpochNo -> PParams era -> PoolEnv era
PoolEnv EpochNo
currentEpoch PParams era
pp, PState era
State (EraRule "POOL" era)
certPState, PoolCert
Signal (EraRule "POOL" era)
poolCert)
      pure $ certState & certPStateL .~ newPState
    ConwayTxCertGov ConwayGovCert
govCert -> do
      forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "GOVCERT" era) (RuleContext 'Transition (EraRule "GOVCERT" era)
 -> Rule (CERT era) 'Transition (State (EraRule "GOVCERT" era)))
-> RuleContext 'Transition (EraRule "GOVCERT" era)
-> Rule (CERT era) 'Transition (State (EraRule "GOVCERT" era))
forall a b. (a -> b) -> a -> b
$
        (Environment (EraRule "GOVCERT" era),
 State (EraRule "GOVCERT" era), Signal (EraRule "GOVCERT" era))
-> TRC (EraRule "GOVCERT" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
-> ConwayGovCertEnv era
forall era.
PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
-> ConwayGovCertEnv era
ConwayGovCertEnv PParams era
pp EpochNo
currentEpoch StrictMaybe (Committee era)
committee Map (GovPurposeId 'CommitteePurpose) (GovActionState era)
committeeProposals, State (EraRule "GOVCERT" era)
State (CERT era)
certState, Signal (EraRule "GOVCERT" era)
ConwayGovCert
govCert)

instance
  ( Era era
  , STS (DELEG era)
  , PredicateFailure (EraRule "DELEG" era) ~ ConwayDelegPredFailure era
  ) =>
  Embed (DELEG era) (CERT era)
  where
  wrapFailed :: PredicateFailure (DELEG era) -> PredicateFailure (CERT era)
wrapFailed = PredicateFailure (EraRule "DELEG" era) -> ConwayCertPredFailure era
PredicateFailure (DELEG era) -> PredicateFailure (CERT era)
forall era.
PredicateFailure (EraRule "DELEG" era) -> ConwayCertPredFailure era
DelegFailure
  wrapEvent :: Event (DELEG era) -> Event (CERT era)
wrapEvent = Void -> ConwayCertEvent era
Event (DELEG era) -> Event (CERT era)
forall a. Void -> a
absurd

instance
  ( Era era
  , STS (Shelley.POOL era)
  , Event (EraRule "POOL" era) ~ Shelley.PoolEvent era
  , PredicateFailure (EraRule "POOL" era) ~ Shelley.ShelleyPoolPredFailure era
  , PredicateFailure (Shelley.POOL era) ~ Shelley.ShelleyPoolPredFailure era
  , BaseM (Shelley.POOL era) ~ ShelleyBase
  ) =>
  Embed (Shelley.POOL era) (CERT era)
  where
  wrapFailed :: PredicateFailure (POOL era) -> PredicateFailure (CERT era)
wrapFailed = PredicateFailure (EraRule "POOL" era) -> ConwayCertPredFailure era
PredicateFailure (POOL era) -> PredicateFailure (CERT era)
forall era.
PredicateFailure (EraRule "POOL" era) -> ConwayCertPredFailure era
PoolFailure
  wrapEvent :: Event (POOL era) -> Event (CERT era)
wrapEvent = Event (EraRule "POOL" era) -> ConwayCertEvent era
Event (POOL era) -> Event (CERT era)
forall era. Event (EraRule "POOL" era) -> ConwayCertEvent era
PoolEvent

instance
  ( Era era
  , STS (GOVCERT era)
  , PredicateFailure (EraRule "GOVCERT" era) ~ ConwayGovCertPredFailure era
  ) =>
  Embed (GOVCERT era) (CERT era)
  where
  wrapFailed :: PredicateFailure (GOVCERT era) -> PredicateFailure (CERT era)
wrapFailed = PredicateFailure (EraRule "GOVCERT" era)
-> ConwayCertPredFailure era
PredicateFailure (GOVCERT era) -> PredicateFailure (CERT era)
forall era.
PredicateFailure (EraRule "GOVCERT" era)
-> ConwayCertPredFailure era
GovCertFailure
  wrapEvent :: Event (GOVCERT era) -> Event (CERT era)
wrapEvent = Void -> ConwayCertEvent era
Event (GOVCERT era) -> Event (CERT era)
forall a. Void -> a
absurd

instance
  ( EncCBOR (PredicateFailure (EraRule "DELEG" era))
  , EncCBOR (PredicateFailure (EraRule "POOL" era))
  , EncCBOR (PredicateFailure (EraRule "GOVCERT" era))
  ) =>
  EncCBOR (ConwayCertPredFailure era)
  where
  encCBOR :: ConwayCertPredFailure era -> Encoding
encCBOR =
    Encode Open (ConwayCertPredFailure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (ConwayCertPredFailure era) -> Encoding)
-> (ConwayCertPredFailure era
    -> Encode Open (ConwayCertPredFailure era))
-> ConwayCertPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      DelegFailure PredicateFailure (EraRule "DELEG" era)
x -> (PredicateFailure (EraRule "DELEG" era)
 -> ConwayCertPredFailure era)
-> Word
-> Encode
     Open
     (PredicateFailure (EraRule "DELEG" era)
      -> ConwayCertPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
PredicateFailure (EraRule "DELEG" era) -> ConwayCertPredFailure era
DelegFailure @era) Word
1 Encode
  Open
  (PredicateFailure (EraRule "DELEG" era)
   -> ConwayCertPredFailure era)
-> Encode (Closed Dense) (PredicateFailure (EraRule "DELEG" era))
-> Encode Open (ConwayCertPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> PredicateFailure (EraRule "DELEG" era)
-> Encode (Closed Dense) (PredicateFailure (EraRule "DELEG" era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To PredicateFailure (EraRule "DELEG" era)
x
      PoolFailure PredicateFailure (EraRule "POOL" era)
x -> (PredicateFailure (EraRule "POOL" era)
 -> ConwayCertPredFailure era)
-> Word
-> Encode
     Open
     (PredicateFailure (EraRule "POOL" era)
      -> ConwayCertPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
PredicateFailure (EraRule "POOL" era) -> ConwayCertPredFailure era
PoolFailure @era) Word
2 Encode
  Open
  (PredicateFailure (EraRule "POOL" era)
   -> ConwayCertPredFailure era)
-> Encode (Closed Dense) (PredicateFailure (EraRule "POOL" era))
-> Encode Open (ConwayCertPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> PredicateFailure (EraRule "POOL" era)
-> Encode (Closed Dense) (PredicateFailure (EraRule "POOL" era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To PredicateFailure (EraRule "POOL" era)
x
      GovCertFailure PredicateFailure (EraRule "GOVCERT" era)
x -> (PredicateFailure (EraRule "GOVCERT" era)
 -> ConwayCertPredFailure era)
-> Word
-> Encode
     Open
     (PredicateFailure (EraRule "GOVCERT" era)
      -> ConwayCertPredFailure era)
forall t. t -> Word -> Encode Open t
Sum (forall era.
PredicateFailure (EraRule "GOVCERT" era)
-> ConwayCertPredFailure era
GovCertFailure @era) Word
3 Encode
  Open
  (PredicateFailure (EraRule "GOVCERT" era)
   -> ConwayCertPredFailure era)
-> Encode (Closed Dense) (PredicateFailure (EraRule "GOVCERT" era))
-> Encode Open (ConwayCertPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> PredicateFailure (EraRule "GOVCERT" era)
-> Encode (Closed Dense) (PredicateFailure (EraRule "GOVCERT" era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To PredicateFailure (EraRule "GOVCERT" era)
x

instance
  ( Typeable era
  , DecCBOR (PredicateFailure (EraRule "DELEG" era))
  , DecCBOR (PredicateFailure (EraRule "POOL" era))
  , DecCBOR (PredicateFailure (EraRule "GOVCERT" era))
  ) =>
  DecCBOR (ConwayCertPredFailure era)
  where
  decCBOR :: forall s. Decoder s (ConwayCertPredFailure era)
decCBOR =
    Decode (Closed Dense) (ConwayCertPredFailure era)
-> Decoder s (ConwayCertPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) (ConwayCertPredFailure era)
 -> Decoder s (ConwayCertPredFailure era))
-> Decode (Closed Dense) (ConwayCertPredFailure era)
-> Decoder s (ConwayCertPredFailure era)
forall a b. (a -> b) -> a -> b
$ Text
-> (Word -> Decode Open (ConwayCertPredFailure era))
-> Decode (Closed Dense) (ConwayCertPredFailure era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"ConwayCertPredFailure" ((Word -> Decode Open (ConwayCertPredFailure era))
 -> Decode (Closed Dense) (ConwayCertPredFailure era))
-> (Word -> Decode Open (ConwayCertPredFailure era))
-> Decode (Closed Dense) (ConwayCertPredFailure era)
forall a b. (a -> b) -> a -> b
$ \case
      Word
1 -> (PredicateFailure (EraRule "DELEG" era)
 -> ConwayCertPredFailure era)
-> Decode
     Open
     (PredicateFailure (EraRule "DELEG" era)
      -> ConwayCertPredFailure era)
forall t. t -> Decode Open t
SumD PredicateFailure (EraRule "DELEG" era) -> ConwayCertPredFailure era
forall era.
PredicateFailure (EraRule "DELEG" era) -> ConwayCertPredFailure era
DelegFailure Decode
  Open
  (PredicateFailure (EraRule "DELEG" era)
   -> ConwayCertPredFailure era)
-> Decode
     (Closed (ZonkAny 0)) (PredicateFailure (EraRule "DELEG" era))
-> Decode Open (ConwayCertPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
  (Closed (ZonkAny 0)) (PredicateFailure (EraRule "DELEG" era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
2 -> (PredicateFailure (EraRule "POOL" era)
 -> ConwayCertPredFailure era)
-> Decode
     Open
     (PredicateFailure (EraRule "POOL" era)
      -> ConwayCertPredFailure era)
forall t. t -> Decode Open t
SumD PredicateFailure (EraRule "POOL" era) -> ConwayCertPredFailure era
forall era.
PredicateFailure (EraRule "POOL" era) -> ConwayCertPredFailure era
PoolFailure Decode
  Open
  (PredicateFailure (EraRule "POOL" era)
   -> ConwayCertPredFailure era)
-> Decode
     (Closed (ZonkAny 1)) (PredicateFailure (EraRule "POOL" era))
-> Decode Open (ConwayCertPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 1)) (PredicateFailure (EraRule "POOL" era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
3 -> (PredicateFailure (EraRule "GOVCERT" era)
 -> ConwayCertPredFailure era)
-> Decode
     Open
     (PredicateFailure (EraRule "GOVCERT" era)
      -> ConwayCertPredFailure era)
forall t. t -> Decode Open t
SumD PredicateFailure (EraRule "GOVCERT" era)
-> ConwayCertPredFailure era
forall era.
PredicateFailure (EraRule "GOVCERT" era)
-> ConwayCertPredFailure era
GovCertFailure Decode
  Open
  (PredicateFailure (EraRule "GOVCERT" era)
   -> ConwayCertPredFailure era)
-> Decode
     (Closed (ZonkAny 2)) (PredicateFailure (EraRule "GOVCERT" era))
-> Decode Open (ConwayCertPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
  (Closed (ZonkAny 2)) (PredicateFailure (EraRule "GOVCERT" era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      Word
n -> Word -> Decode Open (ConwayCertPredFailure era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n