{-# 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 (
  ConwayCERT,
  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 (
  ConwayCERT,
  ConwayDELEG,
  ConwayEra,
  ConwayGOVCERT,
 )
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 Cardano.Ledger.Shelley.Rules (PoolEvent, ShelleyPOOL, ShelleyPoolPredFailure)
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 ((&), (.~), (^.))
import NoThunks.Class (NoThunks)

data CertEnv era = CertEnv
  { forall era. CertEnv era -> PParams era
cePParams :: PParams era
  , forall era. CertEnv era -> EpochNo
ceCurrentEpoch :: EpochNo
  -- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
  , forall era. CertEnv era -> StrictMaybe (Committee era)
ceCurrentCommittee :: StrictMaybe (Committee era)
  , forall era.
CertEnv era
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
ceCommitteeProposals :: Map.Map (GovPurposeId 'CommitteePurpose era) (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 era) (GovActionState era)
_) =
    let CertEnv {Map (GovPurposeId 'CommitteePurpose era) (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 era) (GovActionState era)
cePParams :: PParams era
ceCurrentEpoch :: EpochNo
ceCurrentCommittee :: StrictMaybe (Committee era)
ceCommitteeProposals :: Map (GovPurposeId 'CommitteePurpose era) (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 era) (GovActionState era)
 -> CertEnv era)
-> Encode
     ('Closed 'Dense)
     (PParams era
      -> EpochNo
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
      -> CertEnv era)
forall t. t -> Encode ('Closed 'Dense) t
Rec PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> CertEnv era
forall era.
PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> CertEnv era
CertEnv
            Encode
  ('Closed 'Dense)
  (PParams era
   -> EpochNo
   -> StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   -> CertEnv era)
-> Encode ('Closed 'Dense) (PParams era)
-> Encode
     ('Closed 'Dense)
     (EpochNo
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose era) (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 era) (GovActionState era)
   -> CertEnv era)
-> Encode ('Closed 'Dense) EpochNo
-> Encode
     ('Closed 'Dense)
     (StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose era) (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 era) (GovActionState era)
   -> CertEnv era)
-> Encode ('Closed 'Dense) (StrictMaybe (Committee era))
-> Encode
     ('Closed 'Dense)
     (Map (GovPurposeId 'CommitteePurpose era) (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 era) (GovActionState era)
   -> CertEnv era)
-> Encode
     ('Closed 'Dense)
     (Map (GovPurposeId 'CommitteePurpose era) (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 era) (GovActionState era)
-> Encode
     ('Closed 'Dense)
     (Map (GovPurposeId 'CommitteePurpose era) (GovActionState era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (GovPurposeId 'CommitteePurpose era) (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" 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
  ( NoThunks (PredicateFailure (EraRule "DELEG" era))
  , NoThunks (PredicateFailure (EraRule "POOL" era))
  , NoThunks (PredicateFailure (EraRule "GOVCERT" era))
  ) =>
  NoThunks (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) (ConwayCERT era)
  , Embed (EraRule "POOL" era) (ConwayCERT era)
  , Embed (EraRule "GOVCERT" era) (ConwayCERT era)
  , TxCert era ~ ConwayTxCert era
  , EraCertState era
  ) =>
  STS (ConwayCERT era)
  where
  type State (ConwayCERT era) = CertState era
  type Signal (ConwayCERT era) = TxCert era
  type Environment (ConwayCERT era) = CertEnv era
  type BaseM (ConwayCERT era) = ShelleyBase
  type PredicateFailure (ConwayCERT era) = ConwayCertPredFailure era
  type Event (ConwayCERT era) = ConwayCertEvent era

  transitionRules :: [TransitionRule (ConwayCERT 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) (ConwayCERT era),
 Embed (EraRule "POOL" era) (ConwayCERT era),
 Embed (EraRule "GOVCERT" era) (ConwayCERT era),
 TxCert era ~ ConwayTxCert era, EraCertState era) =>
TransitionRule (ConwayCERT 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) (ConwayCERT era)
  , Embed (EraRule "POOL" era) (ConwayCERT era)
  , Embed (EraRule "GOVCERT" era) (ConwayCERT era)
  , TxCert era ~ ConwayTxCert era
  , EraCertState era
  ) =>
  TransitionRule (ConwayCERT 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) (ConwayCERT era),
 Embed (EraRule "POOL" era) (ConwayCERT era),
 Embed (EraRule "GOVCERT" era) (ConwayCERT era),
 TxCert era ~ ConwayTxCert era, EraCertState era) =>
TransitionRule (ConwayCERT era)
certTransition = do
  TRC (CertEnv PParams era
pp EpochNo
currentEpoch StrictMaybe (Committee era)
committee Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
committeeProposals, State (ConwayCERT era)
certState, Signal (ConwayCERT era)
c) <- Rule
  (ConwayCERT era)
  'Transition
  (RuleContext 'Transition (ConwayCERT era))
F (Clause (ConwayCERT era) 'Transition) (TRC (ConwayCERT era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let
    certPState :: PState era
certPState = CertState era
State (ConwayCERT 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 :: Map (KeyHash 'StakePool) PoolParams
pools = PState era -> Map (KeyHash 'StakePool) PoolParams
forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psStakePoolParams PState era
certPState
  case Signal (ConwayCERT era)
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 (ConwayCERT era) 'Transition (State (EraRule "DELEG" era)))
-> RuleContext 'Transition (EraRule "DELEG" era)
-> Rule (ConwayCERT 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) PoolParams -> ConwayDelegEnv era
forall era.
PParams era
-> Map (KeyHash 'StakePool) PoolParams -> ConwayDelegEnv era
ConwayDelegEnv PParams era
pp Map (KeyHash 'StakePool) PoolParams
pools, State (EraRule "DELEG" era)
State (ConwayCERT era)
certState, Signal (EraRule "DELEG" era)
ConwayDelegCert
delegCert)
    ConwayTxCertPool PoolCert
poolCert -> do
      PState era
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 (ConwayCERT era) 'Transition (State (EraRule "POOL" era)))
-> RuleContext 'Transition (EraRule "POOL" era)
-> Rule (ConwayCERT 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)
      CertState era
-> F (Clause (ConwayCERT era) 'Transition) (CertState era)
forall a. a -> F (Clause (ConwayCERT era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ConwayCERT era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ConwayCERT era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$ CertState era
State (ConwayCERT era)
certState CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (PState era -> Identity (PState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL ((PState era -> Identity (PState era))
 -> CertState era -> Identity (CertState era))
-> PState era -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ PState era
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
      (ConwayCERT era) 'Transition (State (EraRule "GOVCERT" era)))
-> RuleContext 'Transition (EraRule "GOVCERT" era)
-> Rule
     (ConwayCERT 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 era) (GovActionState era)
-> ConwayGovCertEnv era
forall era.
PParams era
-> EpochNo
-> StrictMaybe (Committee era)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> ConwayGovCertEnv era
ConwayGovCertEnv PParams era
pp EpochNo
currentEpoch StrictMaybe (Committee era)
committee Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
committeeProposals, State (EraRule "GOVCERT" era)
State (ConwayCERT era)
certState, Signal (EraRule "GOVCERT" era)
ConwayGovCert
govCert)

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

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

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

instance
  ( Typeable era
  , 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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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