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

module Test.Cardano.Ledger.Conway.Imp.GovCertSpec (spec) where

import Cardano.Ledger.BaseTypes (EpochInterval (..), Mismatch (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Rules (ConwayGovCertPredFailure (..), ConwayGovPredFailure (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Shelley.LedgerState (curPParamsEpochStateL, nesEsL)
import Cardano.Ledger.Val (Val (..))
import Data.Maybe.Strict (StrictMaybe (..))
import qualified Data.Sequence.Strict as SSeq
import Lens.Micro ((&), (.~))
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Conway.ImpTest
import Test.Cardano.Ledger.Core.Rational (IsRatio (..))
import Test.Cardano.Ledger.Imp.Common

spec ::
  forall era.
  ( ConwayEraImp era
  , InjectRuleFailure "LEDGER" ConwayGovCertPredFailure era
  , InjectRuleFailure "LEDGER" ConwayGovPredFailure era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayGovCertPredFailure era,
 InjectRuleFailure "LEDGER" ConwayGovPredFailure era) =>
SpecWith (ImpInit (LedgerSpec era))
spec = do
  forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Resigning proposed CC key" forall a b. (a -> b) -> a -> b
$ do
    Credential 'ColdCommitteeRole
ccColdCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
    ProposalProcedure era
proposal <- forall era.
ConwayEraImp era =>
Maybe (StrictMaybe (GovPurposeId 'CommitteePurpose era))
-> Set (Credential 'ColdCommitteeRole)
-> [(Credential 'ColdCommitteeRole, EpochInterval)]
-> UnitInterval
-> ImpTestM era (ProposalProcedure era)
mkUpdateCommitteeProposal forall a. Maybe a
Nothing forall a. Monoid a => a
mempty [(Credential 'ColdCommitteeRole
ccColdCred, Word32 -> EpochInterval
EpochInterval Word32
1234)] (Integer
1 forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2)
    Maybe GovActionId
mbGovId <-
      forall era.
ConwayEraImp era =>
ProposalProcedure era
-> SubmitFailureExpectation era -> ImpTestM era (Maybe GovActionId)
submitBootstrapAwareFailingProposal ProposalProcedure era
proposal forall a b. (a -> b) -> a -> b
$
        forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> SubmitFailureExpectation era
FailBootstrap [forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. ProposalProcedure era -> ConwayGovPredFailure era
DisallowedProposalDuringBootstrap ProposalProcedure era
proposal]
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GovActionId
mbGovId forall a b. (a -> b) -> a -> b
$ \GovActionId
_ ->
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_
        ( forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton (forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
ResignCommitteeColdTxCert Credential 'ColdCommitteeRole
ccColdCred forall a. StrictMaybe a
SNothing)
        )
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"succeeds for" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"registering and unregistering a DRep" forall a b. (a -> b) -> a -> b
$ do
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
100
      Credential 'DRepRole
drepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      Coin
drepDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton (forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
RegDRepTxCert Credential 'DRepRole
drepCred Coin
drepDeposit forall a. StrictMaybe a
SNothing)
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton (forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
UnRegDRepTxCert Credential 'DRepRole
drepCred Coin
drepDeposit)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"resigning a non-CC key" forall a b. (a -> b) -> a -> b
$ do
      Credential 'ColdCommitteeRole
someCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        ( forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton (forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
ResignCommitteeColdTxCert Credential 'ColdCommitteeRole
someCred forall a. StrictMaybe a
SNothing)
        )
        (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeIsUnknown Credential 'ColdCommitteeRole
someCred))
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"re-registering a CC hot key" forall a b. (a -> b) -> a -> b
$ do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      Set (Credential 'ColdCommitteeRole)
initialCommittee <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set (Credential 'ColdCommitteeRole)
initialCommittee forall a b. (a -> b) -> a -> b
$ \Credential 'ColdCommitteeRole
kh ->
        forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
10 forall a b. (a -> b) -> a -> b
$ do
          Credential 'HotCommitteeRole
ccHotCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
          forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
            forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
              forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
                forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton (forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
AuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole
kh Credential 'HotCommitteeRole
ccHotCred)

  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"fails for" forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"invalid deposit provided with DRep registration cert" forall a b. (a -> b) -> a -> b
$ do
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
100
      Coin
expectedDRepDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL
      let providedDRepDeposit :: Coin
providedDRepDeposit = Coin
expectedDRepDeposit forall t. Val t => t -> t -> t
<+> Integer -> Coin
Coin Integer
10
      KeyHash 'DRepRole
khDRep <- forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        ( forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton
                (forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
RegDRepTxCert (forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash 'DRepRole
khDRep) Coin
providedDRepDeposit forall a. StrictMaybe a
SNothing)
        )
        ( forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$
            forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectDeposit forall a b. (a -> b) -> a -> b
$
              Mismatch
                { mismatchSupplied :: Coin
mismatchSupplied = Coin
providedDRepDeposit
                , mismatchExpected :: Coin
mismatchExpected = Coin
expectedDRepDeposit
                }
        )
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"invalid refund provided with DRep deregistration cert" forall a b. (a -> b) -> a -> b
$ do
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
100
      Coin
drepDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL
      let refund :: Coin
refund = Coin
drepDeposit forall t. Val t => t -> t -> t
<+> Integer -> Coin
Coin Integer
10
      Credential 'DRepRole
drepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
        forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
          forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
            forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton
              (forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
RegDRepTxCert Credential 'DRepRole
drepCred Coin
drepDeposit forall a. StrictMaybe a
SNothing)
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        ( forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton
                (forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
UnRegDRepTxCert Credential 'DRepRole
drepCred Coin
refund)
        )
        ( forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$
            forall era. Mismatch 'RelEQ Coin -> ConwayGovCertPredFailure era
ConwayDRepIncorrectRefund forall a b. (a -> b) -> a -> b
$
              Mismatch
                { mismatchSupplied :: Coin
mismatchSupplied = Coin
refund
                , mismatchExpected :: Coin
mismatchExpected = Coin
drepDeposit
                }
        )
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"DRep already registered" forall a b. (a -> b) -> a -> b
$ do
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
100
      Coin
drepDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL
      Credential 'DRepRole
drepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      let
        regTx :: Tx era
regTx =
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton
                (forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> TxCert era
RegDRepTxCert Credential 'DRepRole
drepCred Coin
drepDeposit forall a. StrictMaybe a
SNothing)
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ Tx era
regTx
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        Tx era
regTx
        (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepAlreadyRegistered Credential 'DRepRole
drepCred)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"unregistering a nonexistent DRep" forall a b. (a -> b) -> a -> b
$ do
      forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams forall a b. (a -> b) -> a -> b
$ forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
100
      Coin
drepDeposit <- forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES forall a b. (a -> b) -> a -> b
$ forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL
      Credential 'DRepRole
drepCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        ( forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton (forall era.
ConwayEraTxCert era =>
Credential 'DRepRole -> Coin -> TxCert era
UnRegDRepTxCert Credential 'DRepRole
drepCred Coin
drepDeposit)
        )
        (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era. Credential 'DRepRole -> ConwayGovCertPredFailure era
ConwayDRepNotRegistered Credential 'DRepRole
drepCred)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"registering a resigned CC member hotkey" forall a b. (a -> b) -> a -> b
$ do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      Set (Credential 'ColdCommitteeRole)
initialCommittee <- forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential 'ColdCommitteeRole))
getCommitteeMembers
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set (Credential 'ColdCommitteeRole)
initialCommittee forall a b. (a -> b) -> a -> b
$ \Credential 'ColdCommitteeRole
ccCred -> do
        Credential 'HotCommitteeRole
ccHotCred <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
        let
          registerHotKeyTx :: Tx era
registerHotKeyTx =
            forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
              forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
                forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton (forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole
-> Credential 'HotCommitteeRole -> TxCert era
AuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole
ccCred Credential 'HotCommitteeRole
ccHotCred)
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ Tx era
registerHotKeyTx
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era ()
submitTx_ forall a b. (a -> b) -> a -> b
$
          forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
            forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
              forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton (forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
ResignCommitteeColdTxCert Credential 'ColdCommitteeRole
ccCred forall a. StrictMaybe a
SNothing)
        forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
          Tx era
registerHotKeyTx
          (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeHasPreviouslyResigned Credential 'ColdCommitteeRole
ccCred)
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"resigning a nonexistent CC member hotkey" forall a b. (a -> b) -> a -> b
$ do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential 'HotCommitteeRole))
registerInitialCommittee
      Credential 'ColdCommitteeRole
nonExistentColdKey <- forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) g (r :: KeyRole).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      let failingTx :: Tx era
failingTx =
            forall era. EraTx era => TxBody era -> Tx era
mkBasicTx forall era. EraTxBody era => TxBody era
mkBasicTxBody
              forall a b. a -> (a -> b) -> b
& forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
                forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
SSeq.singleton (forall era.
ConwayEraTxCert era =>
Credential 'ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
ResignCommitteeColdTxCert Credential 'ColdCommitteeRole
nonExistentColdKey forall a. StrictMaybe a
SNothing)
      forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        Tx era
failingTx
        [ forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure forall a b. (a -> b) -> a -> b
$ forall era.
Credential 'ColdCommitteeRole -> ConwayGovCertPredFailure era
ConwayCommitteeIsUnknown Credential 'ColdCommitteeRole
nonExistentColdKey
        ]