{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Cardano.Ledger.Conway.Imp.DelegSpec (
  spec,
) where

import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.BaseTypes (EpochInterval (..), StrictMaybe (..), addEpochInterval)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Conway.Rules (ConwayDelegPredFailure (..))
import Cardano.Ledger.Conway.TxCert
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.DRep
import Cardano.Ledger.Plutus (
  SLanguage (..),
  hashPlutusScript,
 )
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.UMap as UMap
import Cardano.Ledger.Val (Val (..))
import Data.Functor ((<&>))
import qualified Data.Map.Strict as Map
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import Lens.Micro ((%~), (&), (.~))
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Conway.ImpTest
import Test.Cardano.Ledger.Imp.Common
import Test.Cardano.Ledger.Plutus.Examples (evenRedeemerNoDatum)

spec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayDelegPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayDelegPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
spec = do
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Register stake credential" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"With correct deposit or without any deposit" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
RegTxCert (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)]
        forall {era}.
EraGov era =>
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)

      forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit]
        forall {era}.
EraGov era =>
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Twice the same certificate in the same transaction" forall a b. (a -> b) -> a -> b
$ do
      -- This is expected behavior because `certsTxBodyL` removes duplicates
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL
      forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit
                 , forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit
                 ]
        forall {era}.
EraGov era =>
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"When already already registered" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL
      let sh :: ScriptHash
sh = forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript (forall (l :: Language). SLanguage l -> Plutus l
evenRedeemerNoDatum SLanguage 'PlutusV3
SPlutusV3)
      let tx :: Tx era
tx =
            forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
              forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
                forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
sh) Coin
expectedDeposit]
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ Tx era
tx

      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        Tx era
tx
        [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyRegisteredDELEG (forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
sh)
        ]
      forall {era}.
EraGov era =>
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered (forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
sh)

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"With incorrect deposit" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      Positive Integer
n <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      let wrongDeposit :: Coin
wrongDeposit = Coin
expectedDeposit forall t. Val t => t -> t -> t
<+> Integer -> Coin
Coin Integer
n

      forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
          ( forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
              forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
                forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
wrongDeposit]
          )
          [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. Coin -> ConwayDelegPredFailure era
IncorrectDepositDELEG Coin
wrongDeposit]
        forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)

  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Unregister stake credentials" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"When registered" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL
      let sh :: Credential kr
sh = forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall a b. (a -> b) -> a -> b
$ forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript (forall (l :: Language). SLanguage l -> Plutus l
evenRedeemerNoDatum SLanguage 'PlutusV3
SPlutusV3)
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert forall {kr :: KeyRole}. Credential kr
sh Coin
expectedDeposit]

      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert forall {kr :: KeyRole}. Credential kr
sh Coin
expectedDeposit]
      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered forall {kr :: KeyRole}. Credential kr
sh

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"When not registered" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL
      forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh ->
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
          ( forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
              forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
                forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit]
          )
          [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)
          ]

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"With incorrect deposit" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash

      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]

      Positive Integer
n <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      let wrongDeposit :: Coin
wrongDeposit = Coin
expectedDeposit forall t. Val t => t -> t -> t
<+> Integer -> Coin
Coin Integer
n

      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        ( forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred Coin
wrongDeposit]
        )
        [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. Coin -> ConwayDelegPredFailure era
IncorrectDepositDELEG Coin
wrongDeposit]

      forall {era}.
EraGov era =>
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered Credential 'Staking
cred

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"With non-zero reward balance" forall a b. (a -> b) -> a -> b
$ do
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash

      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]

      forall era.
ConwayEraImp era =>
Credential 'Staking -> ImpTestM era ()
submitAndExpireProposalToMakeReward Credential 'Staking
cred

      Coin
reward <- forall era.
HasCallStack =>
Credential 'Staking -> ImpTestM era Coin
lookupReward Credential 'Staking
cred
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        ( forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]
        )
        [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. Coin -> ConwayDelegPredFailure era
StakeKeyHasNonZeroRewardAccountBalanceDELEG Coin
reward]
      forall {era}.
EraGov era =>
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered Credential 'Staking
cred

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Register and unregister in the same transaction" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL
      forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit
                 , forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit
                 ]
        forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"deregistering returns the deposit" forall a b. (a -> b) -> a -> b
$ do
      let
        keyDeposit :: Coin
keyDeposit = Integer -> Coin
Coin Integer
2
        -- This is paid out as the reward
        govActionDeposit :: Coin
govActionDeposit = Integer -> Coin
Coin Integer
3
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
        PParams era
pp
          forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
keyDeposit
          forall a b. a -> (a -> b) -> b
& forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
govActionDeposit
      Credential 'Staking
stakeCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      RewardAccount
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
Credential 'Staking -> ImpTestM era RewardAccount
registerStakeCredential Credential 'Staking
stakeCred
      Credential 'Staking
otherStakeCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      RewardAccount
otherRewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
Credential 'Staking -> ImpTestM era RewardAccount
registerStakeCredential Credential 'Staking
otherStakeCred
      KeyHash 'StakePool
khStakePool <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
khStakePool
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall a b. (a -> b) -> a -> b
$
        forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [a] -> StrictSeq a
SSeq.fromList
              [ forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
stakeCred (KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash 'StakePool
khStakePool DRep
DRepAlwaysAbstain)
              , forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
otherStakeCred (KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash 'StakePool
khStakePool DRep
DRepAlwaysAbstain)
              ]
      forall era. RewardAccount -> ImpTestM era ()
expectRegisteredRewardAddress RewardAccount
rewardAccount
      forall era. RewardAccount -> ImpTestM era ()
expectRegisteredRewardAddress RewardAccount
otherRewardAccount
      forall era.
ConwayEraImp era =>
Credential 'Staking -> ImpTestM era ()
submitAndExpireProposalToMakeReward Credential 'Staking
otherStakeCred
      forall era.
HasCallStack =>
Credential 'Staking -> ImpTestM era Coin
lookupReward Credential 'Staking
otherStakeCred forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
govActionDeposit
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall a b. (a -> b) -> a -> b
$
        forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [a] -> StrictSeq a
SSeq.fromList
              [forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
stakeCred]
          forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map RewardAccount Coin -> Withdrawals
Withdrawals
              ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [ (RewardAccount
rewardAccount, Integer -> Coin
Coin Integer
0)
                  , (RewardAccount
otherRewardAccount, Coin
govActionDeposit)
                  ]
              )
      forall era.
HasCallStack =>
Credential 'Staking -> ImpTestM era Coin
lookupReward Credential 'Staking
otherStakeCred forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Integer -> Coin
Coin Integer
0
      forall era. RewardAccount -> ImpTestM era ()
expectNotRegisteredRewardAddress RewardAccount
rewardAccount

  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Delegate stake" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate registered stake credentials to registered pool" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]

      KeyHash 'StakePool
poolKh <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh

      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)]

      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Register and delegate in the same transaction" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      KeyHash 'StakePool
poolKh <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit
               , forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)
               ]
      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh

      forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh) Coin
expectedDeposit]
        forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) KeyHash 'StakePool
poolKh

      forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit
                 , forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
DelegStakeTxCert (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) KeyHash 'StakePool
poolKh -- using the pattern from Shelley
                 ]
        forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) KeyHash 'StakePool
poolKh

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate unregistered stake credentials" forall a b. (a -> b) -> a -> b
$ do
      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      KeyHash 'StakePool
poolKh <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        ( forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)]
        )
        [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG Credential 'Staking
cred]

      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate to unregistered pool" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]

      KeyHash 'StakePool
poolKh <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        ( forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)]
        )
        [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. KeyHash 'StakePool -> ConwayDelegPredFailure era
DelegateeStakePoolNotRegisteredDELEG KeyHash 'StakePool
poolKh]

      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate already delegated credentials" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      KeyHash 'StakePool
poolKh <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit
               , forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)
               ]
      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)]
      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh

      KeyHash 'StakePool
poolKh1 <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh1
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh1)]
      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh1

      KeyHash 'StakePool
poolKh2 <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh2
      KeyHash 'StakePool
poolKh3 <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh3

      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh2)
               , forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh3)
               ]

      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh3

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate and unregister" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      KeyHash 'StakePool
poolKh <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit
               , forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)
               , forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit
               ]
      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
cred
      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred

  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Delegate vote" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate vote of registered stake credentials to registered drep" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]

      (Credential 'DRepRole
drepCred, Credential 'Staking
_, KeyPair 'Payment
_) <- forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
     era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (DRep -> Delegatee
DelegVote (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred))]

      forall {era}.
EraGov era =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)
      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred
      forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenBootstrap forall a b. (a -> b) -> a -> b
$ do
        forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Ensure DRep delegation is populated after bootstrap" forall a b. (a -> b) -> a -> b
$ do
          -- Clear out delegation, in order to check its repopulation from UMap.
          let deleteDelegation :: Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
deleteDelegation =
                forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Lens' DRepState (Set (Credential 'Staking))
drepDelegsL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Ord a => a -> Set a -> Set a
Set.delete Credential 'Staking
cred) Credential 'DRepRole
drepCred
          --  Drep delegation for both version 9 and 10 are populating both umap and
          --  `drepDelegs`, so manually modifying the umap in the state is the only way to
          --  test the correct repopulation of `drepDelegs`
          forall era.
(NewEpochState era -> NewEpochState era) -> ImpTestM era ()
modifyNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (EpochState era) (Map (Credential 'DRepRole) DRepState)
epochStateRegDrepL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
deleteDelegation
          NonEmpty (Credential 'HotCommitteeRole)
hotCreds <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
          (KeyHash 'StakePool
spo, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3_000_000_000
          ProtVer
protVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
          GovActionId
gai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)
          forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCreds GovActionId
gai
          forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spo) GovActionId
gai
          forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
          forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai)
          forall {era}.
EraGov era =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate vote of registered stake credentials to unregistered drep" forall a b. (a -> b) -> a -> b
$ do
      RewardAccount Network
_ Credential 'Staking
cred <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      Credential 'DRepRole
drepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      let tx :: Tx era
tx =
            forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
              forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
                forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (DRep -> Delegatee
DelegVote (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred))]
          inBootstrap :: ImpM (LedgerSpec era) ()
inBootstrap = do
            forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ Tx era
tx
            forall {era}.
EraGov era =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)
            forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Ensure delegation is cleaned up on the transition out of bootstrap" forall a b. (a -> b) -> a -> b
$ do
              NonEmpty (Credential 'HotCommitteeRole)
hotCreds <- forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
              (KeyHash 'StakePool
spo, Credential 'Payment
_, Credential 'Staking
_) <- forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
     era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3_000_000_000
              ProtVer
protVer <- forall era. EraGov era => ImpTestM era ProtVer
getProtVer
              GovActionId
gai <- forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction forall a b. (a -> b) -> a -> b
$ forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)
              forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCreds GovActionId
gai
              forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spo) GovActionId
gai
              forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
              forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose era))
getLastEnactedHardForkInitiation forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` forall a. a -> StrictMaybe a
SJust (forall (p :: GovActionPurpose) era.
GovActionId -> GovPurposeId p era
GovPurposeId GovActionId
gai)
              forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred

          outOfBootstrap :: ImpM (LedgerSpec era) ()
outOfBootstrap = do
            forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx Tx era
tx [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. Credential 'DRepRole -> ConwayDelegPredFailure era
DelegateeDRepNotRegisteredDELEG Credential 'DRepRole
drepCred]
            forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred
      forall era a.
EraGov era =>
ImpTestM era a -> ImpTestM era a -> ImpTestM era a
ifBootstrap ImpM (LedgerSpec era) ()
inBootstrap ImpM (LedgerSpec era) ()
outOfBootstrap

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate vote of unregistered stake credentials" forall a b. (a -> b) -> a -> b
$ do
      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Credential 'DRepRole
drepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        ( forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (DRep -> Delegatee
DelegVote (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred))]
        )
        [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG Credential 'Staking
cred]

      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Redelegate vote" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Credential 'DRepRole
drepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep

      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert Credential 'Staking
cred (DRep -> Delegatee
DelegVote (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)) Coin
expectedDeposit]
      forall {era}.
EraGov era =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)

      Credential 'DRepRole
drepCred2 <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (DRep -> Delegatee
DelegVote (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred2))]

      forall {era}.
EraGov era =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred2)

      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Check that unregistration of previous delegation does not affect current delegation" forall a b. (a -> b) -> a -> b
$ do
        forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'DRepRole -> ImpTestM era ()
unRegisterDRep Credential 'DRepRole
drepCred
        -- we need to preserve the buggy behavior until the boostrap phase is over.
        forall era a.
EraGov era =>
ImpTestM era a -> ImpTestM era a -> ImpTestM era a
ifBootstrap (forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred) (forall {era}.
EraGov era =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred2))

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate vote and unregister stake credentials" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL
      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Credential 'DRepRole
drepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert Credential 'Staking
cred (DRep -> Delegatee
DelegVote (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)) Coin
expectedDeposit]
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]
      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
cred
      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred

  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Delegate both stake and vote" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate and unregister credentials" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      KeyHash 'StakePool
poolKh <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
      Credential 'DRepRole
drepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep

      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert
                  Credential 'Staking
cred
                  (KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash 'StakePool
poolKh (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred))
                  Coin
expectedDeposit
               ]
      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
      forall {era}.
EraGov era =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)

      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]
      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
cred
      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred
      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate to DRep and SPO and change delegation to a different SPO" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      KeyHash 'StakePool
poolKh <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
      Credential 'DRepRole
drepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep

      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert
                  Credential 'Staking
cred
                  (KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash 'StakePool
poolKh (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred))
                  Coin
expectedDeposit
               ]
      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
      forall {era}.
EraGov era =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)

      KeyHash 'StakePool
poolKh' <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh'
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh')]
      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh'
      forall {era}.
EraGov era =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)

    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate, retire and re-register pool" forall a b. (a -> b) -> a -> b
$ do
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL
      Credential 'Staking
cred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      KeyHash 'StakePool
poolKh <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      RewardAccount
rewardAccount <- forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
      Credential 'DRepRole
drepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep

      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert
                  Credential 'Staking
cred
                  (KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash 'StakePool
poolKh (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred))
                  Coin
expectedDeposit
               ]
      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
      forall {era}.
EraGov era =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)

      let poolLifetime :: Word32
poolLifetime = Word32
2
      let poolExpiry :: ImpM (LedgerSpec era) EpochNo
poolExpiry = forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall era. Lens' (NewEpochState era) EpochNo
nesELL forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \EpochNo
n -> EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
n forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval Word32
poolLifetime

      ImpM (LedgerSpec era) EpochNo
poolExpiry forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EpochNo
pe ->
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool
poolKh EpochNo
pe]

      -- when pool is re-registered after its expiration, all delegations are cleared
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
poolLifetime
      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> RewardAccount -> ImpTestM era ()
registerPoolWithRewardAccount KeyHash 'StakePool
poolKh RewardAccount
rewardAccount
      forall {era}. Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred
      -- the vote delegation is kept
      forall {era}.
EraGov era =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)

      -- re-delegate
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert
                  Credential 'Staking
cred
                  (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)
               ]
      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh

      -- when pool is re-registered before its expiration, delegations are kept
      ImpM (LedgerSpec era) EpochNo
poolExpiry forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EpochNo
pe ->
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool
poolKh EpochNo
pe]
      -- re-register the pool before the expiration time
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
poolLifetime forall a. Num a => a -> a -> a
- Natural
1
      forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> RewardAccount -> ImpTestM era ()
registerPoolWithRewardAccount KeyHash 'StakePool
poolKh RewardAccount
rewardAccount
      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh

      -- when pool is retired and re-registered in the same transaction, delegations are kept
      PoolParams
pps <- forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> RewardAccount -> ImpTestM era PoolParams
poolParams KeyHash 'StakePool
poolKh RewardAccount
rewardAccount
      ImpM (LedgerSpec era) EpochNo
poolExpiry forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EpochNo
pe ->
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ [forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool
poolKh EpochNo
pe, forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
pps]

      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
      forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
poolLifetime
      forall {era}.
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
  where
    expectRegistered :: Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered Credential 'Staking
cred = do
      UMap
umap <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) UMap
dsUnifiedL
      Coin
expectedDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL

      let umapDeposit :: Maybe Coin
umapDeposit = RDPair -> Coin
rdDepositCoin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. k -> UView k v -> Maybe v
UMap.lookup Credential 'Staking
cred (UMap -> UView (Credential 'Staking) RDPair
RewDepUView UMap
umap)
      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn
        (forall a. Show a => a -> String
show Credential 'Staking
cred forall a. Semigroup a => a -> a -> a
<> String
" expected to be in UMap RewDep with the correct deposit")
        forall a b. (a -> b) -> a -> b
$ Maybe Coin
umapDeposit forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` forall a. a -> Maybe a
Just Coin
expectedDeposit

    expectNotRegistered :: Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
cred = do
      UMap
umap <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) UMap
dsUnifiedL
      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn (forall a. Show a => a -> String
show Credential 'Staking
cred forall a. Semigroup a => a -> a -> a
<> String
" expected to not be in UMap RewDep") forall a b. (a -> b) -> a -> b
$
        forall k v. k -> UView k v -> Bool
UMap.notMember Credential 'Staking
cred (UMap -> UView (Credential 'Staking) RDPair
RewDepUView UMap
umap) forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Bool
True

    expectDelegatedToPool :: Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh = do
      UMap
umap <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) UMap
dsUnifiedL
      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn (forall a. Show a => a -> String
show Credential 'Staking
cred forall a. Semigroup a => a -> a -> a
<> String
" expected to have stake delegated to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show KeyHash 'StakePool
poolKh) forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
cred (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap UMap
umap) forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` forall a. a -> Maybe a
Just KeyHash 'StakePool
poolKh

    expectNotDelegatedToPool :: Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred = do
      UMap
umap <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) UMap
dsUnifiedL
      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn (forall a. Show a => a -> String
show Credential 'Staking
cred forall a. Semigroup a => a -> a -> a
<> String
" expected to not have delegated stake") forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => k -> Map k a -> Bool
Map.notMember Credential 'Staking
cred (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap UMap
umap) forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Bool
True

    expectDelegatedVote :: Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred DRep
drep = do
      UMap
umap <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) UMap
dsUnifiedL
      Map (Credential 'DRepRole) DRepState
dreps <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (EpochState era) (Map (Credential 'DRepRole) DRepState)
epochStateRegDrepL
      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn (forall a. Show a => a -> String
show Credential 'Staking
cred forall a. Semigroup a => a -> a -> a
<> String
" expected to have their vote delegated to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show DRep
drep) forall a b. (a -> b) -> a -> b
$ do
        forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
cred (UMap -> Map (Credential 'Staking) DRep
dRepMap UMap
umap) forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` forall a. a -> Maybe a
Just DRep
drep
        case DRep
drep of
          DRepCredential Credential 'DRepRole
drepCred ->
            case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
drepCred Map (Credential 'DRepRole) DRepState
dreps of
              Maybe DRepState
Nothing ->
                forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure String
"Expected DRep to be registered"
              Just DRepState
drepState ->
                forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool
                  String
"Expected DRep delegations to contain the stake credential"
                  (Credential 'Staking
cred forall a. Ord a => a -> Set a -> Bool
`Set.member` DRepState -> Set (Credential 'Staking)
drepDelegs DRepState
drepState)
          DRep
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    expectNotDelegatedVote :: Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred = do
      UMap
umap <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) UMap
dsUnifiedL
      forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn (forall a. Show a => a -> String
show Credential 'Staking
cred forall a. Semigroup a => a -> a -> a
<> String
" expected to not have their vote delegated") forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => k -> Map k a -> Bool
Map.notMember Credential 'Staking
cred (UMap -> Map (Credential 'Staking) DRep
dRepMap UMap
umap) forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` Bool
True