{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Cardano.Ledger.Api.State.Imp.QuerySpec where

import Cardano.Ledger.Api.State.Query (
  CommitteeMemberState (..),
  CommitteeMembersState (..),
  HotCredAuthStatus (..),
  MemberStatus (..),
  NextEpochChange (..),
  queryCommitteeMembersState,
  queryDRepDelegations,
  queryDRepState,
 )
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway (hardforkConwayBootstrapPhase)
import Cardano.Ledger.Conway.Governance (
  GovAction (..),
  GovPurposeId (..),
  Voter (StakePoolVoter),
 )
import Cardano.Ledger.Conway.PParams (ppDRepActivityL)
import Cardano.Ledger.Credential (Credential (KeyHashObj))
import Cardano.Ledger.DRep
import Cardano.Ledger.Keys (KeyRole (..))
import Cardano.Ledger.Shelley.LedgerState
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Lens.Micro
import Lens.Micro.Mtl
import Test.Cardano.Ledger.Conway.ImpTest
import Test.Cardano.Ledger.Core.Rational ((%!))
import Test.Cardano.Ledger.Imp.Common

spec ::
  forall era.
  ConwayEraImp era =>
  Spec
spec :: forall era. ConwayEraImp era => Spec
spec = forall era.
ShelleyEraImp era =>
SpecWith (ImpInit (LedgerSpec era)) -> Spec
withEachEraVersion @era (SpecWith (ImpInit (LedgerSpec era)) -> Spec)
-> SpecWith (ImpInit (LedgerSpec era)) -> Spec
forall a b. (a -> b) -> a -> b
$ do
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Expiries are reported correctly" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
      let drepStateFromQuery ::
            (HasCallStack, Monad m) =>
            Credential DRepRole ->
            NewEpochState era ->
            m DRepState
          drepStateFromQuery :: forall (m :: * -> *).
(HasCallStack, Monad m) =>
Credential DRepRole -> NewEpochState era -> m DRepState
drepStateFromQuery Credential DRepRole
drep NewEpochState era
nes =
            case Credential DRepRole
-> Map (Credential DRepRole) DRepState -> Maybe DRepState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential DRepRole
drep (NewEpochState era
-> Set (Credential DRepRole) -> Map (Credential DRepRole) DRepState
forall era.
ConwayEraCertState era =>
NewEpochState era
-> Set (Credential DRepRole) -> Map (Credential DRepRole) DRepState
queryDRepState NewEpochState era
nes Set (Credential DRepRole)
forall a. Monoid a => a
mempty) of
              Maybe DRepState
Nothing -> String -> m DRepState
forall a. HasCallStack => String -> a
error (String -> m DRepState) -> String -> m DRepState
forall a b. (a -> b) -> a -> b
$ String
"Expected for DRep " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Credential DRepRole -> String
forall a. Show a => a -> String
show Credential DRepRole
drep String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to be present in the query result"
              Just DRepState
state -> DRepState -> m DRepState
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DRepState
state
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"simple expiry" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
        let drepActivity = Word32
3
        modifyPParams $ ppDRepActivityL .~ EpochInterval drepActivity
        (drep, _, _) <- setupSingleDRep 1_000_000
        nes <- getsNES id
        drepState <- drepStateFromQuery drep nes
        drepState ^. drepExpiryL `shouldBe` addEpochInterval curEpochNo (EpochInterval drepActivity)
        let n = Natural
4
        passNEpochsChecking n $
          isDRepExpired drep `shouldReturn` False
        expectDRepExpiry drep $ addEpochInterval curEpochNo $ EpochInterval drepActivity
        expectActualDRepExpiry drep $
          addEpochInterval curEpochNo $
            EpochInterval (drepActivity + fromIntegral n)

      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"dRep registered when there are dormant epochs" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        let drepActivity :: Word32
drepActivity = Word32
3
        (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppDRepActivityL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
drepActivity
        let n :: Natural
n = Natural
2
        Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
n
        EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
EpochNo -> ImpTestM era ()
expectNumDormantEpochs (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word64 -> EpochNo
EpochNo (Natural -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)
        (drep, _, _) <- Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
setupSingleDRep Integer
1_000_000

        let expectedExpiry = do
              epochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
              let tot = EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
epochNo (Word32 -> EpochInterval
EpochInterval Word32
drepActivity)
              pv <- getProtVer
              pure $
                if hardforkConwayBootstrapPhase pv
                  then binOpEpochNo (+) tot (fromIntegral n)
                  else tot

        expectedExpiry >>= expectActualDRepExpiry drep

        nes <- getsNES id
        mkMinFeeUpdateGovAction SNothing >>= submitGovAction_

        expectedExpiry >>= expectDRepExpiry drep
        drepState <- drepStateFromQuery drep nes
        expectedExpiry >>= shouldBe (drepState ^. drepExpiryL)

      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"proposals are made and numDormantEpochs are added" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
        let drepActivity = Word32
3
        modifyPParams $ ppDRepActivityL .~ EpochInterval drepActivity
        (drep, _, _) <- setupSingleDRep 1_000_000
        nes <- getsNES id
        drepState <- drepStateFromQuery drep nes
        drepState ^. drepExpiryL `shouldBe` addEpochInterval curEpochNo (EpochInterval drepActivity)
        let n = Natural
2
            actualExpiry = EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (EpochInterval -> EpochNo) -> EpochInterval -> EpochNo
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval (Word32
drepActivity Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)
        passNEpochsChecking n $
          isDRepExpired drep `shouldReturn` False
        expectActualDRepExpiry drep actualExpiry
        expectDRepExpiry drep $ addEpochInterval curEpochNo $ EpochInterval drepActivity
        mkMinFeeUpdateGovAction SNothing >>= submitGovAction_
        expectDRepExpiry drep actualExpiry
        nes1 <- getsNES id
        drepState1 <- drepStateFromQuery drep nes1
        drepState1 ^. drepExpiryL `shouldBe` actualExpiry
        passNEpochsChecking (fromIntegral drepActivity) $
          isDRepExpired drep `shouldReturn` False
        passEpoch
        isDRepExpired drep `shouldReturn` True
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"update certificates are submitted and proposals are made" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
        curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
        let drepActivity = Word32
3
        modifyPParams $ ppDRepActivityL .~ EpochInterval drepActivity
        (drep, _, _) <- setupSingleDRep 1_000_000
        nes <- getsNES id
        drepState <- drepStateFromQuery drep nes
        drepState ^. drepExpiryL `shouldBe` addEpochInterval curEpochNo (EpochInterval drepActivity)
        let n = Natural
3
        passNEpochsChecking n $
          isDRepExpired drep `shouldReturn` False
        expectNumDormantEpochs $ EpochNo (fromIntegral n)
        expectDRepExpiry drep $ addEpochInterval curEpochNo $ EpochInterval drepActivity
        expectActualDRepExpiry drep $
          addEpochInterval curEpochNo $
            EpochInterval (drepActivity + fromIntegral n)
        updateDRep drep
        expectDRepExpiry drep $ addEpochInterval curEpochNo $ EpochInterval drepActivity
        expectActualDRepExpiry drep $
          addEpochInterval curEpochNo $
            EpochInterval (drepActivity + fromIntegral n)
        expectNumDormantEpochs $ EpochNo (fromIntegral n)
        nes1 <- getsNES id
        drepState1 <- drepStateFromQuery drep nes1
        drepState1
          ^. drepExpiryL
            `shouldBe` addEpochInterval
              curEpochNo
              (EpochInterval (drepActivity + fromIntegral n))
        expectDRepExpiry drep $ addEpochInterval curEpochNo $ EpochInterval drepActivity
        passEpoch
        expectNumDormantEpochs $ EpochNo (fromIntegral n + 1)
        mkMinFeeUpdateGovAction SNothing >>= submitGovAction_
        expectNumDormantEpochs $ EpochNo 0
        nes2 <- getsNES id
        drepState2 <- drepStateFromQuery drep nes2
        let drepExpiry2 = EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (EpochInterval -> EpochNo) -> EpochInterval -> EpochNo
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval (Word32
drepActivity Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)
        drepState2 ^. drepExpiryL `shouldBe` drepExpiry2
        expectActualDRepExpiry drep drepExpiry2
        passNEpochsChecking (fromIntegral drepActivity) $ do
          isDRepExpired drep `shouldReturn` False
        passEpoch
        isDRepExpired drep `shouldReturn` True
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Committee members hot key pre-authorization" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"authorized members not elected get removed in the next epoch" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        c1 <- KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
        submitGovAction_ $
          UpdateCommittee SNothing mempty (Map.singleton c1 (EpochNo 4321)) (1 %! 1)
        hk1 <- registerCommitteeHotKey c1
        expectQueryResult (Set.singleton c1) mempty mempty $
          [(c1, CommitteeMemberState (MemberAuthorized hk1) Unrecognized Nothing ToBeRemoved)]
        passEpoch
        expectQueryResult (Set.singleton c1) mempty mempty Map.empty

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"members should remain authorized if authorized during the epoch after their election" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$
      ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
        (drep, _, _) <- Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
setupSingleDRep Integer
1_000_000
        (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000

        c1 <- KeyHashObj <$> freshKeyHash
        c1Expiry <- flip addEpochInterval (EpochInterval 10) <$> getsNES nesELL

        initialCommitteeMembers <- getCommitteeMembers
        GovPurposeId gid <-
          submitCommitteeElection
            SNothing
            drep
            initialCommitteeMembers
            [(c1, c1Expiry)]
        submitYesVote_ (StakePoolVoter spoC) gid

        passEpoch
        hk1 <- registerCommitteeHotKey c1
        expectQueryResult (Set.singleton c1) mempty mempty $
          [(c1, CommitteeMemberState (MemberAuthorized hk1) Unrecognized Nothing ToBeEnacted)]
        passEpoch
        expectQueryResult (Set.singleton c1) mempty mempty $
          [(c1, CommitteeMemberState (MemberAuthorized hk1) Active (Just c1Expiry) NoChangeExpected)]

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"queryDRepDelegationState" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    (credDrep, delegator, _) <- Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
setupSingleDRep Integer
1_000_000

    kh <- freshKeyHash
    let cred = KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash Staking
kh
    _ <- registerStakeCredential cred
    _ <- delegateToDRep cred (Coin 2_000_000) DRepAlwaysAbstain

    kh2 <- freshKeyHash
    let cred2 = KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash Staking
kh2
    _ <- registerStakeCredential cred2
    _ <- delegateToDRep cred2 (Coin 3_000_000) DRepAlwaysNoConfidence

    let realDRepCred = Credential DRepRole -> DRep
DRepCredential Credential DRepRole
credDrep

    nes <- getsNES id
    let abstainDelegations =
          DRep
-> Set (Credential Staking) -> Map DRep (Set (Credential Staking))
forall k a. k -> a -> Map k a
Map.singleton DRep
DRepAlwaysAbstain ([Credential Staking] -> Set (Credential Staking)
forall a. Ord a => [a] -> Set a
Set.fromList [Item [Credential Staking]
Credential Staking
cred])
        noConfidenceDelegations =
          DRep
-> Set (Credential Staking) -> Map DRep (Set (Credential Staking))
forall k a. k -> a -> Map k a
Map.singleton DRep
DRepAlwaysNoConfidence ([Credential Staking] -> Set (Credential Staking)
forall a. Ord a => [a] -> Set a
Set.fromList [Item [Credential Staking]
Credential Staking
cred2])
        realDRepDelegations = DRep
-> Set (Credential Staking) -> Map DRep (Set (Credential Staking))
forall k a. k -> a -> Map k a
Map.singleton DRep
realDRepCred ([Credential Staking] -> Set (Credential Staking)
forall a. Ord a => [a] -> Set a
Set.fromList [Item [Credential Staking]
Credential Staking
delegator])
        expectedAllDelegations =
          Map DRep (Set (Credential Staking))
realDRepDelegations
            Map DRep (Set (Credential Staking))
-> Map DRep (Set (Credential Staking))
-> Map DRep (Set (Credential Staking))
forall a. Semigroup a => a -> a -> a
<> Map DRep (Set (Credential Staking))
abstainDelegations
            Map DRep (Set (Credential Staking))
-> Map DRep (Set (Credential Staking))
-> Map DRep (Set (Credential Staking))
forall a. Semigroup a => a -> a -> a
<> Map DRep (Set (Credential Staking))
noConfidenceDelegations
    queryDRepDelegations nes mempty `shouldBe` expectedAllDelegations
    queryDRepDelegations nes (Set.singleton DRepAlwaysAbstain)
      `shouldBe` abstainDelegations
    queryDRepDelegations nes (Set.singleton DRepAlwaysNoConfidence)
      `shouldBe` noConfidenceDelegations
    queryDRepDelegations nes (Set.singleton realDRepCred)
      `shouldBe` realDRepDelegations

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Committee queries" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
    (drep, _, _) <- Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential DRepRole, Credential Staking, KeyPair Payment)
setupSingleDRep Integer
1_000_000
    (spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
    curEpochNo <- getsNES nesELL
    let offsetEpochInterval Word32
n = EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
n)
    let cExpiry Word32
n =
          (,)
            (Credential ColdCommitteeRole
 -> EpochNo -> (Credential ColdCommitteeRole, EpochNo))
-> ImpM (LedgerSpec era) (Credential ColdCommitteeRole)
-> ImpM
     (LedgerSpec era)
     (EpochNo -> (Credential ColdCommitteeRole, EpochNo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash)
            ImpM
  (LedgerSpec era)
  (EpochNo -> (Credential ColdCommitteeRole, EpochNo))
-> ImpTestM era EpochNo
-> ImpM (LedgerSpec era) (Credential ColdCommitteeRole, EpochNo)
forall a b.
ImpM (LedgerSpec era) (a -> b)
-> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EpochNo -> ImpTestM era EpochNo
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32 -> EpochNo
offsetEpochInterval Word32
n)
    (c1, c1Expiry) <- cExpiry 12
    (c2, c2Expiry) <- cExpiry 2
    (c3, c3Expiry) <- cExpiry 7
    (c4, c4Expiry) <- cExpiry 5
    c5 <- KeyHashObj <$> freshKeyHash
    c6 <- KeyHashObj <$> freshKeyHash
    c7 <- KeyHashObj <$> freshKeyHash
    c8 <- KeyHashObj <$> freshKeyHash
    let newMembers =
          [ (Credential ColdCommitteeRole
c1, EpochNo
c1Expiry)
          , (Credential ColdCommitteeRole
c2, EpochNo
c2Expiry)
          , (Credential ColdCommitteeRole
c3, EpochNo
c3Expiry)
          , (Credential ColdCommitteeRole
c4, EpochNo
c4Expiry)
          ]
    initialMembers <- getCommitteeMembers

    ga1@(GovPurposeId gaid1) <-
      submitCommitteeElection
        SNothing
        drep
        initialMembers
        newMembers
    submitYesVote_ (StakePoolVoter spoC) gaid1

    expectMembers initialMembers
    passNEpochs 2 -- epoch 2
    expectMembers $ Map.keysSet newMembers
    -- members for which the expiration epoch is the current epoch are `ToBeExpired`
    expectNoFilterQueryResult
      [ (c1, CommitteeMemberState MemberNotAuthorized Active (Just c1Expiry) NoChangeExpected)
      , (c2, CommitteeMemberState MemberNotAuthorized Active (Just c2Expiry) ToBeExpired)
      , (c3, CommitteeMemberState MemberNotAuthorized Active (Just c3Expiry) NoChangeExpected)
      , (c4, CommitteeMemberState MemberNotAuthorized Active (Just c4Expiry) NoChangeExpected)
      ]
    -- hot cred status of members with registered hot keys becomes `MemberAuthorized`
    hk1 <- registerCommitteeHotKey c1
    hk2 <- registerCommitteeHotKey c2
    expectNoFilterQueryResult
      [ (c1, CommitteeMemberState (MemberAuthorized hk1) Active (Just c1Expiry) NoChangeExpected)
      , (c2, CommitteeMemberState (MemberAuthorized hk2) Active (Just c2Expiry) ToBeExpired)
      , (c3, CommitteeMemberState MemberNotAuthorized Active (Just c3Expiry) NoChangeExpected)
      , (c4, CommitteeMemberState MemberNotAuthorized Active (Just c4Expiry) NoChangeExpected)
      ]
    expectQueryResult
      [c2, c3, c5]
      mempty
      [Active, Unrecognized]
      [ (c3, CommitteeMemberState MemberNotAuthorized Active (Just c3Expiry) NoChangeExpected)
      , (c2, CommitteeMemberState (MemberAuthorized hk2) Active (Just c2Expiry) ToBeExpired)
      ]

    c3Anchor <- arbitrary
    _ <- resignCommitteeColdKey c3 (SJust c3Anchor)
    _ <-
      submitGovAction $
        UpdateCommittee
          (SJust ga1)
          mempty
          (Map.fromList [(c5, offsetEpochInterval 10), (c8, offsetEpochInterval 10)])
          (1 %! 1)
    hk5 <- registerCommitteeHotKey c5
    passTick
    -- hot cred status of resigned member becomes `Resigned`
    -- registering a hot key for a credential that's not part of the committee will yield `Unrecognized` member status
    -- and expected change of `ToBeRemoved`
    expectNoFilterQueryResult
      [ (c1, CommitteeMemberState (MemberAuthorized hk1) Active (Just c1Expiry) NoChangeExpected)
      , (c2, CommitteeMemberState (MemberAuthorized hk2) Active (Just c2Expiry) ToBeExpired)
      , (c3, CommitteeMemberState (MemberResigned (Just c3Anchor)) Active (Just c3Expiry) NoChangeExpected)
      , (c4, CommitteeMemberState MemberNotAuthorized Active (Just c4Expiry) NoChangeExpected)
      , (c5, CommitteeMemberState (MemberAuthorized hk5) Unrecognized Nothing ToBeRemoved)
      ]
    expectQueryResult
      [c2, c3, c5]
      [hk5]
      [Unrecognized]
      ( Map.singleton
          c5
          (CommitteeMemberState (MemberAuthorized hk5) Unrecognized Nothing ToBeRemoved)
      )

    passEpoch -- epoch 3
    -- the `Unrecognized` member gets removed from the query result
    -- the member which in the previous epoch was expected `ToBeEpired`, has now MemberStatus `Expired` and `NoChangeExpected`
    expectNoFilterQueryResult
      [ (c1, CommitteeMemberState (MemberAuthorized hk1) Active (Just c1Expiry) NoChangeExpected)
      , (c2, CommitteeMemberState (MemberAuthorized hk2) Expired (Just c2Expiry) NoChangeExpected)
      , (c3, CommitteeMemberState (MemberResigned (Just c3Anchor)) Active (Just c3Expiry) NoChangeExpected)
      , (c4, CommitteeMemberState MemberNotAuthorized Active (Just c4Expiry) NoChangeExpected)
      ]

    -- elect new committee to be: c1 (term extended ), c3 (no changes), c4 (term shortened, expiring next epoch), c6, c7 (new)
    let c1NewExpiry = Word32 -> EpochNo
offsetEpochInterval Word32
13
        c4NewExpiry = Word32 -> EpochNo
offsetEpochInterval Word32
4
        c6Expiry = Word32 -> EpochNo
offsetEpochInterval Word32
6
        c7Expiry = Word32 -> EpochNo
offsetEpochInterval Word32
7
    ga2@(GovPurposeId gaid2) <-
      submitCommitteeElection
        (SJust ga1)
        drep
        [c2]
        [ (c1, c1NewExpiry)
        , (c4, c4NewExpiry)
        , (c6, c6Expiry)
        , (c7, c7Expiry)
        ]
    submitYesVote_ (StakePoolVoter spoC) gaid2
    passEpoch -- epoch 4
    hk6 <- registerCommitteeHotKey c6
    hk8 <- registerCommitteeHotKey c8

    -- in the next epoch after the election, the old committee is still in place
    expectMembers [c1, c2, c3, c4]

    -- members that are not be part of the next committee are `ToBeRemoved`
    -- members that are part of both current and next committee have `NoChangeExpected` or `TermAdjusted`
    -- members that part of only next committee are `ToBeEnacted`
    expectNoFilterQueryResult
      [ (c1, CommitteeMemberState (MemberAuthorized hk1) Active (Just c1Expiry) (TermAdjusted c1NewExpiry))
      , (c2, CommitteeMemberState (MemberAuthorized hk2) Expired (Just c2Expiry) ToBeRemoved)
      , (c3, CommitteeMemberState (MemberResigned (Just c3Anchor)) Active (Just c3Expiry) NoChangeExpected)
      , -- though its term was adjusted, `ToBeExpired` takes precedence
        (c4, CommitteeMemberState MemberNotAuthorized Active (Just c4Expiry) ToBeExpired)
      , (c6, CommitteeMemberState (MemberAuthorized hk6) Unrecognized Nothing ToBeEnacted)
      , (c7, CommitteeMemberState MemberNotAuthorized Unrecognized Nothing ToBeEnacted)
      , (c8, CommitteeMemberState (MemberAuthorized hk8) Unrecognized Nothing ToBeRemoved)
      ]
    expectQueryResult
      [c1]
      mempty
      mempty
      [ (c1, CommitteeMemberState (MemberAuthorized hk1) Active (Just c1Expiry) (TermAdjusted c1NewExpiry))
      ]
    expectQueryResult
      [c2]
      [hk2]
      [Expired]
      ( Map.singleton
          c2
          (CommitteeMemberState (MemberAuthorized hk2) Expired (Just c2Expiry) ToBeRemoved)
      )

    passNEpochs 2 -- epoch 6
    -- the new committee is in place with the adjusted terms
    expectMembers [c1, c3, c4, c6, c7]
    expectNoFilterQueryResult
      [ (c1, CommitteeMemberState (MemberAuthorized hk1) Active (Just c1NewExpiry) NoChangeExpected)
      , (c3, CommitteeMemberState (MemberResigned (Just c3Anchor)) Active (Just c3Expiry) NoChangeExpected)
      , (c4, CommitteeMemberState MemberNotAuthorized Expired (Just c4NewExpiry) NoChangeExpected)
      , (c6, CommitteeMemberState (MemberAuthorized hk6) Active (Just c6Expiry) ToBeExpired)
      , (c7, CommitteeMemberState MemberNotAuthorized Active (Just c7Expiry) NoChangeExpected)
      ]
    expectQueryResult
      Set.empty
      Set.empty
      [Unrecognized]
      Map.empty

    -- elect new committee to be:
    -- c4 (which is presently `Expired`, set a new term),
    -- c6 (which is presently `ToBeExpired`, set a new term)
    -- c7 (which will become `ToBeExpired` in the next epoch)
    -- c3 (which would become `ToBeExpired` in the next epoch, but set a new term)
    let c3NewExpiry = Word32 -> EpochNo
offsetEpochInterval Word32
9
        c4NewNewExpiry = Word32 -> EpochNo
offsetEpochInterval Word32
9
        c6NewExpiry = Word32 -> EpochNo
offsetEpochInterval Word32
9
    GovPurposeId gaid3 <-
      submitCommitteeElection
        (SJust ga2)
        drep
        [c1]
        [ (c3, c3NewExpiry)
        , (c4, c4NewNewExpiry)
        , (c6, c6NewExpiry)
        ]
    submitYesVote_ (StakePoolVoter spoC) gaid3
    passEpoch -- epoch 7
    -- members whose term changed have next epoch change `TermAdjusted`
    expectNoFilterQueryResult
      [ (c1, CommitteeMemberState (MemberAuthorized hk1) Active (Just c1NewExpiry) ToBeRemoved)
      ,
        ( c3
        , CommitteeMemberState
            (MemberResigned (Just c3Anchor))
            Active
            (Just c3Expiry)
            (TermAdjusted c3NewExpiry)
        )
      ,
        ( c4
        , CommitteeMemberState MemberNotAuthorized Expired (Just c4NewExpiry) (TermAdjusted c4NewNewExpiry)
        )
      , (c6, CommitteeMemberState (MemberAuthorized hk6) Expired (Just c6Expiry) (TermAdjusted c6NewExpiry))
      , (c7, CommitteeMemberState MemberNotAuthorized Active (Just c7Expiry) ToBeExpired)
      ]
    passEpoch -- epoch 8
    expectMembers [c3, c4, c6, c7]
    expectNoFilterQueryResult
      [
        ( c3
        , CommitteeMemberState (MemberResigned (Just c3Anchor)) Active (Just c3NewExpiry) NoChangeExpected
        )
      , (c4, CommitteeMemberState MemberNotAuthorized Active (Just c4NewNewExpiry) NoChangeExpected)
      , (c6, CommitteeMemberState (MemberAuthorized hk6) Active (Just c6NewExpiry) NoChangeExpected)
      , (c7, CommitteeMemberState MemberNotAuthorized Expired (Just c7Expiry) NoChangeExpected)
      ]
  where
    expectQueryResult ::
      HasCallStack =>
      Set.Set (Credential ColdCommitteeRole) ->
      Set.Set (Credential HotCommitteeRole) ->
      Set.Set MemberStatus ->
      Map.Map (Credential ColdCommitteeRole) CommitteeMemberState ->
      ImpTestM era ()
    expectQueryResult :: HasCallStack =>
Set (Credential ColdCommitteeRole)
-> Set (Credential HotCommitteeRole)
-> Set MemberStatus
-> Map (Credential ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
expectQueryResult Set (Credential ColdCommitteeRole)
ckFilter Set (Credential HotCommitteeRole)
hkFilter Set MemberStatus
statusFilter Map (Credential ColdCommitteeRole) CommitteeMemberState
expResult = do
      nes <- Getting (NewEpochState era) (ImpTestState era) (NewEpochState era)
-> ImpTestM era (NewEpochState era)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (NewEpochState era) (ImpTestState era) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(NewEpochState era -> f (NewEpochState era))
-> ImpTestState era -> f (ImpTestState era)
impNESL
      let CommitteeMembersState {csCommittee} =
            queryCommitteeMembersState
              ckFilter
              hkFilter
              statusFilter
              nes
      impAnn "Expecting query result" $
        csCommittee `shouldBe` expResult

    expectNoFilterQueryResult ::
      HasCallStack =>
      Map.Map (Credential ColdCommitteeRole) CommitteeMemberState ->
      ImpTestM era ()
    expectNoFilterQueryResult :: HasCallStack =>
Map (Credential ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
expectNoFilterQueryResult =
      HasCallStack =>
Set (Credential ColdCommitteeRole)
-> Set (Credential HotCommitteeRole)
-> Set MemberStatus
-> Map (Credential ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
Set (Credential ColdCommitteeRole)
-> Set (Credential HotCommitteeRole)
-> Set MemberStatus
-> Map (Credential ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
expectQueryResult Set (Credential ColdCommitteeRole)
forall a. Monoid a => a
mempty Set (Credential HotCommitteeRole)
forall a. Monoid a => a
mempty Set MemberStatus
forall a. Monoid a => a
mempty