{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Test.Cardano.Ledger.Conway.Imp.DelegSpec (
spec,
) where
import Cardano.Ledger.Address (RewardAccount (..))
import Cardano.Ledger.BaseTypes (
EpochInterval (..),
Mismatch (..),
ProtVer (..),
StrictMaybe (..),
addEpochInterval,
natVersion,
)
import Cardano.Ledger.Coin (Coin (..), compactCoinOrError)
import Cardano.Ledger.Conway
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Conway.Rules (ConwayDelegPredFailure (..))
import Cardano.Ledger.Conway.State hiding (balance)
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.Val (Val (..))
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
String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Register stake credential" (SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"With correct deposit or without any deposit" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash 'Staking)
-> (KeyHash 'Staking -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
let cred :: Credential 'Staking
cred = KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh
TxCert era
regTxCert <- Credential 'Staking -> ImpM (LedgerSpec era) (TxCert era)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'Staking -> ImpTestM era (TxCert era)
genRegTxCert Credential 'Staking
cred
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (StrictSeq (TxCert era))
TxCert era
regTxCert]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered Credential 'Staking
cred
ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash 'Staking)
-> (KeyHash 'Staking -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Twice the same certificate in the same transaction" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash 'Staking)
-> (KeyHash 'Staking -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit
, Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit
]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"When already already registered" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
let sh :: ScriptHash
sh = Plutus 'PlutusV3 -> ScriptHash
forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript (Plutus 'PlutusV3 -> ScriptHash) -> Plutus 'PlutusV3 -> ScriptHash
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV3 -> Plutus 'PlutusV3
forall (l :: Language). SLanguage l -> Plutus l
evenRedeemerNoDatum SLanguage 'PlutusV3
SPlutusV3
let tx :: Tx era
tx =
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (ScriptHash -> Credential 'Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
sh) Coin
expectedDeposit]
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ Tx era
tx
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
Tx era
tx
[ ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> ConwayDelegPredFailure era
forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyRegisteredDELEG (ScriptHash -> Credential 'Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
sh)
]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered (ScriptHash -> Credential 'Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj ScriptHash
sh)
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"With incorrect deposit" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
ProtVer
pv <- SimpleGetter (NewEpochState era) ProtVer -> ImpTestM era ProtVer
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) ProtVer -> ImpTestM era ProtVer)
-> SimpleGetter (NewEpochState era) ProtVer -> ImpTestM era ProtVer
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((ProtVer -> Const r ProtVer)
-> EpochState era -> Const r (EpochState era))
-> (ProtVer -> Const r ProtVer)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((ProtVer -> Const r ProtVer)
-> PParams era -> Const r (PParams era))
-> (ProtVer -> Const r ProtVer)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const r ProtVer)
-> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
Positive Integer
n <- ImpM (LedgerSpec era) (Positive Integer)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
let wrongDeposit :: Coin
wrongDeposit = Coin
expectedDeposit Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Integer -> Coin
Coin Integer
n
ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash 'Staking)
-> (KeyHash 'Staking -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
( TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
wrongDeposit]
)
[ ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
if ProtVer -> Bool
hardforkConwayDELEGIncorrectDepositsAndRefunds ProtVer
pv
then
Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
DepositIncorrectDELEG
Mismatch
{ mismatchSupplied :: Coin
mismatchSupplied = Coin
wrongDeposit
, mismatchExpected :: Coin
mismatchExpected = Coin
expectedDeposit
}
else Coin -> ConwayDelegPredFailure era
forall era. Coin -> ConwayDelegPredFailure era
IncorrectDepositDELEG Coin
wrongDeposit
]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)
String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Unregister stake credentials" (SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"When registered" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
let sh :: Credential kr
sh = ScriptHash -> Credential kr
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> Credential kr) -> ScriptHash -> Credential kr
forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV3 -> ScriptHash
forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript (SLanguage 'PlutusV3 -> Plutus 'PlutusV3
forall (l :: Language). SLanguage l -> Plutus l
evenRedeemerNoDatum SLanguage 'PlutusV3
SPlutusV3)
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
forall {kr :: KeyRole}. Credential kr
sh Coin
expectedDeposit]
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
forall {kr :: KeyRole}. Credential kr
sh Coin
expectedDeposit]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
forall {kr :: KeyRole}. Credential kr
sh
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"When not registered" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash 'Staking)
-> (KeyHash 'Staking -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh ->
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
( TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit]
)
[ ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> ConwayDelegPredFailure era
forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)
]
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"With incorrect refund" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
ProtVer
pv <- SimpleGetter (NewEpochState era) ProtVer -> ImpTestM era ProtVer
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) ProtVer -> ImpTestM era ProtVer)
-> SimpleGetter (NewEpochState era) ProtVer -> ImpTestM era ProtVer
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((ProtVer -> Const r ProtVer)
-> EpochState era -> Const r (EpochState era))
-> (ProtVer -> Const r ProtVer)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((ProtVer -> Const r ProtVer)
-> PParams era -> Const r (PParams era))
-> (ProtVer -> Const r ProtVer)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Const r ProtVer)
-> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]
Positive Integer
n <- ImpM (LedgerSpec era) (Positive Integer)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
let wrongDeposit :: Coin
wrongDeposit = Coin
expectedDeposit Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<+> Integer -> Coin
Coin Integer
n
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
( TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred Coin
wrongDeposit]
)
[ ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$
if ProtVer -> Bool
hardforkConwayDELEGIncorrectDepositsAndRefunds ProtVer
pv
then
Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
forall era. Mismatch 'RelEQ Coin -> ConwayDelegPredFailure era
RefundIncorrectDELEG
Mismatch
{ mismatchSupplied :: Coin
mismatchSupplied = Coin
wrongDeposit
, mismatchExpected :: Coin
mismatchExpected = Coin
expectedDeposit
}
else Coin -> ConwayDelegPredFailure era
forall era. Coin -> ConwayDelegPredFailure era
IncorrectDepositDELEG Coin
wrongDeposit
]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered Credential 'Staking
cred
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"With non-zero reward balance" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
(PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL ((EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
2
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]
Credential 'Staking -> ImpM (LedgerSpec era) ()
forall era.
ConwayEraImp era =>
Credential 'Staking -> ImpTestM era ()
submitAndExpireProposalToMakeReward Credential 'Staking
cred
Coin
balance <- Credential 'Staking -> ImpTestM era Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential 'Staking -> ImpTestM era Coin
getBalance Credential 'Staking
cred
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
( TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]
)
[ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ Coin -> ConwayDelegPredFailure era
forall era. Coin -> ConwayDelegPredFailure era
StakeKeyHasNonZeroRewardAccountBalanceDELEG Coin
balance]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered Credential 'Staking
cred
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Register and unregister in the same transaction" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash 'Staking)
-> (KeyHash 'Staking -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit
, Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit
]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh)
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"deregistering returns the deposit" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
let
keyDeposit :: Coin
keyDeposit = Integer -> Coin
Coin Integer
2
govActionDeposit :: Coin
govActionDeposit = Integer -> Coin
Coin Integer
3
(PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
PParams era
pp
PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
keyDeposit
PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. ConwayEraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppGovActionDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
govActionDeposit
Credential 'Staking
stakeCred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
RewardAccount
rewardAccount <- Credential 'Staking -> ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
Credential 'Staking -> ImpTestM era RewardAccount
registerStakeCredential Credential 'Staking
stakeCred
Credential 'Staking
otherStakeCred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
RewardAccount
otherRewardAccount <- Credential 'Staking -> ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
Credential 'Staking -> ImpTestM era RewardAccount
registerStakeCredential Credential 'Staking
otherStakeCred
KeyHash 'StakePool
khStakePool <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
khStakePool
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> (TxBody era -> Tx era) -> TxBody era -> ImpM (LedgerSpec era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (TxBody era -> ImpM (LedgerSpec era) ())
-> TxBody era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxCert era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList
[ Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
stakeCred (KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash 'StakePool
khStakePool DRep
DRepAlwaysAbstain)
, Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
otherStakeCred (KeyHash 'StakePool -> DRep -> Delegatee
DelegStakeVote KeyHash 'StakePool
khStakePool DRep
DRepAlwaysAbstain)
]
RewardAccount -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, EraCertState era) =>
RewardAccount -> ImpTestM era ()
expectRegisteredRewardAddress RewardAccount
rewardAccount
RewardAccount -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, EraCertState era) =>
RewardAccount -> ImpTestM era ()
expectRegisteredRewardAddress RewardAccount
otherRewardAccount
Credential 'Staking -> ImpM (LedgerSpec era) ()
forall era.
ConwayEraImp era =>
Credential 'Staking -> ImpTestM era ()
submitAndExpireProposalToMakeReward Credential 'Staking
otherStakeCred
Credential 'Staking -> ImpTestM era Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential 'Staking -> ImpTestM era Coin
getBalance Credential 'Staking
otherStakeCred ImpTestM era Coin -> Coin -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Coin
govActionDeposit
TxCert era
unRegTxCert <- Credential 'Staking -> ImpM (LedgerSpec era) (TxCert era)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Credential 'Staking -> ImpTestM era (TxCert era)
genUnRegTxCert Credential 'Staking
stakeCred
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> (TxBody era -> Tx era) -> TxBody era -> ImpM (LedgerSpec era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx (TxBody era -> ImpM (LedgerSpec era) ())
-> TxBody era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxCert era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert era] -> StrictSeq (TxCert era)
forall a. [a] -> StrictSeq a
SSeq.fromList [Item [TxCert era]
TxCert era
unRegTxCert]
TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Withdrawals -> Identity Withdrawals)
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL
((Withdrawals -> Identity Withdrawals)
-> TxBody era -> Identity (TxBody era))
-> Withdrawals -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map RewardAccount Coin -> Withdrawals
Withdrawals
( [(RewardAccount, Coin)] -> Map RewardAccount Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (RewardAccount
rewardAccount, Integer -> Coin
Coin Integer
0)
, (RewardAccount
otherRewardAccount, Coin
govActionDeposit)
]
)
Credential 'Staking -> ImpTestM era Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential 'Staking -> ImpTestM era Coin
getBalance Credential 'Staking
otherStakeCred ImpTestM era Coin -> Coin -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Integer -> Coin
Coin Integer
0
RewardAccount -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, EraCertState era) =>
RewardAccount -> ImpTestM era ()
expectNotRegisteredRewardAddress RewardAccount
rewardAccount
String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Delegate stake" (SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate registered stake credentials to registered pool" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]
KeyHash 'StakePool
poolKh <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Register and delegate in the same transaction" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool
poolKh <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit
, Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)
]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash 'Staking)
-> (KeyHash 'Staking -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh) Coin
expectedDeposit]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) KeyHash 'StakePool
poolKh
ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM (LedgerSpec era) (KeyHash 'Staking)
-> (KeyHash 'Staking -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \KeyHash 'Staking
kh -> do
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) Coin
expectedDeposit
, Credential 'Staking -> KeyHash 'StakePool -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> KeyHash 'StakePool -> TxCert era
DelegStakeTxCert (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) KeyHash 'StakePool
poolKh
]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'Staking
kh) KeyHash 'StakePool
poolKh
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate unregistered stake credentials" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool
poolKh <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
( TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)]
)
[ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> ConwayDelegPredFailure era
forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG Credential 'Staking
cred]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
cred
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate to unregistered pool" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]
KeyHash 'StakePool
poolKh <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
( TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)]
)
[ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool -> ConwayDelegPredFailure era
forall era. KeyHash 'StakePool -> ConwayDelegPredFailure era
DelegateeStakePoolNotRegisteredDELEG KeyHash 'StakePool
poolKh]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate already delegated credentials" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool
poolKh <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit
, Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)
]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
KeyHash 'StakePool
poolKh1 <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh1
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh1)]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh1
KeyHash 'StakePool
poolKh2 <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh2
KeyHash 'StakePool
poolKh3 <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh3
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh2)
, Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh3)
]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh3
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate and unregister" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool
poolKh <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit
, Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)
, Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit
]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
cred
String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Delegate vote" (SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate vote of registered stake credentials to registered drep" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
RegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]
(Credential 'DRepRole
drepCred, Credential 'Staking
_, KeyPair 'Payment
_) <- Integer
-> ImpTestM
era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
1_000_000
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (DRep -> Delegatee
DelegVote (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred))]
HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred
ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Ensure DRep delegation is populated after bootstrap" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
let deleteDelegation :: Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
deleteDelegation =
(DRepState -> DRepState)
-> Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ((Set (Credential 'Staking) -> Identity (Set (Credential 'Staking)))
-> DRepState -> Identity DRepState
Lens' DRepState (Set (Credential 'Staking))
drepDelegsL ((Set (Credential 'Staking)
-> Identity (Set (Credential 'Staking)))
-> DRepState -> Identity DRepState)
-> (Set (Credential 'Staking) -> Set (Credential 'Staking))
-> DRepState
-> DRepState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential 'Staking
-> Set (Credential 'Staking) -> Set (Credential 'Staking)
forall a. Ord a => a -> Set a -> Set a
Set.delete Credential 'Staking
cred) Credential 'DRepRole
drepCred
(NewEpochState era -> NewEpochState era)
-> ImpM (LedgerSpec era) ()
forall era.
(NewEpochState era -> NewEpochState era) -> ImpTestM era ()
modifyNES ((NewEpochState era -> NewEpochState era)
-> ImpM (LedgerSpec era) ())
-> (NewEpochState era -> NewEpochState era)
-> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era))
-> ((Map (Credential 'DRepRole) DRepState
-> Identity (Map (Credential 'DRepRole) DRepState))
-> EpochState era -> Identity (EpochState era))
-> (Map (Credential 'DRepRole) DRepState
-> Identity (Map (Credential 'DRepRole) DRepState))
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
-> Identity (Map (Credential 'DRepRole) DRepState))
-> EpochState era -> Identity (EpochState era)
forall era.
ConwayEraCertState era =>
Lens' (EpochState era) (Map (Credential 'DRepRole) DRepState)
Lens' (EpochState era) (Map (Credential 'DRepRole) DRepState)
epochStateRegDrepL ((Map (Credential 'DRepRole) DRepState
-> Identity (Map (Credential 'DRepRole) DRepState))
-> NewEpochState era -> Identity (NewEpochState era))
-> (Map (Credential 'DRepRole) DRepState
-> Map (Credential 'DRepRole) DRepState)
-> NewEpochState era
-> NewEpochState era
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 <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
(KeyHash 'StakePool
spo, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3_000_000_000
ProtVer
protVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
GovActionId
gai <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose)
forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)
NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCreds GovActionId
gai
Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spo) GovActionId
gai
Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose))
-> StrictMaybe (GovPurposeId 'HardForkPurpose)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'HardForkPurpose
-> StrictMaybe (GovPurposeId 'HardForkPurpose)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'HardForkPurpose
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
GovPurposeId GovActionId
gai)
HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate vote of registered stake credentials to unregistered drep" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
RewardAccount Network
_ Credential 'Staking
cred <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
Credential 'DRepRole
drepCred <- KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
-> ImpM (LedgerSpec era) (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
let tx :: Tx era
tx =
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> TxCert era
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
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ Tx era
tx
HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)
String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
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" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
NonEmpty (Credential 'HotCommitteeRole)
hotCreds <- ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
(KeyHash 'StakePool
spo, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
3_000_000_000
ProtVer
protVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
GovActionId
gai <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose)
forall a. StrictMaybe a
SNothing (ProtVer -> ProtVer
majorFollow ProtVer
protVer)
NonEmpty (Credential 'HotCommitteeRole)
-> GovActionId -> ImpM (LedgerSpec era) ()
forall era (f :: * -> *).
(ConwayEraImp era, Foldable f) =>
f (Credential 'HotCommitteeRole) -> GovActionId -> ImpTestM era ()
submitYesVoteCCs_ NonEmpty (Credential 'HotCommitteeRole)
hotCreds GovActionId
gai
Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Voter -> GovActionId -> ImpTestM era ()
submitYesVote_ (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
spo) GovActionId
gai
Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose))
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose))
getLastEnactedHardForkInitiation ImpTestM era (StrictMaybe (GovPurposeId 'HardForkPurpose))
-> StrictMaybe (GovPurposeId 'HardForkPurpose)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` GovPurposeId 'HardForkPurpose
-> StrictMaybe (GovPurposeId 'HardForkPurpose)
forall a. a -> StrictMaybe a
SJust (GovActionId -> GovPurposeId 'HardForkPurpose
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
GovPurposeId GovActionId
gai)
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred
outOfBootstrap :: ImpM (LedgerSpec era) ()
outOfBootstrap = do
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx Tx era
tx [ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole -> ConwayDelegPredFailure era
forall era. Credential 'DRepRole -> ConwayDelegPredFailure era
DelegateeDRepNotRegisteredDELEG Credential 'DRepRole
drepCred]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred
ImpM (LedgerSpec era) ()
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era a.
EraGov era =>
ImpTestM era a -> ImpTestM era a -> ImpTestM era a
ifBootstrap ImpM (LedgerSpec era) ()
inBootstrap ImpM (LedgerSpec era) ()
outOfBootstrap
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate vote of unregistered stake credentials" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
Credential 'DRepRole
drepCred <- KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
-> ImpM (LedgerSpec era) (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
( TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (DRep -> Delegatee
DelegVote (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred))]
)
[ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayDelegPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> ConwayDelegPredFailure era
forall era. Credential 'Staking -> ConwayDelegPredFailure era
StakeKeyNotRegisteredDELEG Credential 'Staking
cred]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
cred
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Redelegate vote" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
Credential 'DRepRole
drepCred <- KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
-> ImpM (LedgerSpec era) (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> Coin -> TxCert era
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]
HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)
Credential 'DRepRole
drepCred2 <- KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
-> ImpM (LedgerSpec era) (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (DRep -> Delegatee
DelegVote (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred2))]
HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred2)
String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
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" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
Credential 'DRepRole -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxCert era, ConwayEraCertState era) =>
Credential 'DRepRole -> ImpTestM era ()
unRegisterDRep Credential 'DRepRole
drepCred
ImpM (LedgerSpec era) ()
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era a.
EraGov era =>
ImpTestM era a -> ImpTestM era a -> ImpTestM era a
ifBootstrap (HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred) (HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred2))
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate vote and unregister stake credentials" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
Credential 'DRepRole
drepCred <- KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
-> ImpM (LedgerSpec era) (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> Coin -> TxCert era
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]
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
cred
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred
SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall era.
SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
disableImpInitExpectLedgerRuleConformance (SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate vote and unregister after hardfork" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
let
bootstrapVer :: ProtVer
bootstrapVer = Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @9) Natural
0
setProtVer :: ProtVer -> ImpTestM era ()
setProtVer ProtVer
pv = (NewEpochState era -> NewEpochState era) -> ImpTestM era ()
forall era.
(NewEpochState era -> NewEpochState era) -> ImpTestM era ()
modifyNES ((NewEpochState era -> NewEpochState era) -> ImpTestM era ())
-> (NewEpochState era -> NewEpochState era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era))
-> ((ProtVer -> Identity ProtVer)
-> EpochState era -> Identity (EpochState era))
-> (ProtVer -> Identity ProtVer)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Identity (PParams era))
-> EpochState era -> Identity (EpochState era))
-> ((ProtVer -> Identity ProtVer)
-> PParams era -> Identity (PParams era))
-> (ProtVer -> Identity ProtVer)
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtVer -> Identity ProtVer)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL ((ProtVer -> Identity ProtVer)
-> NewEpochState era -> Identity (NewEpochState era))
-> ProtVer -> NewEpochState era -> NewEpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtVer
pv
ProtVer
initialProtVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
(Credential 'DRepRole
_, Credential 'HotCommitteeRole
ccCred, GovPurposeId 'CommitteePurpose
_) <- String
-> ImpM
(LedgerSpec era)
(Credential 'DRepRole, Credential 'HotCommitteeRole,
GovPurposeId 'CommitteePurpose)
-> ImpM
(LedgerSpec era)
(Credential 'DRepRole, Credential 'HotCommitteeRole,
GovPurposeId 'CommitteePurpose)
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Set up a committee" (ImpM
(LedgerSpec era)
(Credential 'DRepRole, Credential 'HotCommitteeRole,
GovPurposeId 'CommitteePurpose)
-> ImpM
(LedgerSpec era)
(Credential 'DRepRole, Credential 'HotCommitteeRole,
GovPurposeId 'CommitteePurpose))
-> ImpM
(LedgerSpec era)
(Credential 'DRepRole, Credential 'HotCommitteeRole,
GovPurposeId 'CommitteePurpose)
-> ImpM
(LedgerSpec era)
(Credential 'DRepRole, Credential 'HotCommitteeRole,
GovPurposeId 'CommitteePurpose)
forall a b. (a -> b) -> a -> b
$ do
ProtVer -> ImpM (LedgerSpec era) ()
forall {era}.
(Assert
(OrdCond
(CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
(TypeError ...),
EraGov era) =>
ProtVer -> ImpTestM era ()
setProtVer (ProtVer -> ImpM (LedgerSpec era) ())
-> ProtVer -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @10) Natural
0
(Credential 'DRepRole, Credential 'HotCommitteeRole,
GovPurposeId 'CommitteePurpose)
res <- ImpM
(LedgerSpec era)
(Credential 'DRepRole, Credential 'HotCommitteeRole,
GovPurposeId 'CommitteePurpose)
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM
era
(Credential 'DRepRole, Credential 'HotCommitteeRole,
GovPurposeId 'CommitteePurpose)
electBasicCommittee
ProtVer -> ImpM (LedgerSpec era) ()
forall {era}.
(Assert
(OrdCond
(CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
(TypeError ...),
EraGov era) =>
ProtVer -> ImpTestM era ()
setProtVer ProtVer
initialProtVer
(Credential 'DRepRole, Credential 'HotCommitteeRole,
GovPurposeId 'CommitteePurpose)
-> ImpM
(LedgerSpec era)
(Credential 'DRepRole, Credential 'HotCommitteeRole,
GovPurposeId 'CommitteePurpose)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential 'DRepRole, Credential 'HotCommitteeRole,
GovPurposeId 'CommitteePurpose)
res
(KeyHash 'StakePool
khSPO, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10_000_000
~(Credential 'DRepRole
drepCred, Credential 'Staking
_, KeyPair 'Payment
_) <-
if ProtVer
initialProtVer ProtVer -> ProtVer -> Bool
forall a. Ord a => a -> a -> Bool
> ProtVer
bootstrapVer
then Integer
-> ImpTestM
era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall era.
ConwayEraImp era =>
Integer
-> ImpTestM
era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
setupSingleDRep Integer
100_000_000
else (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
-> ImpTestM
era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
-> ImpTestM
era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment))
-> (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
-> ImpTestM
era (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall a b. (a -> b) -> a -> b
$ String
-> (Credential 'DRepRole, Credential 'Staking, KeyPair 'Payment)
forall a. HasCallStack => String -> a
error String
"drepCred should not be accessed before protver 10"
Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert Credential 'Staking
cred (DRep -> Delegatee
DelegVote DRep
DRepAlwaysAbstain) Coin
expectedDeposit]
Credential 'Staking -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
Credential 'Staking -> ImpTestM era ()
registerAndRetirePoolToMakeReward Credential 'Staking
cred
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered Credential 'Staking
cred
HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred DRep
DRepAlwaysAbstain
String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Version should be unchanged" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer ImpTestM era ProtVer -> ProtVer -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
initialProtVer
let nextVer :: ProtVer
nextVer = ProtVer -> ProtVer
majorFollow ProtVer
initialProtVer
GovActionId
hfGaid <- GovAction era -> ImpTestM era GovActionId
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpTestM era GovActionId)
-> GovAction era -> ImpTestM era GovActionId
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'HardForkPurpose)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose)
-> ProtVer -> GovAction era
HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose)
forall a. StrictMaybe a
SNothing ProtVer
nextVer
Vote -> Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (KeyHash 'StakePool -> Voter
StakePoolVoter KeyHash 'StakePool
khSPO) GovActionId
hfGaid
Vote -> Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (Credential 'HotCommitteeRole -> Voter
CommitteeVoter Credential 'HotCommitteeRole
ccCred) GovActionId
hfGaid
Bool -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtVer
initialProtVer ProtVer -> ProtVer -> Bool
forall a. Ord a => a -> a -> Bool
> ProtVer
bootstrapVer) (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
Vote -> Voter -> GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ShelleyEraImp era, ConwayEraTxBody era, HasCallStack) =>
Vote -> Voter -> GovActionId -> ImpTestM era ()
submitVote_ Vote
VoteYes (Credential 'DRepRole -> Voter
DRepVoter Credential 'DRepRole
drepCred) GovActionId
hfGaid
Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
GovActionId -> ImpM (LedgerSpec era) ()
forall era.
(ConwayEraGov era, ConwayEraPParams era, HasCallStack,
ConwayEraCertState era) =>
GovActionId -> ImpTestM era ()
logRatificationChecks GovActionId
hfGaid
String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Version should be bumped" (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer ImpTestM era ProtVer -> ProtVer -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` ProtVer
nextVer
Coin
withdrawalAmount <- Lens' (PParams era) Coin -> ImpTestM era Coin
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (Coin -> f Coin) -> PParams era -> f (PParams era)
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL
RewardAccount
rewardAccount <- Credential 'Staking -> ImpTestM era RewardAccount
forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor Credential 'Staking
cred
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
cred]
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((Withdrawals -> Identity Withdrawals)
-> TxBody era -> Identity (TxBody era))
-> (Withdrawals -> Identity Withdrawals)
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Withdrawals -> Identity Withdrawals)
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL
((Withdrawals -> Identity Withdrawals)
-> Tx era -> Identity (Tx era))
-> Withdrawals -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map RewardAccount Coin -> Withdrawals
Withdrawals (RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton RewardAccount
rewardAccount Coin
withdrawalAmount)
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
cred
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate vote and undelegate after delegating to some stake pools" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
(KeyHash 'StakePool
khSPO, Credential 'Payment
_, Credential 'Staking
_) <- Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall era.
(ShelleyEraImp era, ConwayEraTxCert era) =>
Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
setupPoolWithStake (Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking))
-> Coin
-> ImpTestM
era (KeyHash 'StakePool, Credential 'Payment, Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> Coin -> TxCert era
RegDepositDelegTxCert Credential 'Staking
cred (DRep -> Delegatee
DelegVote DRep
DRepAlwaysAbstain) Coin
expectedDeposit]
Credential 'Staking -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
Credential 'Staking -> ImpTestM era ()
registerAndRetirePoolToMakeReward Credential 'Staking
cred
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered Credential 'Staking
cred
HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred DRep
DRepAlwaysAbstain
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ @[] [Int
Item [Int]
1 .. Int
3 :: Int] ((Int -> ImpM (LedgerSpec era) ()) -> ImpM (LedgerSpec era) ())
-> (Int -> ImpM (LedgerSpec era) ()) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \Int
_ -> do
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
khSPO)]
Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
3
Coin
withdrawalAmount <- Lens' (PParams era) Coin -> ImpTestM era Coin
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (Coin -> f Coin) -> PParams era -> f (PParams era)
forall era.
(EraPParams era, HasCallStack) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL
RewardAccount
rewardAccount <- Credential 'Staking -> ImpTestM era RewardAccount
forall era. Credential 'Staking -> ImpTestM era RewardAccount
getRewardAccountFor Credential 'Staking
cred
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> TxCert era
forall era.
ShelleyEraTxCert era =>
Credential 'Staking -> TxCert era
UnRegTxCert Credential 'Staking
cred]
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((Withdrawals -> Identity Withdrawals)
-> TxBody era -> Identity (TxBody era))
-> (Withdrawals -> Identity Withdrawals)
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Withdrawals -> Identity Withdrawals)
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL
((Withdrawals -> Identity Withdrawals)
-> Tx era -> Identity (Tx era))
-> Withdrawals -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map RewardAccount Coin -> Withdrawals
Withdrawals (RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton RewardAccount
rewardAccount Coin
withdrawalAmount)
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
cred
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred
String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Delegate both stake and vote - separated out for conformance mismatch" (SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$
SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall era.
SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
disableImpInitExpectLedgerRuleConformance (SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate, retire and re-register pool" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool
poolKh <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
RewardAccount
rewardAccount <- ImpTestM era RewardAccount
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era RewardAccount
registerRewardAccount
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
Credential 'DRepRole
drepCred <- KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
-> ImpM (LedgerSpec era) (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Credential 'Staking -> Delegatee -> Coin -> TxCert era
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
]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec 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 = SimpleGetter (NewEpochState era) EpochNo
-> ImpM (LedgerSpec era) EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL ImpM (LedgerSpec era) EpochNo
-> (EpochNo -> EpochNo) -> ImpM (LedgerSpec era) EpochNo
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \EpochNo
n -> EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
n (EpochInterval -> EpochNo) -> EpochInterval -> EpochNo
forall a b. (a -> b) -> a -> b
$ Word32 -> EpochInterval
EpochInterval Word32
poolLifetime
ImpM (LedgerSpec era) EpochNo
poolExpiry ImpM (LedgerSpec era) EpochNo
-> (EpochNo -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EpochNo
pe ->
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [KeyHash 'StakePool -> EpochNo -> TxCert era
forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool
poolKh EpochNo
pe]
Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs (Natural -> ImpM (LedgerSpec era) ())
-> Natural -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
poolLifetime
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred
KeyHash 'StakePool -> RewardAccount -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> RewardAccount -> ImpTestM era ()
registerPoolWithRewardAccount KeyHash 'StakePool
poolKh RewardAccount
rewardAccount
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred
HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert
Credential 'Staking
cred
(KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh)
]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
ImpM (LedgerSpec era) EpochNo
poolExpiry ImpM (LedgerSpec era) EpochNo
-> (EpochNo -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EpochNo
pe ->
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [KeyHash 'StakePool -> EpochNo -> TxCert era
forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool
poolKh EpochNo
pe]
Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs (Natural -> ImpM (LedgerSpec era) ())
-> Natural -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
poolLifetime Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1
KeyHash 'StakePool -> RewardAccount -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> RewardAccount -> ImpTestM era ()
registerPoolWithRewardAccount KeyHash 'StakePool
poolKh RewardAccount
rewardAccount
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs Natural
2
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
PoolParams
pps <- KeyHash 'StakePool -> RewardAccount -> ImpTestM era PoolParams
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> RewardAccount -> ImpTestM era PoolParams
freshPoolParams KeyHash 'StakePool
poolKh RewardAccount
rewardAccount
ImpM (LedgerSpec era) EpochNo
poolExpiry ImpM (LedgerSpec era) EpochNo
-> (EpochNo -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) ()
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \EpochNo
pe ->
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [KeyHash 'StakePool -> EpochNo -> TxCert era
forall era.
EraTxCert era =>
KeyHash 'StakePool -> EpochNo -> TxCert era
RetirePoolTxCert KeyHash 'StakePool
poolKh EpochNo
pe, PoolParams -> TxCert era
forall era. EraTxCert era => PoolParams -> TxCert era
RegPoolTxCert PoolParams
pps]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
Natural -> ImpM (LedgerSpec era) ()
forall era. ShelleyEraImp era => Natural -> ImpTestM era ()
passNEpochs (Natural -> ImpM (LedgerSpec era) ())
-> Natural -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
poolLifetime
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Delegate both stake and vote" (SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate and unregister credentials" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool
poolKh <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
Credential 'DRepRole
drepCred <- KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
-> ImpM (LedgerSpec era) (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Credential 'Staking -> Delegatee -> Coin -> TxCert era
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
]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Coin -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Coin -> TxCert era
UnRegDepositTxCert Credential 'Staking
cred Coin
expectedDeposit]
HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
cred
String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delegate to DRep and SPO and change delegation to a different SPO" (ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
Credential 'Staking
cred <- KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'Staking -> Credential 'Staking)
-> ImpM (LedgerSpec era) (KeyHash 'Staking)
-> ImpM (LedgerSpec era) (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Staking)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool
poolKh <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh
Credential 'DRepRole
drepCred <- KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash 'DRepRole -> Credential 'DRepRole)
-> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
-> ImpM (LedgerSpec era) (Credential 'DRepRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'DRepRole)
forall era. ConwayEraImp era => ImpTestM era (KeyHash 'DRepRole)
registerDRep
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Credential 'Staking -> Delegatee -> Coin -> TxCert era
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
]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh
HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)
KeyHash 'StakePool
poolKh' <- ImpM (LedgerSpec era) (KeyHash 'StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
KeyHash 'StakePool -> ImpTestM era ()
registerPool KeyHash 'StakePool
poolKh'
Tx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ (Tx era -> ImpM (LedgerSpec era) ())
-> Tx era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx era -> Identity (Tx era))
-> StrictSeq (TxCert era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential 'Staking -> Delegatee -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential 'Staking -> Delegatee -> TxCert era
DelegTxCert Credential 'Staking
cred (KeyHash 'StakePool -> Delegatee
DelegStake KeyHash 'StakePool
poolKh')]
HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh'
HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred (Credential 'DRepRole -> DRep
DRepCredential Credential 'DRepRole
drepCred)
where
expectRegistered :: HasCallStack => Credential 'Staking -> ImpTestM era ()
expectRegistered :: HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
expectRegistered Credential 'Staking
cred = do
Accounts era
accounts <- SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era))
-> SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Accounts era -> Const r (Accounts era))
-> EpochState era -> Const r (EpochState era))
-> (Accounts era -> Const r (Accounts era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era))
-> ((Accounts era -> Const r (Accounts era))
-> LedgerState era -> Const r (LedgerState era))
-> (Accounts era -> Const r (Accounts era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era))
-> ((Accounts era -> Const r (Accounts era))
-> CertState era -> Const r (CertState era))
-> (Accounts era -> Const r (Accounts era))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Const r (DState era))
-> CertState era -> Const r (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const r (DState era))
-> CertState era -> Const r (CertState era))
-> ((Accounts era -> Const r (Accounts era))
-> DState era -> Const r (DState era))
-> (Accounts era -> Const r (Accounts era))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Const r (Accounts era))
-> DState era -> Const r (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
Coin
expectedDeposit <- SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin)
-> SimpleGetter (NewEpochState era) Coin -> ImpTestM era Coin
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Coin -> Const r Coin)
-> EpochState era -> Const r (EpochState era))
-> (Coin -> Const r Coin)
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era)
forall era. EraGov era => Lens' (EpochState era) (PParams era)
Lens' (EpochState era) (PParams era)
curPParamsEpochStateL ((PParams era -> Const r (PParams era))
-> EpochState era -> Const r (EpochState era))
-> ((Coin -> Const r Coin) -> PParams era -> Const r (PParams era))
-> (Coin -> Const r Coin)
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Const r Coin) -> PParams era -> Const r (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL
AccountState era
accountState <- Maybe (AccountState era)
-> ImpM (LedgerSpec era) (AccountState era)
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Maybe a -> m a
expectJust (Maybe (AccountState era)
-> ImpM (LedgerSpec era) (AccountState era))
-> Maybe (AccountState era)
-> ImpM (LedgerSpec era) (AccountState era)
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> Accounts era -> Maybe (AccountState era)
forall era.
EraAccounts era =>
Credential 'Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState Credential 'Staking
cred Accounts era
accounts
String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn (Credential 'Staking -> String
forall a. Show a => a -> String
show Credential 'Staking
cred String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" expected to be in Accounts with the correct deposit") (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
AccountState era
accountState AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
depositAccountStateL CompactForm Coin -> CompactForm Coin -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Coin
expectedDeposit
expectNotRegistered :: HasCallStack => Credential 'Staking -> ImpTestM era ()
expectNotRegistered :: HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotRegistered Credential 'Staking
cred = do
Accounts era
accounts <- SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era))
-> SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Accounts era -> Const r (Accounts era))
-> EpochState era -> Const r (EpochState era))
-> (Accounts era -> Const r (Accounts era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era))
-> ((Accounts era -> Const r (Accounts era))
-> LedgerState era -> Const r (LedgerState era))
-> (Accounts era -> Const r (Accounts era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era))
-> ((Accounts era -> Const r (Accounts era))
-> CertState era -> Const r (CertState era))
-> (Accounts era -> Const r (Accounts era))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Const r (DState era))
-> CertState era -> Const r (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const r (DState era))
-> CertState era -> Const r (CertState era))
-> ((Accounts era -> Const r (Accounts era))
-> DState era -> Const r (DState era))
-> (Accounts era -> Const r (Accounts era))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Const r (Accounts era))
-> DState era -> Const r (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn (Credential 'Staking -> String
forall a. Show a => a -> String
show Credential 'Staking
cred String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" expected to not be in Accounts") (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
Maybe (AccountState era) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, ToExpr a) =>
Maybe a -> m ()
expectNothingExpr (Maybe (AccountState era) -> ImpM (LedgerSpec era) ())
-> Maybe (AccountState era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> Accounts era -> Maybe (AccountState era)
forall era.
EraAccounts era =>
Credential 'Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState Credential 'Staking
cred Accounts era
accounts
expectDelegatedToPool ::
HasCallStack => Credential 'Staking -> KeyHash 'StakePool -> ImpTestM era ()
expectDelegatedToPool :: HasCallStack =>
Credential 'Staking
-> KeyHash 'StakePool -> ImpM (LedgerSpec era) ()
expectDelegatedToPool Credential 'Staking
cred KeyHash 'StakePool
poolKh = do
Accounts era
accounts <- SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era))
-> SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Accounts era -> Const r (Accounts era))
-> EpochState era -> Const r (EpochState era))
-> (Accounts era -> Const r (Accounts era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era))
-> ((Accounts era -> Const r (Accounts era))
-> LedgerState era -> Const r (LedgerState era))
-> (Accounts era -> Const r (Accounts era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era))
-> ((Accounts era -> Const r (Accounts era))
-> CertState era -> Const r (CertState era))
-> (Accounts era -> Const r (Accounts era))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Const r (DState era))
-> CertState era -> Const r (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const r (DState era))
-> CertState era -> Const r (CertState era))
-> ((Accounts era -> Const r (Accounts era))
-> DState era -> Const r (DState era))
-> (Accounts era -> Const r (Accounts era))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Const r (Accounts era))
-> DState era -> Const r (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn (Credential 'Staking -> String
forall a. Show a => a -> String
show Credential 'Staking
cred String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" expected to have delegated to " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> KeyHash 'StakePool -> String
forall a. Show a => a -> String
show KeyHash 'StakePool
poolKh) (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
AccountState era
accountState <- Maybe (AccountState era)
-> ImpM (LedgerSpec era) (AccountState era)
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Maybe a -> m a
expectJust (Maybe (AccountState era)
-> ImpM (LedgerSpec era) (AccountState era))
-> Maybe (AccountState era)
-> ImpM (LedgerSpec era) (AccountState era)
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> Accounts era -> Maybe (AccountState era)
forall era.
EraAccounts era =>
Credential 'Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState Credential 'Staking
cred Accounts era
accounts
AccountState era
accountState AccountState era
-> Getting
(Maybe (KeyHash 'StakePool))
(AccountState era)
(Maybe (KeyHash 'StakePool))
-> Maybe (KeyHash 'StakePool)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (KeyHash 'StakePool))
(AccountState era)
(Maybe (KeyHash 'StakePool))
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash 'StakePool))
Lens' (AccountState era) (Maybe (KeyHash 'StakePool))
stakePoolDelegationAccountStateL Maybe (KeyHash 'StakePool)
-> Maybe (KeyHash 'StakePool) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` KeyHash 'StakePool -> Maybe (KeyHash 'StakePool)
forall a. a -> Maybe a
Just KeyHash 'StakePool
poolKh
expectNotDelegatedToPool :: HasCallStack => Credential 'Staking -> ImpTestM era ()
expectNotDelegatedToPool :: HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedToPool Credential 'Staking
cred = do
Accounts era
accounts <- SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era))
-> SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Accounts era -> Const r (Accounts era))
-> EpochState era -> Const r (EpochState era))
-> (Accounts era -> Const r (Accounts era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era))
-> ((Accounts era -> Const r (Accounts era))
-> LedgerState era -> Const r (LedgerState era))
-> (Accounts era -> Const r (Accounts era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era))
-> ((Accounts era -> Const r (Accounts era))
-> CertState era -> Const r (CertState era))
-> (Accounts era -> Const r (Accounts era))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Const r (DState era))
-> CertState era -> Const r (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const r (DState era))
-> CertState era -> Const r (CertState era))
-> ((Accounts era -> Const r (Accounts era))
-> DState era -> Const r (DState era))
-> (Accounts era -> Const r (Accounts era))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Const r (Accounts era))
-> DState era -> Const r (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn (Credential 'Staking -> String
forall a. Show a => a -> String
show Credential 'Staking
cred String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" expected to not have delegated to a stake pool") (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
AccountState era
accountState <- Maybe (AccountState era)
-> ImpM (LedgerSpec era) (AccountState era)
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Maybe a -> m a
expectJust (Maybe (AccountState era)
-> ImpM (LedgerSpec era) (AccountState era))
-> Maybe (AccountState era)
-> ImpM (LedgerSpec era) (AccountState era)
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> Accounts era -> Maybe (AccountState era)
forall era.
EraAccounts era =>
Credential 'Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState Credential 'Staking
cred Accounts era
accounts
Maybe (KeyHash 'StakePool) -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, ToExpr a) =>
Maybe a -> m ()
expectNothingExpr (AccountState era
accountState AccountState era
-> Getting
(Maybe (KeyHash 'StakePool))
(AccountState era)
(Maybe (KeyHash 'StakePool))
-> Maybe (KeyHash 'StakePool)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (KeyHash 'StakePool))
(AccountState era)
(Maybe (KeyHash 'StakePool))
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash 'StakePool))
Lens' (AccountState era) (Maybe (KeyHash 'StakePool))
stakePoolDelegationAccountStateL)
expectDelegatedVote :: HasCallStack => Credential 'Staking -> DRep -> ImpTestM era ()
expectDelegatedVote :: HasCallStack =>
Credential 'Staking -> DRep -> ImpM (LedgerSpec era) ()
expectDelegatedVote Credential 'Staking
cred DRep
drep = do
Accounts era
accounts <- SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era))
-> SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Accounts era -> Const r (Accounts era))
-> EpochState era -> Const r (EpochState era))
-> (Accounts era -> Const r (Accounts era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era))
-> ((Accounts era -> Const r (Accounts era))
-> LedgerState era -> Const r (LedgerState era))
-> (Accounts era -> Const r (Accounts era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era))
-> ((Accounts era -> Const r (Accounts era))
-> CertState era -> Const r (CertState era))
-> (Accounts era -> Const r (Accounts era))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Const r (DState era))
-> CertState era -> Const r (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const r (DState era))
-> CertState era -> Const r (CertState era))
-> ((Accounts era -> Const r (Accounts era))
-> DState era -> Const r (DState era))
-> (Accounts era -> Const r (Accounts era))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Const r (Accounts era))
-> DState era -> Const r (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
Map (Credential 'DRepRole) DRepState
dreps <- SimpleGetter
(NewEpochState era) (Map (Credential 'DRepRole) DRepState)
-> ImpTestM era (Map (Credential 'DRepRole) DRepState)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter
(NewEpochState era) (Map (Credential 'DRepRole) DRepState)
-> ImpTestM era (Map (Credential 'DRepRole) DRepState))
-> SimpleGetter
(NewEpochState era) (Map (Credential 'DRepRole) DRepState)
-> ImpTestM era (Map (Credential 'DRepRole) DRepState)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Map (Credential 'DRepRole) DRepState
-> Const r (Map (Credential 'DRepRole) DRepState))
-> EpochState era -> Const r (EpochState era))
-> (Map (Credential 'DRepRole) DRepState
-> Const r (Map (Credential 'DRepRole) DRepState))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
-> Const r (Map (Credential 'DRepRole) DRepState))
-> EpochState era -> Const r (EpochState era)
forall era.
ConwayEraCertState era =>
Lens' (EpochState era) (Map (Credential 'DRepRole) DRepState)
Lens' (EpochState era) (Map (Credential 'DRepRole) DRepState)
epochStateRegDrepL
String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn (Credential 'Staking -> String
forall a. Show a => a -> String
show Credential 'Staking
cred String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" expected to have delegated to " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> DRep -> String
forall a. Show a => a -> String
show DRep
drep) (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
AccountState era
accountState <- Maybe (AccountState era)
-> ImpM (LedgerSpec era) (AccountState era)
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => Maybe a -> m a
expectJust (Maybe (AccountState era)
-> ImpM (LedgerSpec era) (AccountState era))
-> Maybe (AccountState era)
-> ImpM (LedgerSpec era) (AccountState era)
forall a b. (a -> b) -> a -> b
$ Credential 'Staking -> Accounts era -> Maybe (AccountState era)
forall era.
EraAccounts era =>
Credential 'Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState Credential 'Staking
cred Accounts era
accounts
AccountState era
accountState AccountState era
-> Getting (Maybe DRep) (AccountState era) (Maybe DRep)
-> Maybe DRep
forall s a. s -> Getting a s a -> a
^. Getting (Maybe DRep) (AccountState era) (Maybe DRep)
forall era.
ConwayEraAccounts era =>
Lens' (AccountState era) (Maybe DRep)
Lens' (AccountState era) (Maybe DRep)
dRepDelegationAccountStateL Maybe DRep -> Maybe DRep -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` DRep -> Maybe DRep
forall a. a -> Maybe a
Just DRep
drep
case DRep
drep of
DRepCredential Credential 'DRepRole
drepCred ->
case Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Maybe DRepState
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 ->
ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall era. EraGov era => ImpTestM era () -> ImpTestM era ()
whenPostBootstrap (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
String -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure (String -> ImpM (LedgerSpec era) ())
-> String -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
String
"Expected DRep: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Credential 'DRepRole -> String
forall a. Show a => a -> String
show Credential 'DRepRole
drepCred String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" to be registered"
Just DRepState
drepState ->
String -> Bool -> ImpM (LedgerSpec era) ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> Bool -> m ()
assertBool
String
"Expected DRep delegations to contain the stake credential"
(Credential 'Staking
cred Credential 'Staking -> Set (Credential 'Staking) -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` DRepState -> Set (Credential 'Staking)
drepDelegs DRepState
drepState)
DRep
_ -> () -> ImpM (LedgerSpec era) ()
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
expectNotDelegatedVote :: HasCallStack => Credential 'Staking -> ImpTestM era ()
expectNotDelegatedVote :: HasCallStack => Credential 'Staking -> ImpM (LedgerSpec era) ()
expectNotDelegatedVote Credential 'Staking
cred = do
Accounts era
accounts <- SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era)
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era))
-> SimpleGetter (NewEpochState era) (Accounts era)
-> ImpTestM era (Accounts era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era))
-> ((Accounts era -> Const r (Accounts era))
-> EpochState era -> Const r (EpochState era))
-> (Accounts era -> Const r (Accounts era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era))
-> ((Accounts era -> Const r (Accounts era))
-> LedgerState era -> Const r (LedgerState era))
-> (Accounts era -> Const r (Accounts era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era))
-> ((Accounts era -> Const r (Accounts era))
-> CertState era -> Const r (CertState era))
-> (Accounts era -> Const r (Accounts era))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era -> Const r (DState era))
-> CertState era -> Const r (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const r (DState era))
-> CertState era -> Const r (CertState era))
-> ((Accounts era -> Const r (Accounts era))
-> DState era -> Const r (DState era))
-> (Accounts era -> Const r (Accounts era))
-> CertState era
-> Const r (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era -> Const r (Accounts era))
-> DState era -> Const r (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL
String -> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn (Credential 'Staking -> String
forall a. Show a => a -> String
show Credential 'Staking
cred String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" expected to not have their vote delegated") (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$
Maybe DRep -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, ToExpr a) =>
Maybe a -> m ()
expectNothingExpr (Credential 'Staking -> Accounts era -> Maybe DRep
forall era.
ConwayEraAccounts era =>
Credential 'Staking -> Accounts era -> Maybe DRep
lookupDRepDelegation Credential 'Staking
cred Accounts era
accounts)