{-# 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 (..),
) 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)
import Cardano.Ledger.Conway.Governance (
  GovAction (..),
  GovActionId (..),
  GovActionPurpose (..),
  GovActionState (..),
  GovPurposeId (..),
  GovRelation (..),
  ProposalProcedure (..),
  Proposals,
  Voter (..),
  VotingProcedure (..),
  VotingProcedures (..),
  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 (
  ConwayEraCertState (..),
  VState (..),
 )
import Cardano.Ledger.Conway.TxCert
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Rules.ValidationMode (Test, runTest)
import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
import Cardano.Ledger.Shelley.LedgerState (dsUnifiedL)
import Cardano.Ledger.Shelley.PParams (pvCanFollow)
import Cardano.Ledger.State (
  CommitteeState (..),
  EraCertState (..),
  PState (..),
  authorizedHotCommitteeCredentials,
 )
import Cardano.Ledger.TxIn (TxId (..))
import qualified Cardano.Ledger.UMap as UMap
import Control.DeepSeq (NFData)
import Control.Monad (unless)
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
  }
  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 (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
_) =
    let GovEnv {StrictMaybe ScriptHash
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
geTxId :: TxId
geEpoch :: EpochNo
gePParams :: PParams era
gePPolicy :: StrictMaybe ScriptHash
geCertState :: CertState 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
 -> GovEnv era)
-> Encode
     ('Closed 'Dense)
     (TxId
      -> EpochNo
      -> PParams era
      -> StrictMaybe ScriptHash
      -> CertState era
      -> GovEnv era)
forall t. t -> Encode ('Closed 'Dense) t
Rec TxId
-> EpochNo
-> PParams era
-> StrictMaybe ScriptHash
-> CertState era
-> GovEnv era
forall era.
TxId
-> EpochNo
-> PParams era
-> StrictMaybe ScriptHash
-> CertState era
-> GovEnv era
GovEnv
            Encode
  ('Closed 'Dense)
  (TxId
   -> EpochNo
   -> PParams era
   -> StrictMaybe ScriptHash
   -> CertState era
   -> GovEnv era)
-> Encode ('Closed 'Dense) TxId
-> Encode
     ('Closed 'Dense)
     (EpochNo
      -> PParams era
      -> StrictMaybe ScriptHash
      -> CertState 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
   -> GovEnv era)
-> Encode ('Closed 'Dense) EpochNo
-> Encode
     ('Closed 'Dense)
     (PParams era
      -> StrictMaybe ScriptHash -> CertState 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 -> GovEnv era)
-> Encode ('Closed 'Dense) (PParams era)
-> Encode
     ('Closed 'Dense)
     (StrictMaybe ScriptHash -> CertState 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 -> GovEnv era)
-> Encode ('Closed 'Dense) (StrictMaybe ScriptHash)
-> Encode ('Closed 'Dense) (CertState 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 -> GovEnv era)
-> Encode ('Closed 'Dense) (CertState era)
-> Encode ('Closed 'Dense) (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

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 era))
      -- | 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)
  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 Any) (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 Any) (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 Any) (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 Any) (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 Any) 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 Any) RewardAccount
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (Network -> ConwayGovPredFailure era)
-> Decode ('Closed Any) 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 Any) 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 Any) (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 Any) (Set RewardAccount)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (Network -> ConwayGovPredFailure era)
-> Decode ('Closed Any) 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 Any) 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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (NonEmpty (Voter, GovActionId))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
10 -> (StrictMaybe (GovPurposeId 'HardForkPurpose era)
 -> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era)
-> Decode
     'Open
     (StrictMaybe (GovPurposeId 'HardForkPurpose era)
      -> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era)
forall t. t -> Decode 'Open t
SumD StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
ProposalCantFollow Decode
  'Open
  (StrictMaybe (GovPurposeId 'HardForkPurpose era)
   -> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era)
-> Decode
     ('Closed Any) (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> 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 Any) (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era)
-> Decode ('Closed Any) (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 Any) (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 Any) (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 Any) (StrictMaybe ScriptHash)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (StrictMaybe ScriptHash -> ConwayGovPredFailure era)
-> Decode ('Closed Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) 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 Any) 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 Any) (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 Any) (NonEmpty RewardAccount)
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 era)
prevgaid Mismatch 'RelGT ProtVer
mm ->
        (StrictMaybe (GovPurposeId 'HardForkPurpose era)
 -> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era)
-> Word
-> Encode
     'Open
     (StrictMaybe (GovPurposeId 'HardForkPurpose era)
      -> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
ProposalCantFollow Word
10 Encode
  'Open
  (StrictMaybe (GovPurposeId 'HardForkPurpose era)
   -> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era)
-> Encode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> 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 era)
-> Encode
     ('Closed 'Dense) (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe (GovPurposeId 'HardForkPurpose era)
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

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
  , 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,
 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
HF.bootstrapPhase (PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL) =
      [(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 era)
_ 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
HF.bootstrapPhase (PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL) =
      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
  , 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,
 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
txid EpochNo
currentEpoch PParams era
pp StrictMaybe ScriptHash
constitutionPolicy CertState era
certState
      , State (EraRule "GOV" era)
st
      , GovSignal {VotingProcedures era
gsVotingProcedures :: forall era. GovSignal era -> VotingProcedures era
gsVotingProcedures :: VotingProcedures era
gsVotingProcedures, OSet (ProposalProcedure era)
gsProposalProcedures :: forall era. GovSignal era -> OSet (ProposalProcedure era)
gsProposalProcedures :: OSet (ProposalProcedure era)
gsProposalProcedures, StrictSeq (TxCert era)
gsCertificates :: forall era. GovSignal era -> StrictSeq (TxCert era)
gsCertificates :: StrictSeq (TxCert era)
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 :: GovRelation StrictMaybe era
prevGovActionIds = State (EraRule "GOV" era)
Proposals era
st Proposals era
-> Getting
     (GovRelation StrictMaybe era)
     (Proposals era)
     (GovRelation StrictMaybe era)
-> GovRelation StrictMaybe era
forall s a. s -> Getting a s a -> a
^. (GovRelation PRoot era
 -> Const (GovRelation StrictMaybe era) (GovRelation PRoot era))
-> Proposals era
-> Const (GovRelation StrictMaybe era) (Proposals era)
forall era (f :: * -> *).
Functor f =>
(GovRelation PRoot era -> f (GovRelation PRoot era))
-> Proposals era -> f (Proposals era)
pRootsL ((GovRelation PRoot era
  -> Const (GovRelation StrictMaybe era) (GovRelation PRoot era))
 -> Proposals era
 -> Const (GovRelation StrictMaybe era) (Proposals era))
-> ((GovRelation StrictMaybe era
     -> Const
          (GovRelation StrictMaybe era) (GovRelation StrictMaybe era))
    -> GovRelation PRoot era
    -> Const (GovRelation StrictMaybe era) (GovRelation PRoot era))
-> Getting
     (GovRelation StrictMaybe era)
     (Proposals era)
     (GovRelation StrictMaybe era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovRelation PRoot era -> GovRelation StrictMaybe era)
-> SimpleGetter
     (GovRelation PRoot era) (GovRelation StrictMaybe era)
forall s a. (s -> a) -> SimpleGetter s a
L.to GovRelation PRoot era -> GovRelation StrictMaybe era
forall era. GovRelation PRoot era -> GovRelation StrictMaybe era
toPrevGovActionIds
      certVState :: VState era
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 :: PState era
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 :: DState era
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 :: CommitteeState era
committeeState = VState era -> CommitteeState era
forall era. VState era -> CommitteeState era
vsCommitteeState VState era
certVState
      knownDReps :: Map (Credential 'DRepRole) DRepState
knownDReps = VState era -> Map (Credential 'DRepRole) DRepState
forall era. VState era -> Map (Credential 'DRepRole) DRepState
vsDReps VState era
certVState
      knownStakePools :: Map (KeyHash 'StakePool) PoolParams
knownStakePools = PState era -> Map (KeyHash 'StakePool) PoolParams
forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psStakePoolParams PState era
certPState
      knownCommitteeMembers :: Set (Credential 'HotCommitteeRole)
knownCommitteeMembers = CommitteeState era -> Set (Credential 'HotCommitteeRole)
forall era.
CommitteeState era -> Set (Credential 'HotCommitteeRole)
authorizedHotCommitteeCredentials CommitteeState era
committeeState

  Network
expectedNetworkId <- BaseM (EraRule "GOV" era) Network
-> Rule (EraRule "GOV" era) 'Transition Network
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (EraRule "GOV" era) Network
 -> Rule (EraRule "GOV" era) 'Transition Network)
-> BaseM (EraRule "GOV" era) Network
-> Rule (EraRule "GOV" era) 'Transition Network
forall a b. (a -> b) -> a -> b
$ (Globals -> Network) -> ReaderT Globals Identity Network
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> Network
networkId

  let processProposal :: Proposals era
-> (GovActionIx, ProposalProcedure era)
-> F (Clause (EraRule "GOV" era) 'Transition) (Proposals era)
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
pProcDeposit :: forall era. ProposalProcedure era -> Coin
pProcReturnAddr :: forall era. ProposalProcedure era -> RewardAccount
pProcAnchor :: forall era. ProposalProcedure era -> Anchor
..}) = 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
              (StrictMaybe (GovPurposeId 'HardForkPurpose era)
prevGaid, ProtVer
newProtVer, ProtVer
prevProtVer) <-
                forall era.
EraPParams era =>
GovAction era
-> PParams era
-> GovRelation StrictMaybe era
-> Proposals era
-> Maybe
     (StrictMaybe (GovPurposeId 'HardForkPurpose era), ProtVer, ProtVer)
preceedingHardFork @era GovAction era
pProcGovAction PParams era
pp GovRelation StrictMaybe era
prevGovActionIds State (EraRule "GOV" era)
Proposals era
st
              if ProtVer -> ProtVer -> Bool
pvCanFollow ProtVer
prevProtVer ProtVer
newProtVer
                then Maybe (ConwayGovPredFailure era)
forall a. Maybe a
Nothing
                else
                  ConwayGovPredFailure era -> Maybe (ConwayGovPredFailure era)
forall a. a -> Maybe a
Just (ConwayGovPredFailure era -> Maybe (ConwayGovPredFailure era))
-> ConwayGovPredFailure era -> Maybe (ConwayGovPredFailure era)
forall a b. (a -> b) -> a -> b
$
                    forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
ProposalCantFollow @era StrictMaybe (GovPurposeId 'HardForkPurpose era)
prevGaid (Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
forall a b. (a -> b) -> a -> b
$
                      Mismatch
                        { mismatchSupplied :: ProtVer
mismatchSupplied = ProtVer
newProtVer
                        , mismatchExpected :: ProtVer
mismatchExpected = ProtVer
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
HF.bootstrapPhase (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 -> UMap -> Bool
UMap.member' (RewardAccount -> Credential 'Staking
raCredential RewardAccount
refundAddress) (DState era
certDState DState era -> Getting UMap (DState era) UMap -> UMap
forall s a. s -> Getting a s a -> a
^. Getting UMap (DState era) UMap
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL)
            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 -> UMap -> Bool
UMap.member' (RewardAccount -> Credential 'Staking
raCredential RewardAccount
withdrawalAddress) (DState era
certDState DState era -> Getting UMap (DState era) UMap -> UMap
forall s a. s -> Getting a s a -> a
^. Getting UMap (DState era) UMap
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL)
              [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
HF.bootstrapPhase (PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL)) (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 era)
_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 era)
_ 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 era
proposals <-
    (Proposals era
 -> (GovActionIx, ProposalProcedure era)
 -> F (Clause (EraRule "GOV" era) 'Transition) (Proposals era))
-> Proposals era
-> Seq (GovActionIx, ProposalProcedure era)
-> F (Clause (EraRule "GOV" era) 'Transition) (Proposals era)
forall (t :: * -> *) (m :: * -> *) ans k.
(Foldable t, Monad m) =>
(ans -> k -> m ans) -> ans -> t k -> m ans
foldlM' Proposals era
-> (GovActionIx, ProposalProcedure era)
-> F (Clause (EraRule "GOV" era) 'Transition) (Proposals era)
processProposal State (EraRule "GOV" era)
Proposals era
st (Seq (GovActionIx, ProposalProcedure era)
 -> F (Clause (EraRule "GOV" era) 'Transition) (Proposals era))
-> Seq (GovActionIx, ProposalProcedure era)
-> F (Clause (EraRule "GOV" era) 'Transition) (Proposals era)
forall a b. (a -> b) -> a -> b
$
      Seq (ProposalProcedure era)
-> Seq (GovActionIx, ProposalProcedure era)
forall era.
Seq (ProposalProcedure era)
-> Seq (GovActionIx, ProposalProcedure era)
indexedGovProps (StrictSeq (ProposalProcedure era) -> Seq (ProposalProcedure era)
forall a. StrictSeq a -> Seq a
SSeq.fromStrict (OSet (ProposalProcedure era) -> StrictSeq (ProposalProcedure era)
forall a. OSet a -> StrictSeq a
OSet.toStrictSeq OSet (ProposalProcedure era)
gsProposalProcedures))

  let knownVotes :: [(Voter, GovActionState era)]
knownVotes = [(Voter
voter, GovActionState era
gas) | (Voter
voter, Vote
_vote, GovActionState era
gas) <- [(Voter, Vote, GovActionState era)]
knownVotesWithCast]
      ([GovActionId]
unknownGovActionIds, ![(Voter, Vote, GovActionState era)]
knownVotesWithCast, Set (Voter, GovActionId)
replacedVotes) =
        (Voter
 -> GovActionId
 -> VotingProcedure era
 -> ([GovActionId], [(Voter, Vote, GovActionState era)],
     Set (Voter, GovActionId))
 -> ([GovActionId], [(Voter, Vote, GovActionState era)],
     Set (Voter, GovActionId)))
-> ([GovActionId], [(Voter, Vote, GovActionState era)],
    Set (Voter, GovActionId))
-> VotingProcedures era
-> ([GovActionId], [(Voter, Vote, GovActionState era)],
    Set (Voter, GovActionId))
forall era c.
(Voter -> GovActionId -> VotingProcedure era -> c -> c)
-> c -> VotingProcedures era -> c
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 (Voter, GovActionId)
forall a. Set a
Set.empty)
          (Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
VotingProcedures Map Voter (Map GovActionId (VotingProcedure era))
knownVoters)
      curGovActionIds :: Map GovActionId (GovActionState era)
curGovActionIds = Proposals era -> Map GovActionId (GovActionState era)
forall era. Proposals era -> Map GovActionId (GovActionState era)
proposalsActionsMap Proposals era
proposals
      internVoter :: Voter -> Maybe Voter
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) PoolParams
-> Maybe (KeyHash 'StakePool)
forall k a. Ord k => k -> Map k a -> Maybe k
internMap KeyHash 'StakePool
poolId Map (KeyHash 'StakePool) PoolParams
knownStakePools
      (Set Voter
unknownVoters, Map Voter (Map GovActionId (VotingProcedure era))
knownVoters) =
        ([Voter] -> Set Voter)
-> ([(Voter, Map GovActionId (VotingProcedure era))]
    -> Map Voter (Map GovActionId (VotingProcedure era)))
-> ([Voter], [(Voter, Map GovActionId (VotingProcedure era))])
-> (Set Voter, Map Voter (Map GovActionId (VotingProcedure era)))
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Voter] -> Set Voter
forall a. Ord a => [a] -> Set a
Set.fromList [(Voter, Map GovActionId (VotingProcedure era))]
-> Map Voter (Map GovActionId (VotingProcedure era))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (([Voter], [(Voter, Map GovActionId (VotingProcedure era))])
 -> (Set Voter, Map Voter (Map GovActionId (VotingProcedure era))))
-> ([Voter], [(Voter, Map GovActionId (VotingProcedure era))])
-> (Set Voter, Map Voter (Map GovActionId (VotingProcedure era)))
forall a b. (a -> b) -> a -> b
$
          [Either Voter (Voter, Map GovActionId (VotingProcedure era))]
-> ([Voter], [(Voter, Map GovActionId (VotingProcedure era))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
            [ Either Voter (Voter, Map GovActionId (VotingProcedure era))
-> (Voter
    -> Either Voter (Voter, Map GovActionId (VotingProcedure era)))
-> Maybe Voter
-> Either Voter (Voter, Map GovActionId (VotingProcedure era))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Voter
-> Either Voter (Voter, Map GovActionId (VotingProcedure era))
forall a b. a -> Either a b
Left Voter
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)) (Voter -> Maybe Voter
internVoter Voter
voter)
            | (Voter
voter, Map GovActionId (VotingProcedure era)
votes) <- Map Voter (Map GovActionId (VotingProcedure era))
-> [(Voter, Map GovActionId (VotingProcedure era))]
forall k a. Map k a -> [(k, a)]
Map.toList (VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
unVotingProcedures VotingProcedures era
gsVotingProcedures)
            ]

  Set Voter
-> (NonEmpty Voter -> 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 Set Voter
unknownVoters NonEmpty Voter -> PredicateFailure (EraRule "GOV" era)
NonEmpty Voter -> ConwayGovPredFailure era
forall era. NonEmpty Voter -> ConwayGovPredFailure era
VotersDoNotExist
  [GovActionId]
-> (NonEmpty GovActionId -> 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 [GovActionId]
unknownGovActionIds NonEmpty GovActionId -> PredicateFailure (EraRule "GOV" era)
NonEmpty GovActionId -> ConwayGovPredFailure era
forall era. NonEmpty GovActionId -> ConwayGovPredFailure era
GovActionsDoNotExist
  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
-> [(Voter, GovActionState era)] -> Test (ConwayGovPredFailure era)
forall era.
EraPParams era =>
PParams era
-> [(Voter, GovActionState era)] -> Test (ConwayGovPredFailure era)
checkBootstrapVotes PParams era
pp [(Voter, GovActionState era)]
knownVotes
  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
$ EpochNo
-> [(Voter, GovActionState era)] -> Test (ConwayGovPredFailure era)
forall era.
EpochNo
-> [(Voter, GovActionState era)] -> Test (ConwayGovPredFailure era)
checkVotesAreNotForExpiredActions EpochNo
currentEpoch [(Voter, GovActionState era)]
knownVotes
  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
$ EpochNo
-> CommitteeState era
-> [(Voter, GovActionState era)]
-> Test (ConwayGovPredFailure era)
forall era.
ConwayEraPParams era =>
EpochNo
-> CommitteeState era
-> [(Voter, GovActionState era)]
-> Test (ConwayGovPredFailure era)
checkVotersAreValid EpochNo
currentEpoch CommitteeState era
committeeState [(Voter, GovActionState era)]
knownVotes

  let
    !updatedProposalStates :: Proposals era
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 :: Set (Credential 'DRepRole)
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 :: Proposals era -> Proposals era
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
  Event (EraRule "GOV" era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (EraRule "GOV" era)
 -> F (Clause (EraRule "GOV" era) 'Transition) ())
-> Event (EraRule "GOV" era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ TxId -> Proposals era -> ConwayGovEvent era
forall era. TxId -> Proposals era -> ConwayGovEvent era
GovNewProposals TxId
txid Proposals era
updatedProposalStates
  Event (EraRule "GOV" era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (EraRule "GOV" era)
 -> F (Clause (EraRule "GOV" era) 'Transition) ())
-> Event (EraRule "GOV" era)
-> F (Clause (EraRule "GOV" era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ TxId
-> Set (Voter, GovActionId)
-> Set (Credential 'DRepRole)
-> ConwayGovEvent era
forall era.
TxId
-> Set (Voter, GovActionId)
-> Set (Credential 'DRepRole)
-> ConwayGovEvent era
GovRemovedVotes TxId
txid Set (Voter, GovActionId)
replacedVotes Set (Credential 'DRepRole)
unregisteredDReps

  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
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)]

-- | 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 era ->
  Proposals era ->
  Maybe (StrictMaybe (GovPurposeId 'HardForkPurpose era), ProtVer, ProtVer)
preceedingHardFork :: forall era.
EraPParams era =>
GovAction era
-> PParams era
-> GovRelation StrictMaybe era
-> Proposals era
-> Maybe
     (StrictMaybe (GovPurposeId 'HardForkPurpose era), ProtVer, ProtVer)
preceedingHardFork (HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
mPrev ProtVer
newProtVer) PParams era
pp GovRelation StrictMaybe era
pgaids Proposals era
ps
  | StrictMaybe (GovPurposeId 'HardForkPurpose era)
mPrev StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> StrictMaybe (GovPurposeId 'HardForkPurpose era) -> Bool
forall a. Eq a => a -> a -> Bool
== GovRelation StrictMaybe era
pgaids GovRelation StrictMaybe era
-> Getting
     (StrictMaybe (GovPurposeId 'HardForkPurpose era))
     (GovRelation StrictMaybe era)
     (StrictMaybe (GovPurposeId 'HardForkPurpose era))
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (GovPurposeId 'HardForkPurpose era))
  (GovRelation StrictMaybe era)
  (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall (f1 :: * -> *) era (f2 :: * -> *).
Functor f2 =>
(f1 (GovPurposeId 'HardForkPurpose era)
 -> f2 (f1 (GovPurposeId 'HardForkPurpose era)))
-> GovRelation f1 era -> f2 (GovRelation f1 era)
grHardForkL = (StrictMaybe (GovPurposeId 'HardForkPurpose era), ProtVer, ProtVer)
-> Maybe
     (StrictMaybe (GovPurposeId 'HardForkPurpose era), ProtVer, ProtVer)
forall a. a -> Maybe a
Just (StrictMaybe (GovPurposeId 'HardForkPurpose era)
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 GovActionId
prevGovActionId) <- StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Maybe (StrictMaybe (GovPurposeId 'HardForkPurpose era))
forall a. a -> Maybe a
Just StrictMaybe (GovPurposeId 'HardForkPurpose era)
mPrev
      HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
_ ProtVer
prevProtVer <- GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction (GovActionState era -> GovAction era)
-> Maybe (GovActionState era) -> Maybe (GovAction era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GovActionId -> Proposals era -> Maybe (GovActionState era)
forall era.
GovActionId -> Proposals era -> Maybe (GovActionState era)
proposalsLookupId GovActionId
prevGovActionId Proposals era
ps
      (StrictMaybe (GovPurposeId 'HardForkPurpose era), ProtVer, ProtVer)
-> Maybe
     (StrictMaybe (GovPurposeId 'HardForkPurpose era), ProtVer, ProtVer)
forall a. a -> Maybe a
Just (StrictMaybe (GovPurposeId 'HardForkPurpose era)
mPrev, ProtVer
newProtVer, ProtVer
prevProtVer)
preceedingHardFork GovAction era
_ PParams era
_ GovRelation StrictMaybe era
_ Proposals era
_ = Maybe
  (StrictMaybe (GovPurposeId 'HardForkPurpose era), ProtVer, ProtVer)
forall a. Maybe a
Nothing