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

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

import Cardano.Ledger.Api.State.Query (
  CommitteeMemberState (..),
  CommitteeMembersState (..),
  HotCredAuthStatus (..),
  MemberStatus (..),
  NextEpochChange (..),
  queryCommitteeMembersState,
  queryDRepState,
 )
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin
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 qualified Cardano.Ledger.Shelley.HardForks as HF
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 =>
  SpecWith (ImpInit (LedgerSpec era))
spec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
spec = 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
        EpochNo
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
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
        (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- 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
        NewEpochState era
nes <- SimpleGetter (NewEpochState era) (NewEpochState era)
-> ImpTestM era (NewEpochState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (NewEpochState era -> Const r (NewEpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall a. a -> a
SimpleGetter (NewEpochState era) (NewEpochState era)
id
        DRepState
drepState <- Credential 'DRepRole
-> NewEpochState era -> ImpM (LedgerSpec era) DRepState
forall (m :: * -> *).
(HasCallStack, Monad m) =>
Credential 'DRepRole -> NewEpochState era -> m DRepState
drepStateFromQuery Credential 'DRepRole
drep NewEpochState era
nes
        DRepState
drepState DRepState -> Getting EpochNo DRepState EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo DRepState EpochNo
Lens' DRepState EpochNo
drepExpiryL EpochNo -> EpochNo -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
drepActivity)
        let n :: Natural
n = Natural
4
        Natural -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
Natural -> ImpTestM era () -> ImpTestM era ()
passNEpochsChecking Natural
n (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
          Credential 'DRepRole -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era Bool
isDRepExpired Credential 'DRepRole
drep ImpTestM era Bool -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (EpochInterval -> EpochNo) -> EpochInterval -> EpochNo
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval Word32
drepActivity
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
          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)

      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)
        (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- 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 :: ImpTestM era EpochNo
expectedExpiry = do
              EpochNo
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
tot = EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
epochNo (Word32 -> EpochInterval
EpochInterval Word32
drepActivity)
              ProtVer
pv <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
              EpochNo -> ImpTestM era EpochNo
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EpochNo -> ImpTestM era EpochNo)
-> EpochNo -> ImpTestM era EpochNo
forall a b. (a -> b) -> a -> b
$
                if ProtVer -> Bool
HF.bootstrapPhase ProtVer
pv
                  then (Word64 -> Word64 -> Word64) -> EpochNo -> EpochNo -> EpochNo
binOpEpochNo Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(+) EpochNo
tot (Natural -> EpochNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)
                  else EpochNo
tot

        ImpTestM era EpochNo
expectedExpiry ImpTestM era EpochNo
-> (EpochNo -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep

        NewEpochState era
nes <- SimpleGetter (NewEpochState era) (NewEpochState era)
-> ImpTestM era (NewEpochState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (NewEpochState era -> Const r (NewEpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall a. a -> a
SimpleGetter (NewEpochState era) (NewEpochState era)
id
        StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era ()
submitGovAction_

        ImpTestM era EpochNo
expectedExpiry ImpTestM era EpochNo
-> (EpochNo -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep
        DRepState
drepState <- Credential 'DRepRole
-> NewEpochState era -> ImpM (LedgerSpec era) DRepState
forall (m :: * -> *).
(HasCallStack, Monad m) =>
Credential 'DRepRole -> NewEpochState era -> m DRepState
drepStateFromQuery Credential 'DRepRole
drep NewEpochState era
nes
        ImpTestM era EpochNo
expectedExpiry ImpTestM era EpochNo
-> (EpochNo -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EpochNo -> EpochNo -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
shouldBe (DRepState
drepState DRepState -> Getting EpochNo DRepState EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo DRepState EpochNo
Lens' DRepState EpochNo
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
        EpochNo
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
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
        (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- 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
        NewEpochState era
nes <- SimpleGetter (NewEpochState era) (NewEpochState era)
-> ImpTestM era (NewEpochState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (NewEpochState era -> Const r (NewEpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall a. a -> a
SimpleGetter (NewEpochState era) (NewEpochState era)
id
        DRepState
drepState <- Credential 'DRepRole
-> NewEpochState era -> ImpM (LedgerSpec era) DRepState
forall (m :: * -> *).
(HasCallStack, Monad m) =>
Credential 'DRepRole -> NewEpochState era -> m DRepState
drepStateFromQuery Credential 'DRepRole
drep NewEpochState era
nes
        DRepState
drepState DRepState -> Getting EpochNo DRepState EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo DRepState EpochNo
Lens' DRepState EpochNo
drepExpiryL EpochNo -> EpochNo -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
drepActivity)
        let n :: Natural
n = Natural
2
            actualExpiry :: EpochNo
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)
        Natural -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
Natural -> ImpTestM era () -> ImpTestM era ()
passNEpochsChecking Natural
n (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
          Credential 'DRepRole -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era Bool
isDRepExpired Credential 'DRepRole
drep ImpTestM era Bool -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep EpochNo
actualExpiry
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (EpochInterval -> EpochNo) -> EpochInterval -> EpochNo
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval Word32
drepActivity
        StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era ()
submitGovAction_
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep EpochNo
actualExpiry
        NewEpochState era
nes1 <- SimpleGetter (NewEpochState era) (NewEpochState era)
-> ImpTestM era (NewEpochState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (NewEpochState era -> Const r (NewEpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall a. a -> a
SimpleGetter (NewEpochState era) (NewEpochState era)
id
        DRepState
drepState1 <- Credential 'DRepRole
-> NewEpochState era -> ImpM (LedgerSpec era) DRepState
forall (m :: * -> *).
(HasCallStack, Monad m) =>
Credential 'DRepRole -> NewEpochState era -> m DRepState
drepStateFromQuery Credential 'DRepRole
drep NewEpochState era
nes1
        DRepState
drepState1 DRepState -> Getting EpochNo DRepState EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo DRepState EpochNo
Lens' DRepState EpochNo
drepExpiryL EpochNo -> EpochNo -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` EpochNo
actualExpiry
        Natural -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
Natural -> ImpTestM era () -> ImpTestM era ()
passNEpochsChecking (Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
drepActivity) (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
          Credential 'DRepRole -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era Bool
isDRepExpired Credential 'DRepRole
drep ImpTestM era Bool -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        Credential 'DRepRole -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era Bool
isDRepExpired Credential 'DRepRole
drep ImpTestM era Bool -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
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
        EpochNo
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
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
        (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- 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
        NewEpochState era
nes <- SimpleGetter (NewEpochState era) (NewEpochState era)
-> ImpTestM era (NewEpochState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (NewEpochState era -> Const r (NewEpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall a. a -> a
SimpleGetter (NewEpochState era) (NewEpochState era)
id
        DRepState
drepState <- Credential 'DRepRole
-> NewEpochState era -> ImpM (LedgerSpec era) DRepState
forall (m :: * -> *).
(HasCallStack, Monad m) =>
Credential 'DRepRole -> NewEpochState era -> m DRepState
drepStateFromQuery Credential 'DRepRole
drep NewEpochState era
nes
        DRepState
drepState DRepState -> Getting EpochNo DRepState EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo DRepState EpochNo
Lens' DRepState EpochNo
drepExpiryL EpochNo -> EpochNo -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
drepActivity)
        let n :: Natural
n = Natural
3
        Natural -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
Natural -> ImpTestM era () -> ImpTestM era ()
passNEpochsChecking Natural
n (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
          Credential 'DRepRole -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era Bool
isDRepExpired Credential 'DRepRole
drep ImpTestM era Bool -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        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)
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (EpochInterval -> EpochNo) -> EpochInterval -> EpochNo
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval Word32
drepActivity
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
          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)
        Credential 'DRepRole -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'DRepRole -> ImpTestM era ()
updateDRep Credential 'DRepRole
drep
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (EpochInterval -> EpochNo) -> EpochInterval -> EpochNo
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval Word32
drepActivity
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
          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)
        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)
        NewEpochState era
nes1 <- SimpleGetter (NewEpochState era) (NewEpochState era)
-> ImpTestM era (NewEpochState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (NewEpochState era -> Const r (NewEpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall a. a -> a
SimpleGetter (NewEpochState era) (NewEpochState era)
id
        DRepState
drepState1 <- Credential 'DRepRole
-> NewEpochState era -> ImpM (LedgerSpec era) DRepState
forall (m :: * -> *).
(HasCallStack, Monad m) =>
Credential 'DRepRole -> NewEpochState era -> m DRepState
drepStateFromQuery Credential 'DRepRole
drep NewEpochState era
nes1
        DRepState
drepState1
          DRepState -> Getting EpochNo DRepState EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo DRepState EpochNo
Lens' DRepState EpochNo
drepExpiryL
            EpochNo -> EpochNo -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` EpochNo -> EpochInterval -> EpochNo
addEpochInterval
              EpochNo
curEpochNo
              (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))
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectDRepExpiry Credential 'DRepRole
drep (EpochNo -> ImpM (LedgerSpec era) ())
-> EpochNo -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (EpochInterval -> EpochNo) -> EpochInterval -> EpochNo
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval Word32
drepActivity
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        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 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
        StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing ImpTestM era (GovAction era)
-> (GovAction era -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era ()
submitGovAction_
        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 Word64
0
        NewEpochState era
nes2 <- SimpleGetter (NewEpochState era) (NewEpochState era)
-> ImpTestM era (NewEpochState era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (NewEpochState era -> Const r (NewEpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall a. a -> a
SimpleGetter (NewEpochState era) (NewEpochState era)
id
        DRepState
drepState2 <- Credential 'DRepRole
-> NewEpochState era -> ImpM (LedgerSpec era) DRepState
forall (m :: * -> *).
(HasCallStack, Monad m) =>
Credential 'DRepRole -> NewEpochState era -> m DRepState
drepStateFromQuery Credential 'DRepRole
drep NewEpochState era
nes2
        let drepExpiry2 :: EpochNo
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)
        DRepState
drepState2 DRepState -> Getting EpochNo DRepState EpochNo -> EpochNo
forall s a. s -> Getting a s a -> a
^. Getting EpochNo DRepState EpochNo
Lens' DRepState EpochNo
drepExpiryL EpochNo -> EpochNo -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` EpochNo
drepExpiry2
        Credential 'DRepRole -> EpochNo -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> EpochNo -> ImpTestM era ()
expectActualDRepExpiry Credential 'DRepRole
drep EpochNo
drepExpiry2
        Natural -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
Natural -> ImpTestM era () -> ImpTestM era ()
passNEpochsChecking (Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
drepActivity) (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
          Credential 'DRepRole -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era Bool
isDRepExpired Credential 'DRepRole
drep ImpTestM era Bool -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
False
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        Credential 'DRepRole -> ImpTestM era Bool
forall era.
(HasCallStack, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era Bool
isDRepExpired Credential 'DRepRole
drep ImpTestM era Bool -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Bool
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
        Credential 'ColdCommitteeRole
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
        GovAction era -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era ()
submitGovAction_ (GovAction era -> ImpM (LedgerSpec era) ())
-> GovAction era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
          StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty (Credential 'ColdCommitteeRole
-> EpochNo -> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. k -> a -> Map k a
Map.singleton Credential 'ColdCommitteeRole
c1 (Word64 -> EpochNo
EpochNo Word64
4321)) (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)
        Credential 'HotCommitteeRole
hk1 <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
c1
        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 (Credential 'ColdCommitteeRole
-> Set (Credential 'ColdCommitteeRole)
forall a. a -> Set a
Set.singleton Credential 'ColdCommitteeRole
c1) Set (Credential 'HotCommitteeRole)
forall a. Monoid a => a
mempty Set MemberStatus
forall a. Monoid a => a
mempty (Map (Credential 'ColdCommitteeRole) CommitteeMemberState
 -> ImpM (LedgerSpec era) ())
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
          [(Credential 'ColdCommitteeRole
c1, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk1) MemberStatus
Unrecognized Maybe EpochNo
forall a. Maybe a
Nothing NextEpochChange
ToBeRemoved)]
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        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 (Credential 'ColdCommitteeRole
-> Set (Credential 'ColdCommitteeRole)
forall a. a -> Set a
Set.singleton Credential 'ColdCommitteeRole
c1) Set (Credential 'HotCommitteeRole)
forall a. Monoid a => a
mempty Set MemberStatus
forall a. Monoid a => a
mempty Map (Credential 'ColdCommitteeRole) CommitteeMemberState
forall k a. Map k a
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
        (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- 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
        (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000

        Credential 'ColdCommitteeRole
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
        EpochNo
c1Expiry <- (EpochNo -> EpochInterval -> EpochNo)
-> EpochInterval -> EpochNo -> EpochNo
forall a b c. (a -> b -> c) -> b -> a -> c
flip EpochNo -> EpochInterval -> EpochNo
addEpochInterval (Word32 -> EpochInterval
EpochInterval Word32
10) (EpochNo -> EpochNo)
-> ImpTestM era EpochNo -> ImpTestM era EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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

        Set (Credential 'ColdCommitteeRole)
initialCommitteeMembers <- ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
        GovPurposeId GovActionId
gid <-
          StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
electCommittee
            StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
            Credential 'DRepRole
drep
            Set (Credential 'ColdCommitteeRole)
initialCommitteeMembers
            [(Credential 'ColdCommitteeRole
c1, EpochNo
c1Expiry)]
        Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gid

        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        Credential 'HotCommitteeRole
hk1 <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
c1
        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 (Credential 'ColdCommitteeRole
-> Set (Credential 'ColdCommitteeRole)
forall a. a -> Set a
Set.singleton Credential 'ColdCommitteeRole
c1) Set (Credential 'HotCommitteeRole)
forall a. Monoid a => a
mempty Set MemberStatus
forall a. Monoid a => a
mempty (Map (Credential 'ColdCommitteeRole) CommitteeMemberState
 -> ImpM (LedgerSpec era) ())
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
          [(Credential 'ColdCommitteeRole
c1, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk1) MemberStatus
Unrecognized Maybe EpochNo
forall a. Maybe a
Nothing NextEpochChange
ToBeEnacted)]
        ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch
        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 (Credential 'ColdCommitteeRole
-> Set (Credential 'ColdCommitteeRole)
forall a. a -> Set a
Set.singleton Credential 'ColdCommitteeRole
c1) Set (Credential 'HotCommitteeRole)
forall a. Monoid a => a
mempty Set MemberStatus
forall a. Monoid a => a
mempty (Map (Credential 'ColdCommitteeRole) CommitteeMemberState
 -> ImpM (LedgerSpec era) ())
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
          [(Credential 'ColdCommitteeRole
c1, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk1) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c1Expiry) NextEpochChange
NoChangeExpected)]

  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
    (Credential 'DRepRole
drep, Credential 'Staking
_, KeyPair 'Payment
_) <- 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
    (KeyHash 'StakePool
spoC, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
    EpochNo
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 offsetEpochInterval :: Word32 -> EpochNo
offsetEpochInterval Word32
n = EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
curEpochNo (Word32 -> EpochInterval
EpochInterval Word32
n)
    let cExpiry :: Word32
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole, EpochNo)
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)
    (Credential 'ColdCommitteeRole
c1, EpochNo
c1Expiry) <- Word32
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole, EpochNo)
cExpiry Word32
12
    (Credential 'ColdCommitteeRole
c2, EpochNo
c2Expiry) <- Word32
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole, EpochNo)
cExpiry Word32
2
    (Credential 'ColdCommitteeRole
c3, EpochNo
c3Expiry) <- Word32
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole, EpochNo)
cExpiry Word32
7
    (Credential 'ColdCommitteeRole
c4, EpochNo
c4Expiry) <- Word32
-> ImpM (LedgerSpec era) (Credential 'ColdCommitteeRole, EpochNo)
cExpiry Word32
5
    Credential 'ColdCommitteeRole
c5 <- 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
    Credential 'ColdCommitteeRole
c6 <- 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
    Credential 'ColdCommitteeRole
c7 <- 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
    Credential 'ColdCommitteeRole
c8 <- 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
    let newMembers :: Map (Credential 'ColdCommitteeRole) EpochNo
newMembers =
          [ (Credential 'ColdCommitteeRole
c1, EpochNo
c1Expiry)
          , (Credential 'ColdCommitteeRole
c2, EpochNo
c2Expiry)
          , (Credential 'ColdCommitteeRole
c3, EpochNo
c3Expiry)
          , (Credential 'ColdCommitteeRole
c4, EpochNo
c4Expiry)
          ]
    Set (Credential 'ColdCommitteeRole)
initialMembers <- ImpTestM era (Set (Credential 'ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers

    ga1 :: GovPurposeId 'CommitteePurpose era
ga1@(GovPurposeId GovActionId
gaid1) <-
      StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
electCommittee
        StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. StrictMaybe a
SNothing
        Credential 'DRepRole
drep
        Set (Credential 'ColdCommitteeRole)
initialMembers
        Map (Credential 'ColdCommitteeRole) EpochNo
newMembers
    Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaid1

    Set (Credential 'ColdCommitteeRole) -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers Set (Credential 'ColdCommitteeRole)
initialMembers
    Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2 -- epoch 2
    Set (Credential 'ColdCommitteeRole) -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers (Set (Credential 'ColdCommitteeRole) -> ImpM (LedgerSpec era) ())
-> Set (Credential 'ColdCommitteeRole) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Map (Credential 'ColdCommitteeRole) EpochNo
-> Set (Credential 'ColdCommitteeRole)
forall k a. Map k a -> Set k
Map.keysSet Map (Credential 'ColdCommitteeRole) EpochNo
newMembers
    -- members for which the expiration epoch is the current epoch are `ToBeExpired`
    HasCallStack =>
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
expectNoFilterQueryResult
      [ (Credential 'ColdCommitteeRole
c1, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c1Expiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c2, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c2Expiry) NextEpochChange
ToBeExpired)
      , (Credential 'ColdCommitteeRole
c3, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c3Expiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c4, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c4Expiry) NextEpochChange
NoChangeExpected)
      ]
    -- hot cred status of members with registered hot keys becomes `MemberAuthorized`
    Credential 'HotCommitteeRole
hk1 <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
c1
    Credential 'HotCommitteeRole
hk2 <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
c2
    HasCallStack =>
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
expectNoFilterQueryResult
      [ (Credential 'ColdCommitteeRole
c1, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk1) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c1Expiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c2, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk2) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c2Expiry) NextEpochChange
ToBeExpired)
      , (Credential 'ColdCommitteeRole
c3, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c3Expiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c4, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c4Expiry) NextEpochChange
NoChangeExpected)
      ]
    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
      [Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c2, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c3, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c5]
      Set (Credential 'HotCommitteeRole)
forall a. Monoid a => a
mempty
      [Item (Set MemberStatus)
MemberStatus
Active, Item (Set MemberStatus)
MemberStatus
Unrecognized]
      [ (Credential 'ColdCommitteeRole
c3, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c3Expiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c2, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk2) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c2Expiry) NextEpochChange
ToBeExpired)
      ]

    Anchor
c3Anchor <- ImpM (LedgerSpec era) Anchor
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
    Maybe (Credential 'HotCommitteeRole)
_ <- Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
forall era.
(ShelleyEraImp era, ConwayEraTxCert era, ConwayEraCertState era) =>
Credential 'ColdCommitteeRole
-> StrictMaybe Anchor
-> ImpTestM era (Maybe (Credential 'HotCommitteeRole))
resignCommitteeColdKey Credential 'ColdCommitteeRole
c3 (Anchor -> StrictMaybe Anchor
forall a. a -> StrictMaybe a
SJust Anchor
c3Anchor)
    GovActionId
_ <-
      GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$
        StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee
          (GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
ga1)
          Set (Credential 'ColdCommitteeRole)
forall a. Monoid a => a
mempty
          ([(Credential 'ColdCommitteeRole, EpochNo)]
-> Map (Credential 'ColdCommitteeRole) EpochNo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Credential 'ColdCommitteeRole
c5, Word32 -> EpochNo
offsetEpochInterval Word32
10), (Credential 'ColdCommitteeRole
c8, Word32 -> EpochNo
offsetEpochInterval Word32
10)])
          (Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1)
    Credential 'HotCommitteeRole
hk5 <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
c5
    ImpM (LedgerSpec era) ()
forall era. (HasCallStack, ShelleyEraImp era) => ImpTestM era ()
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`
    HasCallStack =>
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
expectNoFilterQueryResult
      [ (Credential 'ColdCommitteeRole
c1, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk1) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c1Expiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c2, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk2) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c2Expiry) NextEpochChange
ToBeExpired)
      , (Credential 'ColdCommitteeRole
c3, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Maybe Anchor -> HotCredAuthStatus
MemberResigned (Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just Anchor
c3Anchor)) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c3Expiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c4, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c4Expiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c5, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk5) MemberStatus
Unrecognized Maybe EpochNo
forall a. Maybe a
Nothing NextEpochChange
ToBeRemoved)
      ]
    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
      [Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c2, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c3, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c5]
      [Item (Set (Credential 'HotCommitteeRole))
Credential 'HotCommitteeRole
hk5]
      [Item (Set MemberStatus)
MemberStatus
Unrecognized]
      ( Credential 'ColdCommitteeRole
-> CommitteeMemberState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
forall k a. k -> a -> Map k a
Map.singleton
          Credential 'ColdCommitteeRole
c5
          (HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk5) MemberStatus
Unrecognized Maybe EpochNo
forall a. Maybe a
Nothing NextEpochChange
ToBeRemoved)
      )

    ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
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`
    HasCallStack =>
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
expectNoFilterQueryResult
      [ (Credential 'ColdCommitteeRole
c1, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk1) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c1Expiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c2, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk2) MemberStatus
Expired (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c2Expiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c3, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Maybe Anchor -> HotCredAuthStatus
MemberResigned (Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just Anchor
c3Anchor)) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c3Expiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c4, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c4Expiry) NextEpochChange
NoChangeExpected)
      ]

    -- elect new committee to be: c1 (term extended ), c3 (no changes), c4 (term shortened, expiring next epoch), c6, c7 (new)
    let c1NewExpiry :: EpochNo
c1NewExpiry = Word32 -> EpochNo
offsetEpochInterval Word32
13
        c4NewExpiry :: EpochNo
c4NewExpiry = Word32 -> EpochNo
offsetEpochInterval Word32
4
        c6Expiry :: EpochNo
c6Expiry = Word32 -> EpochNo
offsetEpochInterval Word32
6
        c7Expiry :: EpochNo
c7Expiry = Word32 -> EpochNo
offsetEpochInterval Word32
7
    ga2 :: GovPurposeId 'CommitteePurpose era
ga2@(GovPurposeId GovActionId
gaid2) <-
      StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
electCommittee
        (GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
ga1)
        Credential 'DRepRole
drep
        [Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c2]
        [ (Credential 'ColdCommitteeRole
c1, EpochNo
c1NewExpiry)
        , (Credential 'ColdCommitteeRole
c4, EpochNo
c4NewExpiry)
        , (Credential 'ColdCommitteeRole
c6, EpochNo
c6Expiry)
        , (Credential 'ColdCommitteeRole
c7, EpochNo
c7Expiry)
        ]
    Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaid2
    ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- epoch 4
    Credential 'HotCommitteeRole
hk6 <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
c6
    Credential 'HotCommitteeRole
hk8 <- Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'ColdCommitteeRole
-> ImpTestM era (Credential 'HotCommitteeRole)
registerCommitteeHotKey Credential 'ColdCommitteeRole
c8

    -- in the next epoch after the election, the old committee is still in place
    Set (Credential 'ColdCommitteeRole) -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers [Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c1, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c2, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c3, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
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`
    HasCallStack =>
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
expectNoFilterQueryResult
      [ (Credential 'ColdCommitteeRole
c1, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk1) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c1Expiry) (EpochNo -> NextEpochChange
TermAdjusted EpochNo
c1NewExpiry))
      , (Credential 'ColdCommitteeRole
c2, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk2) MemberStatus
Expired (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c2Expiry) NextEpochChange
ToBeRemoved)
      , (Credential 'ColdCommitteeRole
c3, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Maybe Anchor -> HotCredAuthStatus
MemberResigned (Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just Anchor
c3Anchor)) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c3Expiry) NextEpochChange
NoChangeExpected)
      , -- though its term was adjusted, `ToBeExpired` takes precedence
        (Credential 'ColdCommitteeRole
c4, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c4Expiry) NextEpochChange
ToBeExpired)
      , (Credential 'ColdCommitteeRole
c6, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk6) MemberStatus
Unrecognized Maybe EpochNo
forall a. Maybe a
Nothing NextEpochChange
ToBeEnacted)
      , (Credential 'ColdCommitteeRole
c7, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Unrecognized Maybe EpochNo
forall a. Maybe a
Nothing NextEpochChange
ToBeEnacted)
      , (Credential 'ColdCommitteeRole
c8, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk8) MemberStatus
Unrecognized Maybe EpochNo
forall a. Maybe a
Nothing NextEpochChange
ToBeRemoved)
      ]
    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
      [Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c1]
      Set (Credential 'HotCommitteeRole)
forall a. Monoid a => a
mempty
      Set MemberStatus
forall a. Monoid a => a
mempty
      [ (Credential 'ColdCommitteeRole
c1, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk1) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c1Expiry) (EpochNo -> NextEpochChange
TermAdjusted EpochNo
c1NewExpiry))
      ]
    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
      [Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c2]
      [Item (Set (Credential 'HotCommitteeRole))
Credential 'HotCommitteeRole
hk2]
      [Item (Set MemberStatus)
MemberStatus
Expired]
      ( Credential 'ColdCommitteeRole
-> CommitteeMemberState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
forall k a. k -> a -> Map k a
Map.singleton
          Credential 'ColdCommitteeRole
c2
          (HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk2) MemberStatus
Expired (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c2Expiry) NextEpochChange
ToBeRemoved)
      )

    Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2 -- epoch 6
    -- the new committee is in place with the adjusted terms
    Set (Credential 'ColdCommitteeRole) -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers [Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c1, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c3, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c4, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c6, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c7]
    HasCallStack =>
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
expectNoFilterQueryResult
      [ (Credential 'ColdCommitteeRole
c1, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk1) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c1NewExpiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c3, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Maybe Anchor -> HotCredAuthStatus
MemberResigned (Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just Anchor
c3Anchor)) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c3Expiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c4, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Expired (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c4NewExpiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c6, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk6) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c6Expiry) NextEpochChange
ToBeExpired)
      , (Credential 'ColdCommitteeRole
c7, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c7Expiry) NextEpochChange
NoChangeExpected)
      ]
    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. Set a
Set.empty
      Set (Credential 'HotCommitteeRole)
forall a. Set a
Set.empty
      [Item (Set MemberStatus)
MemberStatus
Unrecognized]
      Map (Credential 'ColdCommitteeRole) CommitteeMemberState
forall k a. Map k a
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 :: EpochNo
c3NewExpiry = Word32 -> EpochNo
offsetEpochInterval Word32
9
        c4NewNewExpiry :: EpochNo
c4NewNewExpiry = Word32 -> EpochNo
offsetEpochInterval Word32
9
        c6NewExpiry :: EpochNo
c6NewExpiry = Word32 -> EpochNo
offsetEpochInterval Word32
9
    GovPurposeId GovActionId
gaid3 <-
      StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
forall era.
(HasCallStack, ConwayEraImp era) =>
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Credential 'DRepRole
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> ImpTestM era (GovPurposeId 'CommitteePurpose era)
electCommittee
        (GovPurposeId 'CommitteePurpose era
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall a. a -> StrictMaybe a
SJust GovPurposeId 'CommitteePurpose era
ga2)
        Credential 'DRepRole
drep
        [Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c1]
        [ (Credential 'ColdCommitteeRole
c3, EpochNo
c3NewExpiry)
        , (Credential 'ColdCommitteeRole
c4, EpochNo
c4NewNewExpiry)
        , (Credential 'ColdCommitteeRole
c6, EpochNo
c6NewExpiry)
        ]
    Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spoC) GovActionId
gaid3
    ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- epoch 7
    -- members whose term changed have next epoch change `TermAdjusted`
    HasCallStack =>
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
expectNoFilterQueryResult
      [ (Credential 'ColdCommitteeRole
c1, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk1) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c1NewExpiry) NextEpochChange
ToBeRemoved)
      ,
        ( Credential 'ColdCommitteeRole
c3
        , HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState
            (Maybe Anchor -> HotCredAuthStatus
MemberResigned (Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just Anchor
c3Anchor))
            MemberStatus
Active
            (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c3Expiry)
            (EpochNo -> NextEpochChange
TermAdjusted EpochNo
c3NewExpiry)
        )
      ,
        ( Credential 'ColdCommitteeRole
c4
        , HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Expired (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c4NewExpiry) (EpochNo -> NextEpochChange
TermAdjusted EpochNo
c4NewNewExpiry)
        )
      , (Credential 'ColdCommitteeRole
c6, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk6) MemberStatus
Expired (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c6Expiry) (EpochNo -> NextEpochChange
TermAdjusted EpochNo
c6NewExpiry))
      , (Credential 'ColdCommitteeRole
c7, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c7Expiry) NextEpochChange
ToBeExpired)
      ]
    ImpM (LedgerSpec era) ()
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era ()
passEpoch -- epoch 8
    Set (Credential 'ColdCommitteeRole) -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ConwayEraGov era) =>
Set (Credential 'ColdCommitteeRole) -> ImpTestM era ()
expectMembers [Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c3, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c4, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c6, Item (Set (Credential 'ColdCommitteeRole))
Credential 'ColdCommitteeRole
c7]
    HasCallStack =>
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
expectNoFilterQueryResult
      [
        ( Credential 'ColdCommitteeRole
c3
        , HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Maybe Anchor -> HotCredAuthStatus
MemberResigned (Anchor -> Maybe Anchor
forall a. a -> Maybe a
Just Anchor
c3Anchor)) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c3NewExpiry) NextEpochChange
NoChangeExpected
        )
      , (Credential 'ColdCommitteeRole
c4, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c4NewNewExpiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c6, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState (Credential 'HotCommitteeRole -> HotCredAuthStatus
MemberAuthorized Credential 'HotCommitteeRole
hk6) MemberStatus
Active (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c6NewExpiry) NextEpochChange
NoChangeExpected)
      , (Credential 'ColdCommitteeRole
c7, HotCredAuthStatus
-> MemberStatus
-> Maybe EpochNo
-> NextEpochChange
-> CommitteeMemberState
CommitteeMemberState HotCredAuthStatus
MemberNotAuthorized MemberStatus
Expired (EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
c7Expiry) NextEpochChange
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
      NewEpochState era
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 {Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee :: Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee :: CommitteeMembersState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee} =
            Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> NewEpochState era
-> CommitteeMembersState
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
Set (Credential 'ColdCommitteeRole)
-> Set (Credential 'HotCommitteeRole)
-> Set MemberStatus
-> NewEpochState era
-> CommitteeMembersState
queryCommitteeMembersState
              Set (Credential 'ColdCommitteeRole)
ckFilter
              Set (Credential 'HotCommitteeRole)
hkFilter
              Set MemberStatus
statusFilter
              NewEpochState era
nes
      String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Expecting query result" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
        Map (Credential 'ColdCommitteeRole) CommitteeMemberState
csCommittee Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> Map (Credential 'ColdCommitteeRole) CommitteeMemberState
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Map (Credential 'ColdCommitteeRole) CommitteeMemberState
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