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

module Cardano.Ledger.Conway.Rules.GovCert (
  ConwayGOVCERT,
  ConwayGovCertPredFailure (..),
  ConwayGovCertEnv (..),
  computeDRepExpiry,
) where

import Cardano.Ledger.BaseTypes (
  EpochNo,
  Mismatch (..),
  Relation (..),
  ShelleyBase,
  StrictMaybe,
  addEpochInterval,
  strictMaybe,
 )
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.Era (ConwayEra, ConwayGOVCERT)
import Cardano.Ledger.Conway.Governance (
  Committee (..),
  GovAction (..),
  GovActionPurpose (..),
  GovActionState (..),
  GovPurposeId,
  ProposalProcedure (..),
 )
import Cardano.Ledger.Conway.State (
  ConwayEraCertState (..),
  VState (..),
  csCommitteeCredsL,
  vsCommitteeStateL,
  vsDRepsL,
  vsNumDormantEpochsL,
 )
import Cardano.Ledger.Conway.TxCert (ConwayGovCert (..))
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.DRep (DRepState (..), drepAnchorL, drepDepositL, drepExpiryL)
import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
import Cardano.Ledger.State (
  CommitteeAuthorization (..),
  CommitteeState (..),
  EraCertState (..),
  dsUnifiedL,
 )
import qualified Cardano.Ledger.UMap as UM
import Cardano.Slotting.Slot (EpochInterval, binOpEpochNo)
import Control.DeepSeq (NFData)
import Control.Monad (guard)
import Control.State.Transition.Extended (
  BaseM,
  Environment,
  Event,
  PredicateFailure,
  STS,
  Signal,
  State,
  TRC (TRC),
  TransitionRule,
  failOnJust,
  judgmentContext,
  transitionRules,
  (?!),
 )
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust)
import Data.Typeable (Typeable)
import Data.Void (Void)
import GHC.Generics (Generic)
import Lens.Micro ((%~), (&), (.~), (^.))
import NoThunks.Class (NoThunks (..))

data ConwayGovCertEnv era = ConwayGovCertEnv
  { forall era. ConwayGovCertEnv era -> PParams era
cgcePParams :: PParams era
  , forall era. ConwayGovCertEnv era -> EpochNo
cgceCurrentEpoch :: EpochNo
  -- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
  , forall era. ConwayGovCertEnv era -> StrictMaybe (Committee era)
cgceCurrentCommittee :: StrictMaybe (Committee era)
  , forall era.
ConwayGovCertEnv era
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCommitteeProposals :: Map.Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
  -- ^ All of the `UpdateCommittee` proposals
  }
  deriving ((forall x. ConwayGovCertEnv era -> Rep (ConwayGovCertEnv era) x)
-> (forall x. Rep (ConwayGovCertEnv era) x -> ConwayGovCertEnv era)
-> Generic (ConwayGovCertEnv era)
forall x. Rep (ConwayGovCertEnv era) x -> ConwayGovCertEnv era
forall x. ConwayGovCertEnv era -> Rep (ConwayGovCertEnv era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ConwayGovCertEnv era) x -> ConwayGovCertEnv era
forall era x. ConwayGovCertEnv era -> Rep (ConwayGovCertEnv era) x
$cfrom :: forall era x. ConwayGovCertEnv era -> Rep (ConwayGovCertEnv era) x
from :: forall x. ConwayGovCertEnv era -> Rep (ConwayGovCertEnv era) x
$cto :: forall era x. Rep (ConwayGovCertEnv era) x -> ConwayGovCertEnv era
to :: forall x. Rep (ConwayGovCertEnv era) x -> ConwayGovCertEnv era
Generic)

instance EraPParams era => EncCBOR (ConwayGovCertEnv era) where
  encCBOR :: ConwayGovCertEnv era -> Encoding
encCBOR x :: ConwayGovCertEnv era
x@(ConwayGovCertEnv PParams era
_ EpochNo
_ StrictMaybe (Committee era)
_ Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
_) =
    let ConwayGovCertEnv {Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
StrictMaybe (Committee era)
PParams era
EpochNo
cgcePParams :: forall era. ConwayGovCertEnv era -> PParams era
cgceCurrentEpoch :: forall era. ConwayGovCertEnv era -> EpochNo
cgceCurrentCommittee :: forall era. ConwayGovCertEnv era -> StrictMaybe (Committee era)
cgceCommitteeProposals :: forall era.
ConwayGovCertEnv era
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgcePParams :: PParams era
cgceCurrentEpoch :: EpochNo
cgceCurrentCommittee :: StrictMaybe (Committee era)
cgceCommitteeProposals :: Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
..} = ConwayGovCertEnv era
x
     in Encode ('Closed 'Dense) (ConwayGovCertEnv era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (ConwayGovCertEnv era) -> Encoding)
-> Encode ('Closed 'Dense) (ConwayGovCertEnv era) -> Encoding
forall a b. (a -> b) -> a -> b
$
          (PParams era
 -> EpochNo
 -> StrictMaybe (Committee era)
 -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
 -> ConwayGovCertEnv era)
-> Encode
     ('Closed 'Dense)
     (PParams era
      -> EpochNo
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
      -> ConwayGovCertEnv era)
forall t. t -> Encode ('Closed 'Dense) t
Rec 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
            Encode
  ('Closed 'Dense)
  (PParams era
   -> EpochNo
   -> StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   -> ConwayGovCertEnv era)
-> Encode ('Closed 'Dense) (PParams era)
-> Encode
     ('Closed 'Dense)
     (EpochNo
      -> StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
      -> ConwayGovCertEnv 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
cgcePParams
            Encode
  ('Closed 'Dense)
  (EpochNo
   -> StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   -> ConwayGovCertEnv era)
-> Encode ('Closed 'Dense) EpochNo
-> Encode
     ('Closed 'Dense)
     (StrictMaybe (Committee era)
      -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
      -> ConwayGovCertEnv 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
cgceCurrentEpoch
            Encode
  ('Closed 'Dense)
  (StrictMaybe (Committee era)
   -> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   -> ConwayGovCertEnv era)
-> Encode ('Closed 'Dense) (StrictMaybe (Committee era))
-> Encode
     ('Closed 'Dense)
     (Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
      -> ConwayGovCertEnv 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)
cgceCurrentCommittee
            Encode
  ('Closed 'Dense)
  (Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   -> ConwayGovCertEnv era)
-> Encode
     ('Closed 'Dense)
     (Map (GovPurposeId 'CommitteePurpose era) (GovActionState era))
-> Encode ('Closed 'Dense) (ConwayGovCertEnv 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)
cgceCommitteeProposals

instance EraPParams era => NFData (ConwayGovCertEnv era)

deriving instance EraPParams era => Show (ConwayGovCertEnv era)

deriving instance EraPParams era => Eq (ConwayGovCertEnv era)

data ConwayGovCertPredFailure era
  = ConwayDRepAlreadyRegistered (Credential 'DRepRole)
  | ConwayDRepNotRegistered (Credential 'DRepRole)
  | ConwayDRepIncorrectDeposit (Mismatch 'RelEQ Coin)
  | ConwayCommitteeHasPreviouslyResigned (Credential 'ColdCommitteeRole)
  | ConwayDRepIncorrectRefund (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.
    ConwayCommitteeIsUnknown (Credential 'ColdCommitteeRole)
  deriving (Int -> ConwayGovCertPredFailure era -> ShowS
[ConwayGovCertPredFailure era] -> ShowS
ConwayGovCertPredFailure era -> String
(Int -> ConwayGovCertPredFailure era -> ShowS)
-> (ConwayGovCertPredFailure era -> String)
-> ([ConwayGovCertPredFailure era] -> ShowS)
-> Show (ConwayGovCertPredFailure era)
forall era. Int -> ConwayGovCertPredFailure era -> ShowS
forall era. [ConwayGovCertPredFailure era] -> ShowS
forall era. ConwayGovCertPredFailure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ConwayGovCertPredFailure era -> ShowS
showsPrec :: Int -> ConwayGovCertPredFailure era -> ShowS
$cshow :: forall era. ConwayGovCertPredFailure era -> String
show :: ConwayGovCertPredFailure era -> String
$cshowList :: forall era. [ConwayGovCertPredFailure era] -> ShowS
showList :: [ConwayGovCertPredFailure era] -> ShowS
Show, ConwayGovCertPredFailure era
-> ConwayGovCertPredFailure era -> Bool
(ConwayGovCertPredFailure era
 -> ConwayGovCertPredFailure era -> Bool)
-> (ConwayGovCertPredFailure era
    -> ConwayGovCertPredFailure era -> Bool)
-> Eq (ConwayGovCertPredFailure era)
forall era.
ConwayGovCertPredFailure era
-> ConwayGovCertPredFailure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
ConwayGovCertPredFailure era
-> ConwayGovCertPredFailure era -> Bool
== :: ConwayGovCertPredFailure era
-> ConwayGovCertPredFailure era -> Bool
$c/= :: forall era.
ConwayGovCertPredFailure era
-> ConwayGovCertPredFailure era -> Bool
/= :: ConwayGovCertPredFailure era
-> ConwayGovCertPredFailure era -> Bool
Eq, (forall x.
 ConwayGovCertPredFailure era
 -> Rep (ConwayGovCertPredFailure era) x)
-> (forall x.
    Rep (ConwayGovCertPredFailure era) x
    -> ConwayGovCertPredFailure era)
-> Generic (ConwayGovCertPredFailure era)
forall x.
Rep (ConwayGovCertPredFailure era) x
-> ConwayGovCertPredFailure era
forall x.
ConwayGovCertPredFailure era
-> Rep (ConwayGovCertPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayGovCertPredFailure era) x
-> ConwayGovCertPredFailure era
forall era x.
ConwayGovCertPredFailure era
-> Rep (ConwayGovCertPredFailure era) x
$cfrom :: forall era x.
ConwayGovCertPredFailure era
-> Rep (ConwayGovCertPredFailure era) x
from :: forall x.
ConwayGovCertPredFailure era
-> Rep (ConwayGovCertPredFailure era) x
$cto :: forall era x.
Rep (ConwayGovCertPredFailure era) x
-> ConwayGovCertPredFailure era
to :: forall x.
Rep (ConwayGovCertPredFailure era) x
-> ConwayGovCertPredFailure era
Generic)

type instance EraRuleFailure "GOVCERT" ConwayEra = ConwayGovCertPredFailure ConwayEra

type instance EraRuleEvent "GOVCERT" ConwayEra = VoidEraRule "GOVCERT" ConwayEra

instance InjectRuleFailure "GOVCERT" ConwayGovCertPredFailure ConwayEra

instance NoThunks (ConwayGovCertPredFailure era)

instance NFData (ConwayGovCertPredFailure era)

instance Era era => EncCBOR (ConwayGovCertPredFailure era) where
  encCBOR :: ConwayGovCertPredFailure era -> Encoding
encCBOR =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode @_ @(ConwayGovCertPredFailure era) (Encode 'Open (ConwayGovCertPredFailure era) -> Encoding)
-> (ConwayGovCertPredFailure era
    -> Encode 'Open (ConwayGovCertPredFailure era))
-> ConwayGovCertPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      ConwayDRepAlreadyRegistered Credential 'DRepRole
cred -> (Credential 'DRepRole -> ConwayGovCertPredFailure era)
-> Word
-> Encode
     'Open (Credential 'DRepRole -> ConwayGovCertPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Credential 'DRepRole -> ConwayGovCertPredFailure era
forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepAlreadyRegistered Word
0 Encode 'Open (Credential 'DRepRole -> ConwayGovCertPredFailure era)
-> Encode ('Closed 'Dense) (Credential 'DRepRole)
-> Encode 'Open (ConwayGovCertPredFailure 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
      ConwayDRepNotRegistered Credential 'DRepRole
cred -> (Credential 'DRepRole -> ConwayGovCertPredFailure era)
-> Word
-> Encode
     'Open (Credential 'DRepRole -> ConwayGovCertPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Credential 'DRepRole -> ConwayGovCertPredFailure era
forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepNotRegistered Word
1 Encode 'Open (Credential 'DRepRole -> ConwayGovCertPredFailure era)
-> Encode ('Closed 'Dense) (Credential 'DRepRole)
-> Encode 'Open (ConwayGovCertPredFailure 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
      ConwayDRepIncorrectDeposit Mismatch 'RelEQ Coin
mm -> (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
-> Word
-> Encode
     'Open (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectDeposit Word
2 Encode 'Open (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
-> Encode ('Closed 'Dense) (Mismatch 'RelEQ Coin)
-> Encode 'Open (ConwayGovCertPredFailure 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. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelEQ Coin
mm
      ConwayCommitteeHasPreviouslyResigned Credential 'ColdCommitteeRole
coldCred -> (Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era)
-> Word
-> Encode
     'Open
     (Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeHasPreviouslyResigned Word
3 Encode
  'Open
  (Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era)
-> Encode ('Closed 'Dense) (Credential 'ColdCommitteeRole)
-> Encode 'Open (ConwayGovCertPredFailure 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
      ConwayDRepIncorrectRefund Mismatch 'RelEQ Coin
mm -> (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
-> Word
-> Encode
     'Open (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectRefund Word
4 Encode 'Open (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
-> Encode ('Closed 'Dense) (Mismatch 'RelEQ Coin)
-> Encode 'Open (ConwayGovCertPredFailure 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. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelEQ Coin
mm
      ConwayCommitteeIsUnknown Credential 'ColdCommitteeRole
coldCred -> (Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era)
-> Word
-> Encode
     'Open
     (Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeIsUnknown Word
5 Encode
  'Open
  (Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era)
-> Encode ('Closed 'Dense) (Credential 'ColdCommitteeRole)
-> Encode 'Open (ConwayGovCertPredFailure 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 (ConwayGovCertPredFailure era) where
  decCBOR :: forall s. Decoder s (ConwayGovCertPredFailure era)
decCBOR = Decode ('Closed 'Dense) (ConwayGovCertPredFailure era)
-> Decoder s (ConwayGovCertPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (ConwayGovCertPredFailure era)
 -> Decoder s (ConwayGovCertPredFailure era))
-> ((Word -> Decode 'Open (ConwayGovCertPredFailure era))
    -> Decode ('Closed 'Dense) (ConwayGovCertPredFailure era))
-> (Word -> Decode 'Open (ConwayGovCertPredFailure era))
-> Decoder s (ConwayGovCertPredFailure era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> (Word -> Decode 'Open (ConwayGovCertPredFailure era))
-> Decode ('Closed 'Dense) (ConwayGovCertPredFailure era)
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"ConwayGovCertPredFailure" ((Word -> Decode 'Open (ConwayGovCertPredFailure era))
 -> Decoder s (ConwayGovCertPredFailure era))
-> (Word -> Decode 'Open (ConwayGovCertPredFailure era))
-> Decoder s (ConwayGovCertPredFailure era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> (Credential 'DRepRole -> ConwayGovCertPredFailure era)
-> Decode
     'Open (Credential 'DRepRole -> ConwayGovCertPredFailure era)
forall t. t -> Decode 'Open t
SumD Credential 'DRepRole -> ConwayGovCertPredFailure era
forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepAlreadyRegistered Decode 'Open (Credential 'DRepRole -> ConwayGovCertPredFailure era)
-> Decode ('Closed Any) (Credential 'DRepRole)
-> Decode 'Open (ConwayGovCertPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Credential 'DRepRole)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> (Credential 'DRepRole -> ConwayGovCertPredFailure era)
-> Decode
     'Open (Credential 'DRepRole -> ConwayGovCertPredFailure era)
forall t. t -> Decode 'Open t
SumD Credential 'DRepRole -> ConwayGovCertPredFailure era
forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepNotRegistered Decode 'Open (Credential 'DRepRole -> ConwayGovCertPredFailure era)
-> Decode ('Closed Any) (Credential 'DRepRole)
-> Decode 'Open (ConwayGovCertPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Credential 'DRepRole)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
-> Decode
     'Open (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
forall t. t -> Decode 'Open t
SumD Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectDeposit Decode 'Open (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
-> Decode ('Closed Any) (Mismatch 'RelEQ Coin)
-> Decode 'Open (ConwayGovCertPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Mismatch 'RelEQ Coin)
forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
3 -> (Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era)
-> Decode
     'Open
     (Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era)
forall t. t -> Decode 'Open t
SumD Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeHasPreviouslyResigned Decode
  'Open
  (Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era)
-> Decode ('Closed Any) (Credential 'ColdCommitteeRole)
-> Decode 'Open (ConwayGovCertPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Credential 'ColdCommitteeRole)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
-> Decode
     'Open (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
forall t. t -> Decode 'Open t
SumD Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectRefund Decode 'Open (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
-> Decode ('Closed Any) (Mismatch 'RelEQ Coin)
-> Decode 'Open (ConwayGovCertPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Mismatch 'RelEQ Coin)
forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
5 -> (Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era)
-> Decode
     'Open
     (Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era)
forall t. t -> Decode 'Open t
SumD Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeIsUnknown Decode
  'Open
  (Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era)
-> Decode ('Closed Any) (Credential 'ColdCommitteeRole)
-> Decode 'Open (ConwayGovCertPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Credential 'ColdCommitteeRole)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> Word -> Decode 'Open (ConwayGovCertPredFailure 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
  , EraRule "GOVCERT" era ~ ConwayGOVCERT era
  , Eq (PredicateFailure (EraRule "GOVCERT" era))
  , Show (PredicateFailure (EraRule "GOVCERT" era))
  , ConwayEraCertState era
  ) =>
  STS (ConwayGOVCERT era)
  where
  type State (ConwayGOVCERT era) = CertState era
  type Signal (ConwayGOVCERT era) = ConwayGovCert
  type Environment (ConwayGOVCERT era) = ConwayGovCertEnv era
  type BaseM (ConwayGOVCERT era) = ShelleyBase
  type PredicateFailure (ConwayGOVCERT era) = ConwayGovCertPredFailure era
  type Event (ConwayGOVCERT era) = Void

  transitionRules :: [TransitionRule (ConwayGOVCERT era)]
transitionRules = [forall era.
(ConwayEraPParams era, ConwayEraCertState era) =>
TransitionRule (ConwayGOVCERT era)
conwayGovCertTransition @era]

conwayGovCertTransition ::
  ( ConwayEraPParams era
  , ConwayEraCertState era
  ) =>
  TransitionRule (ConwayGOVCERT era)
conwayGovCertTransition :: forall era.
(ConwayEraPParams era, ConwayEraCertState era) =>
TransitionRule (ConwayGOVCERT era)
conwayGovCertTransition = do
  TRC
    ( ConwayGovCertEnv {PParams era
cgcePParams :: forall era. ConwayGovCertEnv era -> PParams era
cgcePParams :: PParams era
cgcePParams, EpochNo
cgceCurrentEpoch :: forall era. ConwayGovCertEnv era -> EpochNo
cgceCurrentEpoch :: EpochNo
cgceCurrentEpoch, StrictMaybe (Committee era)
cgceCurrentCommittee :: forall era. ConwayGovCertEnv era -> StrictMaybe (Committee era)
cgceCurrentCommittee :: StrictMaybe (Committee era)
cgceCurrentCommittee, Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCommitteeProposals :: forall era.
ConwayGovCertEnv era
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCommitteeProposals :: Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCommitteeProposals}
      , State (ConwayGOVCERT era)
certState
      , Signal (ConwayGOVCERT era)
cert
      ) <-
    Rule
  (ConwayGOVCERT era)
  'Transition
  (RuleContext 'Transition (ConwayGOVCERT era))
F (Clause (ConwayGOVCERT era) 'Transition)
  (TRC (ConwayGOVCERT era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let ppDRepDeposit :: Coin
ppDRepDeposit = PParams era
cgcePParams PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppDRepDepositL
      ppDRepActivity :: EpochInterval
ppDRepActivity = PParams era
cgcePParams PParams era
-> Getting EpochInterval (PParams era) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. Getting EpochInterval (PParams era) EpochInterval
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppDRepActivityL
      checkAndOverwriteCommitteeMemberState :: Credential 'ColdCommitteeRole
-> CommitteeAuthorization
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
checkAndOverwriteCommitteeMemberState Credential 'ColdCommitteeRole
coldCred CommitteeAuthorization
newMemberState = do
        let VState {vsCommitteeState :: forall era. VState era -> CommitteeState era
vsCommitteeState = CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds} = CertState era
State (ConwayGOVCERT era)
certState CertState era
-> Getting (VState era) (CertState era) (VState era) -> VState era
forall s a. s -> Getting a s a -> a
^. Getting (VState era) (CertState era) (VState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL
            coldCredResigned :: Maybe (Credential 'ColdCommitteeRole)
coldCredResigned =
              Credential 'ColdCommitteeRole
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Maybe CommitteeAuthorization
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'ColdCommitteeRole
coldCred Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
csCommitteeCreds Maybe CommitteeAuthorization
-> (CommitteeAuthorization
    -> Maybe (Credential 'ColdCommitteeRole))
-> Maybe (Credential 'ColdCommitteeRole)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                CommitteeMemberResigned {} -> Credential 'ColdCommitteeRole
-> Maybe (Credential 'ColdCommitteeRole)
forall a. a -> Maybe a
Just Credential 'ColdCommitteeRole
coldCred
                CommitteeHotCredential {} -> Maybe (Credential 'ColdCommitteeRole)
forall a. Maybe a
Nothing
        Maybe (Credential 'ColdCommitteeRole)
-> (Credential 'ColdCommitteeRole
    -> PredicateFailure (ConwayGOVCERT era))
-> Rule (ConwayGOVCERT era) 'Transition ()
forall a sts (ctx :: RuleType).
Maybe a -> (a -> PredicateFailure sts) -> Rule sts ctx ()
failOnJust Maybe (Credential 'ColdCommitteeRole)
coldCredResigned Credential 'ColdCommitteeRole
-> PredicateFailure (ConwayGOVCERT era)
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeHasPreviouslyResigned
        let isCurrentMember :: Bool
isCurrentMember =
              Bool
-> (Committee era -> Bool) -> StrictMaybe (Committee era) -> Bool
forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe Bool
False (Credential 'ColdCommitteeRole
-> Map (Credential 'ColdCommitteeRole) EpochNo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'ColdCommitteeRole
coldCred (Map (Credential 'ColdCommitteeRole) EpochNo -> Bool)
-> (Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo)
-> Committee era
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers) StrictMaybe (Committee era)
cgceCurrentCommittee
            committeeUpdateContainsColdCred :: GovActionState era -> Bool
committeeUpdateContainsColdCred GovActionState {ProposalProcedure era
gasProposalProcedure :: ProposalProcedure era
gasProposalProcedure :: forall era. GovActionState era -> ProposalProcedure era
gasProposalProcedure} =
              case ProposalProcedure era -> GovAction era
forall era. ProposalProcedure era -> GovAction era
pProcGovAction ProposalProcedure era
gasProposalProcedure of
                UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
_ Set (Credential 'ColdCommitteeRole)
_ Map (Credential 'ColdCommitteeRole) EpochNo
newMembers UnitInterval
_ -> Credential 'ColdCommitteeRole
-> Map (Credential 'ColdCommitteeRole) EpochNo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'ColdCommitteeRole
coldCred Map (Credential 'ColdCommitteeRole) EpochNo
newMembers
                GovAction era
_ -> Bool
False
            isPotentialFutureMember :: Bool
isPotentialFutureMember =
              (GovActionState era -> Bool)
-> Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any GovActionState era -> Bool
committeeUpdateContainsColdCred Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
cgceCommitteeProposals
        Bool
isCurrentMember Bool -> Bool -> Bool
|| Bool
isPotentialFutureMember Bool
-> PredicateFailure (ConwayGOVCERT era)
-> Rule (ConwayGOVCERT era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeIsUnknown Credential 'ColdCommitteeRole
coldCred
        CertState era
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
forall a. a -> F (Clause (ConwayGOVCERT era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
          CertState era
State (ConwayGOVCERT era)
certState
            CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Identity (VState era))
 -> CertState era -> Identity (CertState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Identity
          (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> VState era -> Identity (VState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Identity
         (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommitteeState era -> Identity (CommitteeState era))
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(CommitteeState era -> f (CommitteeState era))
-> VState era -> f (VState era)
vsCommitteeStateL ((CommitteeState era -> Identity (CommitteeState era))
 -> VState era -> Identity (VState era))
-> ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
     -> Identity
          (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
    -> CommitteeState era -> Identity (CommitteeState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Identity
         (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> VState era
-> Identity (VState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
 -> Identity
      (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> CommitteeState era -> Identity (CommitteeState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
 -> f (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
-> CommitteeState era -> f (CommitteeState era)
csCommitteeCredsL ((Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
  -> Identity
       (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization))
 -> CertState era -> Identity (CertState era))
-> (Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
    -> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization)
-> CertState era
-> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential 'ColdCommitteeRole
-> CommitteeAuthorization
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'ColdCommitteeRole
coldCred CommitteeAuthorization
newMemberState
  case Signal (ConwayGOVCERT era)
cert of
    ConwayRegDRep Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
mAnchor -> do
      Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember Credential 'DRepRole
cred (CertState era
State (ConwayGOVCERT era)
certState CertState era
-> Getting
     (Map (Credential 'DRepRole) DRepState)
     (CertState era)
     (Map (Credential 'DRepRole) DRepState)
-> Map (Credential 'DRepRole) DRepState
forall s a. s -> Getting a s a -> a
^. (VState era
 -> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> CertState era
-> Const (Map (Credential 'DRepRole) DRepState) (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era
  -> Const (Map (Credential 'DRepRole) DRepState) (VState era))
 -> CertState era
 -> Const (Map (Credential 'DRepRole) DRepState) (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const
          (Map (Credential 'DRepRole) DRepState)
          (Map (Credential 'DRepRole) DRepState))
    -> VState era
    -> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> Getting
     (Map (Credential 'DRepRole) DRepState)
     (CertState era)
     (Map (Credential 'DRepRole) DRepState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
 -> Const
      (Map (Credential 'DRepRole) DRepState)
      (Map (Credential 'DRepRole) DRepState))
-> VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL) Bool
-> PredicateFailure (ConwayGOVCERT era)
-> Rule (ConwayGOVCERT era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Credential 'DRepRole -> ConwayGovCertPredFailure era
forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepAlreadyRegistered Credential 'DRepRole
cred
      Coin
deposit
        Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
ppDRepDeposit
          Bool
-> PredicateFailure (ConwayGOVCERT era)
-> Rule (ConwayGOVCERT era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectDeposit
            Mismatch
              { mismatchSupplied :: Coin
mismatchSupplied = Coin
deposit
              , mismatchExpected :: Coin
mismatchExpected = Coin
ppDRepDeposit
              }
      let drepState :: DRepState
drepState =
            DRepState
              { drepExpiry :: EpochNo
drepExpiry =
                  PParams era -> EpochNo -> EpochNo -> EpochNo
forall era.
ConwayEraPParams era =>
PParams era -> EpochNo -> EpochNo -> EpochNo
computeDRepExpiryVersioned
                    PParams era
cgcePParams
                    EpochNo
cgceCurrentEpoch
                    (CertState era
State (ConwayGOVCERT era)
certState CertState era -> Getting EpochNo (CertState era) EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. (VState era -> Const EpochNo (VState era))
-> CertState era -> Const EpochNo (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const EpochNo (VState era))
 -> CertState era -> Const EpochNo (CertState era))
-> ((EpochNo -> Const EpochNo EpochNo)
    -> VState era -> Const EpochNo (VState era))
-> Getting EpochNo (CertState era) EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochNo -> Const EpochNo EpochNo)
-> VState era -> Const EpochNo (VState era)
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo) -> VState era -> f (VState era)
vsNumDormantEpochsL)
              , drepAnchor :: StrictMaybe Anchor
drepAnchor = StrictMaybe Anchor
mAnchor
              , drepDeposit :: Coin
drepDeposit = Coin
ppDRepDeposit
              , drepDelegs :: Set (Credential 'Staking)
drepDelegs = Set (Credential 'Staking)
forall a. Monoid a => a
mempty
              }
      CertState era
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
forall a. a -> F (Clause (ConwayGOVCERT era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
        CertState era
State (ConwayGOVCERT era)
certState
          CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Identity (VState era))
 -> CertState era -> Identity (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Identity (Map (Credential 'DRepRole) DRepState))
    -> VState era -> Identity (VState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Identity (Map (Credential 'DRepRole) DRepState))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
 -> Identity (Map (Credential 'DRepRole) DRepState))
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL ((Map (Credential 'DRepRole) DRepState
  -> Identity (Map (Credential 'DRepRole) DRepState))
 -> CertState era -> Identity (CertState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Map (Credential 'DRepRole) DRepState)
-> CertState era
-> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential 'DRepRole
-> DRepState
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'DRepRole
cred DRepState
drepState
    ConwayUnRegDRep Credential 'DRepRole
cred Coin
refund -> do
      let mDRepState :: Maybe DRepState
mDRepState = Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Maybe DRepState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
cred (CertState era
State (ConwayGOVCERT era)
certState CertState era
-> Getting
     (Map (Credential 'DRepRole) DRepState)
     (CertState era)
     (Map (Credential 'DRepRole) DRepState)
-> Map (Credential 'DRepRole) DRepState
forall s a. s -> Getting a s a -> a
^. (VState era
 -> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> CertState era
-> Const (Map (Credential 'DRepRole) DRepState) (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era
  -> Const (Map (Credential 'DRepRole) DRepState) (VState era))
 -> CertState era
 -> Const (Map (Credential 'DRepRole) DRepState) (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const
          (Map (Credential 'DRepRole) DRepState)
          (Map (Credential 'DRepRole) DRepState))
    -> VState era
    -> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> Getting
     (Map (Credential 'DRepRole) DRepState)
     (CertState era)
     (Map (Credential 'DRepRole) DRepState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
 -> Const
      (Map (Credential 'DRepRole) DRepState)
      (Map (Credential 'DRepRole) DRepState))
-> VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL)
          drepRefundMismatch :: Maybe Coin
drepRefundMismatch = do
            DRepState
drepState <- Maybe DRepState
mDRepState
            let paidDeposit :: Coin
paidDeposit = DRepState
drepState DRepState -> Getting Coin DRepState Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin DRepState Coin
Lens' DRepState Coin
drepDepositL
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Coin
refund Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
/= Coin
paidDeposit)
            Coin -> Maybe Coin
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Coin
paidDeposit
      Maybe DRepState -> Bool
forall a. Maybe a -> Bool
isJust Maybe DRepState
mDRepState Bool
-> PredicateFailure (ConwayGOVCERT era)
-> Rule (ConwayGOVCERT era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Credential 'DRepRole -> ConwayGovCertPredFailure era
forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepNotRegistered Credential 'DRepRole
cred
      Maybe Coin
-> (Coin -> PredicateFailure (ConwayGOVCERT era))
-> Rule (ConwayGOVCERT era) 'Transition ()
forall a sts (ctx :: RuleType).
Maybe a -> (a -> PredicateFailure sts) -> Rule sts ctx ()
failOnJust Maybe Coin
drepRefundMismatch ((Coin -> PredicateFailure (ConwayGOVCERT era))
 -> Rule (ConwayGOVCERT era) 'Transition ())
-> (Coin -> PredicateFailure (ConwayGOVCERT era))
-> Rule (ConwayGOVCERT era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectRefund (Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era)
-> (Coin -> Mismatch 'RelEQ Coin)
-> Coin
-> ConwayGovCertPredFailure era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Coin -> Mismatch 'RelEQ Coin
forall (r :: Relation) a. a -> a -> Mismatch r a
Mismatch Coin
refund
      let
        certState' :: CertState era
certState' =
          CertState era
State (ConwayGOVCERT era)
certState CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Identity (VState era))
 -> CertState era -> Identity (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Identity (Map (Credential 'DRepRole) DRepState))
    -> VState era -> Identity (VState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Identity (Map (Credential 'DRepRole) DRepState))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
 -> Identity (Map (Credential 'DRepRole) DRepState))
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL ((Map (Credential 'DRepRole) DRepState
  -> Identity (Map (Credential 'DRepRole) DRepState))
 -> CertState era -> Identity (CertState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Map (Credential 'DRepRole) DRepState)
-> CertState era
-> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Credential 'DRepRole
cred
      CertState era
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
forall a. a -> F (Clause (ConwayGOVCERT era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
        case Maybe DRepState
mDRepState of
          Maybe DRepState
Nothing -> CertState era
certState'
          Just DRepState
dRepState ->
            CertState era
certState'
              CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (DState era -> Identity (DState era))
-> CertState era -> Identity (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Identity (DState era))
 -> CertState era -> Identity (CertState era))
-> ((UMap -> Identity UMap) -> DState era -> Identity (DState era))
-> (UMap -> Identity UMap)
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMap -> Identity UMap) -> DState era -> Identity (DState era)
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL
                ((UMap -> Identity UMap)
 -> CertState era -> Identity (CertState era))
-> UMap -> CertState era -> CertState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DRepState -> Set (Credential 'Staking)
drepDelegs DRepState
dRepState Set (Credential 'Staking)
-> UView (Credential 'Staking) DRep -> UMap
forall k v. Set k -> UView k v -> UMap
UM.⋪ UMap -> UView (Credential 'Staking) DRep
UM.DRepUView (CertState era
State (ConwayGOVCERT era)
certState CertState era -> Getting UMap (CertState era) UMap -> UMap
forall s a. s -> Getting a s a -> a
^. (DState era -> Const UMap (DState era))
-> CertState era -> Const UMap (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const UMap (DState era))
 -> CertState era -> Const UMap (CertState era))
-> ((UMap -> Const UMap UMap)
    -> DState era -> Const UMap (DState era))
-> Getting UMap (CertState era) UMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMap -> Const UMap UMap) -> DState era -> Const UMap (DState era)
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL)
    -- Update a DRep expiry along with its anchor.
    ConwayUpdateDRep Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor -> do
      Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'DRepRole
cred (CertState era
State (ConwayGOVCERT era)
certState CertState era
-> Getting
     (Map (Credential 'DRepRole) DRepState)
     (CertState era)
     (Map (Credential 'DRepRole) DRepState)
-> Map (Credential 'DRepRole) DRepState
forall s a. s -> Getting a s a -> a
^. (VState era
 -> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> CertState era
-> Const (Map (Credential 'DRepRole) DRepState) (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era
  -> Const (Map (Credential 'DRepRole) DRepState) (VState era))
 -> CertState era
 -> Const (Map (Credential 'DRepRole) DRepState) (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const
          (Map (Credential 'DRepRole) DRepState)
          (Map (Credential 'DRepRole) DRepState))
    -> VState era
    -> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> Getting
     (Map (Credential 'DRepRole) DRepState)
     (CertState era)
     (Map (Credential 'DRepRole) DRepState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
 -> Const
      (Map (Credential 'DRepRole) DRepState)
      (Map (Credential 'DRepRole) DRepState))
-> VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL) Bool
-> PredicateFailure (ConwayGOVCERT era)
-> Rule (ConwayGOVCERT era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Credential 'DRepRole -> ConwayGovCertPredFailure era
forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepNotRegistered Credential 'DRepRole
cred
      CertState era
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
forall a. a -> F (Clause (ConwayGOVCERT era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CertState era
 -> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era))
-> CertState era
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$
        CertState era
State (ConwayGOVCERT era)
certState
          CertState era -> (CertState era -> CertState era) -> CertState era
forall a b. a -> (a -> b) -> b
& (VState era -> Identity (VState era))
-> CertState era -> Identity (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Identity (VState era))
 -> CertState era -> Identity (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Identity (Map (Credential 'DRepRole) DRepState))
    -> VState era -> Identity (VState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Identity (Map (Credential 'DRepRole) DRepState))
-> CertState era
-> Identity (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
 -> Identity (Map (Credential 'DRepRole) DRepState))
-> VState era -> Identity (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL
            ((Map (Credential 'DRepRole) DRepState
  -> Identity (Map (Credential 'DRepRole) DRepState))
 -> CertState era -> Identity (CertState era))
-> (Map (Credential 'DRepRole) DRepState
    -> Map (Credential 'DRepRole) DRepState)
-> CertState era
-> CertState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ( (DRepState -> DRepState)
-> Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust
                   ( \DRepState
drepState ->
                       DRepState
drepState
                         DRepState -> (DRepState -> DRepState) -> DRepState
forall a b. a -> (a -> b) -> b
& (EpochNo -> Identity EpochNo) -> DRepState -> Identity DRepState
Lens' DRepState EpochNo
drepExpiryL
                           ((EpochNo -> Identity EpochNo) -> DRepState -> Identity DRepState)
-> EpochNo -> DRepState -> DRepState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval -> EpochNo -> EpochNo -> EpochNo
computeDRepExpiry
                             EpochInterval
ppDRepActivity
                             EpochNo
cgceCurrentEpoch
                             (CertState era
State (ConwayGOVCERT era)
certState CertState era -> Getting EpochNo (CertState era) EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. (VState era -> Const EpochNo (VState era))
-> CertState era -> Const EpochNo (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era -> Const EpochNo (VState era))
 -> CertState era -> Const EpochNo (CertState era))
-> ((EpochNo -> Const EpochNo EpochNo)
    -> VState era -> Const EpochNo (VState era))
-> Getting EpochNo (CertState era) EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpochNo -> Const EpochNo EpochNo)
-> VState era -> Const EpochNo (VState era)
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo) -> VState era -> f (VState era)
vsNumDormantEpochsL)
                         DRepState -> (DRepState -> DRepState) -> DRepState
forall a b. a -> (a -> b) -> b
& (StrictMaybe Anchor -> Identity (StrictMaybe Anchor))
-> DRepState -> Identity DRepState
Lens' DRepState (StrictMaybe Anchor)
drepAnchorL ((StrictMaybe Anchor -> Identity (StrictMaybe Anchor))
 -> DRepState -> Identity DRepState)
-> StrictMaybe Anchor -> DRepState -> DRepState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Anchor
mAnchor
                   )
                   Credential 'DRepRole
cred
               )
    ConwayAuthCommitteeHotKey Credential 'ColdCommitteeRole
coldCred Credential 'HotCommitteeRole
hotCred ->
      Credential 'ColdCommitteeRole
-> CommitteeAuthorization
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
checkAndOverwriteCommitteeMemberState Credential 'ColdCommitteeRole
coldCred (CommitteeAuthorization
 -> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era))
-> CommitteeAuthorization
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$ Credential 'HotCommitteeRole -> CommitteeAuthorization
CommitteeHotCredential Credential 'HotCommitteeRole
hotCred
    ConwayResignCommitteeColdKey Credential 'ColdCommitteeRole
coldCred StrictMaybe Anchor
anchor ->
      Credential 'ColdCommitteeRole
-> CommitteeAuthorization
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
checkAndOverwriteCommitteeMemberState Credential 'ColdCommitteeRole
coldCred (CommitteeAuthorization
 -> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era))
-> CommitteeAuthorization
-> F (Clause (ConwayGOVCERT era) 'Transition) (CertState era)
forall a b. (a -> b) -> a -> b
$ StrictMaybe Anchor -> CommitteeAuthorization
CommitteeMemberResigned StrictMaybe Anchor
anchor

computeDRepExpiryVersioned ::
  ConwayEraPParams era =>
  PParams era ->
  -- | Current epoch
  EpochNo ->
  -- | The count of the dormant epochs
  EpochNo ->
  EpochNo
computeDRepExpiryVersioned :: forall era.
ConwayEraPParams era =>
PParams era -> EpochNo -> EpochNo -> EpochNo
computeDRepExpiryVersioned PParams era
pp EpochNo
currentEpoch EpochNo
numDormantEpochs
  -- Starting with version 10, we correctly take into account the number of dormant epochs
  -- when registering a drep
  | ProtVer -> Bool
HF.bootstrapPhase (PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL) =
      EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch (PParams era
pp PParams era
-> Getting EpochInterval (PParams era) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. Getting EpochInterval (PParams era) EpochInterval
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppDRepActivityL)
  | Bool
otherwise =
      EpochInterval -> EpochNo -> EpochNo -> EpochNo
computeDRepExpiry (PParams era
pp PParams era
-> Getting EpochInterval (PParams era) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. Getting EpochInterval (PParams era) EpochInterval
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppDRepActivityL) EpochNo
currentEpoch EpochNo
numDormantEpochs

computeDRepExpiry ::
  -- | DRepActivity PParam
  EpochInterval ->
  -- | Current epoch
  EpochNo ->
  -- | The count of the dormant epochs
  EpochNo ->
  -- | Computed expiry
  EpochNo
computeDRepExpiry :: EpochInterval -> EpochNo -> EpochNo -> EpochNo
computeDRepExpiry EpochInterval
ppDRepActivity EpochNo
currentEpoch =
  (Word64 -> Word64 -> Word64) -> EpochNo -> EpochNo -> EpochNo
binOpEpochNo
    (-)
    (EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
currentEpoch EpochInterval
ppDRepActivity)