{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Dijkstra.Imp.SubGovCertSpec (spec) where

import Cardano.Ledger.BaseTypes (EpochInterval (..), Mismatch (..), StrictMaybe (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Governance (GovAction (..), Voter (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Dijkstra.Core
import Cardano.Ledger.Dijkstra.Rules (
  DijkstraGovCertPredFailure (..),
  DijkstraSubGovCertPredFailure (..),
 )
import Lens.Micro ((&), (.~))
import Test.Cardano.Ledger.Core.Rational (IsRatio (..))
import Test.Cardano.Ledger.Dijkstra.ImpTest
import Test.Cardano.Ledger.Imp.Common

spec :: forall era. DijkstraEraImp era => SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
DijkstraEraImp era =>
SpecWith (ImpInit (LedgerSpec era))
spec = String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"SUBGOVCERT" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep registration" (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
"Fails to update an 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
      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
      anchor <- arbitrary
      submitFailingTx
        ( mkTopTxWithSubTxs
            [ mkBasicTx mkBasicTxBody
                & bodyTxL . certsTxBodyL .~ [UpdateDRepTxCert drepCred anchor]
            ]
        )
        [ injectFailure . DijkstraSubGovCertPredFailure $ DijkstraDRepNotRegistered drepCred
        ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails to register with an invalid 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
      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
      expectedDeposit <- getsPParams ppDRepDepositL
      anchor <- arbitrary
      deposit <- arbitrary `suchThat` (/= expectedDeposit)
      submitFailingTx
        ( mkTopTxWithSubTxs
            [ mkBasicTx mkBasicTxBody
                & bodyTxL . certsTxBodyL .~ [RegDRepTxCert drepCred deposit anchor]
            ]
        )
        [ injectFailure . DijkstraSubGovCertPredFailure . DijkstraDRepIncorrectDeposit $
            Mismatch deposit expectedDeposit
        ]
    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Fails to register an already existing DRep" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
      String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"With correct 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
        drepCred <- ImpM (LedgerSpec era) (Credential DRepRole)
forall era.
DijkstraEraImp era =>
ImpTestM era (Credential DRepRole)
registerDRepSubTx
        drepDeposit <- getsPParams ppDRepDepositL
        anchor2 <- arbitrary
        submitFailingTx
          ( mkTopTxWithSubTxs
              [ mkBasicTx mkBasicTxBody
                  & bodyTxL . certsTxBodyL .~ [RegDRepTxCert drepCred drepDeposit anchor2]
              ]
          )
          [ injectFailure . DijkstraSubGovCertPredFailure $ DijkstraDRepAlreadyRegistered drepCred
          ]
      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
        drepCred <- ImpM (LedgerSpec era) (Credential DRepRole)
forall era.
DijkstraEraImp era =>
ImpTestM era (Credential DRepRole)
registerDRepSubTx
        drepDeposit1 <- getsPParams ppDRepDepositL
        drepDeposit2 <-
          frequency
            [ (1, pure mempty)
            , (99, arbitrary `suchThat` (/= drepDeposit1))
            ]
        anchor2 <- arbitrary
        expectDRepRegistered drepCred
        submitFailingTx
          ( mkTopTxWithSubTxs
              [ mkBasicTx mkBasicTxBody
                  & bodyTxL . certsTxBodyL .~ [RegDRepTxCert drepCred drepDeposit2 anchor2]
              ]
          )
          [ injectFailure . DijkstraSubGovCertPredFailure $ DijkstraDRepAlreadyRegistered drepCred
          , injectFailure . DijkstraSubGovCertPredFailure . DijkstraDRepIncorrectDeposit $
              Mismatch drepDeposit2 drepDeposit1
          ]
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DRep deregistration" (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
"Fails when trying to deregister a nonexistent 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
      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
      drepDeposit <-
        frequency
          [ (1, getsPParams ppDRepDepositL)
          , (99, arbitrary)
          ]
      submitFailingTx
        ( mkTopTxWithSubTxs
            [ mkBasicTx mkBasicTxBody
                & bodyTxL . certsTxBodyL .~ [UnRegDRepTxCert drepCred drepDeposit]
            ]
        )
        [ injectFailure . DijkstraSubGovCertPredFailure $ DijkstraDRepNotRegistered drepCred
        ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails when deregistering with invalid 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
      drepCred <- ImpM (LedgerSpec era) (Credential DRepRole)
forall era.
DijkstraEraImp era =>
ImpTestM era (Credential DRepRole)
registerDRepSubTx
      expectedDeposit <- getsPParams ppDRepDepositL
      actualDeposit <- arbitrary `suchThat` (/= expectedDeposit)
      submitFailingTx
        ( mkTopTxWithSubTxs
            [ mkBasicTx mkBasicTxBody
                & bodyTxL . certsTxBodyL .~ [UnRegDRepTxCert drepCred actualDeposit]
            ]
        )
        [ injectFailure . DijkstraSubGovCertPredFailure . DijkstraDRepIncorrectRefund $
            Mismatch actualDeposit expectedDeposit
        ]
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Committee hot key authorization" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails for an unknown cold credential until it is proposed as a member" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      unknownColdCred <- KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      ccHotCred <- KeyHashObj <$> freshKeyHash
      let authTx =
            [Tx SubTx era] -> Tx TopTx era
forall era. DijkstraEraImp era => [Tx SubTx era] -> Tx TopTx era
mkTopTxWithSubTxs
              [ TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
                  Tx SubTx era -> (Tx SubTx era -> Tx SubTx era) -> Tx SubTx era
forall a b. a -> (a -> b) -> b
& (TxBody SubTx era -> Identity (TxBody SubTx era))
-> Tx SubTx era -> Identity (Tx SubTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody SubTx era -> Identity (TxBody SubTx era))
 -> Tx SubTx era -> Identity (Tx SubTx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx SubTx era
-> Identity (Tx SubTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx SubTx era -> Identity (Tx SubTx era))
-> StrictSeq (TxCert era) -> Tx SubTx era -> Tx SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential ColdCommitteeRole
-> Credential HotCommitteeRole -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential ColdCommitteeRole
-> Credential HotCommitteeRole -> TxCert era
AuthCommitteeHotKeyTxCert Credential ColdCommitteeRole
unknownColdCred Credential HotCommitteeRole
ccHotCred]
              ]
      submitFailingTx
        authTx
        [ injectFailure . DijkstraSubGovCertPredFailure $ DijkstraCommitteeIsUnknown unknownColdCred
        ]
      void $ submitUpdateCommittee Nothing mempty [(unknownColdCred, EpochInterval 20)] (1 %! 2)
      submitTx_ authTx
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails for an unknown cold credential while a no-confidence action is pending" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      ImpM (LedgerSpec era) GovActionId -> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ImpM (LedgerSpec era) GovActionId -> ImpM (LedgerSpec era) ())
-> (GovAction era -> ImpM (LedgerSpec era) GovActionId)
-> GovAction era
-> ImpM (LedgerSpec era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovAction era -> ImpM (LedgerSpec era) GovActionId
forall era.
(ConwayEraImp era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction (GovAction era -> ImpM (LedgerSpec era) ())
-> GovAction era -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ StrictMaybe (GovPurposeId 'CommitteePurpose) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose) -> GovAction era
NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose)
forall a. StrictMaybe a
SNothing
      unknownColdCred <- KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      ccHotCred <- KeyHashObj <$> freshKeyHash
      submitFailingTx
        ( mkTopTxWithSubTxs
            [ mkBasicTx mkBasicTxBody
                & bodyTxL . certsTxBodyL .~ [AuthCommitteeHotKeyTxCert unknownColdCred ccHotCred]
            ]
        )
        [ injectFailure . DijkstraSubGovCertPredFailure $ DijkstraCommitteeIsUnknown unknownColdCred
        ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails for a resigned member" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      ImpM (LedgerSpec era) (NonEmpty (Credential HotCommitteeRole))
-> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ImpM (LedgerSpec era) (NonEmpty (Credential HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential HotCommitteeRole))
registerInitialCommittee
      initialCommittee <- ImpTestM era (Set (Credential ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential ColdCommitteeRole))
getCommitteeMembers
      forM_ initialCommittee $ \Credential ColdCommitteeRole
ccColdCred -> do
        ccHotCred <- KeyHash HotCommitteeRole -> Credential HotCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash HotCommitteeRole -> Credential HotCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash HotCommitteeRole)
-> ImpM (LedgerSpec era) (Credential HotCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash HotCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
        let authTx =
              [Tx SubTx era] -> Tx TopTx era
forall era. DijkstraEraImp era => [Tx SubTx era] -> Tx TopTx era
mkTopTxWithSubTxs
                [ TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
                    Tx SubTx era -> (Tx SubTx era -> Tx SubTx era) -> Tx SubTx era
forall a b. a -> (a -> b) -> b
& (TxBody SubTx era -> Identity (TxBody SubTx era))
-> Tx SubTx era -> Identity (Tx SubTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody SubTx era -> Identity (TxBody SubTx era))
 -> Tx SubTx era -> Identity (Tx SubTx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx SubTx era
-> Identity (Tx SubTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx SubTx era -> Identity (Tx SubTx era))
-> StrictSeq (TxCert era) -> Tx SubTx era -> Tx SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential ColdCommitteeRole
-> Credential HotCommitteeRole -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential ColdCommitteeRole
-> Credential HotCommitteeRole -> TxCert era
AuthCommitteeHotKeyTxCert Credential ColdCommitteeRole
ccColdCred Credential HotCommitteeRole
ccHotCred]
                ]
        submitTxAnn_ "Authorizing a hot key" authTx
        submitTxAnn_ "Resigning the cold key" $
          mkTopTxWithSubTxs
            [ mkBasicTx mkBasicTxBody
                & bodyTxL . certsTxBodyL .~ [ResignCommitteeColdTxCert ccColdCred SNothing]
            ]
        submitFailingTx
          authTx
          [ injectFailure . DijkstraSubGovCertPredFailure $
              DijkstraCommitteeHasPreviouslyResigned ccColdCred
          ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails when the committee has been dissolved by a no-confidence action" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      initialCommittee <- ImpTestM era (Set (Credential ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential ColdCommitteeRole))
getCommitteeMembers
      (drepCred, _, _) <- setupSingleDRep 1_000_000
      (spoKH, _, _) <- setupPoolWithStake $ Coin 1_000_000
      gaid <- submitGovAction $ NoConfidence SNothing
      submitYesVote_ (DRepVoter drepCred) gaid
      submitYesVote_ (StakePoolVoter spoKH) gaid
      passNEpochs 2
      impAnn "There should not be a committee" $ getCommittee `shouldReturn` SNothing
      forM_ initialCommittee $ \Credential ColdCommitteeRole
ccColdCred -> do
        ccHotCred <- KeyHash HotCommitteeRole -> Credential HotCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash HotCommitteeRole -> Credential HotCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash HotCommitteeRole)
-> ImpM (LedgerSpec era) (Credential HotCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash HotCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
        submitFailingTx
          ( mkTopTxWithSubTxs
              [ mkBasicTx mkBasicTxBody
                  & bodyTxL . certsTxBodyL .~ [AuthCommitteeHotKeyTxCert ccColdCred ccHotCred]
              ]
          )
          [ injectFailure . DijkstraSubGovCertPredFailure $ DijkstraCommitteeIsUnknown ccColdCred
          ]
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Committee cold key resignation" (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
"Fails for an unknown cold credential" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      ImpM (LedgerSpec era) (NonEmpty (Credential HotCommitteeRole))
-> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ImpM (LedgerSpec era) (NonEmpty (Credential HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential HotCommitteeRole))
registerInitialCommittee
      unknownColdCred <- KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash ColdCommitteeRole -> Credential ColdCommitteeRole)
-> ImpM (LedgerSpec era) (KeyHash ColdCommitteeRole)
-> ImpM (LedgerSpec era) (Credential ColdCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash ColdCommitteeRole)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      submitFailingTx
        ( mkTopTxWithSubTxs
            [ mkBasicTx mkBasicTxBody
                & bodyTxL . certsTxBodyL .~ [ResignCommitteeColdTxCert unknownColdCred SNothing]
            ]
        )
        [ injectFailure . DijkstraSubGovCertPredFailure $ DijkstraCommitteeIsUnknown unknownColdCred
        ]
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails for a member that has already resigned" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      ImpM (LedgerSpec era) (NonEmpty (Credential HotCommitteeRole))
-> ImpM (LedgerSpec era) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ImpM (LedgerSpec era) (NonEmpty (Credential HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential HotCommitteeRole))
registerInitialCommittee
      initialCommittee <- ImpTestM era (Set (Credential ColdCommitteeRole))
forall era.
ConwayEraImp era =>
ImpTestM era (Set (Credential ColdCommitteeRole))
getCommitteeMembers
      forM_ initialCommittee $ \Credential ColdCommitteeRole
ccColdCred -> do
        let resignTx :: Tx TopTx era
resignTx =
              [Tx SubTx era] -> Tx TopTx era
forall era. DijkstraEraImp era => [Tx SubTx era] -> Tx TopTx era
mkTopTxWithSubTxs
                [ TxBody SubTx era -> Tx SubTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
                    Tx SubTx era -> (Tx SubTx era -> Tx SubTx era) -> Tx SubTx era
forall a b. a -> (a -> b) -> b
& (TxBody SubTx era -> Identity (TxBody SubTx era))
-> Tx SubTx era -> Identity (Tx SubTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody SubTx era -> Identity (TxBody SubTx era))
 -> Tx SubTx era -> Identity (Tx SubTx era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx SubTx era
-> Identity (Tx SubTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx SubTx era -> Identity (Tx SubTx era))
-> StrictSeq (TxCert era) -> Tx SubTx era -> Tx SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
forall era.
ConwayEraTxCert era =>
Credential ColdCommitteeRole -> StrictMaybe Anchor -> TxCert era
ResignCommitteeColdTxCert Credential ColdCommitteeRole
ccColdCred StrictMaybe Anchor
forall a. StrictMaybe a
SNothing]
                ]
        String -> Tx TopTx era -> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
String -> Tx TopTx era -> ImpTestM era ()
submitTxAnn_ String
"Resigning the cold key" Tx TopTx era
resignTx
        Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
          Tx TopTx era
resignTx
          [ DijkstraSubGovCertPredFailure era
-> Item (NonEmpty (EraRuleFailure "LEDGER" era))
DijkstraSubGovCertPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (DijkstraSubGovCertPredFailure era
 -> Item (NonEmpty (EraRuleFailure "LEDGER" era)))
-> (DijkstraGovCertPredFailure era
    -> DijkstraSubGovCertPredFailure era)
-> DijkstraGovCertPredFailure era
-> Item (NonEmpty (EraRuleFailure "LEDGER" era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DijkstraGovCertPredFailure era -> DijkstraSubGovCertPredFailure era
forall era.
DijkstraGovCertPredFailure era -> DijkstraSubGovCertPredFailure era
DijkstraSubGovCertPredFailure (DijkstraGovCertPredFailure era
 -> Item (NonEmpty (EraRuleFailure "LEDGER" era)))
-> DijkstraGovCertPredFailure era
-> Item (NonEmpty (EraRuleFailure "LEDGER" era))
forall a b. (a -> b) -> a -> b
$
              Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
forall era.
Credential ColdCommitteeRole -> DijkstraGovCertPredFailure era
DijkstraCommitteeHasPreviouslyResigned Credential ColdCommitteeRole
ccColdCred
          ]