{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Test.Cardano.Ledger.Api.State.QuerySpec (spec) where

import Cardano.Ledger.Api.State.Query (
  CommitteeMemberState (..),
  CommitteeMembersState (..),
  HotCredAuthStatus (..),
  MemberStatus (..),
  NextEpochChange (..),
  filterStakePoolDelegsAndRewards,
  getNextEpochCommitteeMembers,
  queryCommitteeMembersState,
 )
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.CertState
import Cardano.Ledger.Coin (CompactForm (CompactCoin))
import Cardano.Ledger.Conway (ConwayEra)
import Cardano.Ledger.Conway.Governance (
  Committee (..),
  ConwayEraGov (..),
  ConwayGovState,
  DRepPulsingState (..),
  RatifyState (..),
  ensCommitteeL,
  newEpochStateDRepPulsingStateL,
  rsEnactStateL,
 )
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.PoolDistr
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.UMap (UMap)
import Data.Default (Default (..))
import Data.Foldable (foldMap')
import qualified Data.Map.Strict as Map
import Data.Maybe (isNothing)
import Data.Set (Set)
import qualified Data.Set as Set
import Lens.Micro ((&), (.~), (^.))
import Test.Cardano.Ledger.Api.Arbitrary ()
import Test.Cardano.Ledger.Api.State.Query
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Core.Arbitrary (genValidUMapWithCreds)
import Test.Cardano.Ledger.Shelley.Arbitrary ()
import Test.Cardano.Slotting.Numeric ()

spec :: Spec
spec :: Spec
spec = do
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"GetFilteredDelegationsAndRewardAccounts" forall a b. (a -> b) -> a -> b
$ do
    forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"filterStakePoolDelegsAndRewards same as getFilteredDelegationsAndRewardAccounts" forall a b. (a -> b) -> a -> b
$
      forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (UMap, Set (Credential 'Staking))
genValidUMapWithCreds forall a b. (a -> b) -> a -> b
$ \(UMap
umap :: UMap, Set (Credential 'Staking)
creds) ->
        UMap
-> Set (Credential 'Staking)
-> (Map (Credential 'Staking) (KeyHash 'StakePool),
    Map (Credential 'Staking) Coin)
filterStakePoolDelegsAndRewards UMap
umap Set (Credential 'Staking)
creds
          forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` UMap
-> Set (Credential 'Staking)
-> (Map (Credential 'Staking) (KeyHash 'StakePool),
    Map (Credential 'Staking) Coin)
getFilteredDelegationsAndRewardAccounts UMap
umap Set (Credential 'Staking)
creds

  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"GetCommitteeMembersState" forall a b. (a -> b) -> a -> b
$ do
    forall era.
(ConwayEraGov era, Default (EpochState era),
 Default (StashedAVVMAddresses era),
 GovState era ~ ConwayGovState era) =>
Spec
committeeMembersStateSpec @ConwayEra

committeeMembersStateSpec ::
  forall era.
  ( ConwayEraGov era
  , Default (EpochState era)
  , Default (StashedAVVMAddresses era)
  , GovState era ~ ConwayGovState era
  ) =>
  Spec
committeeMembersStateSpec :: forall era.
(ConwayEraGov era, Default (EpochState era),
 Default (StashedAVVMAddresses era),
 GovState era ~ ConwayGovState era) =>
Spec
committeeMembersStateSpec =
  forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"CommitteeMembersState Query" forall a b. (a -> b) -> a -> b
$ \Set MemberStatus
statusFilter -> do
    forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll forall era. Gen (Maybe (Committee era))
genCommittee forall a b. (a -> b) -> a -> b
$ \Maybe (Committee era)
committee ->
      -- half of the committee members in the next epoch will overlap with the current ones
      forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall era. Maybe (Committee era) -> Gen (Maybe (Committee era))
genNextCommittee @era Maybe (Committee era)
committee) forall a b. (a -> b) -> a -> b
$ \Maybe (Committee era)
nextCommittee ->
        -- replace some arbitrary number of cold keys from the committeeState with the
        -- ones from the committee so we can have Active members
        forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall era.
Maybe (Committee era)
-> Maybe (Committee era) -> Gen (CommitteeState era)
genRelevantCommitteeState @era Maybe (Committee era)
committee Maybe (Committee era)
nextCommittee) forall a b. (a -> b) -> a -> b
$ \CommitteeState era
committeeState -> do
          let nes :: NewEpochState era
nes =
                NewEpochState era
defNewEpochState
                  forall a b. a -> (a -> b) -> b
& forall era. Lens' (NewEpochState era) (EpochState era)
nesEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (VState era)
certVStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (VState era) (CommitteeState era)
vsCommitteeStateL
                    forall s t a b. ASetter s t a b -> b -> s -> t
.~ CommitteeState era
committeeState
                  forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraGov era =>
Lens' (NewEpochState era) (DRepPulsingState era)
newEpochStateDRepPulsingStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete forall a. Default a => a
def RatifyState era
nextRatifyState
                  forall a b. a -> (a -> b) -> b
& forall era. Lens' (NewEpochState era) (EpochState era)
nesEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL
                    forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (Committee era)
committee
              nextRatifyState :: RatifyState era
nextRatifyState =
                (forall a. Default a => a
def @(RatifyState era))
                  forall a b. a -> (a -> b) -> b
& forall era. Lens' (RatifyState era) (EnactState era)
rsEnactStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EnactState era) (StrictMaybe (Committee era))
ensCommitteeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (Committee era)
nextCommittee
              defNewEpochState :: NewEpochState era
defNewEpochState =
                forall era.
EpochNo
-> BlocksMade
-> BlocksMade
-> EpochState era
-> StrictMaybe PulsingRewUpdate
-> PoolDistr
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState @era
                  (Word64 -> EpochNo
EpochNo Word64
0)
                  (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade forall a. Default a => a
def)
                  (Map (KeyHash 'StakePool) Natural -> BlocksMade
BlocksMade forall a. Default a => a
def)
                  forall a. Default a => a
def
                  forall a. Default a => a
def
                  (Map (KeyHash 'StakePool) IndividualPoolStake
-> CompactForm Coin -> PoolDistr
PoolDistr forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ Word64 -> CompactForm Coin
CompactCoin Word64
1)
                  forall a. Default a => a
def
          -- replace some cold and hot keys from the filter with known ones from both
          -- committee and committeeState
          forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall era.
Maybe (Committee era)
-> CommitteeState era -> Gen (Set (Credential 'ColdCommitteeRole))
genRelevantColdCredsFilter Maybe (Committee era)
committee CommitteeState era
committeeState) forall a b. (a -> b) -> a -> b
$ \Set (Credential 'ColdCommitteeRole)
ckFilter ->
            forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (forall era.
CommitteeState era -> Gen (Set (Credential 'HotCommitteeRole))
genRelevantHotCredsFilter CommitteeState era
committeeState) forall a b. (a -> b) -> a -> b
$ \Set (Credential 'HotCommitteeRole)
hkFilter -> do
              forall era. ConwayEraGov era => NewEpochState era -> Expectation
propEmpty NewEpochState era
nes
              forall era. ConwayEraGov era => NewEpochState era -> Expectation
propComplete NewEpochState era
nes
              forall era. ConwayEraGov era => NewEpochState era -> Expectation
propAuthorized NewEpochState era
nes
              forall era. ConwayEraGov era => NewEpochState era -> Expectation
propActiveAuthorized NewEpochState era
nes
              forall era. ConwayEraGov era => NewEpochState era -> Expectation
propNotAuthorized NewEpochState era
nes
              forall era. ConwayEraGov era => NewEpochState era -> Expectation
propResigned NewEpochState era
nes
              forall era. ConwayEraGov era => NewEpochState era -> Expectation
propUnrecognized NewEpochState era
nes
              forall era. ConwayEraGov era => NewEpochState era -> Expectation
propNextEpoch NewEpochState era
nes
              forall era. ConwayEraGov era => NewEpochState era -> Expectation
propNoExpiration NewEpochState era
nes
              forall era.
ConwayEraGov era =>
Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> NewEpochState era
-> Expectation
propFilters Set (Credential 'ColdCommitteeRole)
ckFilter Set (Credential 'HotCommitteeRole)
hkFilter Set MemberStatus
statusFilter NewEpochState era
nes

propEmpty ::
  forall era.
  ConwayEraGov era =>
  NewEpochState era ->
  Expectation
propEmpty :: forall era. ConwayEraGov era => NewEpochState era -> Expectation
propEmpty NewEpochState era
nes = do
  forall era.
ConwayEraGov era =>
NewEpochState era
-> (Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeState era
    -> Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeMembersState
    -> Expectation)
-> Expectation
withCommitteeInfo NewEpochState era
nes forall a b. (a -> b) -> a -> b
$
    \Map (Credential 'ColdCommitteeRole) EpochNo
comMembers (CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers) Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers CommitteeMembersState
noFilterResult -> do
      forall k a. Map k a -> Bool
Map.null (CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee CommitteeMembersState
noFilterResult)
        forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` (forall k a. Map k a -> Bool
Map.null Map (Credential 'ColdCommitteeRole) EpochNo
comMembers Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers)

propComplete ::
  forall era.
  ConwayEraGov era =>
  NewEpochState era ->
  Expectation
propComplete :: forall era. ConwayEraGov era => NewEpochState era -> Expectation
propComplete NewEpochState era
nes = do
  forall era.
ConwayEraGov era =>
NewEpochState era
-> (Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeState era
    -> Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeMembersState
    -> Expectation)
-> Expectation
withCommitteeInfo NewEpochState era
nes forall a b. (a -> b) -> a -> b
$
    \Map (Credential 'ColdCommitteeRole) EpochNo
comMembers (CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers) Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers CommitteeMembersState
noFilterResult -> do
      -- if a credential appears in either Committee or CommitteeState, it should appear
      -- in the result
      forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) EpochNo
comMembers, forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers, forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers]
        forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall k a. Map k a -> Set k
Map.keysSet (CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee CommitteeMembersState
noFilterResult)

propNotAuthorized ::
  forall era.
  ConwayEraGov era =>
  NewEpochState era ->
  Expectation
propNotAuthorized :: forall era. ConwayEraGov era => NewEpochState era -> Expectation
propNotAuthorized NewEpochState era
nes = do
  forall era.
ConwayEraGov era =>
NewEpochState era
-> (Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeState era
    -> Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeMembersState
    -> Expectation)
-> Expectation
withCommitteeInfo NewEpochState era
nes forall a b. (a -> b) -> a -> b
$
    \Map (Credential 'ColdCommitteeRole) EpochNo
_ (CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers) Map (Credential 'ColdCommitteeRole) EpochNo
_ CommitteeMembersState
noFilterResult -> do
      let notAuthorized :: Map (Credential 'ColdCommitteeRole) CommitteeMemberState
notAuthorized =
            forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter
              ( \case
                  CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
_ Maybe EpochNo
_ NextEpochChange
_ -> Bool
True
                  CommitteeMemberState
_ -> Bool
False
              )
              (CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee CommitteeMembersState
noFilterResult)
      -- if the member is NotAuthorized, it should not have an associated hot credential in the committeeState
      forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers Map (Credential 'ColdCommitteeRole) CommitteeMemberState
notAuthorized forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall k a. Map k a
Map.empty

propAuthorized ::
  forall era.
  ConwayEraGov era =>
  NewEpochState era ->
  Expectation
propAuthorized :: forall era. ConwayEraGov era => NewEpochState era -> Expectation
propAuthorized NewEpochState era
nes = do
  forall era.
ConwayEraGov era =>
NewEpochState era
-> (Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeState era
    -> Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeMembersState
    -> Expectation)
-> Expectation
withCommitteeInfo NewEpochState era
nes forall a b. (a -> b) -> a -> b
$
    \Map (Credential 'ColdCommitteeRole) EpochNo
_ (CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers) Map (Credential 'ColdCommitteeRole) EpochNo
_ CommitteeMembersState
noFilterResult -> do
      let ckHk :: [(Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)]
ckHk =
            [ (Credential 'ColdCommitteeRole
ck, Credential 'HotCommitteeRole
hk)
            | (Credential 'ColdCommitteeRole
ck, CommitteeMemberState (MemberAuthorized Credential 'HotCommitteeRole
hk) MemberStatus
_ Maybe EpochNo
_ NextEpochChange
_) <- forall k a. Map k a -> [(k, a)]
Map.toList (CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee CommitteeMembersState
noFilterResult)
            ]
      -- if the member is Authorized, it should appear in the committeeState
      [(Credential 'ColdCommitteeRole, Credential 'HotCommitteeRole)]
ckHk forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [(Credential 'ColdCommitteeRole
ck, Credential 'HotCommitteeRole
hk) | (Credential 'ColdCommitteeRole
ck, CommitteeHotCredential Credential 'HotCommitteeRole
hk) <- forall k a. Map k a -> [(k, a)]
Map.toList Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers]

propResigned ::
  forall era.
  ConwayEraGov era =>
  NewEpochState era ->
  Expectation
propResigned :: forall era. ConwayEraGov era => NewEpochState era -> Expectation
propResigned NewEpochState era
nes = do
  forall era.
ConwayEraGov era =>
NewEpochState era
-> (Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeState era
    -> Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeMembersState
    -> Expectation)
-> Expectation
withCommitteeInfo NewEpochState era
nes forall a b. (a -> b) -> a -> b
$
    \Map (Credential 'ColdCommitteeRole) EpochNo
_ (CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers) Map (Credential 'ColdCommitteeRole) EpochNo
_ CommitteeMembersState
noFilterResult -> do
      let resigned :: [Credential 'ColdCommitteeRole]
resigned =
            [ Credential 'ColdCommitteeRole
ck
            | (Credential 'ColdCommitteeRole
ck, CommitteeMemberState (MemberResigned Maybe Anchor
_) MemberStatus
_ Maybe EpochNo
_ NextEpochChange
_) <- forall k a. Map k a -> [(k, a)]
Map.toList (CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee CommitteeMembersState
noFilterResult)
            ]
      -- if the member is Resignd, it should appear in the committeeState as Nothing
      [Credential 'ColdCommitteeRole]
resigned forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [Credential 'ColdCommitteeRole
ck | (Credential 'ColdCommitteeRole
ck, CommitteeMemberResigned StrictMaybe Anchor
_) <- forall k a. Map k a -> [(k, a)]
Map.toList Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers]

propUnrecognized ::
  forall era.
  ConwayEraGov era =>
  NewEpochState era ->
  Expectation
propUnrecognized :: forall era. ConwayEraGov era => NewEpochState era -> Expectation
propUnrecognized NewEpochState era
nes = do
  forall era.
ConwayEraGov era =>
NewEpochState era
-> (Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeState era
    -> Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeMembersState
    -> Expectation)
-> Expectation
withCommitteeInfo NewEpochState era
nes forall a b. (a -> b) -> a -> b
$
    \Map (Credential 'ColdCommitteeRole) EpochNo
comMembers (CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers) Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers' CommitteeMembersState
noFilterResult -> do
      let unrecognized :: Map (Credential 'ColdCommitteeRole) CommitteeMemberState
unrecognized =
            forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter
              ( \case
                  CommitteeMemberState HotCredAuthStatus
_ MemberStatus
Unrecognized Maybe EpochNo
_ NextEpochChange
_ -> Bool
True
                  CommitteeMemberState
_ -> Bool
False
              )
              (CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee CommitteeMembersState
noFilterResult)
      let nextComMembers :: Set (Credential 'ColdCommitteeRole)
nextComMembers = forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers'
      -- if the member is Unrecognized, it should not be in the committe, but it should be
      -- in the committeeState or in the nextCommittee
      forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map (Credential 'ColdCommitteeRole) EpochNo
comMembers Map (Credential 'ColdCommitteeRole) CommitteeMemberState
unrecognized forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall k a. Map k a
Map.empty
      forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) CommitteeMemberState
unrecognized
        forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` (forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (Credential 'ColdCommitteeRole)
nextComMembers))
      -- all Unrecognized members will be either enacted or removed in the next epoch
      forall a. Ord a => [a] -> Set a
Set.fromList (CommitteeMemberState -> NextEpochChange
cmsNextEpochChange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems Map (Credential 'ColdCommitteeRole) CommitteeMemberState
unrecognized)
        forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` forall a. Ord a => [a] -> Set a
Set.fromList [NextEpochChange
ToBeEnacted, NextEpochChange
ToBeRemoved])
      forall k a. Map k a -> Set k
Map.keysSet (forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\CommitteeMemberState
x -> CommitteeMemberState -> NextEpochChange
cmsNextEpochChange CommitteeMemberState
x forall a. Eq a => a -> a -> Bool
== NextEpochChange
ToBeEnacted) Map (Credential 'ColdCommitteeRole) CommitteeMemberState
unrecognized)
        forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set (Credential 'ColdCommitteeRole)
nextComMembers)
      forall k a. Map k a -> Set k
Map.keysSet (forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\CommitteeMemberState
x -> CommitteeMemberState -> NextEpochChange
cmsNextEpochChange CommitteeMemberState
x forall a. Eq a => a -> a -> Bool
== NextEpochChange
ToBeRemoved) Map (Credential 'ColdCommitteeRole) CommitteeMemberState
unrecognized)
        forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (\Set (Credential 'ColdCommitteeRole)
s -> forall a. Set a -> Bool
Set.null Set (Credential 'ColdCommitteeRole)
s Bool -> Bool -> Bool
|| Bool -> Bool
not (Set (Credential 'ColdCommitteeRole)
s forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set (Credential 'ColdCommitteeRole)
nextComMembers))

propActiveAuthorized ::
  forall era.
  ConwayEraGov era =>
  NewEpochState era ->
  Expectation
propActiveAuthorized :: forall era. ConwayEraGov era => NewEpochState era -> Expectation
propActiveAuthorized NewEpochState era
nes = do
  forall era.
ConwayEraGov era =>
NewEpochState era
-> (Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeState era
    -> Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeMembersState
    -> Expectation)
-> Expectation
withCommitteeInfo NewEpochState era
nes forall a b. (a -> b) -> a -> b
$
    \Map (Credential 'ColdCommitteeRole) EpochNo
comMembers (CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers) Map (Credential 'ColdCommitteeRole) EpochNo
_ CommitteeMembersState
noFilterResult -> do
      let activeAuthorized :: Map (Credential 'ColdCommitteeRole) (Credential 'HotCommitteeRole)
activeAuthorized =
            forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe
              ( \case
                  CommitteeMemberState (MemberAuthorized Credential 'HotCommitteeRole
hk) MemberStatus
Active Maybe EpochNo
_ NextEpochChange
_ -> forall a. a -> Maybe a
Just Credential 'HotCommitteeRole
hk
                  CommitteeMemberState
_ -> forall a. Maybe a
Nothing
              )
              (CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee CommitteeMembersState
noFilterResult)
      let epochNo :: EpochNo
epochNo = NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) EpochNo
nesELL

      -- if a member is active and authorized, then it should be:
      --   - in Committee and not expired
      --   - in CommitteeState, not empty
      forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) (Credential 'HotCommitteeRole)
activeAuthorized
        forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) EpochNo
comMembers)
      forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) (Credential 'HotCommitteeRole)
activeAuthorized
        forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers)
      forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map (Credential 'ColdCommitteeRole) EpochNo
comMembers Map (Credential 'ColdCommitteeRole) (Credential 'HotCommitteeRole)
activeAuthorized
        forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Ord a => a -> a -> Bool
>= EpochNo
epochNo)
      forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers Map (Credential 'ColdCommitteeRole) (Credential 'HotCommitteeRole)
activeAuthorized
        forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
          ( \case
              CommitteeHotCredential Credential 'HotCommitteeRole
_ -> Bool
True
              CommitteeAuthorization
_ -> Bool
False
          )

      CommitteeMembersState -> EpochNo
csEpochNo CommitteeMembersState
noFilterResult forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` EpochNo
epochNo

propFilters ::
  forall era.
  ConwayEraGov era =>
  Set (Credential 'ColdCommitteeRole) ->
  Set (Credential 'HotCommitteeRole) ->
  Set MemberStatus ->
  NewEpochState era ->
  Expectation
propFilters :: forall era.
ConwayEraGov era =>
Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> NewEpochState era
-> Expectation
propFilters Set (Credential 'ColdCommitteeRole)
ckFilter Set (Credential 'HotCommitteeRole)
hkFilter Set MemberStatus
statusFilter NewEpochState era
nes = do
  let (CommitteeMembersState Map (Credential 'ColdCommitteeRole) CommitteeMemberState
result Maybe UnitInterval
_ EpochNo
_) = forall era.
ConwayEraGov era =>
Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> NewEpochState era
-> CommitteeMembersState
queryCommitteeMembersState @era Set (Credential 'ColdCommitteeRole)
ckFilter Set (Credential 'HotCommitteeRole)
hkFilter Set MemberStatus
statusFilter NewEpochState era
nes
  let allCks :: Set (Credential 'ColdCommitteeRole)
allCks = forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) CommitteeMemberState
result
  let (Set (Credential 'HotCommitteeRole)
allHks, Set MemberStatus
allMemberStatuses) =
        forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap'
          ( \case
              CommitteeMemberState (MemberAuthorized Credential 'HotCommitteeRole
hk) MemberStatus
ms Maybe EpochNo
_ NextEpochChange
_ -> (forall a. a -> Set a
Set.singleton Credential 'HotCommitteeRole
hk, forall a. a -> Set a
Set.singleton MemberStatus
ms)
              CommitteeMemberState HotCredAuthStatus
_ MemberStatus
ms Maybe EpochNo
_ NextEpochChange
_ -> (forall a. Set a
Set.empty, forall a. a -> Set a
Set.singleton MemberStatus
ms)
          )
          Map (Credential 'ColdCommitteeRole) CommitteeMemberState
result
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Set a -> Bool
Set.null Set (Credential 'ColdCommitteeRole)
ckFilter) forall a b. (a -> b) -> a -> b
$
    Map (Credential 'ColdCommitteeRole) CommitteeMemberState
result forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` forall a b. a -> b -> a
const (Set (Credential 'ColdCommitteeRole)
allCks forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set (Credential 'ColdCommitteeRole)
ckFilter)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Set a -> Bool
Set.null Set (Credential 'HotCommitteeRole)
hkFilter) forall a b. (a -> b) -> a -> b
$
    Map (Credential 'ColdCommitteeRole) CommitteeMemberState
result forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` forall a b. a -> b -> a
const (Set (Credential 'HotCommitteeRole)
allHks forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set (Credential 'HotCommitteeRole)
hkFilter)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Set a -> Bool
Set.null Set MemberStatus
statusFilter) forall a b. (a -> b) -> a -> b
$
    Map (Credential 'ColdCommitteeRole) CommitteeMemberState
result forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` forall a b. a -> b -> a
const (Set MemberStatus
allMemberStatuses forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set MemberStatus
statusFilter)

propNextEpoch ::
  forall era.
  ConwayEraGov era =>
  NewEpochState era ->
  Expectation
propNextEpoch :: forall era. ConwayEraGov era => NewEpochState era -> Expectation
propNextEpoch NewEpochState era
nes = do
  forall era.
ConwayEraGov era =>
NewEpochState era
-> (Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeState era
    -> Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeMembersState
    -> Expectation)
-> Expectation
withCommitteeInfo NewEpochState era
nes forall a b. (a -> b) -> a -> b
$
    \Map (Credential 'ColdCommitteeRole) EpochNo
comMembers' (CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers') Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers' CommitteeMembersState
noFilterResult -> do
      let comMembers :: Set (Credential 'ColdCommitteeRole)
comMembers = forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) EpochNo
comMembers'
      let comStateMembers :: Set (Credential 'ColdCommitteeRole)
comStateMembers = forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers'
      let nextComMembers :: Set (Credential 'ColdCommitteeRole)
nextComMembers = forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers'

      NextEpochChange
-> CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
filterNext NextEpochChange
ToBeEnacted CommitteeMembersState
noFilterResult
        forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (\Map (Credential 'ColdCommitteeRole) CommitteeMemberState
res -> forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) CommitteeMemberState
res forall a. Eq a => a -> a -> Bool
== Set (Credential 'ColdCommitteeRole)
nextComMembers forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set (Credential 'ColdCommitteeRole)
comMembers)

      NextEpochChange
-> CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
filterNext NextEpochChange
ToBeRemoved CommitteeMembersState
noFilterResult
        forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (\Map (Credential 'ColdCommitteeRole) CommitteeMemberState
res -> forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) CommitteeMemberState
res forall a. Eq a => a -> a -> Bool
== (Set (Credential 'ColdCommitteeRole)
comMembers forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (Credential 'ColdCommitteeRole)
comStateMembers) forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set (Credential 'ColdCommitteeRole)
nextComMembers)

      -- members who are both in current and nextCommittee are either ToBeExpired, TermAdjusted or NoChangeExpected
      forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
        [ forall k a. Map k a -> Set k
Map.keysSet (NextEpochChange
-> CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
filterNext NextEpochChange
NoChangeExpected CommitteeMembersState
noFilterResult)
        , forall k a. Map k a -> Set k
Map.keysSet (NextEpochChange
-> CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
filterNext NextEpochChange
ToBeExpired CommitteeMembersState
noFilterResult)
        , forall k a. Map k a -> Set k
Map.keysSet (CommitteeMembersState
-> Map
     (Credential 'ColdCommitteeRole) (Credential 'ColdCommitteeRole)
termAdjusted CommitteeMembersState
noFilterResult)
        ]
        forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (forall a. Eq a => a -> a -> Bool
== (Set (Credential 'ColdCommitteeRole)
comMembers forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set (Credential 'ColdCommitteeRole)
nextComMembers))

      let currentEpoch :: EpochNo
currentEpoch = CommitteeMembersState -> EpochNo
csEpochNo CommitteeMembersState
noFilterResult
      let expiring :: Set (Credential 'ColdCommitteeRole)
expiring =
            forall k a. Map k a -> Set k
Map.keysSet forall a b. (a -> b) -> a -> b
$
              forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
                (forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall a. Eq a => a -> a -> Bool
== EpochNo
currentEpoch) Map (Credential 'ColdCommitteeRole) EpochNo
comMembers')
                (forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall a. Eq a => a -> a -> Bool
== EpochNo
currentEpoch) Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers')

      -- members ToBeExpired have the expiry set to currentEpoch, either in the current committee or in the next one
      forall k a. Map k a -> Set k
Map.keysSet (NextEpochChange
-> CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
filterNext NextEpochChange
ToBeExpired CommitteeMembersState
noFilterResult)
        forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set (Credential 'ColdCommitteeRole)
expiring)

      CommitteeMemberState -> Maybe EpochNo
cmsExpiration
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NextEpochChange
-> CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
filterNext NextEpochChange
NoChangeExpected CommitteeMembersState
noFilterResult
          forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Ord a => a -> a -> Bool
>= EpochNo
currentEpoch forall a. Num a => a -> a -> a
+ EpochNo
1))
  where
    filterNext :: NextEpochChange
-> CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
filterNext NextEpochChange
nextEpochChange CommitteeMembersState
cms =
      forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter
        ( \case
            CommitteeMemberState HotCredAuthStatus
_ MemberStatus
_ Maybe EpochNo
_ NextEpochChange
nextEpochChange' ->
              NextEpochChange
nextEpochChange forall a. Eq a => a -> a -> Bool
== NextEpochChange
nextEpochChange'
        )
        (CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee CommitteeMembersState
cms)
    termAdjusted :: CommitteeMembersState
-> Map
     (Credential 'ColdCommitteeRole) (Credential 'ColdCommitteeRole)
termAdjusted CommitteeMembersState
cms =
      forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybeWithKey
        ( \Credential 'ColdCommitteeRole
k CommitteeMemberState
cm ->
            case CommitteeMemberState
cm of
              CommitteeMemberState HotCredAuthStatus
_ MemberStatus
_ Maybe EpochNo
_ (TermAdjusted EpochNo
_) -> forall a. a -> Maybe a
Just Credential 'ColdCommitteeRole
k
              CommitteeMemberState
_ -> forall a. Maybe a
Nothing
        )
        (CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee CommitteeMembersState
cms)

propNoExpiration ::
  forall era.
  ConwayEraGov era =>
  NewEpochState era ->
  Expectation
propNoExpiration :: forall era. ConwayEraGov era => NewEpochState era -> Expectation
propNoExpiration NewEpochState era
nes =
  forall era.
ConwayEraGov era =>
NewEpochState era
-> (Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeState era
    -> Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeMembersState
    -> Expectation)
-> Expectation
withCommitteeInfo NewEpochState era
nes forall a b. (a -> b) -> a -> b
$
    \Map (Credential 'ColdCommitteeRole) EpochNo
_ CommitteeState era
_ Map (Credential 'ColdCommitteeRole) EpochNo
_ CommitteeMembersState
noFilterResult -> do
      let noExpiration :: Map (Credential 'ColdCommitteeRole) CommitteeMemberState
noExpiration = forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommitteeMemberState -> Maybe EpochNo
cmsExpiration) (CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee CommitteeMembersState
noFilterResult)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall k a. Map k a -> Bool
Map.null Map (Credential 'ColdCommitteeRole) CommitteeMemberState
noExpiration) forall a b. (a -> b) -> a -> b
$
        -- only Unrecognized members should have no expiration
        forall a. Ord a => [a] -> Set a
Set.fromList (CommitteeMemberState -> MemberStatus
cmsStatus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems Map (Credential 'ColdCommitteeRole) CommitteeMemberState
noExpiration) forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` forall a. a -> Set a
Set.singleton MemberStatus
Unrecognized

genCommittee ::
  forall era.
  Gen (Maybe (Committee era))
genCommittee :: forall era. Gen (Maybe (Committee era))
genCommittee = forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing), (Int
9, forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
Gen [Credential 'ColdCommitteeRole] -> Gen (Committee era)
genCommittee' forall a. Arbitrary a => Gen a
arbitrary)]

genRelevantCommitteeState ::
  forall era.
  Maybe (Committee era) ->
  Maybe (Committee era) ->
  Gen (CommitteeState era)
genRelevantCommitteeState :: forall era.
Maybe (Committee era)
-> Maybe (Committee era) -> Gen (CommitteeState era)
genRelevantCommitteeState Maybe (Committee era)
maybeCm Maybe (Committee era)
maybeNextCm = do
  [Credential 'ColdCommitteeRole]
membersRetaining <-
    forall a. [a] -> [a] -> [a]
(++)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
Maybe (Committee era) -> Gen [Credential 'ColdCommitteeRole]
genMembersRetaining Maybe (Committee era)
maybeCm
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall era.
Maybe (Committee era) -> Gen [Credential 'ColdCommitteeRole]
genMembersRetaining Maybe (Committee era)
maybeNextCm
  [(Credential 'ColdCommitteeRole, CommitteeAuthorization)]
pairs <- forall a b. [a] -> [b] -> [(a, b)]
zip [Credential 'ColdCommitteeRole]
membersRetaining forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
-> CommitteeState era
CommitteeState forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'ColdCommitteeRole, CommitteeAuthorization)]
pairs

genNextCommittee ::
  forall era.
  Maybe (Committee era) ->
  Gen (Maybe (Committee era))
genNextCommittee :: forall era. Maybe (Committee era) -> Gen (Maybe (Committee era))
genNextCommittee Maybe (Committee era)
maybeCm =
  forall a. HasCallStack => [Gen a] -> Gen a
oneof [forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
Gen [Credential 'ColdCommitteeRole] -> Gen (Committee era)
genCommittee' (forall era.
Maybe (Committee era) -> Gen [Credential 'ColdCommitteeRole]
genMembersRetaining Maybe (Committee era)
maybeCm)]

genCommittee' :: Gen [Credential 'ColdCommitteeRole] -> Gen (Committee era)
genCommittee' :: forall era.
Gen [Credential 'ColdCommitteeRole] -> Gen (Committee era)
genCommittee' Gen [Credential 'ColdCommitteeRole]
genCreds = do
  [Credential 'ColdCommitteeRole]
creds <- Gen [Credential 'ColdCommitteeRole]
genCreds
  [(Credential 'ColdCommitteeRole, EpochNo)]
m <- forall a b. [a] -> [b] -> [(a, b)]
zip [Credential 'ColdCommitteeRole]
creds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf (Word64 -> EpochNo
EpochNo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Bounded a, Integral a) => (a, a) -> Gen a
chooseBoundedIntegral (Word64
0, Word64
20))
  forall era.
Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval -> Committee era
Committee (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'ColdCommitteeRole, EpochNo)]
m) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

genRelevantColdCredsFilter ::
  forall era.
  Maybe (Committee era) ->
  CommitteeState era ->
  Gen (Set.Set (Credential 'ColdCommitteeRole))
genRelevantColdCredsFilter :: forall era.
Maybe (Committee era)
-> CommitteeState era -> Gen (Set (Credential 'ColdCommitteeRole))
genRelevantColdCredsFilter Maybe (Committee era)
maybeCm (CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers) = do
  [Credential 'ColdCommitteeRole]
creds <-
    forall a. [a] -> [a] -> [a]
(++)
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era.
Maybe (Committee era) -> Gen [Credential 'ColdCommitteeRole]
genMembersRetaining Maybe (Committee era)
maybeCm
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => [a] -> Gen [a]
genRetaining (forall k a. Map k a -> [k]
Map.keys Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
Set.fromList [Credential 'ColdCommitteeRole]
creds

genRelevantHotCredsFilter ::
  forall era.
  CommitteeState era ->
  Gen (Set.Set (Credential 'HotCommitteeRole))
genRelevantHotCredsFilter :: forall era.
CommitteeState era -> Gen (Set (Credential 'HotCommitteeRole))
genRelevantHotCredsFilter (CommitteeState Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers) =
  forall a. Ord a => [a] -> Set a
Set.fromList
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => [a] -> Gen [a]
genRetaining
      [Credential 'HotCommitteeRole
hk | (Credential 'ColdCommitteeRole
_, CommitteeHotCredential Credential 'HotCommitteeRole
hk) <- forall k a. Map k a -> [(k, a)]
Map.toList Map (Credential 'ColdCommitteeRole) CommitteeAuthorization
comStateMembers]

genMembersRetaining ::
  forall era.
  Maybe (Committee era) ->
  Gen [Credential 'ColdCommitteeRole]
genMembersRetaining :: forall era.
Maybe (Committee era) -> Gen [Credential 'ColdCommitteeRole]
genMembersRetaining Maybe (Committee era)
maybeCm =
  forall a. Arbitrary a => [a] -> Gen [a]
genRetaining forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers Maybe (Committee era)
maybeCm

genRetaining :: Arbitrary a => [a] -> Gen [a]
genRetaining :: forall a. Arbitrary a => [a] -> Gen [a]
genRetaining [a]
ret = do
  Int
retSize <- forall a. Random a => (a, a) -> Gen a
choose (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ret)
  [a]
new <- forall a. Arbitrary a => Gen a
arbitrary
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [a]
new forall a. Semigroup a => a -> a -> a
<> forall a. Int -> [a] -> [a]
take Int
retSize [a]
ret

withCommitteeInfo ::
  ConwayEraGov era =>
  NewEpochState era ->
  ( Map.Map (Credential 'ColdCommitteeRole) EpochNo -> -- current committee members
    CommitteeState era ->
    Map.Map (Credential 'ColdCommitteeRole) EpochNo -> -- next epoch committee members
    CommitteeMembersState ->
    Expectation
  ) ->
  Expectation
withCommitteeInfo :: forall era.
ConwayEraGov era =>
NewEpochState era
-> (Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeState era
    -> Map (Credential 'ColdCommitteeRole) EpochNo
    -> CommitteeMembersState
    -> Expectation)
-> Expectation
withCommitteeInfo NewEpochState era
nes Map (Credential 'ColdCommitteeRole) EpochNo
-> CommitteeState era
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> CommitteeMembersState
-> Expectation
expectation = Map (Credential 'ColdCommitteeRole) EpochNo
-> CommitteeState era
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> CommitteeMembersState
-> Expectation
expectation Map (Credential 'ColdCommitteeRole) EpochNo
comMembers CommitteeState era
comState Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers CommitteeMembersState
noFilterQueryResult
  where
    noFilterQueryResult :: CommitteeMembersState
noFilterQueryResult = forall era.
ConwayEraGov era =>
NewEpochState era -> CommitteeMembersState
queryCommitteeMembersStateNoFilters NewEpochState era
nes
    (Map (Credential 'ColdCommitteeRole) EpochNo
comMembers, CommitteeState era
comState, Map (Credential 'ColdCommitteeRole) EpochNo
nextComMembers) = forall era.
ConwayEraGov era =>
NewEpochState era
-> (Map (Credential 'ColdCommitteeRole) EpochNo,
    CommitteeState era, Map (Credential 'ColdCommitteeRole) EpochNo)
committeeInfo NewEpochState era
nes

committeeInfo ::
  forall era.
  ConwayEraGov era =>
  NewEpochState era ->
  ( Map.Map (Credential 'ColdCommitteeRole) EpochNo
  , CommitteeState era
  , Map.Map (Credential 'ColdCommitteeRole) EpochNo
  )
committeeInfo :: forall era.
ConwayEraGov era =>
NewEpochState era
-> (Map (Credential 'ColdCommitteeRole) EpochNo,
    CommitteeState era, Map (Credential 'ColdCommitteeRole) EpochNo)
committeeInfo NewEpochState era
nes =
  let ledgerState :: LedgerState era
ledgerState = NewEpochState era
nes forall s a. s -> Getting a s a -> a
^. forall era. Lens' (NewEpochState era) (EpochState era)
nesEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL
      govState :: GovState era
govState = LedgerState era
ledgerState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL
      comMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
comMembers =
        forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' forall era.
Committee era -> Map (Credential 'ColdCommitteeRole) EpochNo
committeeMembers forall a b. (a -> b) -> a -> b
$
          forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (GovState era
govState forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraGov era =>
Lens' (GovState era) (StrictMaybe (Committee era))
committeeGovStateL)
      comState :: CommitteeState era
comState = LedgerState era
ledgerState forall s a. s -> Getting a s a -> a
^. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (VState era)
certVStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (VState era) (CommitteeState era)
vsCommitteeStateL
      nextCommitteeMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
nextCommitteeMembers = forall era.
ConwayEraGov era =>
NewEpochState era -> Map (Credential 'ColdCommitteeRole) EpochNo
getNextEpochCommitteeMembers NewEpochState era
nes
   in (Map (Credential 'ColdCommitteeRole) EpochNo
comMembers, CommitteeState era
comState, Map (Credential 'ColdCommitteeRole) EpochNo
nextCommitteeMembers)

queryCommitteeMembersStateNoFilters ::
  forall era.
  ConwayEraGov era =>
  NewEpochState era ->
  CommitteeMembersState
queryCommitteeMembersStateNoFilters :: forall era.
ConwayEraGov era =>
NewEpochState era -> CommitteeMembersState
queryCommitteeMembersStateNoFilters =
  forall era.
ConwayEraGov era =>
Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> NewEpochState era
-> CommitteeMembersState
queryCommitteeMembersState @era
    forall a. Set a
Set.empty
    forall a. Set a
Set.empty
    forall a. Set a
Set.empty