{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Dijkstra.Rules.GovCert (
  DijkstraGOVCERT,
  DijkstraGovCertPredFailure (..),
  conwayToDijkstraGovCertPredFailure,
) where

import Cardano.Ledger.BaseTypes (
  Mismatch (..),
  Relation (..),
  ShelleyBase,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Rules (ConwayGovCertEnv, ConwayGovCertPredFailure (..))
import qualified Cardano.Ledger.Conway.Rules as Conway
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Conway.TxCert (ConwayGovCert (..))
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Dijkstra.Era (DijkstraEra, DijkstraGOVCERT)
import Control.DeepSeq (NFData)
import Control.State.Transition.Extended (
  BaseM,
  Environment,
  Event,
  PredicateFailure,
  STS,
  Signal,
  State,
  transitionRules,
 )
import Data.Typeable (Typeable)
import Data.Void (Void)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))

data DijkstraGovCertPredFailure era
  = DijkstraDRepAlreadyRegistered (Credential DRepRole)
  | DijkstraDRepNotRegistered (Credential DRepRole)
  | DijkstraDRepIncorrectDeposit (Mismatch RelEQ Coin)
  | DijkstraCommitteeHasPreviouslyResigned (Credential ColdCommitteeRole)
  | DijkstraDRepIncorrectRefund (Mismatch RelEQ Coin)
  | -- | Predicate failure whenever an update to an unknown committee member is
    -- attempted. Current Constitutional Committee and all available proposals will be
    -- searched before reporting this predicate failure.
    DijkstraCommitteeIsUnknown (Credential ColdCommitteeRole)
  deriving (Int -> DijkstraGovCertPredFailure era -> ShowS
[DijkstraGovCertPredFailure era] -> ShowS
DijkstraGovCertPredFailure era -> String
(Int -> DijkstraGovCertPredFailure era -> ShowS)
-> (DijkstraGovCertPredFailure era -> String)
-> ([DijkstraGovCertPredFailure era] -> ShowS)
-> Show (DijkstraGovCertPredFailure era)
forall era. Int -> DijkstraGovCertPredFailure era -> ShowS
forall era. [DijkstraGovCertPredFailure era] -> ShowS
forall era. DijkstraGovCertPredFailure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> DijkstraGovCertPredFailure era -> ShowS
showsPrec :: Int -> DijkstraGovCertPredFailure era -> ShowS
$cshow :: forall era. DijkstraGovCertPredFailure era -> String
show :: DijkstraGovCertPredFailure era -> String
$cshowList :: forall era. [DijkstraGovCertPredFailure era] -> ShowS
showList :: [DijkstraGovCertPredFailure era] -> ShowS
Show, DijkstraGovCertPredFailure era
-> DijkstraGovCertPredFailure era -> Bool
(DijkstraGovCertPredFailure era
 -> DijkstraGovCertPredFailure era -> Bool)
-> (DijkstraGovCertPredFailure era
    -> DijkstraGovCertPredFailure era -> Bool)
-> Eq (DijkstraGovCertPredFailure era)
forall era.
DijkstraGovCertPredFailure era
-> DijkstraGovCertPredFailure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
DijkstraGovCertPredFailure era
-> DijkstraGovCertPredFailure era -> Bool
== :: DijkstraGovCertPredFailure era
-> DijkstraGovCertPredFailure era -> Bool
$c/= :: forall era.
DijkstraGovCertPredFailure era
-> DijkstraGovCertPredFailure era -> Bool
/= :: DijkstraGovCertPredFailure era
-> DijkstraGovCertPredFailure era -> Bool
Eq, (forall x.
 DijkstraGovCertPredFailure era
 -> Rep (DijkstraGovCertPredFailure era) x)
-> (forall x.
    Rep (DijkstraGovCertPredFailure era) x
    -> DijkstraGovCertPredFailure era)
-> Generic (DijkstraGovCertPredFailure era)
forall x.
Rep (DijkstraGovCertPredFailure era) x
-> DijkstraGovCertPredFailure era
forall x.
DijkstraGovCertPredFailure era
-> Rep (DijkstraGovCertPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (DijkstraGovCertPredFailure era) x
-> DijkstraGovCertPredFailure era
forall era x.
DijkstraGovCertPredFailure era
-> Rep (DijkstraGovCertPredFailure era) x
$cfrom :: forall era x.
DijkstraGovCertPredFailure era
-> Rep (DijkstraGovCertPredFailure era) x
from :: forall x.
DijkstraGovCertPredFailure era
-> Rep (DijkstraGovCertPredFailure era) x
$cto :: forall era x.
Rep (DijkstraGovCertPredFailure era) x
-> DijkstraGovCertPredFailure era
to :: forall x.
Rep (DijkstraGovCertPredFailure era) x
-> DijkstraGovCertPredFailure era
Generic)

type instance EraRuleFailure "GOVCERT" DijkstraEra = DijkstraGovCertPredFailure DijkstraEra

type instance EraRuleEvent "GOVCERT" DijkstraEra = VoidEraRule "GOVCERT" DijkstraEra

instance InjectRuleFailure "GOVCERT" DijkstraGovCertPredFailure DijkstraEra

instance InjectRuleFailure "GOVCERT" ConwayGovCertPredFailure DijkstraEra where
  injectFailure :: ConwayGovCertPredFailure DijkstraEra
-> EraRuleFailure "GOVCERT" DijkstraEra
injectFailure = ConwayGovCertPredFailure DijkstraEra
-> EraRuleFailure "GOVCERT" DijkstraEra
ConwayGovCertPredFailure DijkstraEra
-> DijkstraGovCertPredFailure DijkstraEra
forall era.
ConwayGovCertPredFailure era -> DijkstraGovCertPredFailure era
conwayToDijkstraGovCertPredFailure

instance NoThunks (DijkstraGovCertPredFailure era)

instance NFData (DijkstraGovCertPredFailure era)

instance Era era => EncCBOR (DijkstraGovCertPredFailure era) where
  encCBOR :: DijkstraGovCertPredFailure era -> Encoding
encCBOR =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode @_ @(DijkstraGovCertPredFailure era) (Encode Open (DijkstraGovCertPredFailure era) -> Encoding)
-> (DijkstraGovCertPredFailure era
    -> Encode Open (DijkstraGovCertPredFailure era))
-> DijkstraGovCertPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      DijkstraDRepAlreadyRegistered Credential DRepRole
cred -> (Credential DRepRole -> DijkstraGovCertPredFailure era)
-> Word
-> Encode
     Open (Credential DRepRole -> DijkstraGovCertPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Credential DRepRole -> DijkstraGovCertPredFailure era
forall era. Credential DRepRole -> DijkstraGovCertPredFailure era
DijkstraDRepAlreadyRegistered Word
0 Encode Open (Credential DRepRole -> DijkstraGovCertPredFailure era)
-> Encode (Closed Dense) (Credential DRepRole)
-> Encode Open (DijkstraGovCertPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Credential DRepRole -> Encode (Closed Dense) (Credential DRepRole)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Credential DRepRole
cred
      DijkstraDRepNotRegistered Credential DRepRole
cred -> (Credential DRepRole -> DijkstraGovCertPredFailure era)
-> Word
-> Encode
     Open (Credential DRepRole -> DijkstraGovCertPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Credential DRepRole -> DijkstraGovCertPredFailure era
forall era. Credential DRepRole -> DijkstraGovCertPredFailure era
DijkstraDRepNotRegistered Word
1 Encode Open (Credential DRepRole -> DijkstraGovCertPredFailure era)
-> Encode (Closed Dense) (Credential DRepRole)
-> Encode Open (DijkstraGovCertPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Credential DRepRole -> Encode (Closed Dense) (Credential DRepRole)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Credential DRepRole
cred
      DijkstraDRepIncorrectDeposit Mismatch RelEQ Coin
mm -> (Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era)
-> Word
-> Encode
     Open (Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era
forall era. Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era
DijkstraDRepIncorrectDeposit Word
2 Encode Open (Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era)
-> Encode (Closed Dense) (Mismatch RelEQ Coin)
-> Encode Open (DijkstraGovCertPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Mismatch RelEQ Coin -> Encode (Closed Dense) (Mismatch RelEQ Coin)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Mismatch RelEQ Coin
mm
      DijkstraCommitteeHasPreviouslyResigned Credential ColdCommitteeRole
coldCred -> (Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era)
-> Word
-> Encode
     Open
     (Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
forall era.
Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
DijkstraCommitteeHasPreviouslyResigned Word
3 Encode
  Open
  (Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era)
-> Encode (Closed Dense) (Credential ColdCommitteeRole)
-> Encode Open (DijkstraGovCertPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Credential ColdCommitteeRole
-> Encode (Closed Dense) (Credential ColdCommitteeRole)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Credential ColdCommitteeRole
coldCred
      DijkstraDRepIncorrectRefund Mismatch RelEQ Coin
mm -> (Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era)
-> Word
-> Encode
     Open (Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era
forall era. Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era
DijkstraDRepIncorrectRefund Word
4 Encode Open (Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era)
-> Encode (Closed Dense) (Mismatch RelEQ Coin)
-> Encode Open (DijkstraGovCertPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Mismatch RelEQ Coin -> Encode (Closed Dense) (Mismatch RelEQ Coin)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Mismatch RelEQ Coin
mm
      DijkstraCommitteeIsUnknown Credential ColdCommitteeRole
coldCred -> (Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era)
-> Word
-> Encode
     Open
     (Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
forall era.
Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
DijkstraCommitteeIsUnknown Word
5 Encode
  Open
  (Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era)
-> Encode (Closed Dense) (Credential ColdCommitteeRole)
-> Encode Open (DijkstraGovCertPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Credential ColdCommitteeRole
-> Encode (Closed Dense) (Credential ColdCommitteeRole)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Credential ColdCommitteeRole
coldCred

instance Typeable era => DecCBOR (DijkstraGovCertPredFailure era) where
  decCBOR :: forall s. Decoder s (DijkstraGovCertPredFailure era)
decCBOR = Decode (Closed Dense) (DijkstraGovCertPredFailure era)
-> Decoder s (DijkstraGovCertPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) (DijkstraGovCertPredFailure era)
 -> Decoder s (DijkstraGovCertPredFailure era))
-> ((Word -> Decode Open (DijkstraGovCertPredFailure era))
    -> Decode (Closed Dense) (DijkstraGovCertPredFailure era))
-> (Word -> Decode Open (DijkstraGovCertPredFailure era))
-> Decoder s (DijkstraGovCertPredFailure era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> (Word -> Decode Open (DijkstraGovCertPredFailure era))
-> Decode (Closed Dense) (DijkstraGovCertPredFailure era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"DijkstraGovCertPredFailure" ((Word -> Decode Open (DijkstraGovCertPredFailure era))
 -> Decoder s (DijkstraGovCertPredFailure era))
-> (Word -> Decode Open (DijkstraGovCertPredFailure era))
-> Decoder s (DijkstraGovCertPredFailure era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> (Credential DRepRole -> DijkstraGovCertPredFailure era)
-> Decode
     Open (Credential DRepRole -> DijkstraGovCertPredFailure era)
forall t. t -> Decode Open t
SumD Credential DRepRole -> DijkstraGovCertPredFailure era
forall era. Credential DRepRole -> DijkstraGovCertPredFailure era
DijkstraDRepAlreadyRegistered Decode Open (Credential DRepRole -> DijkstraGovCertPredFailure era)
-> Decode (Closed (ZonkAny 0)) (Credential DRepRole)
-> Decode Open (DijkstraGovCertPredFailure 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)) (Credential DRepRole)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> (Credential DRepRole -> DijkstraGovCertPredFailure era)
-> Decode
     Open (Credential DRepRole -> DijkstraGovCertPredFailure era)
forall t. t -> Decode Open t
SumD Credential DRepRole -> DijkstraGovCertPredFailure era
forall era. Credential DRepRole -> DijkstraGovCertPredFailure era
DijkstraDRepNotRegistered Decode Open (Credential DRepRole -> DijkstraGovCertPredFailure era)
-> Decode (Closed (ZonkAny 1)) (Credential DRepRole)
-> Decode Open (DijkstraGovCertPredFailure 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)) (Credential DRepRole)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> (Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era)
-> Decode
     Open (Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era)
forall t. t -> Decode Open t
SumD Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era
forall era. Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era
DijkstraDRepIncorrectDeposit Decode Open (Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era)
-> Decode (Closed (ZonkAny 2)) (Mismatch RelEQ Coin)
-> Decode Open (DijkstraGovCertPredFailure 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)) (Mismatch RelEQ Coin)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
3 -> (Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era)
-> Decode
     Open
     (Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era)
forall t. t -> Decode Open t
SumD Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
forall era.
Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
DijkstraCommitteeHasPreviouslyResigned Decode
  Open
  (Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era)
-> Decode (Closed (ZonkAny 3)) (Credential ColdCommitteeRole)
-> Decode Open (DijkstraGovCertPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 3)) (Credential ColdCommitteeRole)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> (Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era)
-> Decode
     Open (Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era)
forall t. t -> Decode Open t
SumD Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era
forall era. Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era
DijkstraDRepIncorrectRefund Decode Open (Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era)
-> Decode (Closed (ZonkAny 4)) (Mismatch RelEQ Coin)
-> Decode Open (DijkstraGovCertPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 4)) (Mismatch RelEQ Coin)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
5 -> (Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era)
-> Decode
     Open
     (Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era)
forall t. t -> Decode Open t
SumD Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
forall era.
Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
DijkstraCommitteeIsUnknown Decode
  Open
  (Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era)
-> Decode (Closed (ZonkAny 5)) (Credential ColdCommitteeRole)
-> Decode Open (DijkstraGovCertPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 5)) (Credential ColdCommitteeRole)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> Word -> Decode Open (DijkstraGovCertPredFailure era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

instance
  ( ConwayEraPParams era
  , State (EraRule "GOVCERT" era) ~ CertState era
  , Signal (EraRule "GOVCERT" era) ~ ConwayGovCert
  , Environment (EraRule "GOVCERT" era) ~ ConwayGovCertEnv era
  , InjectRuleFailure "GOVCERT" ConwayGovCertPredFailure era
  , EraRule "GOVCERT" era ~ DijkstraGOVCERT era
  , Eq (PredicateFailure (EraRule "GOVCERT" era))
  , Show (PredicateFailure (EraRule "GOVCERT" era))
  , ConwayEraCertState era
  ) =>
  STS (DijkstraGOVCERT era)
  where
  type State (DijkstraGOVCERT era) = CertState era
  type Signal (DijkstraGOVCERT era) = ConwayGovCert
  type Environment (DijkstraGOVCERT era) = ConwayGovCertEnv era
  type BaseM (DijkstraGOVCERT era) = ShelleyBase
  type PredicateFailure (DijkstraGOVCERT era) = DijkstraGovCertPredFailure era
  type Event (DijkstraGOVCERT era) = Void

  transitionRules :: [TransitionRule (DijkstraGOVCERT era)]
transitionRules = [forall era.
(ConwayEraPParams era, ConwayEraCertState era,
 InjectRuleFailure "GOVCERT" ConwayGovCertPredFailure era,
 State (EraRule "GOVCERT" era) ~ CertState era,
 Signal (EraRule "GOVCERT" era) ~ ConwayGovCert,
 Environment (EraRule "GOVCERT" era) ~ ConwayGovCertEnv era) =>
TransitionRule (EraRule "GOVCERT" era)
Conway.conwayGovCertTransition @era]

conwayToDijkstraGovCertPredFailure ::
  forall era. ConwayGovCertPredFailure era -> DijkstraGovCertPredFailure era
conwayToDijkstraGovCertPredFailure :: forall era.
ConwayGovCertPredFailure era -> DijkstraGovCertPredFailure era
conwayToDijkstraGovCertPredFailure = \case
  ConwayDRepAlreadyRegistered Credential DRepRole
c -> Credential DRepRole -> DijkstraGovCertPredFailure era
forall era. Credential DRepRole -> DijkstraGovCertPredFailure era
DijkstraDRepAlreadyRegistered Credential DRepRole
c
  ConwayDRepNotRegistered Credential DRepRole
c -> Credential DRepRole -> DijkstraGovCertPredFailure era
forall era. Credential DRepRole -> DijkstraGovCertPredFailure era
DijkstraDRepNotRegistered Credential DRepRole
c
  ConwayDRepIncorrectDeposit Mismatch RelEQ Coin
mm -> Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era
forall era. Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era
DijkstraDRepIncorrectDeposit Mismatch RelEQ Coin
mm
  ConwayCommitteeHasPreviouslyResigned Credential ColdCommitteeRole
c -> Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
forall era.
Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
DijkstraCommitteeHasPreviouslyResigned Credential ColdCommitteeRole
c
  ConwayDRepIncorrectRefund Mismatch RelEQ Coin
mm -> Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era
forall era. Mismatch RelEQ Coin -> DijkstraGovCertPredFailure era
DijkstraDRepIncorrectRefund Mismatch RelEQ Coin
mm
  ConwayCommitteeIsUnknown Credential ColdCommitteeRole
c -> Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
forall era.
Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
DijkstraCommitteeIsUnknown Credential ColdCommitteeRole
c