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

module Cardano.Ledger.Conway.Rules.Gov (
  ConwayGOV,
  GovEnv (..),
  GovSignal (..),
  ConwayGovEvent (..),
  ConwayGovPredFailure (..),
  unelectedCommitteeVoters,
) where

import Cardano.Ledger.Address (RewardAccount, raCredential, raNetwork)
import Cardano.Ledger.BaseTypes (
  EpochInterval (..),
  EpochNo (..),
  Mismatch (..),
  Network,
  ProtVer,
  Relation (..),
  ShelleyBase,
  StrictMaybe (SJust),
  addEpochInterval,
  networkId,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  internMap,
  internSet,
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core (ppGovActionDepositL, ppGovActionLifetimeL)
import Cardano.Ledger.Conway.Era (
  ConwayEra,
  ConwayGOV,
  hardforkConwayBootstrapPhase,
  hardforkConwayDisallowUnelectedCommitteeFromVoting,
 )
import Cardano.Ledger.Conway.Governance (
  Committee,
  ConwayEraGov,
  GovAction (..),
  GovActionId (..),
  GovActionPurpose (..),
  GovActionState (..),
  GovPurposeId (..),
  GovRelation (..),
  ProposalProcedure (..),
  Proposals,
  Voter (..),
  VotingProcedure (..),
  VotingProcedures (..),
  authorizedElectedHotCommitteeCredentials,
  foldrVotingProcedures,
  gasAction,
  gasDRepVotesL,
  grHardForkL,
  indexedGovProps,
  isCommitteeVotingAllowed,
  isDRepVotingAllowed,
  isStakePoolVotingAllowed,
  pProcGovActionL,
  pProcReturnAddrL,
  pRootsL,
  proposalsActionsMap,
  proposalsAddAction,
  proposalsAddVote,
  proposalsLookupId,
  toPrevGovActionIds,
 )
import Cardano.Ledger.Conway.Governance.Proposals (mapProposals)
import Cardano.Ledger.Conway.PParams (ConwayEraPParams (..))
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Conway.TxCert
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Rules.ValidationMode (Test, runTest)
import Cardano.Ledger.Shelley.PParams (pvCanFollow)
import Cardano.Ledger.TxIn (TxId (..))
import Control.DeepSeq (NFData)
import Control.Monad (unless, when)
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition.Extended (
  STS (..),
  TRC (..),
  TransitionRule,
  failBecause,
  failOnJust,
  failOnNonEmpty,
  failureOnNonEmpty,
  judgmentContext,
  liftSTS,
  tellEvent,
  (?!),
 )
import Data.Bifunctor (bimap)
import Data.Either (partitionEithers)
import qualified Data.Foldable as F
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map.Strict as Map
import qualified Data.OSet.Strict as OSet
import Data.Pulse (foldlM')
import qualified Data.Sequence.Strict as SSeq
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Generics (Generic)
import Lens.Micro
import qualified Lens.Micro as L
import NoThunks.Class (NoThunks (..))
import Validation (failureUnless)

data GovEnv era = GovEnv
  { forall era. GovEnv era -> TxId
geTxId :: TxId
  , forall era. GovEnv era -> EpochNo
geEpoch :: EpochNo
  , forall era. GovEnv era -> PParams era
gePParams :: PParams era
  , forall era. GovEnv era -> StrictMaybe ScriptHash
gePPolicy :: StrictMaybe ScriptHash
  , forall era. GovEnv era -> CertState era
geCertState :: CertState era
  , forall era. GovEnv era -> StrictMaybe (Committee era)
geCommittee :: StrictMaybe (Committee era)
  }
  deriving ((forall x. GovEnv era -> Rep (GovEnv era) x)
-> (forall x. Rep (GovEnv era) x -> GovEnv era)
-> Generic (GovEnv era)
forall x. Rep (GovEnv era) x -> GovEnv era
forall x. GovEnv era -> Rep (GovEnv era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (GovEnv era) x -> GovEnv era
forall era x. GovEnv era -> Rep (GovEnv era) x
$cfrom :: forall era x. GovEnv era -> Rep (GovEnv era) x
from :: forall x. GovEnv era -> Rep (GovEnv era) x
$cto :: forall era x. Rep (GovEnv era) x -> GovEnv era
to :: forall x. Rep (GovEnv era) x -> GovEnv era
Generic)

instance (EraGov era, EraPParams era, EraCertState era) => EncCBOR (GovEnv era) where
  encCBOR :: GovEnv era -> Encoding
encCBOR x :: GovEnv era
x@(GovEnv TxId
_ EpochNo
_ PParams era
_ StrictMaybe ScriptHash
_ CertState era
_ StrictMaybe (Committee era)
_) =
    let GovEnv {StrictMaybe ScriptHash
StrictMaybe (Committee era)
PParams era
CertState era
EpochNo
TxId
geTxId :: forall era. GovEnv era -> TxId
geEpoch :: forall era. GovEnv era -> EpochNo
gePParams :: forall era. GovEnv era -> PParams era
gePPolicy :: forall era. GovEnv era -> StrictMaybe ScriptHash
geCertState :: forall era. GovEnv era -> CertState era
geCommittee :: forall era. GovEnv era -> StrictMaybe (Committee era)
geTxId :: TxId
geEpoch :: EpochNo
gePParams :: PParams era
gePPolicy :: StrictMaybe ScriptHash
geCertState :: CertState era
geCommittee :: StrictMaybe (Committee era)
..} = GovEnv era
x
     in Encode (Closed Dense) (GovEnv era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode (Closed Dense) (GovEnv era) -> Encoding)
-> Encode (Closed Dense) (GovEnv era) -> Encoding
forall a b. (a -> b) -> a -> b
$
          (TxId
 -> EpochNo
 -> PParams era
 -> StrictMaybe ScriptHash
 -> CertState era
 -> StrictMaybe (Committee era)
 -> GovEnv era)
-> Encode
     (Closed Dense)
     (TxId
      -> EpochNo
      -> PParams era
      -> StrictMaybe ScriptHash
      -> CertState era
      -> StrictMaybe (Committee era)
      -> GovEnv era)
forall t. t -> Encode (Closed Dense) t
Rec TxId
-> EpochNo
-> PParams era
-> StrictMaybe ScriptHash
-> CertState era
-> StrictMaybe (Committee era)
-> GovEnv era
forall era.
TxId
-> EpochNo
-> PParams era
-> StrictMaybe ScriptHash
-> CertState era
-> StrictMaybe (Committee era)
-> GovEnv era
GovEnv
            Encode
  (Closed Dense)
  (TxId
   -> EpochNo
   -> PParams era
   -> StrictMaybe ScriptHash
   -> CertState era
   -> StrictMaybe (Committee era)
   -> GovEnv era)
-> Encode (Closed Dense) TxId
-> Encode
     (Closed Dense)
     (EpochNo
      -> PParams era
      -> StrictMaybe ScriptHash
      -> CertState era
      -> StrictMaybe (Committee era)
      -> GovEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> TxId -> Encode (Closed Dense) TxId
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To TxId
geTxId
            Encode
  (Closed Dense)
  (EpochNo
   -> PParams era
   -> StrictMaybe ScriptHash
   -> CertState era
   -> StrictMaybe (Committee era)
   -> GovEnv era)
-> Encode (Closed Dense) EpochNo
-> Encode
     (Closed Dense)
     (PParams era
      -> StrictMaybe ScriptHash
      -> CertState era
      -> StrictMaybe (Committee era)
      -> GovEnv 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
geEpoch
            Encode
  (Closed Dense)
  (PParams era
   -> StrictMaybe ScriptHash
   -> CertState era
   -> StrictMaybe (Committee era)
   -> GovEnv era)
-> Encode (Closed Dense) (PParams era)
-> Encode
     (Closed Dense)
     (StrictMaybe ScriptHash
      -> CertState era -> StrictMaybe (Committee era) -> GovEnv 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
gePParams
            Encode
  (Closed Dense)
  (StrictMaybe ScriptHash
   -> CertState era -> StrictMaybe (Committee era) -> GovEnv era)
-> Encode (Closed Dense) (StrictMaybe ScriptHash)
-> Encode
     (Closed Dense)
     (CertState era -> StrictMaybe (Committee era) -> GovEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> StrictMaybe ScriptHash
-> Encode (Closed Dense) (StrictMaybe ScriptHash)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To StrictMaybe ScriptHash
gePPolicy
            Encode
  (Closed Dense)
  (CertState era -> StrictMaybe (Committee era) -> GovEnv era)
-> Encode (Closed Dense) (CertState era)
-> Encode
     (Closed Dense) (StrictMaybe (Committee era) -> GovEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> CertState era -> Encode (Closed Dense) (CertState era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To CertState era
geCertState
            Encode (Closed Dense) (StrictMaybe (Committee era) -> GovEnv era)
-> Encode (Closed Dense) (StrictMaybe (Committee era))
-> Encode (Closed Dense) (GovEnv 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)
geCommittee

instance (NFData (PParams era), Era era, EraCertState era) => NFData (GovEnv era)

deriving instance (Show (PParams era), Era era, EraCertState era) => Show (GovEnv era)

deriving instance (Eq (PParams era), EraCertState era) => Eq (GovEnv era)

data ConwayGovPredFailure era
  = GovActionsDoNotExist (NonEmpty GovActionId)
  | MalformedProposal (GovAction era)
  | ProposalProcedureNetworkIdMismatch RewardAccount Network
  | TreasuryWithdrawalsNetworkIdMismatch (Set.Set RewardAccount) Network
  | ProposalDepositIncorrect (Mismatch RelEQ Coin)
  | -- | Some governance actions are not allowed to be voted on by certain types of
    -- Voters. This failure lists all governance action ids with their respective voters
    -- that are not allowed to vote on those governance actions.
    DisallowedVoters (NonEmpty (Voter, GovActionId))
  | ConflictingCommitteeUpdate
      -- | Credentials that are mentioned as members to be both removed and added
      (Set.Set (Credential ColdCommitteeRole))
  | ExpirationEpochTooSmall
      -- | Members for which the expiration epoch has already been reached
      (Map.Map (Credential ColdCommitteeRole) EpochNo)
  | InvalidPrevGovActionId (ProposalProcedure era)
  | VotingOnExpiredGovAction (NonEmpty (Voter, GovActionId))
  | ProposalCantFollow
      -- | The PrevGovActionId of the HardForkInitiation that fails
      (StrictMaybe (GovPurposeId 'HardForkPurpose))
      -- | Its protocol version and the protocal version of the previous gov-action pointed to by the proposal
      (Mismatch RelGT ProtVer)
  | InvalidPolicyHash
      -- | The policy script hash in the proposal
      (StrictMaybe ScriptHash)
      -- | The policy script hash of the current constitution
      (StrictMaybe ScriptHash)
  | DisallowedProposalDuringBootstrap (ProposalProcedure era)
  | DisallowedVotesDuringBootstrap
      (NonEmpty (Voter, GovActionId))
  | -- | Predicate failure for votes by entities that are not present in the ledger state
    VotersDoNotExist (NonEmpty Voter)
  | -- | Treasury withdrawals that sum up to zero are not allowed
    ZeroTreasuryWithdrawals (GovAction era)
  | -- | Proposals that have an invalid reward account for returns of the deposit
    ProposalReturnAccountDoesNotExist RewardAccount
  | -- | Treasury withdrawal proposals to an invalid reward account
    TreasuryWithdrawalReturnAccountsDoNotExist (NonEmpty RewardAccount)
  | -- | Disallow votes by unelected committee members
    UnelectedCommitteeVoters (NonEmpty (Credential HotCommitteeRole))
  deriving (ConwayGovPredFailure era -> ConwayGovPredFailure era -> Bool
(ConwayGovPredFailure era -> ConwayGovPredFailure era -> Bool)
-> (ConwayGovPredFailure era -> ConwayGovPredFailure era -> Bool)
-> Eq (ConwayGovPredFailure era)
forall era.
EraPParams era =>
ConwayGovPredFailure era -> ConwayGovPredFailure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
EraPParams era =>
ConwayGovPredFailure era -> ConwayGovPredFailure era -> Bool
== :: ConwayGovPredFailure era -> ConwayGovPredFailure era -> Bool
$c/= :: forall era.
EraPParams era =>
ConwayGovPredFailure era -> ConwayGovPredFailure era -> Bool
/= :: ConwayGovPredFailure era -> ConwayGovPredFailure era -> Bool
Eq, Int -> ConwayGovPredFailure era -> ShowS
[ConwayGovPredFailure era] -> ShowS
ConwayGovPredFailure era -> String
(Int -> ConwayGovPredFailure era -> ShowS)
-> (ConwayGovPredFailure era -> String)
-> ([ConwayGovPredFailure era] -> ShowS)
-> Show (ConwayGovPredFailure era)
forall era.
EraPParams era =>
Int -> ConwayGovPredFailure era -> ShowS
forall era. EraPParams era => [ConwayGovPredFailure era] -> ShowS
forall era. EraPParams era => ConwayGovPredFailure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era.
EraPParams era =>
Int -> ConwayGovPredFailure era -> ShowS
showsPrec :: Int -> ConwayGovPredFailure era -> ShowS
$cshow :: forall era. EraPParams era => ConwayGovPredFailure era -> String
show :: ConwayGovPredFailure era -> String
$cshowList :: forall era. EraPParams era => [ConwayGovPredFailure era] -> ShowS
showList :: [ConwayGovPredFailure era] -> ShowS
Show, (forall x.
 ConwayGovPredFailure era -> Rep (ConwayGovPredFailure era) x)
-> (forall x.
    Rep (ConwayGovPredFailure era) x -> ConwayGovPredFailure era)
-> Generic (ConwayGovPredFailure era)
forall x.
Rep (ConwayGovPredFailure era) x -> ConwayGovPredFailure era
forall x.
ConwayGovPredFailure era -> Rep (ConwayGovPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayGovPredFailure era) x -> ConwayGovPredFailure era
forall era x.
ConwayGovPredFailure era -> Rep (ConwayGovPredFailure era) x
$cfrom :: forall era x.
ConwayGovPredFailure era -> Rep (ConwayGovPredFailure era) x
from :: forall x.
ConwayGovPredFailure era -> Rep (ConwayGovPredFailure era) x
$cto :: forall era x.
Rep (ConwayGovPredFailure era) x -> ConwayGovPredFailure era
to :: forall x.
Rep (ConwayGovPredFailure era) x -> ConwayGovPredFailure era
Generic)

type instance EraRuleFailure "GOV" ConwayEra = ConwayGovPredFailure ConwayEra

type instance EraRuleEvent "GOV" ConwayEra = ConwayGovEvent ConwayEra

instance InjectRuleFailure "GOV" ConwayGovPredFailure ConwayEra

instance EraPParams era => NFData (ConwayGovPredFailure era)

instance EraPParams era => NoThunks (ConwayGovPredFailure era)

instance EraPParams era => DecCBOR (ConwayGovPredFailure era) where
  decCBOR :: forall s. Decoder s (ConwayGovPredFailure era)
decCBOR = Decode (Closed Dense) (ConwayGovPredFailure era)
-> Decoder s (ConwayGovPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) (ConwayGovPredFailure era)
 -> Decoder s (ConwayGovPredFailure era))
-> Decode (Closed Dense) (ConwayGovPredFailure era)
-> Decoder s (ConwayGovPredFailure era)
forall a b. (a -> b) -> a -> b
$ Text
-> (Word -> Decode Open (ConwayGovPredFailure era))
-> Decode (Closed Dense) (ConwayGovPredFailure era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"ConwayGovPredFailure" ((Word -> Decode Open (ConwayGovPredFailure era))
 -> Decode (Closed Dense) (ConwayGovPredFailure era))
-> (Word -> Decode Open (ConwayGovPredFailure era))
-> Decode (Closed Dense) (ConwayGovPredFailure era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> (NonEmpty GovActionId -> ConwayGovPredFailure era)
-> Decode Open (NonEmpty GovActionId -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD NonEmpty GovActionId -> ConwayGovPredFailure era
forall era. NonEmpty GovActionId -> ConwayGovPredFailure era
GovActionsDoNotExist Decode Open (NonEmpty GovActionId -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 0)) (NonEmpty GovActionId)
-> Decode Open (ConwayGovPredFailure 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)) (NonEmpty GovActionId)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> (GovAction era -> ConwayGovPredFailure era)
-> Decode Open (GovAction era -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD GovAction era -> ConwayGovPredFailure era
forall era. GovAction era -> ConwayGovPredFailure era
MalformedProposal Decode Open (GovAction era -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 1)) (GovAction era)
-> Decode Open (ConwayGovPredFailure 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)) (GovAction era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> (RewardAccount -> Network -> ConwayGovPredFailure era)
-> Decode
     Open (RewardAccount -> Network -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD RewardAccount -> Network -> ConwayGovPredFailure era
forall era. RewardAccount -> Network -> ConwayGovPredFailure era
ProposalProcedureNetworkIdMismatch Decode Open (RewardAccount -> Network -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 3)) RewardAccount
-> Decode Open (Network -> ConwayGovPredFailure 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)) RewardAccount
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (Network -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 2)) Network
-> Decode Open (ConwayGovPredFailure 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)) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
3 -> (Set RewardAccount -> Network -> ConwayGovPredFailure era)
-> Decode
     Open (Set RewardAccount -> Network -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD Set RewardAccount -> Network -> ConwayGovPredFailure era
forall era.
Set RewardAccount -> Network -> ConwayGovPredFailure era
TreasuryWithdrawalsNetworkIdMismatch Decode
  Open (Set RewardAccount -> Network -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 5)) (Set RewardAccount)
-> Decode Open (Network -> ConwayGovPredFailure 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)) (Set RewardAccount)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (Network -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 4)) Network
-> Decode Open (ConwayGovPredFailure 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)) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> (Mismatch RelEQ Coin -> ConwayGovPredFailure era)
-> Decode Open (Mismatch RelEQ Coin -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD Mismatch RelEQ Coin -> ConwayGovPredFailure era
forall era. Mismatch RelEQ Coin -> ConwayGovPredFailure era
ProposalDepositIncorrect Decode Open (Mismatch RelEQ Coin -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 6)) (Mismatch RelEQ Coin)
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 6)) (Mismatch RelEQ Coin)
forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
5 -> (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Decode
     Open (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVoters Decode
  Open (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 7)) (NonEmpty (Voter, GovActionId))
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 7)) (NonEmpty (Voter, GovActionId))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
6 -> (Set (Credential ColdCommitteeRole) -> ConwayGovPredFailure era)
-> Decode
     Open
     (Set (Credential ColdCommitteeRole) -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD Set (Credential ColdCommitteeRole) -> ConwayGovPredFailure era
forall era.
Set (Credential ColdCommitteeRole) -> ConwayGovPredFailure era
ConflictingCommitteeUpdate Decode
  Open
  (Set (Credential ColdCommitteeRole) -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 8)) (Set (Credential ColdCommitteeRole))
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 8)) (Set (Credential ColdCommitteeRole))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
7 -> (Map (Credential ColdCommitteeRole) EpochNo
 -> ConwayGovPredFailure era)
-> Decode
     Open
     (Map (Credential ColdCommitteeRole) EpochNo
      -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD Map (Credential ColdCommitteeRole) EpochNo
-> ConwayGovPredFailure era
forall era.
Map (Credential ColdCommitteeRole) EpochNo
-> ConwayGovPredFailure era
ExpirationEpochTooSmall Decode
  Open
  (Map (Credential ColdCommitteeRole) EpochNo
   -> ConwayGovPredFailure era)
-> Decode
     (Closed (ZonkAny 9)) (Map (Credential ColdCommitteeRole) EpochNo)
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
  (Closed (ZonkAny 9)) (Map (Credential ColdCommitteeRole) EpochNo)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
8 -> (ProposalProcedure era -> ConwayGovPredFailure era)
-> Decode Open (ProposalProcedure era -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
InvalidPrevGovActionId Decode Open (ProposalProcedure era -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 10)) (ProposalProcedure era)
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 10)) (ProposalProcedure era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
9 -> (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Decode
     Open (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
VotingOnExpiredGovAction Decode
  Open (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 11)) (NonEmpty (Voter, GovActionId))
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 11)) (NonEmpty (Voter, GovActionId))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
10 -> (StrictMaybe (GovPurposeId 'HardForkPurpose)
 -> Mismatch RelGT ProtVer -> ConwayGovPredFailure era)
-> Decode
     Open
     (StrictMaybe (GovPurposeId 'HardForkPurpose)
      -> Mismatch RelGT ProtVer -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD StrictMaybe (GovPurposeId 'HardForkPurpose)
-> Mismatch RelGT ProtVer -> ConwayGovPredFailure era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose)
-> Mismatch RelGT ProtVer -> ConwayGovPredFailure era
ProposalCantFollow Decode
  Open
  (StrictMaybe (GovPurposeId 'HardForkPurpose)
   -> Mismatch RelGT ProtVer -> ConwayGovPredFailure era)
-> Decode
     (Closed (ZonkAny 13)) (StrictMaybe (GovPurposeId 'HardForkPurpose))
-> Decode Open (Mismatch RelGT ProtVer -> ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
  (Closed (ZonkAny 13)) (StrictMaybe (GovPurposeId 'HardForkPurpose))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (Mismatch RelGT ProtVer -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 12)) (Mismatch RelGT ProtVer)
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 12)) (Mismatch RelGT ProtVer)
forall t (w :: Wrapped).
(EncCBORGroup t, DecCBORGroup t) =>
Decode w t
FromGroup
    Word
11 -> (StrictMaybe ScriptHash
 -> StrictMaybe ScriptHash -> ConwayGovPredFailure era)
-> Decode
     Open
     (StrictMaybe ScriptHash
      -> StrictMaybe ScriptHash -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> ConwayGovPredFailure era
forall era.
StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> ConwayGovPredFailure era
InvalidPolicyHash Decode
  Open
  (StrictMaybe ScriptHash
   -> StrictMaybe ScriptHash -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 15)) (StrictMaybe ScriptHash)
-> Decode Open (StrictMaybe ScriptHash -> ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 15)) (StrictMaybe ScriptHash)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode Open (StrictMaybe ScriptHash -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 14)) (StrictMaybe ScriptHash)
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 14)) (StrictMaybe ScriptHash)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
12 -> (ProposalProcedure era -> ConwayGovPredFailure era)
-> Decode Open (ProposalProcedure era -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap Decode Open (ProposalProcedure era -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 16)) (ProposalProcedure era)
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 16)) (ProposalProcedure era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
13 -> (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Decode
     Open (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVotesDuringBootstrap Decode
  Open (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 17)) (NonEmpty (Voter, GovActionId))
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 17)) (NonEmpty (Voter, GovActionId))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
14 -> (NonEmpty Voter -> ConwayGovPredFailure era)
-> Decode Open (NonEmpty Voter -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD NonEmpty Voter -> ConwayGovPredFailure era
forall era. NonEmpty Voter -> ConwayGovPredFailure era
VotersDoNotExist Decode Open (NonEmpty Voter -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 18)) (NonEmpty Voter)
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 18)) (NonEmpty Voter)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
15 -> (GovAction era -> ConwayGovPredFailure era)
-> Decode Open (GovAction era -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD GovAction era -> ConwayGovPredFailure era
forall era. GovAction era -> ConwayGovPredFailure era
ZeroTreasuryWithdrawals Decode Open (GovAction era -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 19)) (GovAction era)
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 19)) (GovAction era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
16 -> (RewardAccount -> ConwayGovPredFailure era)
-> Decode Open (RewardAccount -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD RewardAccount -> ConwayGovPredFailure era
forall era. RewardAccount -> ConwayGovPredFailure era
ProposalReturnAccountDoesNotExist Decode Open (RewardAccount -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 20)) RewardAccount
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 20)) RewardAccount
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
17 -> (NonEmpty RewardAccount -> ConwayGovPredFailure era)
-> Decode Open (NonEmpty RewardAccount -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD NonEmpty RewardAccount -> ConwayGovPredFailure era
forall era. NonEmpty RewardAccount -> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist Decode Open (NonEmpty RewardAccount -> ConwayGovPredFailure era)
-> Decode (Closed (ZonkAny 21)) (NonEmpty RewardAccount)
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 21)) (NonEmpty RewardAccount)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
18 -> (NonEmpty (Credential HotCommitteeRole)
 -> ConwayGovPredFailure era)
-> Decode
     Open
     (NonEmpty (Credential HotCommitteeRole)
      -> ConwayGovPredFailure era)
forall t. t -> Decode Open t
SumD NonEmpty (Credential HotCommitteeRole) -> ConwayGovPredFailure era
forall era.
NonEmpty (Credential HotCommitteeRole) -> ConwayGovPredFailure era
UnelectedCommitteeVoters Decode
  Open
  (NonEmpty (Credential HotCommitteeRole)
   -> ConwayGovPredFailure era)
-> Decode
     (Closed (ZonkAny 22)) (NonEmpty (Credential HotCommitteeRole))
-> Decode Open (ConwayGovPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode
  (Closed (ZonkAny 22)) (NonEmpty (Credential HotCommitteeRole))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
k -> Word -> Decode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k

instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where
  encCBOR :: ConwayGovPredFailure era -> Encoding
encCBOR =
    Encode Open (ConwayGovPredFailure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (ConwayGovPredFailure era) -> Encoding)
-> (ConwayGovPredFailure era
    -> Encode Open (ConwayGovPredFailure era))
-> ConwayGovPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      GovActionsDoNotExist NonEmpty GovActionId
gid ->
        (NonEmpty GovActionId -> ConwayGovPredFailure era)
-> Word
-> Encode Open (NonEmpty GovActionId -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmpty GovActionId -> ConwayGovPredFailure era
forall era. NonEmpty GovActionId -> ConwayGovPredFailure era
GovActionsDoNotExist Word
0 Encode Open (NonEmpty GovActionId -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (NonEmpty GovActionId)
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmpty GovActionId
-> Encode (Closed Dense) (NonEmpty GovActionId)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmpty GovActionId
gid
      MalformedProposal GovAction era
ga ->
        (GovAction era -> ConwayGovPredFailure era)
-> Word -> Encode Open (GovAction era -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum GovAction era -> ConwayGovPredFailure era
forall era. GovAction era -> ConwayGovPredFailure era
MalformedProposal Word
1 Encode Open (GovAction era -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (GovAction era)
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> GovAction era -> Encode (Closed Dense) (GovAction era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To GovAction era
ga
      ProposalProcedureNetworkIdMismatch RewardAccount
acnt Network
nid ->
        (RewardAccount -> Network -> ConwayGovPredFailure era)
-> Word
-> Encode
     Open (RewardAccount -> Network -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum RewardAccount -> Network -> ConwayGovPredFailure era
forall era. RewardAccount -> Network -> ConwayGovPredFailure era
ProposalProcedureNetworkIdMismatch Word
2 Encode Open (RewardAccount -> Network -> ConwayGovPredFailure era)
-> Encode (Closed Dense) RewardAccount
-> Encode Open (Network -> ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> RewardAccount -> Encode (Closed Dense) RewardAccount
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To RewardAccount
acnt Encode Open (Network -> ConwayGovPredFailure era)
-> Encode (Closed Dense) Network
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Network -> Encode (Closed Dense) Network
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Network
nid
      TreasuryWithdrawalsNetworkIdMismatch Set RewardAccount
acnts Network
nid ->
        (Set RewardAccount -> Network -> ConwayGovPredFailure era)
-> Word
-> Encode
     Open (Set RewardAccount -> Network -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Set RewardAccount -> Network -> ConwayGovPredFailure era
forall era.
Set RewardAccount -> Network -> ConwayGovPredFailure era
TreasuryWithdrawalsNetworkIdMismatch Word
3 Encode
  Open (Set RewardAccount -> Network -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (Set RewardAccount)
-> Encode Open (Network -> ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Set RewardAccount -> Encode (Closed Dense) (Set RewardAccount)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Set RewardAccount
acnts Encode Open (Network -> ConwayGovPredFailure era)
-> Encode (Closed Dense) Network
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Network -> Encode (Closed Dense) Network
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Network
nid
      ProposalDepositIncorrect Mismatch RelEQ Coin
mm ->
        (Mismatch RelEQ Coin -> ConwayGovPredFailure era)
-> Word
-> Encode Open (Mismatch RelEQ Coin -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Mismatch RelEQ Coin -> ConwayGovPredFailure era
forall era. Mismatch RelEQ Coin -> ConwayGovPredFailure era
ProposalDepositIncorrect Word
4 Encode Open (Mismatch RelEQ Coin -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (Mismatch RelEQ Coin)
-> Encode Open (ConwayGovPredFailure 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
      DisallowedVoters NonEmpty (Voter, GovActionId)
votes ->
        (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Word
-> Encode
     Open (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVoters Word
5 Encode
  Open (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (NonEmpty (Voter, GovActionId))
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmpty (Voter, GovActionId)
-> Encode (Closed Dense) (NonEmpty (Voter, GovActionId))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmpty (Voter, GovActionId)
votes
      ConflictingCommitteeUpdate Set (Credential ColdCommitteeRole)
members ->
        (Set (Credential ColdCommitteeRole) -> ConwayGovPredFailure era)
-> Word
-> Encode
     Open
     (Set (Credential ColdCommitteeRole) -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Set (Credential ColdCommitteeRole) -> ConwayGovPredFailure era
forall era.
Set (Credential ColdCommitteeRole) -> ConwayGovPredFailure era
ConflictingCommitteeUpdate Word
6 Encode
  Open
  (Set (Credential ColdCommitteeRole) -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (Set (Credential ColdCommitteeRole))
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Set (Credential ColdCommitteeRole)
-> Encode (Closed Dense) (Set (Credential ColdCommitteeRole))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Set (Credential ColdCommitteeRole)
members
      ExpirationEpochTooSmall Map (Credential ColdCommitteeRole) EpochNo
members ->
        (Map (Credential ColdCommitteeRole) EpochNo
 -> ConwayGovPredFailure era)
-> Word
-> Encode
     Open
     (Map (Credential ColdCommitteeRole) EpochNo
      -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum Map (Credential ColdCommitteeRole) EpochNo
-> ConwayGovPredFailure era
forall era.
Map (Credential ColdCommitteeRole) EpochNo
-> ConwayGovPredFailure era
ExpirationEpochTooSmall Word
7 Encode
  Open
  (Map (Credential ColdCommitteeRole) EpochNo
   -> ConwayGovPredFailure era)
-> Encode
     (Closed Dense) (Map (Credential ColdCommitteeRole) EpochNo)
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Map (Credential ColdCommitteeRole) EpochNo
-> Encode
     (Closed Dense) (Map (Credential ColdCommitteeRole) EpochNo)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Map (Credential ColdCommitteeRole) EpochNo
members
      InvalidPrevGovActionId ProposalProcedure era
proposal ->
        (ProposalProcedure era -> ConwayGovPredFailure era)
-> Word
-> Encode Open (ProposalProcedure era -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
InvalidPrevGovActionId Word
8 Encode Open (ProposalProcedure era -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (ProposalProcedure era)
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> ProposalProcedure era
-> Encode (Closed Dense) (ProposalProcedure era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To ProposalProcedure era
proposal
      VotingOnExpiredGovAction NonEmpty (Voter, GovActionId)
ga ->
        (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Word
-> Encode
     Open (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
VotingOnExpiredGovAction Word
9 Encode
  Open (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (NonEmpty (Voter, GovActionId))
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmpty (Voter, GovActionId)
-> Encode (Closed Dense) (NonEmpty (Voter, GovActionId))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmpty (Voter, GovActionId)
ga
      ProposalCantFollow StrictMaybe (GovPurposeId 'HardForkPurpose)
prevgaid Mismatch RelGT ProtVer
mm ->
        (StrictMaybe (GovPurposeId 'HardForkPurpose)
 -> Mismatch RelGT ProtVer -> ConwayGovPredFailure era)
-> Word
-> Encode
     Open
     (StrictMaybe (GovPurposeId 'HardForkPurpose)
      -> Mismatch RelGT ProtVer -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum StrictMaybe (GovPurposeId 'HardForkPurpose)
-> Mismatch RelGT ProtVer -> ConwayGovPredFailure era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose)
-> Mismatch RelGT ProtVer -> ConwayGovPredFailure era
ProposalCantFollow Word
10 Encode
  Open
  (StrictMaybe (GovPurposeId 'HardForkPurpose)
   -> Mismatch RelGT ProtVer -> ConwayGovPredFailure era)
-> Encode
     (Closed Dense) (StrictMaybe (GovPurposeId 'HardForkPurpose))
-> Encode Open (Mismatch RelGT ProtVer -> ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> StrictMaybe (GovPurposeId 'HardForkPurpose)
-> Encode
     (Closed Dense) (StrictMaybe (GovPurposeId 'HardForkPurpose))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To StrictMaybe (GovPurposeId 'HardForkPurpose)
prevgaid Encode Open (Mismatch RelGT ProtVer -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (Mismatch RelGT ProtVer)
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Mismatch RelGT ProtVer
-> Encode (Closed Dense) (Mismatch RelGT ProtVer)
forall t. EncCBORGroup t => t -> Encode (Closed Dense) t
ToGroup Mismatch RelGT ProtVer
mm
      InvalidPolicyHash StrictMaybe ScriptHash
got StrictMaybe ScriptHash
expected ->
        (StrictMaybe ScriptHash
 -> StrictMaybe ScriptHash -> ConwayGovPredFailure era)
-> Word
-> Encode
     Open
     (StrictMaybe ScriptHash
      -> StrictMaybe ScriptHash -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> ConwayGovPredFailure era
forall era.
StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> ConwayGovPredFailure era
InvalidPolicyHash Word
11 Encode
  Open
  (StrictMaybe ScriptHash
   -> StrictMaybe ScriptHash -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (StrictMaybe ScriptHash)
-> Encode Open (StrictMaybe ScriptHash -> ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> StrictMaybe ScriptHash
-> Encode (Closed Dense) (StrictMaybe ScriptHash)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To StrictMaybe ScriptHash
got Encode Open (StrictMaybe ScriptHash -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (StrictMaybe ScriptHash)
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> StrictMaybe ScriptHash
-> Encode (Closed Dense) (StrictMaybe ScriptHash)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To StrictMaybe ScriptHash
expected
      DisallowedProposalDuringBootstrap ProposalProcedure era
proposal ->
        (ProposalProcedure era -> ConwayGovPredFailure era)
-> Word
-> Encode Open (ProposalProcedure era -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap Word
12 Encode Open (ProposalProcedure era -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (ProposalProcedure era)
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> ProposalProcedure era
-> Encode (Closed Dense) (ProposalProcedure era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To ProposalProcedure era
proposal
      DisallowedVotesDuringBootstrap NonEmpty (Voter, GovActionId)
votes ->
        (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Word
-> Encode
     Open (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVotesDuringBootstrap Word
13 Encode
  Open (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (NonEmpty (Voter, GovActionId))
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmpty (Voter, GovActionId)
-> Encode (Closed Dense) (NonEmpty (Voter, GovActionId))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmpty (Voter, GovActionId)
votes
      VotersDoNotExist NonEmpty Voter
voters ->
        (NonEmpty Voter -> ConwayGovPredFailure era)
-> Word -> Encode Open (NonEmpty Voter -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmpty Voter -> ConwayGovPredFailure era
forall era. NonEmpty Voter -> ConwayGovPredFailure era
VotersDoNotExist Word
14 Encode Open (NonEmpty Voter -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (NonEmpty Voter)
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmpty Voter -> Encode (Closed Dense) (NonEmpty Voter)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmpty Voter
voters
      ZeroTreasuryWithdrawals GovAction era
ga ->
        (GovAction era -> ConwayGovPredFailure era)
-> Word -> Encode Open (GovAction era -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum GovAction era -> ConwayGovPredFailure era
forall era. GovAction era -> ConwayGovPredFailure era
ZeroTreasuryWithdrawals Word
15 Encode Open (GovAction era -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (GovAction era)
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> GovAction era -> Encode (Closed Dense) (GovAction era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To GovAction era
ga
      ProposalReturnAccountDoesNotExist RewardAccount
returnAccount ->
        (RewardAccount -> ConwayGovPredFailure era)
-> Word -> Encode Open (RewardAccount -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum RewardAccount -> ConwayGovPredFailure era
forall era. RewardAccount -> ConwayGovPredFailure era
ProposalReturnAccountDoesNotExist Word
16 Encode Open (RewardAccount -> ConwayGovPredFailure era)
-> Encode (Closed Dense) RewardAccount
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> RewardAccount -> Encode (Closed Dense) RewardAccount
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To RewardAccount
returnAccount
      TreasuryWithdrawalReturnAccountsDoNotExist NonEmpty RewardAccount
accounts ->
        (NonEmpty RewardAccount -> ConwayGovPredFailure era)
-> Word
-> Encode Open (NonEmpty RewardAccount -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmpty RewardAccount -> ConwayGovPredFailure era
forall era. NonEmpty RewardAccount -> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist Word
17 Encode Open (NonEmpty RewardAccount -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (NonEmpty RewardAccount)
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmpty RewardAccount
-> Encode (Closed Dense) (NonEmpty RewardAccount)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmpty RewardAccount
accounts
      UnelectedCommitteeVoters NonEmpty (Credential HotCommitteeRole)
committee ->
        (NonEmpty (Credential HotCommitteeRole)
 -> ConwayGovPredFailure era)
-> Word
-> Encode
     Open
     (NonEmpty (Credential HotCommitteeRole)
      -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode Open t
Sum NonEmpty (Credential HotCommitteeRole) -> ConwayGovPredFailure era
forall era.
NonEmpty (Credential HotCommitteeRole) -> ConwayGovPredFailure era
UnelectedCommitteeVoters Word
18 Encode
  Open
  (NonEmpty (Credential HotCommitteeRole)
   -> ConwayGovPredFailure era)
-> Encode (Closed Dense) (NonEmpty (Credential HotCommitteeRole))
-> Encode Open (ConwayGovPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmpty (Credential HotCommitteeRole)
-> Encode (Closed Dense) (NonEmpty (Credential HotCommitteeRole))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmpty (Credential HotCommitteeRole)
committee

instance EraPParams era => ToCBOR (ConwayGovPredFailure era) where
  toCBOR :: ConwayGovPredFailure era -> Encoding
toCBOR = forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era

instance EraPParams era => FromCBOR (ConwayGovPredFailure era) where
  fromCBOR :: forall s. Decoder s (ConwayGovPredFailure era)
fromCBOR = forall era t s. (Era era, DecCBOR t) => Decoder s t
fromEraCBOR @era

data ConwayGovEvent era
  = GovNewProposals !TxId !(Proposals era)
  | GovRemovedVotes
      !TxId
      -- | Votes that were replaced in this tx.
      !(Set (Voter, GovActionId))
      -- | Any votes from these DReps in this or in previous txs are removed
      !(Set (Credential DRepRole))
  deriving ((forall x. ConwayGovEvent era -> Rep (ConwayGovEvent era) x)
-> (forall x. Rep (ConwayGovEvent era) x -> ConwayGovEvent era)
-> Generic (ConwayGovEvent era)
forall x. Rep (ConwayGovEvent era) x -> ConwayGovEvent era
forall x. ConwayGovEvent era -> Rep (ConwayGovEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ConwayGovEvent era) x -> ConwayGovEvent era
forall era x. ConwayGovEvent era -> Rep (ConwayGovEvent era) x
$cfrom :: forall era x. ConwayGovEvent era -> Rep (ConwayGovEvent era) x
from :: forall x. ConwayGovEvent era -> Rep (ConwayGovEvent era) x
$cto :: forall era x. Rep (ConwayGovEvent era) x -> ConwayGovEvent era
to :: forall x. Rep (ConwayGovEvent era) x -> ConwayGovEvent era
Generic, ConwayGovEvent era -> ConwayGovEvent era -> Bool
(ConwayGovEvent era -> ConwayGovEvent era -> Bool)
-> (ConwayGovEvent era -> ConwayGovEvent era -> Bool)
-> Eq (ConwayGovEvent era)
forall era.
EraPParams era =>
ConwayGovEvent era -> ConwayGovEvent era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
EraPParams era =>
ConwayGovEvent era -> ConwayGovEvent era -> Bool
== :: ConwayGovEvent era -> ConwayGovEvent era -> Bool
$c/= :: forall era.
EraPParams era =>
ConwayGovEvent era -> ConwayGovEvent era -> Bool
/= :: ConwayGovEvent era -> ConwayGovEvent era -> Bool
Eq)

instance EraPParams era => NFData (ConwayGovEvent era)

data GovSignal era = GovSignal
  { forall era. GovSignal era -> VotingProcedures era
gsVotingProcedures :: !(VotingProcedures era)
  , forall era. GovSignal era -> OSet (ProposalProcedure era)
gsProposalProcedures :: !(OSet.OSet (ProposalProcedure era))
  , forall era. GovSignal era -> StrictSeq (TxCert era)
gsCertificates :: !(SSeq.StrictSeq (TxCert era))
  }
  deriving ((forall x. GovSignal era -> Rep (GovSignal era) x)
-> (forall x. Rep (GovSignal era) x -> GovSignal era)
-> Generic (GovSignal era)
forall x. Rep (GovSignal era) x -> GovSignal era
forall x. GovSignal era -> Rep (GovSignal era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (GovSignal era) x -> GovSignal era
forall era x. GovSignal era -> Rep (GovSignal era) x
$cfrom :: forall era x. GovSignal era -> Rep (GovSignal era) x
from :: forall x. GovSignal era -> Rep (GovSignal era) x
$cto :: forall era x. Rep (GovSignal era) x -> GovSignal era
to :: forall x. Rep (GovSignal era) x -> GovSignal era
Generic)

instance (EraPParams era, EraTxCert era) => EncCBOR (GovSignal era) where
  encCBOR :: GovSignal era -> Encoding
encCBOR x :: GovSignal era
x@(GovSignal VotingProcedures era
_ OSet (ProposalProcedure era)
_ StrictSeq (TxCert era)
_) =
    let GovSignal {OSet (ProposalProcedure era)
StrictSeq (TxCert era)
VotingProcedures era
gsVotingProcedures :: forall era. GovSignal era -> VotingProcedures era
gsProposalProcedures :: forall era. GovSignal era -> OSet (ProposalProcedure era)
gsCertificates :: forall era. GovSignal era -> StrictSeq (TxCert era)
gsVotingProcedures :: VotingProcedures era
gsProposalProcedures :: OSet (ProposalProcedure era)
gsCertificates :: StrictSeq (TxCert era)
..} = GovSignal era
x
     in Encode (Closed Dense) (GovSignal era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode (Closed Dense) (GovSignal era) -> Encoding)
-> Encode (Closed Dense) (GovSignal era) -> Encoding
forall a b. (a -> b) -> a -> b
$
          (VotingProcedures era
 -> OSet (ProposalProcedure era)
 -> StrictSeq (TxCert era)
 -> GovSignal era)
-> Encode
     (Closed Dense)
     (VotingProcedures era
      -> OSet (ProposalProcedure era)
      -> StrictSeq (TxCert era)
      -> GovSignal era)
forall t. t -> Encode (Closed Dense) t
Rec VotingProcedures era
-> OSet (ProposalProcedure era)
-> StrictSeq (TxCert era)
-> GovSignal era
forall era.
VotingProcedures era
-> OSet (ProposalProcedure era)
-> StrictSeq (TxCert era)
-> GovSignal era
GovSignal
            Encode
  (Closed Dense)
  (VotingProcedures era
   -> OSet (ProposalProcedure era)
   -> StrictSeq (TxCert era)
   -> GovSignal era)
-> Encode (Closed Dense) (VotingProcedures era)
-> Encode
     (Closed Dense)
     (OSet (ProposalProcedure era)
      -> StrictSeq (TxCert era) -> GovSignal era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> VotingProcedures era
-> Encode (Closed Dense) (VotingProcedures era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To VotingProcedures era
gsVotingProcedures
            Encode
  (Closed Dense)
  (OSet (ProposalProcedure era)
   -> StrictSeq (TxCert era) -> GovSignal era)
-> Encode (Closed Dense) (OSet (ProposalProcedure era))
-> Encode (Closed Dense) (StrictSeq (TxCert era) -> GovSignal era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> OSet (ProposalProcedure era)
-> Encode (Closed Dense) (OSet (ProposalProcedure era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To OSet (ProposalProcedure era)
gsProposalProcedures
            Encode (Closed Dense) (StrictSeq (TxCert era) -> GovSignal era)
-> Encode (Closed Dense) (StrictSeq (TxCert era))
-> Encode (Closed Dense) (GovSignal era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> StrictSeq (TxCert era)
-> Encode (Closed Dense) (StrictSeq (TxCert era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To StrictSeq (TxCert era)
gsCertificates

deriving instance (EraPParams era, Eq (TxCert era)) => Eq (GovSignal era)

deriving instance (EraPParams era, Show (TxCert era)) => Show (GovSignal era)

instance (EraPParams era, NFData (TxCert era)) => NFData (GovSignal era)

instance
  ( ConwayEraTxCert era
  , ConwayEraPParams era
  , ConwayEraGov era
  , EraRule "GOV" era ~ ConwayGOV era
  , InjectRuleFailure "GOV" ConwayGovPredFailure era
  , EraCertState era
  , ConwayEraCertState era
  ) =>
  STS (ConwayGOV era)
  where
  type State (ConwayGOV era) = Proposals era
  type Signal (ConwayGOV era) = GovSignal era
  type Environment (ConwayGOV era) = GovEnv era
  type BaseM (ConwayGOV era) = ShelleyBase
  type PredicateFailure (ConwayGOV era) = ConwayGovPredFailure era
  type Event (ConwayGOV era) = ConwayGovEvent era

  initialRules :: [InitialRule (ConwayGOV era)]
initialRules = []

  transitionRules :: [TransitionRule (ConwayGOV era)]
transitionRules = [forall era.
(ConwayEraTxCert era, ConwayEraPParams era, ConwayEraGov era,
 STS (EraRule "GOV" era),
 Event (EraRule "GOV" era) ~ ConwayGovEvent era,
 Signal (EraRule "GOV" era) ~ GovSignal era,
 PredicateFailure (EraRule "GOV" era) ~ ConwayGovPredFailure era,
 BaseM (EraRule "GOV" era) ~ ShelleyBase,
 Environment (EraRule "GOV" era) ~ GovEnv era,
 State (EraRule "GOV" era) ~ Proposals era,
 InjectRuleFailure "GOV" ConwayGovPredFailure era,
 ConwayEraCertState era) =>
TransitionRule (EraRule "GOV" era)
govTransition @era]

checkVotesAreNotForExpiredActions ::
  EpochNo ->
  [(Voter, GovActionState era)] ->
  Test (ConwayGovPredFailure era)
checkVotesAreNotForExpiredActions :: forall era.
EpochNo
-> [(Voter, GovActionState era)] -> Test (ConwayGovPredFailure era)
checkVotesAreNotForExpiredActions EpochNo
curEpoch [(Voter, GovActionState era)]
votes =
  [(Voter, GovActionState era)]
-> (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> (GovActionState era -> Voter -> Bool)
-> Test (ConwayGovPredFailure era)
forall era.
[(Voter, GovActionState era)]
-> (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> (GovActionState era -> Voter -> Bool)
-> Test (ConwayGovPredFailure era)
checkDisallowedVotes [(Voter, GovActionState era)]
votes NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
VotingOnExpiredGovAction ((GovActionState era -> Voter -> Bool)
 -> Test (ConwayGovPredFailure era))
-> (GovActionState era -> Voter -> Bool)
-> Test (ConwayGovPredFailure era)
forall a b. (a -> b) -> a -> b
$ \GovActionState {EpochNo
gasExpiresAfter :: EpochNo
gasExpiresAfter :: forall era. GovActionState era -> EpochNo
gasExpiresAfter} Voter
_ ->
    EpochNo
curEpoch EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
<= EpochNo
gasExpiresAfter

checkVotersAreValid ::
  forall era.
  ConwayEraPParams era =>
  EpochNo ->
  CommitteeState era ->
  [(Voter, GovActionState era)] ->
  Test (ConwayGovPredFailure era)
checkVotersAreValid :: forall era.
ConwayEraPParams era =>
EpochNo
-> CommitteeState era
-> [(Voter, GovActionState era)]
-> Test (ConwayGovPredFailure era)
checkVotersAreValid EpochNo
currentEpoch CommitteeState era
committeeState [(Voter, GovActionState era)]
votes =
  [(Voter, GovActionState era)]
-> (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> (GovActionState era -> Voter -> Bool)
-> Test (ConwayGovPredFailure era)
forall era.
[(Voter, GovActionState era)]
-> (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> (GovActionState era -> Voter -> Bool)
-> Test (ConwayGovPredFailure era)
checkDisallowedVotes [(Voter, GovActionState era)]
votes NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVoters ((GovActionState era -> Voter -> Bool)
 -> Test (ConwayGovPredFailure era))
-> (GovActionState era -> Voter -> Bool)
-> Test (ConwayGovPredFailure era)
forall a b. (a -> b) -> a -> b
$ \GovActionState era
gas ->
    \case
      CommitteeVoter {} -> EpochNo -> CommitteeState era -> GovAction era -> Bool
forall era.
ConwayEraPParams era =>
EpochNo -> CommitteeState era -> GovAction era -> Bool
isCommitteeVotingAllowed EpochNo
currentEpoch CommitteeState era
committeeState (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas)
      DRepVoter {} -> GovAction era -> Bool
forall era. ConwayEraPParams era => GovAction era -> Bool
isDRepVotingAllowed (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas)
      StakePoolVoter {} -> GovAction era -> Bool
forall era. ConwayEraPParams era => GovAction era -> Bool
isStakePoolVotingAllowed (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas)

checkBootstrapVotes ::
  forall era.
  EraPParams era =>
  PParams era ->
  [(Voter, GovActionState era)] ->
  Test (ConwayGovPredFailure era)
checkBootstrapVotes :: forall era.
EraPParams era =>
PParams era
-> [(Voter, GovActionState era)] -> Test (ConwayGovPredFailure era)
checkBootstrapVotes PParams era
pp [(Voter, GovActionState era)]
votes
  | ProtVer -> Bool
hardforkConwayBootstrapPhase (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) =
      [(Voter, GovActionState era)]
-> (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> (GovActionState era -> Voter -> Bool)
-> Test (ConwayGovPredFailure era)
forall era.
[(Voter, GovActionState era)]
-> (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> (GovActionState era -> Voter -> Bool)
-> Test (ConwayGovPredFailure era)
checkDisallowedVotes [(Voter, GovActionState era)]
votes NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
forall era.
NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
DisallowedVotesDuringBootstrap ((GovActionState era -> Voter -> Bool)
 -> Test (ConwayGovPredFailure era))
-> (GovActionState era -> Voter -> Bool)
-> Test (ConwayGovPredFailure era)
forall a b. (a -> b) -> a -> b
$ \GovActionState era
gas ->
        \case
          DRepVoter {} | GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas GovAction era -> GovAction era -> Bool
forall a. Eq a => a -> a -> Bool
== GovAction era
forall era. GovAction era
InfoAction -> Bool
True
          DRepVoter {} -> Bool
False
          Voter
_ -> GovAction era -> Bool
forall era. GovAction era -> Bool
isBootstrapAction (GovAction era -> Bool) -> GovAction era -> Bool
forall a b. (a -> b) -> a -> b
$ GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas
  | Bool
otherwise = () -> Test (ConwayGovPredFailure era)
forall a. a -> Validation (NonEmpty (ConwayGovPredFailure era)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

actionWellFormed ::
  ConwayEraPParams era => ProtVer -> GovAction era -> Test (ConwayGovPredFailure era)
actionWellFormed :: forall era.
ConwayEraPParams era =>
ProtVer -> GovAction era -> Test (ConwayGovPredFailure era)
actionWellFormed ProtVer
pv GovAction era
ga = Bool
-> ConwayGovPredFailure era
-> Validation (NonEmpty (ConwayGovPredFailure era)) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless Bool
isWellFormed (ConwayGovPredFailure era
 -> Validation (NonEmpty (ConwayGovPredFailure era)) ())
-> ConwayGovPredFailure era
-> Validation (NonEmpty (ConwayGovPredFailure era)) ()
forall a b. (a -> b) -> a -> b
$ GovAction era -> ConwayGovPredFailure era
forall era. GovAction era -> ConwayGovPredFailure era
MalformedProposal GovAction era
ga
  where
    isWellFormed :: Bool
isWellFormed = case GovAction era
ga of
      ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
_ PParamsUpdate era
ppd StrictMaybe ScriptHash
_ -> ProtVer -> PParamsUpdate era -> Bool
forall era.
ConwayEraPParams era =>
ProtVer -> PParamsUpdate era -> Bool
ppuWellFormed ProtVer
pv PParamsUpdate era
ppd
      GovAction era
_ -> Bool
True

mkGovActionState ::
  GovActionId ->
  ProposalProcedure era ->
  -- | The number of epochs to expiry from protocol parameters
  EpochInterval ->
  -- | The current epoch
  EpochNo ->
  GovActionState era
mkGovActionState :: forall era.
GovActionId
-> ProposalProcedure era
-> EpochInterval
-> EpochNo
-> GovActionState era
mkGovActionState GovActionId
actionId ProposalProcedure era
proposal EpochInterval
expiryInterval EpochNo
curEpoch =
  GovActionState
    { gasId :: GovActionId
gasId = GovActionId
actionId
    , gasCommitteeVotes :: Map (Credential HotCommitteeRole) Vote
gasCommitteeVotes = Map (Credential HotCommitteeRole) Vote
forall a. Monoid a => a
mempty
    , gasDRepVotes :: Map (Credential DRepRole) Vote
gasDRepVotes = Map (Credential DRepRole) Vote
forall a. Monoid a => a
mempty
    , gasStakePoolVotes :: Map (KeyHash StakePool) Vote
gasStakePoolVotes = Map (KeyHash StakePool) Vote
forall a. Monoid a => a
mempty
    , gasProposalProcedure :: ProposalProcedure era
gasProposalProcedure = ProposalProcedure era
proposal
    , gasProposedIn :: EpochNo
gasProposedIn = EpochNo
curEpoch
    , gasExpiresAfter :: EpochNo
gasExpiresAfter = EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpoch EpochInterval
expiryInterval
    }

checkPolicy ::
  StrictMaybe ScriptHash ->
  StrictMaybe ScriptHash ->
  Test (ConwayGovPredFailure era)
checkPolicy :: forall era.
StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> Test (ConwayGovPredFailure era)
checkPolicy StrictMaybe ScriptHash
expectedPolicyHash StrictMaybe ScriptHash
actualPolicyHash =
  Bool
-> ConwayGovPredFailure era
-> Validation (NonEmpty (ConwayGovPredFailure era)) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless (StrictMaybe ScriptHash
actualPolicyHash StrictMaybe ScriptHash -> StrictMaybe ScriptHash -> Bool
forall a. Eq a => a -> a -> Bool
== StrictMaybe ScriptHash
expectedPolicyHash) (ConwayGovPredFailure era
 -> Validation (NonEmpty (ConwayGovPredFailure era)) ())
-> ConwayGovPredFailure era
-> Validation (NonEmpty (ConwayGovPredFailure era)) ()
forall a b. (a -> b) -> a -> b
$
    StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> ConwayGovPredFailure era
forall era.
StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> ConwayGovPredFailure era
InvalidPolicyHash StrictMaybe ScriptHash
actualPolicyHash StrictMaybe ScriptHash
expectedPolicyHash

checkBootstrapProposal ::
  EraPParams era =>
  PParams era ->
  ProposalProcedure era ->
  Test (ConwayGovPredFailure era)
checkBootstrapProposal :: forall era.
EraPParams era =>
PParams era
-> ProposalProcedure era -> Test (ConwayGovPredFailure era)
checkBootstrapProposal PParams era
pp proposal :: ProposalProcedure era
proposal@ProposalProcedure {GovAction era
pProcGovAction :: GovAction era
pProcGovAction :: forall era. ProposalProcedure era -> GovAction era
pProcGovAction}
  | ProtVer -> Bool
hardforkConwayBootstrapPhase (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) =
      Bool
-> ConwayGovPredFailure era
-> Validation (NonEmpty (ConwayGovPredFailure era)) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless (GovAction era -> Bool
forall era. GovAction era -> Bool
isBootstrapAction GovAction era
pProcGovAction) (ConwayGovPredFailure era
 -> Validation (NonEmpty (ConwayGovPredFailure era)) ())
-> ConwayGovPredFailure era
-> Validation (NonEmpty (ConwayGovPredFailure era)) ()
forall a b. (a -> b) -> a -> b
$ ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal
  | Bool
otherwise = () -> Validation (NonEmpty (ConwayGovPredFailure era)) ()
forall a. a -> Validation (NonEmpty (ConwayGovPredFailure era)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

govTransition ::
  forall era.
  ( ConwayEraTxCert era
  , ConwayEraPParams era
  , ConwayEraGov era
  , STS (EraRule "GOV" era)
  , Event (EraRule "GOV" era) ~ ConwayGovEvent era
  , Signal (EraRule "GOV" era) ~ GovSignal era
  , PredicateFailure (EraRule "GOV" era) ~ ConwayGovPredFailure era
  , BaseM (EraRule "GOV" era) ~ ShelleyBase
  , Environment (EraRule "GOV" era) ~ GovEnv era
  , State (EraRule "GOV" era) ~ Proposals era
  , InjectRuleFailure "GOV" ConwayGovPredFailure era
  , ConwayEraCertState era
  ) =>
  TransitionRule (EraRule "GOV" era)
govTransition :: forall era.
(ConwayEraTxCert era, ConwayEraPParams era, ConwayEraGov era,
 STS (EraRule "GOV" era),
 Event (EraRule "GOV" era) ~ ConwayGovEvent era,
 Signal (EraRule "GOV" era) ~ GovSignal era,
 PredicateFailure (EraRule "GOV" era) ~ ConwayGovPredFailure era,
 BaseM (EraRule "GOV" era) ~ ShelleyBase,
 Environment (EraRule "GOV" era) ~ GovEnv era,
 State (EraRule "GOV" era) ~ Proposals era,
 InjectRuleFailure "GOV" ConwayGovPredFailure era,
 ConwayEraCertState era) =>
TransitionRule (EraRule "GOV" era)
govTransition = do
  TRC
    ( GovEnv txid currentEpoch pp constitutionPolicy certState committee
      , st
      , GovSignal {gsVotingProcedures, gsProposalProcedures, gsCertificates}
      ) <-
    Rule
  (EraRule "GOV" era)
  'Transition
  (RuleContext 'Transition (EraRule "GOV" era))
F (Clause (EraRule "GOV" era) 'Transition)
  (TRC (EraRule "GOV" era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let prevGovActionIds = State (EraRule "GOV" era)
Proposals era
st Proposals era
-> Getting
     (GovRelation StrictMaybe) (Proposals era) (GovRelation StrictMaybe)
-> GovRelation StrictMaybe
forall s a. s -> Getting a s a -> a
^. (GovRelation PRoot
 -> Const (GovRelation StrictMaybe) (GovRelation PRoot))
-> Proposals era -> Const (GovRelation StrictMaybe) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot -> f (GovRelation PRoot))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot
  -> Const (GovRelation StrictMaybe) (GovRelation PRoot))
 -> Proposals era
 -> Const (GovRelation StrictMaybe) (Proposals era))
-> ((GovRelation StrictMaybe
     -> Const (GovRelation StrictMaybe) (GovRelation StrictMaybe))
    -> GovRelation PRoot
    -> Const (GovRelation StrictMaybe) (GovRelation PRoot))
-> Getting
     (GovRelation StrictMaybe) (Proposals era) (GovRelation StrictMaybe)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovRelation PRoot -> GovRelation StrictMaybe)
-> SimpleGetter (GovRelation PRoot) (GovRelation StrictMaybe)
forall s a. (s -> a) -> SimpleGetter s a
L.to GovRelation PRoot -> GovRelation StrictMaybe
toPrevGovActionIds
      certVState = CertState 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
      certPState = CertState 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
      certDState = CertState era
certState CertState era
-> Getting (DState era) (CertState era) (DState era) -> DState era
forall s a. s -> Getting a s a -> a
^. Getting (DState era) (CertState era) (DState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL
      committeeState = VState era -> CommitteeState era
forall era. VState era -> CommitteeState era
vsCommitteeState VState era
certVState
      knownDReps = VState era -> Map (Credential DRepRole) DRepState
forall era. VState era -> Map (Credential DRepRole) DRepState
vsDReps VState era
certVState
      knownStakePools = PState era -> Map (KeyHash StakePool) StakePoolState
forall era. PState era -> Map (KeyHash StakePool) StakePoolState
psStakePools PState era
certPState
      knownCommitteeMembers = CommitteeState era -> Set (Credential HotCommitteeRole)
forall era. CommitteeState era -> Set (Credential HotCommitteeRole)
authorizedHotCommitteeCredentials CommitteeState era
committeeState

  expectedNetworkId <- liftSTS $ asks networkId

  when (hardforkConwayDisallowUnelectedCommitteeFromVoting $ pp ^. ppProtocolVersionL) $
    failOnNonEmpty
      (unelectedCommitteeVoters committee committeeState gsVotingProcedures)
      UnelectedCommitteeVoters

  let processProposal Proposals era
ps (GovActionIx
idx, proposal :: ProposalProcedure era
proposal@ProposalProcedure {Anchor
Coin
RewardAccount
GovAction era
pProcGovAction :: forall era. ProposalProcedure era -> GovAction era
pProcDeposit :: Coin
pProcReturnAddr :: RewardAccount
pProcGovAction :: GovAction era
pProcAnchor :: Anchor
pProcAnchor :: forall era. ProposalProcedure era -> Anchor
pProcReturnAddr :: forall era. ProposalProcedure era -> RewardAccount
pProcDeposit :: forall era. ProposalProcedure era -> Coin
..}) = do
        Test (ConwayGovPredFailure era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (ConwayGovPredFailure era)
 -> F (Clause (EraRule "GOV" era) 'Transition) ())
-> Test (ConwayGovPredFailure era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ PParams era
-> ProposalProcedure era -> Test (ConwayGovPredFailure era)
forall era.
EraPParams era =>
PParams era
-> ProposalProcedure era -> Test (ConwayGovPredFailure era)
checkBootstrapProposal PParams era
pp ProposalProcedure era
proposal

        let newGaid :: GovActionId
newGaid = TxId -> GovActionIx -> GovActionId
GovActionId TxId
txid GovActionIx
idx

        -- In a HardFork, check that the ProtVer can follow
        let badHardFork :: Maybe (ConwayGovPredFailure era)
badHardFork = do
              (prevGaid, newProtVer, prevProtVer) <-
                forall era.
EraPParams era =>
GovAction era
-> PParams era
-> GovRelation StrictMaybe
-> Proposals era
-> Maybe
     (StrictMaybe (GovPurposeId 'HardForkPurpose), ProtVer, ProtVer)
preceedingHardFork @era GovAction era
pProcGovAction PParams era
pp GovRelation StrictMaybe
prevGovActionIds State (EraRule "GOV" era)
Proposals era
st
              if pvCanFollow prevProtVer newProtVer
                then Nothing
                else
                  Just $
                    ProposalCantFollow @era prevGaid $
                      Mismatch
                        { mismatchSupplied = newProtVer
                        , mismatchExpected = prevProtVer
                        }
        Maybe (ConwayGovPredFailure era)
-> (ConwayGovPredFailure era
    -> PredicateFailure (EraRule "GOV" era))
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall a sts (ctx :: RuleType).
Maybe a -> (a -> PredicateFailure sts) -> Rule sts ctx ()
failOnJust Maybe (ConwayGovPredFailure era)
badHardFork ConwayGovPredFailure era -> PredicateFailure (EraRule "GOV" era)
ConwayGovPredFailure era -> ConwayGovPredFailure era
forall a. a -> a
id

        -- PParamsUpdate well-formedness check
        Test (ConwayGovPredFailure era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (ConwayGovPredFailure era)
 -> F (Clause (EraRule "GOV" era) 'Transition) ())
-> Test (ConwayGovPredFailure era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ ProtVer -> GovAction era -> Test (ConwayGovPredFailure era)
forall era.
ConwayEraPParams era =>
ProtVer -> GovAction era -> Test (ConwayGovPredFailure era)
actionWellFormed (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) GovAction era
pProcGovAction

        Bool
-> F (Clause (EraRule "GOV" era) 'Transition) ()
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ProtVer -> Bool
hardforkConwayBootstrapPhase (ProtVer -> Bool) -> ProtVer -> Bool
forall a b. (a -> b) -> a -> b
$ 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) (F (Clause (EraRule "GOV" era) 'Transition) ()
 -> F (Clause (EraRule "GOV" era) 'Transition) ())
-> F (Clause (EraRule "GOV" era) 'Transition) ()
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ do
          let refundAddress :: RewardAccount
refundAddress = ProposalProcedure era
proposal ProposalProcedure era
-> Getting RewardAccount (ProposalProcedure era) RewardAccount
-> RewardAccount
forall s a. s -> Getting a s a -> a
^. Getting RewardAccount (ProposalProcedure era) RewardAccount
forall era (f :: * -> *).
Functor f =>
(RewardAccount -> f RewardAccount)
-> ProposalProcedure era -> f (ProposalProcedure era)
pProcReturnAddrL
              govAction :: GovAction era
govAction = ProposalProcedure era
proposal ProposalProcedure era
-> Getting (GovAction era) (ProposalProcedure era) (GovAction era)
-> GovAction era
forall s a. s -> Getting a s a -> a
^. Getting (GovAction era) (ProposalProcedure era) (GovAction era)
forall era (f :: * -> *).
Functor f =>
(GovAction era -> f (GovAction era))
-> ProposalProcedure era -> f (ProposalProcedure era)
pProcGovActionL
          Credential Staking -> Accounts era -> Bool
forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Bool
isAccountRegistered (RewardAccount -> Credential Staking
raCredential RewardAccount
refundAddress) (DState era
certDState DState era
-> Getting (Accounts era) (DState era) (Accounts era)
-> Accounts era
forall s a. s -> Getting a s a -> a
^. Getting (Accounts era) (DState era) (Accounts era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL)
            Bool
-> PredicateFailure (EraRule "GOV" era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! RewardAccount -> ConwayGovPredFailure era
forall era. RewardAccount -> ConwayGovPredFailure era
ProposalReturnAccountDoesNotExist RewardAccount
refundAddress
          case GovAction era
govAction of
            TreasuryWithdrawals Map RewardAccount Coin
withdrawals StrictMaybe ScriptHash
_ -> do
              let nonRegisteredAccounts :: Map RewardAccount Coin
nonRegisteredAccounts =
                    ((RewardAccount -> Coin -> Bool)
 -> Map RewardAccount Coin -> Map RewardAccount Coin)
-> Map RewardAccount Coin
-> (RewardAccount -> Coin -> Bool)
-> Map RewardAccount Coin
forall a b c. (a -> b -> c) -> b -> a -> c
flip (RewardAccount -> Coin -> Bool)
-> Map RewardAccount Coin -> Map RewardAccount Coin
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey Map RewardAccount Coin
withdrawals ((RewardAccount -> Coin -> Bool) -> Map RewardAccount Coin)
-> (RewardAccount -> Coin -> Bool) -> Map RewardAccount Coin
forall a b. (a -> b) -> a -> b
$ \RewardAccount
withdrawalAddress Coin
_ ->
                      Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Credential Staking -> Accounts era -> Bool
forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Bool
isAccountRegistered (RewardAccount -> Credential Staking
raCredential RewardAccount
withdrawalAddress) (DState era
certDState DState era
-> Getting (Accounts era) (DState era) (Accounts era)
-> Accounts era
forall s a. s -> Getting a s a -> a
^. Getting (Accounts era) (DState era) (Accounts era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL)
              [RewardAccount]
-> (NonEmpty RewardAccount -> PredicateFailure (EraRule "GOV" era))
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall (f :: * -> *) a sts (ctx :: RuleType).
Foldable f =>
f a -> (NonEmpty a -> PredicateFailure sts) -> Rule sts ctx ()
failOnNonEmpty (Map RewardAccount Coin -> [RewardAccount]
forall k a. Map k a -> [k]
Map.keys Map RewardAccount Coin
nonRegisteredAccounts) NonEmpty RewardAccount -> PredicateFailure (EraRule "GOV" era)
NonEmpty RewardAccount -> ConwayGovPredFailure era
forall era. NonEmpty RewardAccount -> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist
            GovAction era
_ -> () -> F (Clause (EraRule "GOV" era) 'Transition) ()
forall a. a -> F (Clause (EraRule "GOV" era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        -- Deposit check
        let expectedDeposit :: Coin
expectedDeposit = PParams era
pp 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
ppGovActionDepositL
         in Coin
pProcDeposit
              Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
expectedDeposit
                Bool
-> PredicateFailure (EraRule "GOV" era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Mismatch RelEQ Coin -> ConwayGovPredFailure era
forall era. Mismatch RelEQ Coin -> ConwayGovPredFailure era
ProposalDepositIncorrect
                  Mismatch
                    { mismatchSupplied :: Coin
mismatchSupplied = Coin
pProcDeposit
                    , mismatchExpected :: Coin
mismatchExpected = Coin
expectedDeposit
                    }

        -- Return address network id check
        RewardAccount -> Network
raNetwork RewardAccount
pProcReturnAddr
          Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
== Network
expectedNetworkId
            Bool
-> PredicateFailure (EraRule "GOV" era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! RewardAccount -> Network -> ConwayGovPredFailure era
forall era. RewardAccount -> Network -> ConwayGovPredFailure era
ProposalProcedureNetworkIdMismatch RewardAccount
pProcReturnAddr Network
expectedNetworkId

        -- Treasury withdrawal return address and committee well-formedness checks
        case GovAction era
pProcGovAction of
          TreasuryWithdrawals Map RewardAccount Coin
wdrls StrictMaybe ScriptHash
proposalPolicy -> do
            let mismatchedAccounts :: Set RewardAccount
mismatchedAccounts =
                  (RewardAccount -> Bool) -> Set RewardAccount -> Set RewardAccount
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
/= Network
expectedNetworkId) (Network -> Bool)
-> (RewardAccount -> Network) -> RewardAccount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardAccount -> Network
raNetwork) (Set RewardAccount -> Set RewardAccount)
-> Set RewardAccount -> Set RewardAccount
forall a b. (a -> b) -> a -> b
$ Map RewardAccount Coin -> Set RewardAccount
forall k a. Map k a -> Set k
Map.keysSet Map RewardAccount Coin
wdrls
            Set RewardAccount -> Bool
forall a. Set a -> Bool
Set.null Set RewardAccount
mismatchedAccounts
              Bool
-> PredicateFailure (EraRule "GOV" era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Set RewardAccount -> Network -> ConwayGovPredFailure era
forall era.
Set RewardAccount -> Network -> ConwayGovPredFailure era
TreasuryWithdrawalsNetworkIdMismatch Set RewardAccount
mismatchedAccounts Network
expectedNetworkId

            -- Policy check
            Test (ConwayGovPredFailure era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (ConwayGovPredFailure era)
 -> F (Clause (EraRule "GOV" era) 'Transition) ())
-> Test (ConwayGovPredFailure era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> Test (ConwayGovPredFailure era)
checkPolicy @era StrictMaybe ScriptHash
constitutionPolicy StrictMaybe ScriptHash
proposalPolicy

            Bool
-> F (Clause (EraRule "GOV" era) 'Transition) ()
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ProtVer -> Bool
hardforkConwayBootstrapPhase (ProtVer -> Bool) -> ProtVer -> Bool
forall a b. (a -> b) -> a -> b
$ 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) (F (Clause (EraRule "GOV" era) 'Transition) ()
 -> F (Clause (EraRule "GOV" era) 'Transition) ())
-> F (Clause (EraRule "GOV" era) 'Transition) ()
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$
              -- The sum of all withdrawals must be positive
              Map RewardAccount Coin -> Coin
forall m. Monoid m => Map RewardAccount m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold Map RewardAccount Coin
wdrls Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
/= Coin
forall a. Monoid a => a
mempty Bool
-> PredicateFailure (EraRule "GOV" era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! GovAction era -> ConwayGovPredFailure era
forall era. GovAction era -> ConwayGovPredFailure era
ZeroTreasuryWithdrawals GovAction era
pProcGovAction
          UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose)
_mPrevGovActionId Set (Credential ColdCommitteeRole)
membersToRemove Map (Credential ColdCommitteeRole) EpochNo
membersToAdd UnitInterval
_qrm -> do
            let conflicting :: Set (Credential ColdCommitteeRole)
conflicting = Set (Credential ColdCommitteeRole)
-> Set (Credential ColdCommitteeRole)
-> Set (Credential ColdCommitteeRole)
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection (Map (Credential ColdCommitteeRole) EpochNo
-> Set (Credential ColdCommitteeRole)
forall k a. Map k a -> Set k
Map.keysSet Map (Credential ColdCommitteeRole) EpochNo
membersToAdd) Set (Credential ColdCommitteeRole)
membersToRemove
             in Set (Credential ColdCommitteeRole) -> Bool
forall a. Set a -> Bool
Set.null Set (Credential ColdCommitteeRole)
conflicting Bool
-> PredicateFailure (EraRule "GOV" era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Set (Credential ColdCommitteeRole) -> ConwayGovPredFailure era
forall era.
Set (Credential ColdCommitteeRole) -> ConwayGovPredFailure era
ConflictingCommitteeUpdate Set (Credential ColdCommitteeRole)
conflicting

            let invalidMembers :: Map (Credential ColdCommitteeRole) EpochNo
invalidMembers = (EpochNo -> Bool)
-> Map (Credential ColdCommitteeRole) EpochNo
-> Map (Credential ColdCommitteeRole) EpochNo
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
<= EpochNo
currentEpoch) Map (Credential ColdCommitteeRole) EpochNo
membersToAdd
             in Map (Credential ColdCommitteeRole) EpochNo -> Bool
forall k a. Map k a -> Bool
Map.null Map (Credential ColdCommitteeRole) EpochNo
invalidMembers Bool
-> PredicateFailure (EraRule "GOV" era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Map (Credential ColdCommitteeRole) EpochNo
-> ConwayGovPredFailure era
forall era.
Map (Credential ColdCommitteeRole) EpochNo
-> ConwayGovPredFailure era
ExpirationEpochTooSmall Map (Credential ColdCommitteeRole) EpochNo
invalidMembers
          ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
_ PParamsUpdate era
_ StrictMaybe ScriptHash
proposalPolicy ->
            Test (ConwayGovPredFailure era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (ConwayGovPredFailure era)
 -> F (Clause (EraRule "GOV" era) 'Transition) ())
-> Test (ConwayGovPredFailure era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe ScriptHash
-> StrictMaybe ScriptHash -> Test (ConwayGovPredFailure era)
checkPolicy @era StrictMaybe ScriptHash
constitutionPolicy StrictMaybe ScriptHash
proposalPolicy
          GovAction era
_ -> () -> F (Clause (EraRule "GOV" era) 'Transition) ()
forall a. a -> F (Clause (EraRule "GOV" era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        -- Ancestry checks and accept proposal
        let expiry :: EpochInterval
expiry = 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
ppGovActionLifetimeL
            actionState :: GovActionState era
actionState = GovActionId
-> ProposalProcedure era
-> EpochInterval
-> EpochNo
-> GovActionState era
forall era.
GovActionId
-> ProposalProcedure era
-> EpochInterval
-> EpochNo
-> GovActionState era
mkGovActionState GovActionId
newGaid ProposalProcedure era
proposal EpochInterval
expiry EpochNo
currentEpoch
         in case GovActionState era -> Proposals era -> Maybe (Proposals era)
forall era.
(EraPParams era, HasCallStack) =>
GovActionState era -> Proposals era -> Maybe (Proposals era)
proposalsAddAction GovActionState era
actionState Proposals era
ps of
              Just Proposals era
updatedPs -> Proposals era
-> F (Clause (EraRule "GOV" era) 'Transition) (Proposals era)
forall a. a -> F (Clause (EraRule "GOV" era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Proposals era
updatedPs
              Maybe (Proposals era)
Nothing -> Proposals era
ps Proposals era
-> F (Clause (EraRule "GOV" era) 'Transition) ()
-> F (Clause (EraRule "GOV" era) 'Transition) (Proposals era)
forall a b.
a
-> F (Clause (EraRule "GOV" era) 'Transition) b
-> F (Clause (EraRule "GOV" era) 'Transition) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ PredicateFailure (EraRule "GOV" era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause (ProposalProcedure era -> ConwayGovPredFailure era
forall era. ProposalProcedure era -> ConwayGovPredFailure era
InvalidPrevGovActionId ProposalProcedure era
proposal)

  proposals <-
    foldlM' processProposal st $
      indexedGovProps (SSeq.fromStrict (OSet.toStrictSeq gsProposalProcedures))

  let knownVotes = [(Voter
voter, GovActionState era
gas) | (Voter
voter, Vote
_vote, GovActionState era
gas) <- [(Voter, Vote, GovActionState era)]
knownVotesWithCast]
      (unknownGovActionIds, !knownVotesWithCast, replacedVotes) =
        foldrVotingProcedures
          -- strictness is not needed for `unknown` or `replaced`
          ( \Voter
voter GovActionId
gaId VotingProcedure era
vp ([GovActionId]
unknown, ![(Voter, Vote, GovActionState era)]
known, Set (Voter, GovActionId)
replaced) ->
              case GovActionId
-> Map GovActionId (GovActionState era)
-> Maybe (GovActionState era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GovActionId
gaId Map GovActionId (GovActionState era)
curGovActionIds of
                Just GovActionState era
gas ->
                  let isVoteReplaced :: Bool
isVoteReplaced =
                        case Voter
voter of
                          CommitteeVoter Credential HotCommitteeRole
hotCred -> Credential HotCommitteeRole
hotCred Credential HotCommitteeRole
-> Map (Credential HotCommitteeRole) Vote -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` GovActionState era -> Map (Credential HotCommitteeRole) Vote
forall era.
GovActionState era -> Map (Credential HotCommitteeRole) Vote
gasCommitteeVotes GovActionState era
gas
                          DRepVoter Credential DRepRole
cred -> Credential DRepRole
cred Credential DRepRole -> Map (Credential DRepRole) Vote -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` GovActionState era -> Map (Credential DRepRole) Vote
forall era. GovActionState era -> Map (Credential DRepRole) Vote
gasDRepVotes GovActionState era
gas
                          StakePoolVoter KeyHash StakePool
poolId -> KeyHash StakePool
poolId KeyHash StakePool -> Map (KeyHash StakePool) Vote -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` GovActionState era -> Map (KeyHash StakePool) Vote
forall era. GovActionState era -> Map (KeyHash StakePool) Vote
gasStakePoolVotes GovActionState era
gas
                      replaced' :: Set (Voter, GovActionId)
replaced'
                        | Bool
isVoteReplaced = (Voter, GovActionId)
-> Set (Voter, GovActionId) -> Set (Voter, GovActionId)
forall a. Ord a => a -> Set a -> Set a
Set.insert (Voter
voter, GovActionId
gaId) Set (Voter, GovActionId)
replaced
                        | Bool
otherwise = Set (Voter, GovActionId)
replaced
                   in ([GovActionId]
unknown, (Voter
voter, VotingProcedure era -> Vote
forall era. VotingProcedure era -> Vote
vProcVote VotingProcedure era
vp, GovActionState era
gas) (Voter, Vote, GovActionState era)
-> [(Voter, Vote, GovActionState era)]
-> [(Voter, Vote, GovActionState era)]
forall a. a -> [a] -> [a]
: [(Voter, Vote, GovActionState era)]
known, Set (Voter, GovActionId)
replaced')
                Maybe (GovActionState era)
Nothing -> (GovActionId
gaId GovActionId -> [GovActionId] -> [GovActionId]
forall a. a -> [a] -> [a]
: [GovActionId]
unknown, [(Voter, Vote, GovActionState era)]
known, Set (Voter, GovActionId)
replaced)
          )
          ([], [], Set.empty)
          (VotingProcedures knownVoters)
      curGovActionIds = Proposals era -> Map GovActionId (GovActionState era)
forall era. Proposals era -> Map GovActionId (GovActionState era)
proposalsActionsMap Proposals era
proposals
      internVoter = \case
        CommitteeVoter Credential HotCommitteeRole
hotCred -> Credential HotCommitteeRole -> Voter
CommitteeVoter (Credential HotCommitteeRole -> Voter)
-> Maybe (Credential HotCommitteeRole) -> Maybe Voter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential HotCommitteeRole
-> Set (Credential HotCommitteeRole)
-> Maybe (Credential HotCommitteeRole)
forall a. Ord a => a -> Set a -> Maybe a
internSet Credential HotCommitteeRole
hotCred Set (Credential HotCommitteeRole)
knownCommitteeMembers
        DRepVoter Credential DRepRole
cred -> Credential DRepRole -> Voter
DRepVoter (Credential DRepRole -> Voter)
-> Maybe (Credential DRepRole) -> Maybe Voter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Credential DRepRole
-> Map (Credential DRepRole) DRepState
-> Maybe (Credential DRepRole)
forall k a. Ord k => k -> Map k a -> Maybe k
internMap Credential DRepRole
cred Map (Credential DRepRole) DRepState
knownDReps
        StakePoolVoter KeyHash StakePool
poolId -> KeyHash StakePool -> Voter
StakePoolVoter (KeyHash StakePool -> Voter)
-> Maybe (KeyHash StakePool) -> Maybe Voter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyHash StakePool
-> Map (KeyHash StakePool) StakePoolState
-> Maybe (KeyHash StakePool)
forall k a. Ord k => k -> Map k a -> Maybe k
internMap KeyHash StakePool
poolId Map (KeyHash StakePool) StakePoolState
knownStakePools
      (unknownVoters, knownVoters) =
        bimap Set.fromList Map.fromList $
          partitionEithers
            [ maybe (Left voter) (\Voter
v -> (Voter, Map GovActionId (VotingProcedure era))
-> Either Voter (Voter, Map GovActionId (VotingProcedure era))
forall a b. b -> Either a b
Right (Voter
v, Map GovActionId (VotingProcedure era)
votes)) (internVoter voter)
            | (voter, votes) <- Map.toList (unVotingProcedures gsVotingProcedures)
            ]

  failOnNonEmpty unknownVoters VotersDoNotExist
  failOnNonEmpty unknownGovActionIds GovActionsDoNotExist
  runTest $ checkBootstrapVotes pp knownVotes
  runTest $ checkVotesAreNotForExpiredActions currentEpoch knownVotes
  runTest $ checkVotersAreValid currentEpoch committeeState knownVotes

  let
    !updatedProposalStates =
      let addVoterVote :: Proposals era -> (Voter, Vote, GovActionState era) -> Proposals era
addVoterVote Proposals era
ps (Voter
voter, Vote
vote, GovActionState era
gas) = Voter -> Vote -> GovActionId -> Proposals era -> Proposals era
forall era.
Voter -> Vote -> GovActionId -> Proposals era -> Proposals era
proposalsAddVote Voter
voter Vote
vote (GovActionState era -> GovActionId
forall era. GovActionState era -> GovActionId
gasId GovActionState era
gas) Proposals era
ps
       in Proposals era -> Proposals era
cleanupProposalVotes (Proposals era -> Proposals era) -> Proposals era -> Proposals era
forall a b. (a -> b) -> a -> b
$ (Proposals era
 -> (Voter, Vote, GovActionState era) -> Proposals era)
-> Proposals era
-> [(Voter, Vote, GovActionState era)]
-> Proposals era
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Proposals era -> (Voter, Vote, GovActionState era) -> Proposals era
forall {era} {era}.
Proposals era -> (Voter, Vote, GovActionState era) -> Proposals era
addVoterVote Proposals era
proposals [(Voter, Vote, GovActionState era)]
knownVotesWithCast
    unregisteredDReps =
      let collectRemovals :: Set (Credential DRepRole)
-> TxCert era -> Set (Credential DRepRole)
collectRemovals Set (Credential DRepRole)
drepCreds = \case
            UnRegDRepTxCert Credential DRepRole
drepCred Coin
_ -> Credential DRepRole
-> Set (Credential DRepRole) -> Set (Credential DRepRole)
forall a. Ord a => a -> Set a -> Set a
Set.insert Credential DRepRole
drepCred Set (Credential DRepRole)
drepCreds
            TxCert era
_ -> Set (Credential DRepRole)
drepCreds
       in (Set (Credential DRepRole)
 -> TxCert era -> Set (Credential DRepRole))
-> Set (Credential DRepRole)
-> StrictSeq (TxCert era)
-> Set (Credential DRepRole)
forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Set (Credential DRepRole)
-> TxCert era -> Set (Credential DRepRole)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraTxCert era) =>
Set (Credential DRepRole)
-> TxCert era -> Set (Credential DRepRole)
collectRemovals Set (Credential DRepRole)
forall a. Monoid a => a
mempty StrictSeq (TxCert era)
gsCertificates
    cleanupProposalVotes
      -- optimization: avoid iterating over proposals when there is nothing to cleanup
      | Set (Credential DRepRole) -> Bool
forall a. Set a -> Bool
Set.null Set (Credential DRepRole)
unregisteredDReps = Proposals era -> Proposals era
forall a. a -> a
id
      | Bool
otherwise =
          let cleanupVoters :: GovActionState era -> GovActionState era
cleanupVoters GovActionState era
gas =
                GovActionState era
gas GovActionState era
-> (GovActionState era -> GovActionState era) -> GovActionState era
forall a b. a -> (a -> b) -> b
& (Map (Credential DRepRole) Vote
 -> Identity (Map (Credential DRepRole) Vote))
-> GovActionState era -> Identity (GovActionState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential DRepRole) Vote
 -> f (Map (Credential DRepRole) Vote))
-> GovActionState era -> f (GovActionState era)
gasDRepVotesL ((Map (Credential DRepRole) Vote
  -> Identity (Map (Credential DRepRole) Vote))
 -> GovActionState era -> Identity (GovActionState era))
-> (Map (Credential DRepRole) Vote
    -> Map (Credential DRepRole) Vote)
-> GovActionState era
-> GovActionState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Map (Credential DRepRole) Vote
-> Set (Credential DRepRole) -> Map (Credential DRepRole) Vote
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Set (Credential DRepRole)
unregisteredDReps)
           in (GovActionState era -> GovActionState era)
-> Proposals era -> Proposals era
forall era.
(GovActionState era -> GovActionState era)
-> Proposals era -> Proposals era
mapProposals GovActionState era -> GovActionState era
cleanupVoters

  -- Report the event
  tellEvent $ GovNewProposals txid updatedProposalStates
  tellEvent $ GovRemovedVotes txid replacedVotes unregisteredDReps

  pure updatedProposalStates

isBootstrapAction :: GovAction era -> Bool
isBootstrapAction :: forall era. GovAction era -> Bool
isBootstrapAction =
  \case
    ParameterChange {} -> Bool
True
    HardForkInitiation {} -> Bool
True
    GovAction era
InfoAction -> Bool
True
    GovAction era
_ -> Bool
False

checkDisallowedVotes ::
  [(Voter, GovActionState era)] ->
  (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era) ->
  (GovActionState era -> Voter -> Bool) ->
  Test (ConwayGovPredFailure era)
checkDisallowedVotes :: forall era.
[(Voter, GovActionState era)]
-> (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> (GovActionState era -> Voter -> Bool)
-> Test (ConwayGovPredFailure era)
checkDisallowedVotes [(Voter, GovActionState era)]
votes NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
failure GovActionState era -> Voter -> Bool
canBeVotedOnBy =
  [(Voter, GovActionId)]
-> (NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era)
-> Validation (NonEmpty (ConwayGovPredFailure era)) ()
forall (f :: * -> *) a e.
Foldable f =>
f a -> (NonEmpty a -> e) -> Validation (NonEmpty e) ()
failureOnNonEmpty [(Voter, GovActionId)]
disallowedVotes NonEmpty (Voter, GovActionId) -> ConwayGovPredFailure era
failure
  where
    disallowedVotes :: [(Voter, GovActionId)]
disallowedVotes =
      [(Voter
voter, GovActionState era -> GovActionId
forall era. GovActionState era -> GovActionId
gasId GovActionState era
gas) | (Voter
voter, GovActionState era
gas) <- [(Voter, GovActionState era)]
votes, Bool -> Bool
not (GovActionState era
gas GovActionState era -> Voter -> Bool
`canBeVotedOnBy` Voter
voter)]

unelectedCommitteeVoters ::
  StrictMaybe (Committee era) ->
  CommitteeState era ->
  VotingProcedures era ->
  Set (Credential HotCommitteeRole)
unelectedCommitteeVoters :: forall era.
StrictMaybe (Committee era)
-> CommitteeState era
-> VotingProcedures era
-> Set (Credential HotCommitteeRole)
unelectedCommitteeVoters StrictMaybe (Committee era)
committee CommitteeState era
committeeState =
  let authorizedElectedCommittee :: Set (Credential HotCommitteeRole)
authorizedElectedCommittee = StrictMaybe (Committee era)
-> CommitteeState era -> Set (Credential HotCommitteeRole)
forall era.
StrictMaybe (Committee era)
-> CommitteeState era -> Set (Credential HotCommitteeRole)
authorizedElectedHotCommitteeCredentials StrictMaybe (Committee era)
committee CommitteeState era
committeeState
      collectUnelectedCommitteeVotes :: Set (Credential HotCommitteeRole)
-> Voter
-> Map GovActionId (VotingProcedure era)
-> Set (Credential HotCommitteeRole)
collectUnelectedCommitteeVotes !Set (Credential HotCommitteeRole)
unelectedHotCreds Voter
voter Map GovActionId (VotingProcedure era)
_ =
        case Voter
voter of
          CommitteeVoter Credential HotCommitteeRole
hotCred
            | Credential HotCommitteeRole
hotCred Credential HotCommitteeRole
-> Set (Credential HotCommitteeRole) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set (Credential HotCommitteeRole)
authorizedElectedCommittee ->
                Credential HotCommitteeRole
-> Set (Credential HotCommitteeRole)
-> Set (Credential HotCommitteeRole)
forall a. Ord a => a -> Set a -> Set a
Set.insert Credential HotCommitteeRole
hotCred Set (Credential HotCommitteeRole)
unelectedHotCreds
          Voter
_ -> Set (Credential HotCommitteeRole)
unelectedHotCreds
   in (Set (Credential HotCommitteeRole)
 -> Voter
 -> Map GovActionId (VotingProcedure era)
 -> Set (Credential HotCommitteeRole))
-> Set (Credential HotCommitteeRole)
-> Map Voter (Map GovActionId (VotingProcedure era))
-> Set (Credential HotCommitteeRole)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Set (Credential HotCommitteeRole)
-> Voter
-> Map GovActionId (VotingProcedure era)
-> Set (Credential HotCommitteeRole)
collectUnelectedCommitteeVotes Set (Credential HotCommitteeRole)
forall a. Set a
Set.empty (Map Voter (Map GovActionId (VotingProcedure era))
 -> Set (Credential HotCommitteeRole))
-> (VotingProcedures era
    -> Map Voter (Map GovActionId (VotingProcedure era)))
-> VotingProcedures era
-> Set (Credential HotCommitteeRole)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
unVotingProcedures

-- | If the GovAction is a HardFork, then return 3 things (if they exist)
-- 1) The (StrictMaybe GovPurposeId), pointed to by the HardFork proposal
-- 2) The proposed ProtVer
-- 3) The ProtVer of the preceeding HardFork
-- If it is not a HardFork, or the previous govActionId points to something other
-- than  HardFork, return Nothing. It will be verified with another predicate check.
preceedingHardFork ::
  EraPParams era =>
  GovAction era ->
  PParams era ->
  GovRelation StrictMaybe ->
  Proposals era ->
  Maybe (StrictMaybe (GovPurposeId 'HardForkPurpose), ProtVer, ProtVer)
preceedingHardFork :: forall era.
EraPParams era =>
GovAction era
-> PParams era
-> GovRelation StrictMaybe
-> Proposals era
-> Maybe
     (StrictMaybe (GovPurposeId 'HardForkPurpose), ProtVer, ProtVer)
preceedingHardFork (HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose)
mPrev ProtVer
newProtVer) PParams era
pp GovRelation StrictMaybe
pgaids Proposals era
ps
  | StrictMaybe (GovPurposeId 'HardForkPurpose)
mPrev StrictMaybe (GovPurposeId 'HardForkPurpose)
-> StrictMaybe (GovPurposeId 'HardForkPurpose) -> Bool
forall a. Eq a => a -> a -> Bool
== GovRelation StrictMaybe
pgaids GovRelation StrictMaybe
-> Getting
     (StrictMaybe (GovPurposeId 'HardForkPurpose))
     (GovRelation StrictMaybe)
     (StrictMaybe (GovPurposeId 'HardForkPurpose))
-> StrictMaybe (GovPurposeId 'HardForkPurpose)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (GovPurposeId 'HardForkPurpose))
  (GovRelation StrictMaybe)
  (StrictMaybe (GovPurposeId 'HardForkPurpose))
forall (f1 :: * -> *) (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'HardForkPurpose)
 -> f2 (f1 (GovPurposeId 'HardForkPurpose)))
-> GovRelation f1 -> f2 (GovRelation f1)
grHardForkL = (StrictMaybe (GovPurposeId 'HardForkPurpose), ProtVer, ProtVer)
-> Maybe
     (StrictMaybe (GovPurposeId 'HardForkPurpose), ProtVer, ProtVer)
forall a. a -> Maybe a
Just (StrictMaybe (GovPurposeId 'HardForkPurpose)
mPrev, ProtVer
newProtVer, 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)
  | Bool
otherwise = do
      SJust (GovPurposeId prevGovActionId) <- StrictMaybe (GovPurposeId 'HardForkPurpose)
-> Maybe (StrictMaybe (GovPurposeId 'HardForkPurpose))
forall a. a -> Maybe a
Just StrictMaybe (GovPurposeId 'HardForkPurpose)
mPrev
      HardForkInitiation _ prevProtVer <- gasAction <$> proposalsLookupId prevGovActionId ps
      Just (mPrev, newProtVer, prevProtVer)
preceedingHardFork GovAction era
_ PParams era
_ GovRelation StrictMaybe
_ Proposals era
_ = Maybe
  (StrictMaybe (GovPurposeId 'HardForkPurpose), ProtVer, ProtVer)
forall a. Maybe a
Nothing