{-# 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 (..),
 )
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.CertState (
  CertState (..),
  CommitteeState (..),
  PState (..),
  VState (..),
  authorizedHotCommitteeCredentials,
 )
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 (..),
  foldlVotingProcedures,
  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.TxCert
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Keys (KeyRole (..))
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.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 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 (EraCrypto era)
geTxId :: !(TxId (EraCrypto era))
  , forall era. GovEnv era -> EpochNo
geEpoch :: !EpochNo
  , forall era. GovEnv era -> PParams era
gePParams :: !(PParams era)
  , forall era. GovEnv era -> StrictMaybe (ScriptHash (EraCrypto era))
gePPolicy :: !(StrictMaybe (ScriptHash (EraCrypto era)))
  , forall era. GovEnv era -> CertState era
geCertState :: !(CertState era)
  }
  deriving (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
$cto :: forall era x. Rep (GovEnv era) x -> GovEnv era
$cfrom :: forall era x. GovEnv era -> Rep (GovEnv era) x
Generic)

instance EraPParams era => EncCBOR (GovEnv era) where
  encCBOR :: GovEnv era -> Encoding
encCBOR x :: GovEnv era
x@(GovEnv TxId (EraCrypto era)
_ EpochNo
_ PParams era
_ StrictMaybe (ScriptHash (EraCrypto era))
_ CertState era
_) =
    let GovEnv {PParams era
StrictMaybe (ScriptHash (EraCrypto era))
CertState era
TxId (EraCrypto era)
EpochNo
geCertState :: CertState era
gePPolicy :: StrictMaybe (ScriptHash (EraCrypto era))
gePParams :: PParams era
geEpoch :: EpochNo
geTxId :: TxId (EraCrypto era)
geCertState :: forall era. GovEnv era -> CertState era
gePPolicy :: forall era. GovEnv era -> StrictMaybe (ScriptHash (EraCrypto era))
gePParams :: forall era. GovEnv era -> PParams era
geEpoch :: forall era. GovEnv era -> EpochNo
geTxId :: forall era. GovEnv era -> TxId (EraCrypto era)
..} = GovEnv era
x
     in forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
          forall t. t -> Encode ('Closed 'Dense) t
Rec forall era.
TxId (EraCrypto era)
-> EpochNo
-> PParams era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> CertState era
-> GovEnv era
GovEnv
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxId (EraCrypto era)
geTxId
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To EpochNo
geEpoch
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PParams era
gePParams
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe (ScriptHash (EraCrypto era))
gePPolicy
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To CertState era
geCertState

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

data ConwayGovPredFailure era
  = GovActionsDoNotExist (NonEmpty (GovActionId (EraCrypto era)))
  | MalformedProposal (GovAction era)
  | ProposalProcedureNetworkIdMismatch (RewardAccount (EraCrypto era)) Network
  | TreasuryWithdrawalsNetworkIdMismatch (Set.Set (RewardAccount (EraCrypto era))) 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 (EraCrypto era), GovActionId (EraCrypto era)))
  | ConflictingCommitteeUpdate
      -- | Credentials that are mentioned as members to be both removed and added
      (Set.Set (Credential 'ColdCommitteeRole (EraCrypto era)))
  | ExpirationEpochTooSmall
      -- | Members for which the expiration epoch has already been reached
      (Map.Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo)
  | InvalidPrevGovActionId (ProposalProcedure era)
  | VotingOnExpiredGovAction (NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era)))
  | 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 (EraCrypto era)))
      -- | The policy script hash of the current constitution
      (StrictMaybe (ScriptHash (EraCrypto era)))
  | DisallowedProposalDuringBootstrap (ProposalProcedure era)
  | DisallowedVotesDuringBootstrap
      (NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era)))
  | -- | Predicate failure for votes by entities that are not present in the ledger state
    VotersDoNotExist (NonEmpty (Voter (EraCrypto era)))
  | -- | 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 (EraCrypto era))
  | -- | Treasury withdrawal proposals to an invalid reward account
    TreasuryWithdrawalReturnAccountsDoNotExist (NonEmpty (RewardAccount (EraCrypto era)))
  deriving (ConwayGovPredFailure era -> ConwayGovPredFailure era -> Bool
forall era.
EraPParams era =>
ConwayGovPredFailure era -> ConwayGovPredFailure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConwayGovPredFailure era -> ConwayGovPredFailure era -> Bool
$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
Eq, Int -> ConwayGovPredFailure era -> ShowS
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
showList :: [ConwayGovPredFailure era] -> ShowS
$cshowList :: forall era. EraPParams era => [ConwayGovPredFailure era] -> ShowS
show :: ConwayGovPredFailure era -> String
$cshow :: forall era. EraPParams era => ConwayGovPredFailure era -> String
showsPrec :: Int -> ConwayGovPredFailure era -> ShowS
$cshowsPrec :: forall era.
EraPParams era =>
Int -> ConwayGovPredFailure era -> ShowS
Show, 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
$cto :: forall era x.
Rep (ConwayGovPredFailure era) x -> ConwayGovPredFailure era
$cfrom :: forall era x.
ConwayGovPredFailure era -> Rep (ConwayGovPredFailure era) x
Generic)

type instance EraRuleFailure "GOV" (ConwayEra c) = ConwayGovPredFailure (ConwayEra c)

type instance EraRuleEvent "GOV" (ConwayEra c) = ConwayGovEvent (ConwayEra c)

instance InjectRuleFailure "GOV" ConwayGovPredFailure (ConwayEra c)

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

instance EraPParams era => EncCBOR (ConwayGovPredFailure era) where
  encCBOR :: ConwayGovPredFailure era -> Encoding
encCBOR =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      GovActionsDoNotExist NonEmpty (GovActionId (EraCrypto era))
gid ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
NonEmpty (GovActionId (EraCrypto era)) -> ConwayGovPredFailure era
GovActionsDoNotExist Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonEmpty (GovActionId (EraCrypto era))
gid
      MalformedProposal GovAction era
ga ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era. GovAction era -> ConwayGovPredFailure era
MalformedProposal Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To GovAction era
ga
      ProposalProcedureNetworkIdMismatch RewardAccount (EraCrypto era)
acnt Network
nid ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
RewardAccount (EraCrypto era)
-> Network -> ConwayGovPredFailure era
ProposalProcedureNetworkIdMismatch Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To RewardAccount (EraCrypto era)
acnt forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Network
nid
      TreasuryWithdrawalsNetworkIdMismatch Set (RewardAccount (EraCrypto era))
acnts Network
nid ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set (RewardAccount (EraCrypto era))
-> Network -> ConwayGovPredFailure era
TreasuryWithdrawalsNetworkIdMismatch Word
3 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (RewardAccount (EraCrypto era))
acnts forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Network
nid
      ProposalDepositIncorrect Mismatch 'RelEQ Coin
mm ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era. Mismatch 'RelEQ Coin -> ConwayGovPredFailure era
ProposalDepositIncorrect Word
4 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelEQ Coin
mm
      DisallowedVoters NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
votes ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
-> ConwayGovPredFailure era
DisallowedVoters Word
5 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
votes
      ConflictingCommitteeUpdate Set (Credential 'ColdCommitteeRole (EraCrypto era))
members ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> ConwayGovPredFailure era
ConflictingCommitteeUpdate Word
6 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (Credential 'ColdCommitteeRole (EraCrypto era))
members
      ExpirationEpochTooSmall Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
members ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> ConwayGovPredFailure era
ExpirationEpochTooSmall Word
7 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
members
      InvalidPrevGovActionId ProposalProcedure era
proposal ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era. ProposalProcedure era -> ConwayGovPredFailure era
InvalidPrevGovActionId Word
8 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ProposalProcedure era
proposal
      VotingOnExpiredGovAction NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
ga ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
-> ConwayGovPredFailure era
VotingOnExpiredGovAction Word
9 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
ga
      ProposalCantFollow StrictMaybe (GovPurposeId 'HardForkPurpose era)
prevgaid Mismatch 'RelGT ProtVer
mm ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Mismatch 'RelGT ProtVer -> ConwayGovPredFailure era
ProposalCantFollow Word
10 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe (GovPurposeId 'HardForkPurpose era)
prevgaid forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBORGroup t => t -> Encode ('Closed 'Dense) t
ToGroup Mismatch 'RelGT ProtVer
mm
      InvalidPolicyHash StrictMaybe (ScriptHash (EraCrypto era))
got StrictMaybe (ScriptHash (EraCrypto era))
expected ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
StrictMaybe (ScriptHash (EraCrypto era))
-> StrictMaybe (ScriptHash (EraCrypto era))
-> ConwayGovPredFailure era
InvalidPolicyHash Word
11 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe (ScriptHash (EraCrypto era))
got forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To StrictMaybe (ScriptHash (EraCrypto era))
expected
      DisallowedProposalDuringBootstrap ProposalProcedure era
proposal ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap Word
12 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ProposalProcedure era
proposal
      DisallowedVotesDuringBootstrap NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
votes ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
-> ConwayGovPredFailure era
DisallowedVotesDuringBootstrap Word
13 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
votes
      VotersDoNotExist NonEmpty (Voter (EraCrypto era))
voters ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
NonEmpty (Voter (EraCrypto era)) -> ConwayGovPredFailure era
VotersDoNotExist Word
14 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonEmpty (Voter (EraCrypto era))
voters
      ZeroTreasuryWithdrawals GovAction era
ga ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era. GovAction era -> ConwayGovPredFailure era
ZeroTreasuryWithdrawals Word
15 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To GovAction era
ga
      ProposalReturnAccountDoesNotExist RewardAccount (EraCrypto era)
returnAccount ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
RewardAccount (EraCrypto era) -> ConwayGovPredFailure era
ProposalReturnAccountDoesNotExist Word
16 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To RewardAccount (EraCrypto era)
returnAccount
      TreasuryWithdrawalReturnAccountsDoNotExist NonEmpty (RewardAccount (EraCrypto era))
accounts ->
        forall t. t -> Word -> Encode 'Open t
Sum forall era.
NonEmpty (RewardAccount (EraCrypto era))
-> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist Word
17 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To NonEmpty (RewardAccount (EraCrypto era))
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 (EraCrypto era)) !(Proposals era)
  | GovRemovedVotes
      !(TxId (EraCrypto era))
      -- | Votes that were replaced in this tx.
      !(Set (Voter (EraCrypto era), GovActionId (EraCrypto era)))
      -- | Any votes from these DReps in this or in previous txs are removed
      !(Set (Credential 'DRepRole (EraCrypto era)))
  deriving (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
$cto :: forall era x. Rep (ConwayGovEvent era) x -> ConwayGovEvent era
$cfrom :: forall era x. ConwayGovEvent era -> Rep (ConwayGovEvent era) x
Generic, ConwayGovEvent era -> ConwayGovEvent era -> Bool
forall era.
EraPParams era =>
ConwayGovEvent era -> ConwayGovEvent era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConwayGovEvent era -> ConwayGovEvent era -> Bool
$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
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 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
$cto :: forall era x. Rep (GovSignal era) x -> GovSignal era
$cfrom :: forall era x. GovSignal era -> Rep (GovSignal era) x
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
gsCertificates :: StrictSeq (TxCert era)
gsProposalProcedures :: OSet (ProposalProcedure era)
gsVotingProcedures :: VotingProcedures era
gsCertificates :: forall era. GovSignal era -> StrictSeq (TxCert era)
gsProposalProcedures :: forall era. GovSignal era -> OSet (ProposalProcedure era)
gsVotingProcedures :: forall era. GovSignal era -> VotingProcedures era
..} = GovSignal era
x
     in forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
          forall t. t -> Encode ('Closed 'Dense) t
Rec forall era.
VotingProcedures era
-> OSet (ProposalProcedure era)
-> StrictSeq (TxCert era)
-> GovSignal era
GovSignal
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To VotingProcedures era
gsVotingProcedures
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To OSet (ProposalProcedure era)
gsProposalProcedures
            forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> 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
  ) =>
  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) =>
TransitionRule (EraRule "GOV" era)
govTransition @era]

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

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

checkBootstrapVotes ::
  forall era.
  EraPParams era =>
  PParams era ->
  [(Voter (EraCrypto era), GovActionState era)] ->
  Test (ConwayGovPredFailure era)
checkBootstrapVotes :: forall era.
EraPParams era =>
PParams era
-> [(Voter (EraCrypto era), GovActionState era)]
-> Test (ConwayGovPredFailure era)
checkBootstrapVotes PParams era
pp [(Voter (EraCrypto era), GovActionState era)]
votes
  | ProtVer -> Bool
HF.bootstrapPhase (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL) =
      forall era.
[(Voter (EraCrypto era), GovActionState era)]
-> (NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
    -> ConwayGovPredFailure era)
-> (GovActionState era -> Voter (EraCrypto era) -> Bool)
-> Test (ConwayGovPredFailure era)
checkDisallowedVotes [(Voter (EraCrypto era), GovActionState era)]
votes forall era.
NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
-> ConwayGovPredFailure era
DisallowedVotesDuringBootstrap forall a b. (a -> b) -> a -> b
$ \GovActionState era
gas ->
        \case
          DRepVoter {} | forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas forall a. Eq a => a -> a -> Bool
== forall era. GovAction era
InfoAction -> Bool
True
          DRepVoter {} -> Bool
False
          Voter (EraCrypto era)
_ -> forall era. GovAction era -> Bool
isBootstrapAction forall a b. (a -> b) -> a -> b
$ forall era. GovActionState era -> GovAction era
gasAction GovActionState era
gas
  | Bool
otherwise = 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 = forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless Bool
isWellFormed forall a b. (a -> b) -> a -> b
$ 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 (EraCrypto era))
_ -> forall era.
ConwayEraPParams era =>
ProtVer -> PParamsUpdate era -> Bool
ppuWellFormed ProtVer
pv PParamsUpdate era
ppd
      GovAction era
_ -> Bool
True

mkGovActionState ::
  GovActionId (EraCrypto era) ->
  ProposalProcedure era ->
  -- | The number of epochs to expiry from protocol parameters
  EpochInterval ->
  -- | The current epoch
  EpochNo ->
  GovActionState era
mkGovActionState :: forall era.
GovActionId (EraCrypto era)
-> ProposalProcedure era
-> EpochInterval
-> EpochNo
-> GovActionState era
mkGovActionState GovActionId (EraCrypto era)
actionId ProposalProcedure era
proposal EpochInterval
expiryInterval EpochNo
curEpoch =
  GovActionState
    { gasId :: GovActionId (EraCrypto era)
gasId = GovActionId (EraCrypto era)
actionId
    , gasCommitteeVotes :: Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
gasCommitteeVotes = forall a. Monoid a => a
mempty
    , gasDRepVotes :: Map (Credential 'DRepRole (EraCrypto era)) Vote
gasDRepVotes = forall a. Monoid a => a
mempty
    , gasStakePoolVotes :: Map (KeyHash 'StakePool (EraCrypto era)) Vote
gasStakePoolVotes = 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 (EraCrypto era)) ->
  StrictMaybe (ScriptHash (EraCrypto era)) ->
  Test (ConwayGovPredFailure era)
checkPolicy :: forall era.
StrictMaybe (ScriptHash (EraCrypto era))
-> StrictMaybe (ScriptHash (EraCrypto era))
-> Test (ConwayGovPredFailure era)
checkPolicy StrictMaybe (ScriptHash (EraCrypto era))
expectedPolicyHash StrictMaybe (ScriptHash (EraCrypto era))
actualPolicyHash =
  forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless (StrictMaybe (ScriptHash (EraCrypto era))
actualPolicyHash forall a. Eq a => a -> a -> Bool
== StrictMaybe (ScriptHash (EraCrypto era))
expectedPolicyHash) forall a b. (a -> b) -> a -> b
$
    forall era.
StrictMaybe (ScriptHash (EraCrypto era))
-> StrictMaybe (ScriptHash (EraCrypto era))
-> ConwayGovPredFailure era
InvalidPolicyHash StrictMaybe (ScriptHash (EraCrypto era))
actualPolicyHash StrictMaybe (ScriptHash (EraCrypto era))
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 :: forall era. ProposalProcedure era -> GovAction era
pProcGovAction :: GovAction era
pProcGovAction}
  | ProtVer -> Bool
HF.bootstrapPhase (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL) =
      forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless (forall era. GovAction era -> Bool
isBootstrapAction GovAction era
pProcGovAction) forall a b. (a -> b) -> a -> b
$ forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal
  | Bool
otherwise = 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
  ) =>
  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) =>
TransitionRule (EraRule "GOV" era)
govTransition = do
  TRC
    ( GovEnv TxId (EraCrypto era)
txid EpochNo
currentEpoch PParams era
pp StrictMaybe (ScriptHash (EraCrypto era))
constitutionPolicy CertState {DState era
certDState :: forall era. CertState era -> DState era
certDState :: DState era
certDState, PState era
certPState :: forall era. CertState era -> PState era
certPState :: PState era
certPState, VState era
certVState :: forall era. CertState era -> VState era
certVState :: VState era
certVState}
      , State (EraRule "GOV" era)
st
      , GovSignal {VotingProcedures era
gsVotingProcedures :: VotingProcedures era
gsVotingProcedures :: forall era. GovSignal era -> VotingProcedures era
gsVotingProcedures, OSet (ProposalProcedure era)
gsProposalProcedures :: OSet (ProposalProcedure era)
gsProposalProcedures :: forall era. GovSignal era -> OSet (ProposalProcedure era)
gsProposalProcedures, StrictSeq (TxCert era)
gsCertificates :: StrictSeq (TxCert era)
gsCertificates :: forall era. GovSignal era -> StrictSeq (TxCert era)
gsCertificates}
      ) <-
    forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let prevGovActionIds :: GovRelation StrictMaybe era
prevGovActionIds = State (EraRule "GOV" era)
st forall s a. s -> Getting a s a -> a
^. forall era. Lens' (Proposals era) (GovRelation PRoot era)
pRootsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
L.to forall era. GovRelation PRoot era -> GovRelation StrictMaybe era
toPrevGovActionIds
      committeeState :: CommitteeState era
committeeState = forall era. VState era -> CommitteeState era
vsCommitteeState VState era
certVState
      knownDReps :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
knownDReps = forall era.
VState era
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
vsDReps VState era
certVState
      knownStakePools :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
knownStakePools = forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams PState era
certPState
      knownCommitteeMembers :: Set (Credential 'HotCommitteeRole (EraCrypto era))
knownCommitteeMembers = forall era.
CommitteeState era
-> Set (Credential 'HotCommitteeRole (EraCrypto era))
authorizedHotCommitteeCredentials CommitteeState era
committeeState

  Network
expectedNetworkId <- forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS forall a b. (a -> b) -> a -> b
$ 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 {RewardAccount (EraCrypto era)
Coin
Anchor (EraCrypto era)
GovAction era
pProcAnchor :: forall era. ProposalProcedure era -> Anchor (EraCrypto era)
pProcReturnAddr :: forall era. ProposalProcedure era -> RewardAccount (EraCrypto era)
pProcDeposit :: forall era. ProposalProcedure era -> Coin
pProcAnchor :: Anchor (EraCrypto era)
pProcGovAction :: GovAction era
pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcDeposit :: Coin
pProcGovAction :: forall era. ProposalProcedure era -> GovAction era
..}) = do
        forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest forall a b. (a -> b) -> a -> b
$ forall era.
EraPParams era =>
PParams era
-> ProposalProcedure era -> Test (ConwayGovPredFailure era)
checkBootstrapProposal PParams era
pp ProposalProcedure era
proposal

        let newGaid :: GovActionId (EraCrypto era)
newGaid = forall c. TxId c -> GovActionIx -> GovActionId c
GovActionId TxId (EraCrypto era)
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)
st
              if ProtVer -> ProtVer -> Bool
pvCanFollow ProtVer
prevProtVer ProtVer
newProtVer
                then forall a. Maybe a
Nothing
                else
                  forall a. a -> Maybe a
Just 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 forall a b. (a -> b) -> a -> b
$
                      Mismatch
                        { mismatchSupplied :: ProtVer
mismatchSupplied = ProtVer
newProtVer
                        , mismatchExpected :: ProtVer
mismatchExpected = ProtVer
prevProtVer
                        }
        forall a sts (ctx :: RuleType).
Maybe a -> (a -> PredicateFailure sts) -> Rule sts ctx ()
failOnJust Maybe (ConwayGovPredFailure era)
badHardFork forall a. a -> a
id

        -- PParamsUpdate well-formedness check
        forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
ProtVer -> GovAction era -> Test (ConwayGovPredFailure era)
actionWellFormed (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL) GovAction era
pProcGovAction

        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ProtVer -> Bool
HF.bootstrapPhase forall a b. (a -> b) -> a -> b
$ PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL) forall a b. (a -> b) -> a -> b
$ do
          let refundAddress :: RewardAccount (EraCrypto era)
refundAddress = ProposalProcedure era
proposal forall s a. s -> Getting a s a -> a
^. forall era.
Lens' (ProposalProcedure era) (RewardAccount (EraCrypto era))
pProcReturnAddrL
              govAction :: GovAction era
govAction = ProposalProcedure era
proposal forall s a. s -> Getting a s a -> a
^. forall era. Lens' (ProposalProcedure era) (GovAction era)
pProcGovActionL
          forall c. Credential 'Staking c -> UMap c -> Bool
UMap.member' (forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAccount (EraCrypto era)
refundAddress) (DState era
certDState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (DState era) (UMap (EraCrypto era))
dsUnifiedL)
            forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era.
RewardAccount (EraCrypto era) -> ConwayGovPredFailure era
ProposalReturnAccountDoesNotExist RewardAccount (EraCrypto era)
refundAddress
          case GovAction era
govAction of
            TreasuryWithdrawals Map (RewardAccount (EraCrypto era)) Coin
withdrawals StrictMaybe (ScriptHash (EraCrypto era))
_ -> do
              let nonRegisteredAccounts :: Map (RewardAccount (EraCrypto era)) Coin
nonRegisteredAccounts =
                    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey Map (RewardAccount (EraCrypto era)) Coin
withdrawals forall a b. (a -> b) -> a -> b
$ \RewardAccount (EraCrypto era)
withdrawalAddress Coin
_ ->
                      Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall c. Credential 'Staking c -> UMap c -> Bool
UMap.member' (forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAccount (EraCrypto era)
withdrawalAddress) (DState era
certDState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (DState era) (UMap (EraCrypto era))
dsUnifiedL)
              forall (f :: * -> *) a sts (ctx :: RuleType).
Foldable f =>
f a -> (NonEmpty a -> PredicateFailure sts) -> Rule sts ctx ()
failOnNonEmpty (forall k a. Map k a -> [k]
Map.keys Map (RewardAccount (EraCrypto era)) Coin
nonRegisteredAccounts) forall era.
NonEmpty (RewardAccount (EraCrypto era))
-> ConwayGovPredFailure era
TreasuryWithdrawalReturnAccountsDoNotExist
            GovAction era
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        -- Deposit check
        let expectedDep :: Coin
expectedDep = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
         in Coin
pProcDeposit
              forall a. Eq a => a -> a -> Bool
== Coin
expectedDep
                forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era. Mismatch 'RelEQ Coin -> ConwayGovPredFailure era
ProposalDepositIncorrect
                  Mismatch
                    { mismatchSupplied :: Coin
mismatchSupplied = Coin
pProcDeposit
                    , mismatchExpected :: Coin
mismatchExpected = Coin
expectedDep
                    }

        -- Return address network id check
        forall c. RewardAccount c -> Network
raNetwork RewardAccount (EraCrypto era)
pProcReturnAddr
          forall a. Eq a => a -> a -> Bool
== Network
expectedNetworkId
            forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era.
RewardAccount (EraCrypto era)
-> Network -> ConwayGovPredFailure era
ProposalProcedureNetworkIdMismatch RewardAccount (EraCrypto era)
pProcReturnAddr Network
expectedNetworkId

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

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

                  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ProtVer -> Bool
HF.bootstrapPhase (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL)) forall a b. (a -> b) -> a -> b
$
                    -- The sum of all withdrawals must be positive
                    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold Map (RewardAccount (EraCrypto era)) Coin
wdrls forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era. GovAction era -> ConwayGovPredFailure era
ZeroTreasuryWithdrawals GovAction era
pProcGovAction
          UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
_mPrevGovActionId Set (Credential 'ColdCommitteeRole (EraCrypto era))
membersToRemove Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
membersToAdd UnitInterval
_qrm -> do
            Rule (EraRule "GOV" era) 'Transition ()
checkConflictingUpdate
            Rule (EraRule "GOV" era) 'Transition ()
checkExpirationEpoch
            where
              checkConflictingUpdate :: Rule (EraRule "GOV" era) 'Transition ()
checkConflictingUpdate =
                let conflicting :: Set (Credential 'ColdCommitteeRole (EraCrypto era))
conflicting =
                      forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
                        (forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
membersToAdd)
                        Set (Credential 'ColdCommitteeRole (EraCrypto era))
membersToRemove
                 in forall a. Set a -> Bool
Set.null Set (Credential 'ColdCommitteeRole (EraCrypto era))
conflicting forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era.
Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> ConwayGovPredFailure era
ConflictingCommitteeUpdate Set (Credential 'ColdCommitteeRole (EraCrypto era))
conflicting
              checkExpirationEpoch :: Rule (EraRule "GOV" era) 'Transition ()
checkExpirationEpoch =
                let invalidMembers :: Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
invalidMembers = forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall a. Ord a => a -> a -> Bool
<= EpochNo
currentEpoch) Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
membersToAdd
                 in forall k a. Map k a -> Bool
Map.null Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
invalidMembers forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! forall era.
Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> ConwayGovPredFailure era
ExpirationEpochTooSmall Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
invalidMembers
          ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
_ PParamsUpdate era
_ StrictMaybe (ScriptHash (EraCrypto era))
proposalPolicy ->
            forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (ScriptHash (EraCrypto era))
-> StrictMaybe (ScriptHash (EraCrypto era))
-> Test (ConwayGovPredFailure era)
checkPolicy @era StrictMaybe (ScriptHash (EraCrypto era))
constitutionPolicy StrictMaybe (ScriptHash (EraCrypto era))
proposalPolicy
          GovAction era
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        -- Ancestry checks and accept proposal
        let expiry :: EpochInterval
expiry = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL
            actionState :: GovActionState era
actionState =
              forall era.
GovActionId (EraCrypto era)
-> ProposalProcedure era
-> EpochInterval
-> EpochNo
-> GovActionState era
mkGovActionState
                GovActionId (EraCrypto era)
newGaid
                ProposalProcedure era
proposal
                EpochInterval
expiry
                EpochNo
currentEpoch
         in case forall era.
(EraPParams era, HasCallStack) =>
GovActionState era -> Proposals era -> Maybe (Proposals era)
proposalsAddAction GovActionState era
actionState Proposals era
ps of
              Just Proposals era
updatedPs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Proposals era
updatedPs
              Maybe (Proposals era)
Nothing -> Proposals era
ps forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall sts (ctx :: RuleType).
PredicateFailure sts -> Rule sts ctx ()
failBecause (forall era. ProposalProcedure era -> ConwayGovPredFailure era
InvalidPrevGovActionId ProposalProcedure era
proposal)

  Proposals era
proposals <-
    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)
st forall a b. (a -> b) -> a -> b
$
      forall era.
Seq (ProposalProcedure era)
-> Seq (GovActionIx, ProposalProcedure era)
indexedGovProps (forall a. StrictSeq a -> Seq a
SSeq.fromStrict (forall a. OSet a -> StrictSeq a
OSet.toStrictSeq OSet (ProposalProcedure era)
gsProposalProcedures))

  -- Inversion of the keys in VotingProcedures, where we can find the voters for every
  -- govActionId
  let ([GovActionId (EraCrypto era)]
unknownGovActionIds, [(Voter (EraCrypto era), GovActionState era)]
knownVotes, Set (Voter (EraCrypto era), GovActionId (EraCrypto era))
replacedVotes) =
        forall era c.
(Voter (EraCrypto era)
 -> GovActionId (EraCrypto era) -> VotingProcedure era -> c -> c)
-> c -> VotingProcedures era -> c
foldrVotingProcedures
          -- strictness is not needed for `unknown` or `replaced`
          ( \Voter (EraCrypto era)
voter GovActionId (EraCrypto era)
gaId VotingProcedure era
_ ([GovActionId (EraCrypto era)]
unknown, ![(Voter (EraCrypto era), GovActionState era)]
known, Set (Voter (EraCrypto era), GovActionId (EraCrypto era))
replaced) ->
              case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GovActionId (EraCrypto era)
gaId Map (GovActionId (EraCrypto era)) (GovActionState era)
curGovActionIds of
                Just GovActionState era
gas ->
                  let isVoteReplaced :: Bool
isVoteReplaced =
                        case Voter (EraCrypto era)
voter of
                          CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
hotCred -> Credential 'HotCommitteeRole (EraCrypto era)
hotCred forall k a. Ord k => k -> Map k a -> Bool
`Map.member` forall era.
GovActionState era
-> Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
gasCommitteeVotes GovActionState era
gas
                          DRepVoter Credential 'DRepRole (EraCrypto era)
cred -> Credential 'DRepRole (EraCrypto era)
cred forall k a. Ord k => k -> Map k a -> Bool
`Map.member` forall era.
GovActionState era
-> Map (Credential 'DRepRole (EraCrypto era)) Vote
gasDRepVotes GovActionState era
gas
                          StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolId -> KeyHash 'StakePool (EraCrypto era)
poolId forall k a. Ord k => k -> Map k a -> Bool
`Map.member` forall era.
GovActionState era -> Map (KeyHash 'StakePool (EraCrypto era)) Vote
gasStakePoolVotes GovActionState era
gas
                      replaced' :: Set (Voter (EraCrypto era), GovActionId (EraCrypto era))
replaced'
                        | Bool
isVoteReplaced = forall a. Ord a => a -> Set a -> Set a
Set.insert (Voter (EraCrypto era)
voter, GovActionId (EraCrypto era)
gaId) Set (Voter (EraCrypto era), GovActionId (EraCrypto era))
replaced
                        | Bool
otherwise = Set (Voter (EraCrypto era), GovActionId (EraCrypto era))
replaced
                   in ([GovActionId (EraCrypto era)]
unknown, (Voter (EraCrypto era)
voter, GovActionState era
gas) forall a. a -> [a] -> [a]
: [(Voter (EraCrypto era), GovActionState era)]
known, Set (Voter (EraCrypto era), GovActionId (EraCrypto era))
replaced')
                Maybe (GovActionState era)
Nothing -> (GovActionId (EraCrypto era)
gaId forall a. a -> [a] -> [a]
: [GovActionId (EraCrypto era)]
unknown, [(Voter (EraCrypto era), GovActionState era)]
known, Set (Voter (EraCrypto era), GovActionId (EraCrypto era))
replaced)
          )
          ([], [], forall a. Set a
Set.empty)
          VotingProcedures era
gsVotingProcedures
      curGovActionIds :: Map (GovActionId (EraCrypto era)) (GovActionState era)
curGovActionIds = forall era.
Proposals era
-> Map (GovActionId (EraCrypto era)) (GovActionState era)
proposalsActionsMap Proposals era
proposals
      isVoterKnown :: Voter (EraCrypto era) -> Bool
isVoterKnown = \case
        CommitteeVoter Credential 'HotCommitteeRole (EraCrypto era)
hotCred -> Credential 'HotCommitteeRole (EraCrypto era)
hotCred forall a. Ord a => a -> Set a -> Bool
`Set.member` Set (Credential 'HotCommitteeRole (EraCrypto era))
knownCommitteeMembers
        DRepVoter Credential 'DRepRole (EraCrypto era)
cred -> Credential 'DRepRole (EraCrypto era)
cred forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
knownDReps
        StakePoolVoter KeyHash 'StakePool (EraCrypto era)
poolId -> KeyHash 'StakePool (EraCrypto era)
poolId forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
knownStakePools
      unknownVoters :: [Voter (EraCrypto era)]
unknownVoters =
        forall k a. Map k a -> [k]
Map.keys forall a b. (a -> b) -> a -> b
$
          forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Voter (EraCrypto era)
voter Map (GovActionId (EraCrypto era)) (VotingProcedure era)
_ -> Bool -> Bool
not (Voter (EraCrypto era) -> Bool
isVoterKnown Voter (EraCrypto era)
voter)) (forall era.
VotingProcedures era
-> Map
     (Voter (EraCrypto era))
     (Map (GovActionId (EraCrypto era)) (VotingProcedure era))
unVotingProcedures VotingProcedures era
gsVotingProcedures)

  forall (f :: * -> *) a sts (ctx :: RuleType).
Foldable f =>
f a -> (NonEmpty a -> PredicateFailure sts) -> Rule sts ctx ()
failOnNonEmpty [Voter (EraCrypto era)]
unknownVoters forall era.
NonEmpty (Voter (EraCrypto era)) -> ConwayGovPredFailure era
VotersDoNotExist
  forall (f :: * -> *) a sts (ctx :: RuleType).
Foldable f =>
f a -> (NonEmpty a -> PredicateFailure sts) -> Rule sts ctx ()
failOnNonEmpty [GovActionId (EraCrypto era)]
unknownGovActionIds forall era.
NonEmpty (GovActionId (EraCrypto era)) -> ConwayGovPredFailure era
GovActionsDoNotExist
  forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest forall a b. (a -> b) -> a -> b
$ forall era.
EraPParams era =>
PParams era
-> [(Voter (EraCrypto era), GovActionState era)]
-> Test (ConwayGovPredFailure era)
checkBootstrapVotes PParams era
pp [(Voter (EraCrypto era), GovActionState era)]
knownVotes
  forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest forall a b. (a -> b) -> a -> b
$ forall era.
EpochNo
-> [(Voter (EraCrypto era), GovActionState era)]
-> Test (ConwayGovPredFailure era)
checkVotesAreNotForExpiredActions EpochNo
currentEpoch [(Voter (EraCrypto era), GovActionState era)]
knownVotes
  forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
EpochNo
-> CommitteeState era
-> [(Voter (EraCrypto era), GovActionState era)]
-> Test (ConwayGovPredFailure era)
checkVotersAreValid EpochNo
currentEpoch CommitteeState era
committeeState [(Voter (EraCrypto era), GovActionState era)]
knownVotes

  let
    addVoterVote :: Proposals era
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> VotingProcedure era
-> Proposals era
addVoterVote Proposals era
ps Voter (EraCrypto era)
voter GovActionId (EraCrypto era)
govActionId VotingProcedure {Vote
vProcVote :: forall era. VotingProcedure era -> Vote
vProcVote :: Vote
vProcVote} =
      forall era.
Voter (EraCrypto era)
-> Vote
-> GovActionId (EraCrypto era)
-> Proposals era
-> Proposals era
proposalsAddVote Voter (EraCrypto era)
voter Vote
vProcVote GovActionId (EraCrypto era)
govActionId Proposals era
ps
    updatedProposalStates :: Proposals era
updatedProposalStates =
      Proposals era -> Proposals era
cleanupProposalVotes forall a b. (a -> b) -> a -> b
$
        forall c era.
(c
 -> Voter (EraCrypto era)
 -> GovActionId (EraCrypto era)
 -> VotingProcedure era
 -> c)
-> c -> VotingProcedures era -> c
foldlVotingProcedures forall {era} {era}.
Proposals era
-> Voter (EraCrypto era)
-> GovActionId (EraCrypto era)
-> VotingProcedure era
-> Proposals era
addVoterVote Proposals era
proposals VotingProcedures era
gsVotingProcedures
    unregisteredDReps :: Set (Credential 'DRepRole (EraCrypto era))
unregisteredDReps =
      let collectRemovals :: Set (Credential 'DRepRole (EraCrypto era))
-> TxCert era -> Set (Credential 'DRepRole (EraCrypto era))
collectRemovals Set (Credential 'DRepRole (EraCrypto era))
drepCreds = \case
            UnRegDRepTxCert Credential 'DRepRole (EraCrypto era)
drepCred Coin
_ -> forall a. Ord a => a -> Set a -> Set a
Set.insert Credential 'DRepRole (EraCrypto era)
drepCred Set (Credential 'DRepRole (EraCrypto era))
drepCreds
            TxCert era
_ -> Set (Credential 'DRepRole (EraCrypto era))
drepCreds
       in forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall {era}.
ConwayEraTxCert era =>
Set (Credential 'DRepRole (EraCrypto era))
-> TxCert era -> Set (Credential 'DRepRole (EraCrypto era))
collectRemovals forall a. Monoid a => a
mempty StrictSeq (TxCert era)
gsCertificates
    cleanupProposalVotes :: Proposals era -> Proposals era
cleanupProposalVotes =
      let cleanupVoters :: GovActionState era -> GovActionState era
cleanupVoters GovActionState era
gas =
            GovActionState era
gas forall a b. a -> (a -> b) -> b
& forall era.
Lens'
  (GovActionState era)
  (Map (Credential 'DRepRole (EraCrypto era)) Vote)
gasDRepVotesL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Set (Credential 'DRepRole (EraCrypto era))
unregisteredDReps)
       in forall era.
(GovActionState era -> GovActionState era)
-> Proposals era -> Proposals era
mapProposals GovActionState era -> GovActionState era
cleanupVoters

  -- Report the event
  forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent forall a b. (a -> b) -> a -> b
$ forall era.
TxId (EraCrypto era) -> Proposals era -> ConwayGovEvent era
GovNewProposals TxId (EraCrypto era)
txid Proposals era
updatedProposalStates
  forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent forall a b. (a -> b) -> a -> b
$ forall era.
TxId (EraCrypto era)
-> Set (Voter (EraCrypto era), GovActionId (EraCrypto era))
-> Set (Credential 'DRepRole (EraCrypto era))
-> ConwayGovEvent era
GovRemovedVotes TxId (EraCrypto era)
txid Set (Voter (EraCrypto era), GovActionId (EraCrypto era))
replacedVotes Set (Credential 'DRepRole (EraCrypto era))
unregisteredDReps

  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 (EraCrypto era), GovActionState era)] ->
  (NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era)) -> ConwayGovPredFailure era) ->
  (GovActionState era -> Voter (EraCrypto era) -> Bool) ->
  Test (ConwayGovPredFailure era)
checkDisallowedVotes :: forall era.
[(Voter (EraCrypto era), GovActionState era)]
-> (NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
    -> ConwayGovPredFailure era)
-> (GovActionState era -> Voter (EraCrypto era) -> Bool)
-> Test (ConwayGovPredFailure era)
checkDisallowedVotes [(Voter (EraCrypto era), GovActionState era)]
votes NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
-> ConwayGovPredFailure era
failure GovActionState era -> Voter (EraCrypto era) -> Bool
canBeVotedOnBy =
  forall (f :: * -> *) a e.
Foldable f =>
f a -> (NonEmpty a -> e) -> Validation (NonEmpty e) ()
failureOnNonEmpty [(Voter (EraCrypto era), GovActionId (EraCrypto era))]
disallowedVotes NonEmpty (Voter (EraCrypto era), GovActionId (EraCrypto era))
-> ConwayGovPredFailure era
failure
  where
    disallowedVotes :: [(Voter (EraCrypto era), GovActionId (EraCrypto era))]
disallowedVotes =
      [(Voter (EraCrypto era)
voter, forall era. GovActionState era -> GovActionId (EraCrypto era)
gasId GovActionState era
gas) | (Voter (EraCrypto era)
voter, GovActionState era
gas) <- [(Voter (EraCrypto era), GovActionState era)]
votes, Bool -> Bool
not (GovActionState era
gas GovActionState era -> Voter (EraCrypto era) -> Bool
`canBeVotedOnBy` Voter (EraCrypto era)
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 forall a. Eq a => a -> a -> Bool
== GovRelation StrictMaybe era
pgaids forall s a. s -> Getting a s a -> a
^. forall (f :: * -> *) era.
Lens' (GovRelation f era) (f (GovPurposeId 'HardForkPurpose era))
grHardForkL = forall a. a -> Maybe a
Just (StrictMaybe (GovPurposeId 'HardForkPurpose era)
mPrev, ProtVer
newProtVer, PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL)
  | Bool
otherwise = do
      SJust (GovPurposeId GovActionId (EraCrypto era)
prevGovActionId) <- forall a. a -> Maybe a
Just StrictMaybe (GovPurposeId 'HardForkPurpose era)
mPrev
      HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
_ ProtVer
prevProtVer <- forall era. GovActionState era -> GovAction era
gasAction forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
GovActionId (EraCrypto era)
-> Proposals era -> Maybe (GovActionState era)
proposalsLookupId GovActionId (EraCrypto era)
prevGovActionId Proposals era
ps
      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
_ = forall a. Maybe a
Nothing