{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

import Cardano.Ledger.Address (accountAddressNetworkIdL)
import Cardano.Ledger.BaseTypes (
  EpochInterval (..),
  Mismatch (..),
  Network (..),
  StrictMaybe (..),
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Governance (
  Constitution (..),
  GovAction (..),
  GovActionId (..),
  GovActionIx (..),
  GovActionState (..),
  GovPurposeId (..),
  ProposalProcedure (..),
  Vote (..),
  Voter (..),
  VotingProcedure (..),
  VotingProcedures (..),
  constitutionGovStateL,
  constitutionGuardrailsScriptHashL,
 )
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Dijkstra.Core
import Cardano.Ledger.Dijkstra.Rules (
  DijkstraGovPredFailure (..),
  DijkstraSubGovPredFailure (..),
 )
import Cardano.Ledger.Shelley.LedgerState (epochStateGovStateL, nesELL, nesEsL)
import Cardano.Ledger.Shelley.Scripts (pattern RequireSignature)
import Cardano.Ledger.Val ((<->))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.NonEmpty as NEM
import qualified Data.Map.Strict as Map
import qualified Data.OMap.Strict as OMap
import qualified Data.Set as Set
import qualified Data.Set.NonEmpty as NES
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
"SUBGOV" (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
"a proposal in a sub-transaction is accepted" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    proposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
forall era. GovAction era
InfoAction
    submittedTx <- submitTx . mkTopTxWithSubTxs . pure $ proposeSubTx proposal
    case fst <$> OMap.assocList (submittedTx ^. bodyTxL . subTransactionsTxBodyL) of
      [Item [TxId]
subTxId] -> do
        gas <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState (GovActionId -> ImpTestM era (GovActionState era))
-> GovActionId -> ImpTestM era (GovActionState era)
forall a b. (a -> b) -> a -> b
$ TxId -> GovActionIx -> GovActionId
GovActionId Item [TxId]
TxId
subTxId (Word16 -> GovActionIx
GovActionIx Word16
0)
        gasProposalProcedure gas `shouldBe` proposal
      [TxId]
_ -> String -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
assertFailure String
"Expected exactly one sub-transaction"

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ProposalCantFollow" (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
"a hardfork that cannot follow the current protocol version" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      currentProtVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      nextProtVer <- genCantFollow currentProtVer
      proposal <- mkProposal $ HardForkInitiation SNothing nextProtVer
      submitFailingSubTx
        (proposeSubTx proposal)
        [ injectFailure . DijkstraSubGovPredFailure . ProposalCantFollow SNothing $
            Mismatch {mismatchSupplied = nextProtVer, mismatchExpected = currentProtVer}
        ]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a hardfork that cannot follow its parent" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      currentProtVer <- ImpTestM era ProtVer
forall era. EraGov era => ImpTestM era ProtVer
getProtVer
      let parentProtVer = ProtVer -> ProtVer
minorFollow ProtVer
currentProtVer
      parentGovActionId <- submitGovAction $ HardForkInitiation SNothing parentProtVer
      badProtVer <- genCantFollow parentProtVer
      let parentPurposeId = GovPurposeId p -> StrictMaybe (GovPurposeId p)
forall a. a -> StrictMaybe a
SJust (GovPurposeId p -> StrictMaybe (GovPurposeId p))
-> GovPurposeId p -> StrictMaybe (GovPurposeId p)
forall a b. (a -> b) -> a -> b
$ GovActionId -> GovPurposeId p
forall (p :: GovActionPurpose). GovActionId -> GovPurposeId p
GovPurposeId GovActionId
parentGovActionId
      proposal <- mkProposal $ HardForkInitiation parentPurposeId badProtVer
      submitFailingSubTx
        (proposeSubTx proposal)
        [ injectFailure . DijkstraSubGovPredFailure . ProposalCantFollow parentPurposeId $
            Mismatch {mismatchSupplied = badProtVer, mismatchExpected = parentProtVer}
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"MalformedProposal" (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
"an empty parameter update" (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) ()
forall era. DijkstraEraImp era => ImpTestM era ()
useNativeGuardrailsScript
      govAction <- StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
      proposal <- mkProposal govAction
      submitFailingSubTx
        (proposeSubTx proposal)
        [injectFailure . DijkstraSubGovPredFailure $ MalformedProposal govAction]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a zero-valued protocol parameter" (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) ()
forall era. DijkstraEraImp era => ImpTestM era ()
useNativeGuardrailsScript
      govAction <-
        StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId
-> PParamsUpdate era -> ImpTestM era (GovAction era)
mkParameterChangeGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing (PParamsUpdate era -> ImpTestM era (GovAction era))
-> PParamsUpdate era -> ImpTestM era (GovAction era)
forall a b. (a -> b) -> a -> b
$ PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word32 -> Identity (StrictMaybe Word32))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxBBSizeL ((StrictMaybe Word32 -> Identity (StrictMaybe Word32))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Word32 -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> StrictMaybe Word32
forall a. a -> StrictMaybe a
SJust Word32
0
      proposal <- mkProposal govAction
      submitFailingSubTx
        (proposeSubTx proposal)
        [injectFailure . DijkstraSubGovPredFailure $ MalformedProposal govAction]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ProposalReturnAccountDoesNotExist" (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
"an unregistered return account" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      account <- ImpTestM era AccountAddress
forall era. Era era => ImpTestM era AccountAddress
freshUnregisteredAccount
      proposal <- mkProposalWithAccountAddress InfoAction account
      submitFailingSubTx
        (proposeSubTx proposal)
        [ injectFailure . DijkstraSubGovPredFailure $
            ProposalReturnAccountDoesNotExist account
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TreasuryWithdrawalReturnAccountsDoNotExist" (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
"an unregistered withdrawal account" (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) ()
forall era. DijkstraEraImp era => ImpTestM era ()
useNativeGuardrailsScript
      account <- ImpTestM era AccountAddress
forall era. Era era => ImpTestM era AccountAddress
freshUnregisteredAccount
      registeredAccount <- registerAccountAddress
      govAction <-
        mkTreasuryWithdrawalsGovAction
          [(account, Coin 1_000_000), (registeredAccount, Coin 1_000_000)]
      proposal <- mkProposal govAction
      submitFailingSubTx
        (proposeSubTx proposal)
        [ injectFailure . DijkstraSubGovPredFailure $
            TreasuryWithdrawalReturnAccountsDoNotExist [account]
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ProposalDepositIncorrect" (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
"a deposit below the protocol parameter" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      accountAddress <- ImpTestM era AccountAddress
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era AccountAddress
registerAccountAddress
      expectedDeposit <- getsPParams ppGovActionDepositL
      anchor <- arbitrary
      let suppliedDeposit = Coin
expectedDeposit Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Integer -> Coin
Coin Integer
1
          proposal =
            ProposalProcedure
              { pProcReturnAddr :: AccountAddress
pProcReturnAddr = AccountAddress
accountAddress
              , pProcGovAction :: GovAction era
pProcGovAction = GovAction era
forall era. GovAction era
InfoAction
              , pProcDeposit :: Coin
pProcDeposit = Coin
suppliedDeposit
              , pProcAnchor :: Anchor
pProcAnchor = Anchor
anchor
              }
      submitFailingSubTx
        (proposeSubTx proposal)
        [ injectFailure . DijkstraSubGovPredFailure . ProposalDepositIncorrect $
            Mismatch {mismatchSupplied = suppliedDeposit, mismatchExpected = expectedDeposit}
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ProposalProcedureNetworkIdMismatch" (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
"a return account on the wrong network" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      accountAddress <- ImpTestM era AccountAddress
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era AccountAddress
registerAccountAddress
      let onWrongNetwork = AccountAddress
accountAddress AccountAddress
-> (AccountAddress -> AccountAddress) -> AccountAddress
forall a b. a -> (a -> b) -> b
& (Network -> Identity Network)
-> AccountAddress -> Identity AccountAddress
Lens' AccountAddress Network
accountAddressNetworkIdL ((Network -> Identity Network)
 -> AccountAddress -> Identity AccountAddress)
-> Network -> AccountAddress -> AccountAddress
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Network
Mainnet
      proposal <- mkProposalWithAccountAddress InfoAction onWrongNetwork
      submitFailingSubTx
        (proposeSubTx proposal)
        [ injectFailure . DijkstraSubGovPredFailure $
            ProposalProcedureNetworkIdMismatch onWrongNetwork Testnet
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"TreasuryWithdrawalsNetworkIdMismatch" (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
"a withdrawal account on the wrong network" (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) ()
forall era. DijkstraEraImp era => ImpTestM era ()
useNativeGuardrailsScript
      accountAddress <- ImpTestM era AccountAddress
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era AccountAddress
registerAccountAddress
      let onWrongNetwork = AccountAddress
accountAddress AccountAddress
-> (AccountAddress -> AccountAddress) -> AccountAddress
forall a b. a -> (a -> b) -> b
& (Network -> Identity Network)
-> AccountAddress -> Identity AccountAddress
Lens' AccountAddress Network
accountAddressNetworkIdL ((Network -> Identity Network)
 -> AccountAddress -> Identity AccountAddress)
-> Network -> AccountAddress -> AccountAddress
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Network
Mainnet
      govAction <- mkTreasuryWithdrawalsGovAction [(onWrongNetwork, Coin 1_000_000)]
      proposal <- mkProposal govAction
      submitFailingSubTx
        (proposeSubTx proposal)
        [ injectFailure . DijkstraSubGovPredFailure $
            TreasuryWithdrawalsNetworkIdMismatch (NES.singleton onWrongNetwork) Testnet
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"InvalidGuardrailsScriptHash" (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
"a policy that is not the constitution's guardrails script" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      guardrailsScriptHash <- ImpTestM era (StrictMaybe ScriptHash)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy
      wrongScriptHash <- impAddNativeScript . RequireSignature =<< freshKeyHash
      let govAction =
            StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
forall a. StrictMaybe a
SNothing (PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word16 -> Identity (StrictMaybe Word16))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate era) (StrictMaybe Word16)
ppuCommitteeMinSizeL ((StrictMaybe Word16 -> Identity (StrictMaybe Word16))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Word16 -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16 -> StrictMaybe Word16
forall a. a -> StrictMaybe a
SJust Word16
2) (StrictMaybe ScriptHash -> GovAction era)
-> StrictMaybe ScriptHash -> GovAction era
forall a b. (a -> b) -> a -> b
$
              ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
wrongScriptHash
      proposal <- mkProposal govAction
      submitFailingSubTx
        (proposeSubTx proposal)
        [ injectFailure . DijkstraSubGovPredFailure $
            InvalidGuardrailsScriptHash (SJust wrongScriptHash) guardrailsScriptHash
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ZeroTreasuryWithdrawals" (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
"withdrawals that sum to zero" (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) ()
forall era. DijkstraEraImp era => ImpTestM era ()
useNativeGuardrailsScript
      govAction <- [(AccountAddress, Coin)] -> ImpTestM era (GovAction era)
forall era.
ConwayEraGov era =>
[(AccountAddress, Coin)] -> ImpTestM era (GovAction era)
mkTreasuryWithdrawalsGovAction []
      proposal <- mkProposal govAction
      submitFailingSubTx
        (proposeSubTx proposal)
        [injectFailure . DijkstraSubGovPredFailure $ ZeroTreasuryWithdrawals govAction]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ConflictingCommitteeUpdate" (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
"a member that is both added and removed" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      committeeCredential <- 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
      proposal <-
        mkUpdateCommitteeProposal
          Nothing
          (Set.singleton committeeCredential)
          [(committeeCredential, EpochInterval 1)]
          (1 %! 1)
      submitFailingSubTx
        (proposeSubTx proposal)
        [ injectFailure . DijkstraSubGovPredFailure . ConflictingCommitteeUpdate $
            NES.singleton committeeCredential
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"ExpirationEpochTooSmall" (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
"an expiration in the current epoch" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      committeeCredential <- 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
      currentEpochNo <- getsNES nesELL
      proposal <-
        mkUpdateCommitteeProposal
          Nothing
          mempty
          [(committeeCredential, EpochInterval 0)]
          (0 %! 1)
      submitFailingSubTx
        (proposeSubTx proposal)
        [ injectFailure . DijkstraSubGovPredFailure . ExpirationEpochTooSmall $
            NEM.singleton committeeCredential currentEpochNo
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"InvalidPrevGovActionId" (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
"a parent of the wrong purpose" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      govActionId <- GovAction era -> ImpTestM era GovActionId
forall era.
(ConwayEraImp era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
forall era. GovAction era
InfoAction
      proposal <- mkProposal . NoConfidence . SJust $ GovPurposeId govActionId
      submitFailingSubTx
        (proposeSubTx proposal)
        [injectFailure . DijkstraSubGovPredFailure $ InvalidPrevGovActionId proposal]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a parent index that does not exist" (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) ()
forall era. DijkstraEraImp era => ImpTestM era ()
useNativeGuardrailsScript
      govActionId <- StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing ImpTestM era (GovAction era)
-> (GovAction era -> ImpTestM era GovActionId)
-> ImpTestM era GovActionId
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GovAction era -> ImpTestM era GovActionId
forall era.
(ConwayEraImp era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction
      govAction <-
        mkMinFeeUpdateGovAction . SJust $ govActionId {gaidGovActionIx = GovActionIx 999}
      proposal <- mkProposal govAction
      submitFailingSubTx
        (proposeSubTx proposal)
        [injectFailure . DijkstraSubGovPredFailure $ InvalidPrevGovActionId proposal]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"UnelectedCommitteeVoters" (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
"a member that is proposed but not enacted" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      coldCredential <- 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
      void $ submitUpdateCommittee Nothing mempty [(coldCredential, EpochInterval 10)] (1 %! 2)
      hotCredential <- registerCommitteeHotKey coldCredential
      govActionId <- submitGovAction InfoAction
      submitFailingSubTx
        (voteSubTx VoteYes (CommitteeVoter hotCredential) govActionId)
        [ injectFailure . DijkstraSubGovPredFailure $
            UnelectedCommitteeVoters [hotCredential]
        ]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"an unknown hot credential, alongside VotersDoNotExist" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      govActionId <- GovAction era -> ImpTestM era GovActionId
forall era.
(ConwayEraImp era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
forall era. GovAction era
InfoAction
      hotCredential <- KeyHashObj <$> freshKeyHash
      submitFailingSubTx
        (voteSubTx VoteYes (CommitteeVoter hotCredential) govActionId)
        [ injectFailure . DijkstraSubGovPredFailure $
            UnelectedCommitteeVoters [hotCredential]
        , injectFailure . DijkstraSubGovPredFailure $
            VotersDoNotExist [CommitteeVoter hotCredential]
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"VotersDoNotExist" (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
"every unknown voter is reported" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      govActionId <- GovAction era -> ImpTestM era GovActionId
forall era.
(ConwayEraImp era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
forall era. GovAction era
InfoAction
      drepCredential <- KeyHashObj <$> freshKeyHash
      poolId <- freshKeyHash
      let voters = [Credential DRepRole -> Voter
DRepVoter Credential DRepRole
drepCredential, KeyHash StakePool -> Voter
StakePoolVoter KeyHash StakePool
poolId]
          subTx :: Tx SubTx era
          subTx =
            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 -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$
              TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
                TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (VotingProcedures era -> Identity (VotingProcedures era))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (VotingProcedures era)
forall (l :: TxLevel). Lens' (TxBody l era) (VotingProcedures era)
votingProceduresTxBodyL ((VotingProcedures era -> Identity (VotingProcedures era))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> VotingProcedures era -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Vote -> [Voter] -> GovActionId -> VotingProcedures era
forall era. Vote -> [Voter] -> GovActionId -> VotingProcedures era
votingProceduresFor Vote
VoteYes [Voter]
voters GovActionId
govActionId
      submitFailingSubTx
        subTx
        [ injectFailure . DijkstraSubGovPredFailure $
            VotersDoNotExist [DRepVoter drepCredential, StakePoolVoter poolId]
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"GovActionsDoNotExist" (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
"a vote on an unknown gov action index" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (drep, _, _) <- 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
      govActionId <- submitGovAction InfoAction
      let unknownGovActionId = GovActionId
govActionId {gaidGovActionIx = GovActionIx 99}
      submitFailingSubTx
        (voteSubTx VoteYes (DRepVoter drep) unknownGovActionId)
        [ injectFailure . DijkstraSubGovPredFailure $
            GovActionsDoNotExist [unknownGovActionId]
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"VotingOnExpiredGovAction" (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
"a vote on an action past its lifetime" (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
      poolId <- ImpM (LedgerSpec era) (KeyHash StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      registerPool poolId
      govActionId <- mkProposal InfoAction >>= submitProposal
      passNEpochs 3
      let voter = KeyHash StakePool -> Voter
StakePoolVoter KeyHash StakePool
poolId
      submitFailingSubTx
        (voteSubTx VoteYes voter govActionId)
        [ injectFailure . DijkstraSubGovPredFailure $
            VotingOnExpiredGovAction [(voter, govActionId)]
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"DisallowedVoters" (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
"a committee vote on NoConfidence" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      hotCredential <- NonEmpty (Credential HotCommitteeRole)
-> Credential HotCommitteeRole
forall a. NonEmpty a -> a
NE.head (NonEmpty (Credential HotCommitteeRole)
 -> Credential HotCommitteeRole)
-> ImpM (LedgerSpec era) (NonEmpty (Credential HotCommitteeRole))
-> ImpTestM era (Credential HotCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (NonEmpty (Credential HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential HotCommitteeRole))
registerInitialCommittee
      govActionId <- submitGovAction $ NoConfidence SNothing
      let voter = Credential HotCommitteeRole -> Voter
CommitteeVoter Credential HotCommitteeRole
hotCredential
      submitFailingSubTx
        (voteSubTx VoteYes voter govActionId)
        [ injectFailure . DijkstraSubGovPredFailure $
            DisallowedVoters [(voter, govActionId)]
        ]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a committee vote on UpdateCommittee" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      hotCredential <- NonEmpty (Credential HotCommitteeRole)
-> Credential HotCommitteeRole
forall a. NonEmpty a -> a
NE.head (NonEmpty (Credential HotCommitteeRole)
 -> Credential HotCommitteeRole)
-> ImpM (LedgerSpec era) (NonEmpty (Credential HotCommitteeRole))
-> ImpTestM era (Credential HotCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (NonEmpty (Credential HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential HotCommitteeRole))
registerInitialCommittee
      newMember <- KeyHashObj <$> freshKeyHash
      govActionId <-
        submitUpdateCommittee Nothing mempty [(newMember, EpochInterval 10)] (1 %! 2)
      let voter = Credential HotCommitteeRole -> Voter
CommitteeVoter Credential HotCommitteeRole
hotCredential
      submitFailingSubTx
        (voteSubTx VoteYes voter govActionId)
        [ injectFailure . DijkstraSubGovPredFailure $
            DisallowedVoters [(voter, govActionId)]
        ]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a stake pool vote on NewConstitution" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (poolId, _, _) <- Coin
-> ImpTestM
     era (KeyHash StakePool, Credential Payment, Credential Staking)
forall era.
ConwayEraImp era =>
Coin
-> ImpTestM
     era (KeyHash StakePool, Credential Payment, Credential Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash StakePool, Credential Payment, Credential Staking))
-> Coin
-> ImpTestM
     era (KeyHash StakePool, Credential Payment, Credential Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      anchor <- arbitrary
      govActionId <- submitGovAction . NewConstitution SNothing $ Constitution anchor SNothing
      let voter = KeyHash StakePool -> Voter
StakePoolVoter KeyHash StakePool
poolId
      submitFailingSubTx
        (voteSubTx VoteYes voter govActionId)
        [ injectFailure . DijkstraSubGovPredFailure $
            DisallowedVoters [(voter, govActionId)]
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Accepted at the boundary" (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
"a proposal carrying the constitution's guardrails script" (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) ()
forall era. DijkstraEraImp era => ImpTestM era ()
useNativeGuardrailsScript
      govAction <- StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
      proposal <- mkProposal govAction
      submitTx_ . mkTopTxWithSubTxs . pure $ proposeSubTx proposal

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"an expiration epoch one after the current one" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      committeeCredential <- 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
      proposal <-
        mkUpdateCommitteeProposal
          Nothing
          mempty
          [(committeeCredential, EpochInterval 1)]
          (0 %! 1)
      submitTx_ . mkTopTxWithSubTxs . pure $ proposeSubTx proposal

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Composite tests" (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
"failures of several proposals, in the order of the body" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      firstAccount <- ImpTestM era AccountAddress
forall era. Era era => ImpTestM era AccountAddress
freshUnregisteredAccount
      secondAccount <- freshUnregisteredAccount
      firstProposal <- mkProposalWithAccountAddress InfoAction firstAccount
      secondProposal <- mkProposalWithAccountAddress InfoAction secondAccount
      let subTx :: Tx SubTx era
          subTx =
            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 -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$
              TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (OSet (ProposalProcedure era)
 -> Identity (OSet (ProposalProcedure era)))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (OSet (ProposalProcedure era))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL ((OSet (ProposalProcedure era)
  -> Identity (OSet (ProposalProcedure era)))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> OSet (ProposalProcedure era)
-> TxBody SubTx era
-> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (OSet (ProposalProcedure era))
ProposalProcedure era
firstProposal, Item (OSet (ProposalProcedure era))
ProposalProcedure era
secondProposal]
      submitFailingSubTx
        subTx
        [ injectFailure . DijkstraSubGovPredFailure $
            ProposalReturnAccountDoesNotExist firstAccount
        , injectFailure . DijkstraSubGovPredFailure $
            ProposalReturnAccountDoesNotExist secondAccount
        ]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"two failures of one committee update, in the order the rule checks them" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      committeeCredential <- 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
      currentEpochNo <- getsNES nesELL
      proposal <-
        mkUpdateCommitteeProposal
          Nothing
          (Set.singleton committeeCredential)
          [(committeeCredential, EpochInterval 0)]
          (1 %! 1)
      submitFailingSubTx
        (proposeSubTx proposal)
        [ injectFailure . DijkstraSubGovPredFailure . ConflictingCommitteeUpdate $
            NES.singleton committeeCredential
        , injectFailure . DijkstraSubGovPredFailure . ExpirationEpochTooSmall $
            NEM.singleton committeeCredential currentEpochNo
        ]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"seven failures of one proposal, in the order the rule checks them" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      guardrailsScriptHash <- ImpTestM era (StrictMaybe ScriptHash)
forall era.
ConwayEraGov era =>
ImpTestM era (StrictMaybe ScriptHash)
getGovPolicy
      wrongScriptHash <- impAddNativeScript . RequireSignature =<< freshKeyHash
      expectedDeposit <- getsPParams ppGovActionDepositL
      account <- freshUnregisteredAccount
      anchor <- arbitrary
      let onWrongNetwork = AccountAddress
account AccountAddress
-> (AccountAddress -> AccountAddress) -> AccountAddress
forall a b. a -> (a -> b) -> b
& (Network -> Identity Network)
-> AccountAddress -> Identity AccountAddress
Lens' AccountAddress Network
accountAddressNetworkIdL ((Network -> Identity Network)
 -> AccountAddress -> Identity AccountAddress)
-> Network -> AccountAddress -> AccountAddress
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Network
Mainnet
          suppliedDeposit = Coin
expectedDeposit Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Integer -> Coin
Coin Integer
1
          govAction =
            Map AccountAddress Coin -> StrictMaybe ScriptHash -> GovAction era
forall era.
Map AccountAddress Coin -> StrictMaybe ScriptHash -> GovAction era
TreasuryWithdrawals (AccountAddress -> Coin -> Map AccountAddress Coin
forall k a. k -> a -> Map k a
Map.singleton AccountAddress
onWrongNetwork Coin
forall a. Monoid a => a
mempty) (ScriptHash -> StrictMaybe ScriptHash
forall a. a -> StrictMaybe a
SJust ScriptHash
wrongScriptHash)
          proposal =
            ProposalProcedure
              { pProcReturnAddr :: AccountAddress
pProcReturnAddr = AccountAddress
onWrongNetwork
              , pProcGovAction :: GovAction era
pProcGovAction = GovAction era
forall era. GovAction era
govAction
              , pProcDeposit :: Coin
pProcDeposit = Coin
suppliedDeposit
              , pProcAnchor :: Anchor
pProcAnchor = Anchor
anchor
              }
      submitFailingSubTx
        (proposeSubTx proposal)
        [ injectFailure . DijkstraSubGovPredFailure $
            ProposalReturnAccountDoesNotExist onWrongNetwork
        , injectFailure . DijkstraSubGovPredFailure $
            TreasuryWithdrawalReturnAccountsDoNotExist [onWrongNetwork]
        , injectFailure . DijkstraSubGovPredFailure . ProposalDepositIncorrect $
            Mismatch {mismatchSupplied = suppliedDeposit, mismatchExpected = expectedDeposit}
        , injectFailure . DijkstraSubGovPredFailure $
            ProposalProcedureNetworkIdMismatch onWrongNetwork Testnet
        , injectFailure . DijkstraSubGovPredFailure $
            TreasuryWithdrawalsNetworkIdMismatch (NES.singleton onWrongNetwork) Testnet
        , injectFailure . DijkstraSubGovPredFailure $
            InvalidGuardrailsScriptHash (SJust wrongScriptHash) guardrailsScriptHash
        , injectFailure . DijkstraSubGovPredFailure $ ZeroTreasuryWithdrawals govAction
        ]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"failures of several sub-transactions, in sub-transaction order" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      firstAccount <- ImpTestM era AccountAddress
forall era. Era era => ImpTestM era AccountAddress
freshUnregisteredAccount
      secondAccount <- freshUnregisteredAccount
      firstProposal <- mkProposalWithAccountAddress InfoAction firstAccount
      secondProposal <- mkProposalWithAccountAddress InfoAction secondAccount
      submitFailingTx
        (mkTopTxWithSubTxs [proposeSubTx firstProposal, proposeSubTx secondProposal])
        [ injectFailure . DijkstraSubGovPredFailure $
            ProposalReturnAccountDoesNotExist firstAccount
        , injectFailure . DijkstraSubGovPredFailure $
            ProposalReturnAccountDoesNotExist secondAccount
        ]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"the top-level failure precedes the same failure from a sub-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
      account <- ImpTestM era AccountAddress
forall era. Era era => ImpTestM era AccountAddress
freshUnregisteredAccount
      proposal <- mkProposalWithAccountAddress InfoAction account
      submitFailingTx
        ( mkTopTxWithSubTxs [proposeSubTx proposal]
            & bodyTxL . proposalProceduresTxBodyL .~ [proposal]
        )
        [ injectFailure $ ProposalReturnAccountDoesNotExist account
        , injectFailure . DijkstraSubGovPredFailure $
            ProposalReturnAccountDoesNotExist account
        ]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Unreachable in Dijkstra" (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
"DisallowedProposalDuringBootstrap does not fire for a non-bootstrap proposal" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      anchor <- ImpM (LedgerSpec era) Anchor
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
      proposal <- mkProposal . NewConstitution SNothing $ Constitution anchor SNothing
      submitTx_ . mkTopTxWithSubTxs . pure $ proposeSubTx proposal

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"DisallowedVotesDuringBootstrap does not fire for a DRep 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
      (drep, _, _) <- 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
      anchor <- arbitrary
      govActionId <- submitGovAction . NewConstitution SNothing $ Constitution anchor SNothing
      submitTx_ . mkTopTxWithSubTxs . pure $ voteSubTx VoteYes (DRepVoter drep) govActionId
      expectVote govActionId (DRepVoter drep) VoteYes

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Sub-transaction semantics" (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
"a top-level proposal and a sub-transaction proposal get distinct ids" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      topProposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
forall era. GovAction era
InfoAction
      subProposal <- mkProposal InfoAction
      (subTx, subGovActionId) <- proposeSubTxWithStableId subProposal
      submittedTx <-
        submitTx $
          mkTopTxWithSubTxs [subTx] & bodyTxL . proposalProceduresTxBodyL .~ [topProposal]
      subGas <- getGovActionState subGovActionId
      topGas <- getGovActionState $ GovActionId (txIdTx submittedTx) (GovActionIx 0)
      gasProposalProcedure subGas `shouldBe` subProposal
      gasProposalProcedure topGas `shouldBe` topProposal
      gaidTxId subGovActionId `shouldNotBe` txIdTx submittedTx

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"each sub-transaction numbers its own proposals from zero" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      firstProposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
forall era. GovAction era
InfoAction
      secondProposal <- mkProposal InfoAction
      (firstSubTx, firstGovActionId) <- proposeSubTxWithStableId firstProposal
      (secondSubTx, secondGovActionId) <- proposeSubTxWithStableId secondProposal
      submitTx_ $ mkTopTxWithSubTxs [firstSubTx, secondSubTx]
      gaidGovActionIx firstGovActionId `shouldBe` GovActionIx 0
      gaidGovActionIx secondGovActionId `shouldBe` GovActionIx 0
      gaidTxId firstGovActionId `shouldNotBe` gaidTxId secondGovActionId
      firstGas <- getGovActionState firstGovActionId
      secondGas <- getGovActionState secondGovActionId
      gasProposalProcedure firstGas `shouldBe` firstProposal
      gasProposalProcedure secondGas `shouldBe` secondProposal

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"each proposal in a sub-transaction gets the next index" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      firstProposal <- GovAction era -> ImpTestM era (ProposalProcedure era)
forall era.
ConwayEraImp era =>
GovAction era -> ImpTestM era (ProposalProcedure era)
mkProposal GovAction era
forall era. GovAction era
InfoAction
      secondProposal <- mkProposal InfoAction
      txIn <- freshFundedTxIn
      let subTx :: Tx SubTx era
          subTx =
            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 -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$
              TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
                TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> Set TxIn -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
txIn]
                TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (OSet (ProposalProcedure era)
 -> Identity (OSet (ProposalProcedure era)))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (OSet (ProposalProcedure era))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL ((OSet (ProposalProcedure era)
  -> Identity (OSet (ProposalProcedure era)))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> OSet (ProposalProcedure era)
-> TxBody SubTx era
-> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (OSet (ProposalProcedure era))
ProposalProcedure era
firstProposal, Item (OSet (ProposalProcedure era))
ProposalProcedure era
secondProposal]
          subTxId = Tx SubTx era -> TxId
forall era (l :: TxLevel). EraTx era => Tx l era -> TxId
txIdTx Tx SubTx era
subTx
      submitTx_ $ mkTopTxWithSubTxs [subTx]
      firstGas <- getGovActionState $ GovActionId subTxId (GovActionIx 0)
      secondGas <- getGovActionState $ GovActionId subTxId (GovActionIx 1)
      gasProposalProcedure firstGas `shouldBe` firstProposal
      gasProposalProcedure secondGas `shouldBe` secondProposal

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a sub-transaction votes on a proposal made by an earlier sibling" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (drep, _, _) <- 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
      proposal <- mkProposal InfoAction
      (proposingSubTx, govActionId) <- proposeSubTxWithStableId proposal
      submitTx_ $
        mkTopTxWithSubTxs [proposingSubTx, voteSubTx VoteYes (DRepVoter drep) govActionId]
      expectVote govActionId (DRepVoter drep) VoteYes

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a sub-transaction cannot vote on a proposal made by a later sibling" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (drep, _, _) <- 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
      proposal <- mkProposal InfoAction
      (proposingSubTx, govActionId) <- proposeSubTxWithStableId proposal
      submitFailingTx
        (mkTopTxWithSubTxs [voteSubTx VoteYes (DRepVoter drep) govActionId, proposingSubTx])
        [injectFailure . DijkstraSubGovPredFailure $ GovActionsDoNotExist [govActionId]]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"the top level votes on a proposal made by a sub-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
      (drep, _, _) <- 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
      proposal <- mkProposal InfoAction
      (proposingSubTx, govActionId) <- proposeSubTxWithStableId proposal
      let votes = Vote -> [Voter] -> GovActionId -> VotingProcedures era
forall era. Vote -> [Voter] -> GovActionId -> VotingProcedures era
votingProceduresFor Vote
VoteYes [Credential DRepRole -> Voter
DRepVoter Credential DRepRole
drep] GovActionId
govActionId
      submitTx_ $
        mkTopTxWithSubTxs [proposingSubTx] & bodyTxL . votingProceduresTxBodyL .~ votes
      expectVote govActionId (DRepVoter drep) VoteYes

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a vote in a sub-transaction replaces one cast by an earlier sibling" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (drep, _, _) <- 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
      govActionId <- submitGovAction InfoAction
      submitTx_ $
        mkTopTxWithSubTxs
          [ voteSubTx VoteYes (DRepVoter drep) govActionId
          , voteSubTx VoteNo (DRepVoter drep) govActionId
          ]
      expectVote govActionId (DRepVoter drep) VoteNo

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a sub-transaction proposal is the parent of a later sibling's proposal" (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) ()
forall era. DijkstraEraImp era => ImpTestM era ()
useNativeGuardrailsScript
      parentAction <- StrictMaybe GovActionId -> ImpTestM era (GovAction era)
forall era.
ConwayEraImp era =>
StrictMaybe GovActionId -> ImpTestM era (GovAction era)
mkMinFeeUpdateGovAction StrictMaybe GovActionId
forall a. StrictMaybe a
SNothing
      parentProposal <- mkProposal parentAction
      (parentSubTx, parentGovActionId) <- proposeSubTxWithStableId parentProposal
      childAction <- mkMinFeeUpdateGovAction $ SJust parentGovActionId
      childProposal <- mkProposal childAction
      submitTx_ $ mkTopTxWithSubTxs [parentSubTx, proposeSubTx childProposal]
      void $ getGovActionState parentGovActionId

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a committee member votes in a sub-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
      hotCredential <- NonEmpty (Credential HotCommitteeRole)
-> Credential HotCommitteeRole
forall a. NonEmpty a -> a
NE.head (NonEmpty (Credential HotCommitteeRole)
 -> Credential HotCommitteeRole)
-> ImpM (LedgerSpec era) (NonEmpty (Credential HotCommitteeRole))
-> ImpTestM era (Credential HotCommitteeRole)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (NonEmpty (Credential HotCommitteeRole))
forall era.
(HasCallStack, ConwayEraImp era) =>
ImpTestM era (NonEmpty (Credential HotCommitteeRole))
registerInitialCommittee
      govActionId <- submitGovAction InfoAction
      let voter = Credential HotCommitteeRole -> Voter
CommitteeVoter Credential HotCommitteeRole
hotCredential
      submitTx_ . mkTopTxWithSubTxs . pure $ voteSubTx VoteYes voter govActionId
      expectVote govActionId voter VoteYes

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a stake pool votes in a sub-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
      (poolId, _, _) <- Coin
-> ImpTestM
     era (KeyHash StakePool, Credential Payment, Credential Staking)
forall era.
ConwayEraImp era =>
Coin
-> ImpTestM
     era (KeyHash StakePool, Credential Payment, Credential Staking)
setupPoolWithStake (Coin
 -> ImpTestM
      era (KeyHash StakePool, Credential Payment, Credential Staking))
-> Coin
-> ImpTestM
     era (KeyHash StakePool, Credential Payment, Credential Staking)
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
42_000_000
      govActionId <- submitGovAction InfoAction
      let voter = KeyHash StakePool -> Voter
StakePoolVoter KeyHash StakePool
poolId
      submitTx_ . mkTopTxWithSubTxs . pure $ voteSubTx VoteYes voter govActionId
      expectVote govActionId voter VoteYes

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a sub-transaction votes with a DRep it registers in that same sub-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
      govActionId <- GovAction era -> ImpTestM era GovActionId
forall era.
(ConwayEraImp era, HasCallStack) =>
GovAction era -> ImpTestM era GovActionId
submitGovAction GovAction era
forall era. GovAction era
InfoAction
      drepCredential <- KeyHashObj <$> freshKeyHash
      deposit <- getsPParams ppDRepDepositL
      txIn <- freshFundedTxIn
      submitTx_ . mkTopTxWithSubTxs . pure $
        voteSubTx VoteYes (DRepVoter drepCredential) govActionId
          & bodyTxL . inputsTxBodyL .~ [txIn]
          & bodyTxL . certsTxBodyL .~ [RegDRepTxCert drepCredential deposit SNothing]
      expectVote govActionId (DRepVoter drepCredential) VoteYes

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a DRep unregistered in a sub-transaction loses the votes it has cast" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (drep, _, _) <- 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
      govActionId <- submitGovAction InfoAction
      submitVote_ VoteYes (DRepVoter drep) govActionId
      expectVote govActionId (DRepVoter drep) VoteYes
      deposit <- getsPParams ppDRepDepositL
      submitTx_ . mkTopTxWithSubTxs . pure . mkBasicTx $
        mkBasicTxBody & certsTxBodyL .~ [UnRegDRepTxCert drep deposit]
      cleanedGas <- getGovActionState govActionId
      Map.lookup drep (gasDRepVotes cleanedGas) `shouldBe` Nothing

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a sub-transaction proposes and votes in the same body" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (drep, _, _) <- 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
      existingGovActionId <- submitGovAction InfoAction
      proposal <- mkProposal InfoAction
      txIn <- freshFundedTxIn
      let votes = Vote -> [Voter] -> GovActionId -> VotingProcedures era
forall era. Vote -> [Voter] -> GovActionId -> VotingProcedures era
votingProceduresFor Vote
VoteYes [Credential DRepRole -> Voter
DRepVoter Credential DRepRole
drep] GovActionId
existingGovActionId
          subTx :: Tx SubTx era
          subTx =
            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 -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$
              TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
                TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> Set TxIn -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
txIn]
                TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (OSet (ProposalProcedure era)
 -> Identity (OSet (ProposalProcedure era)))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (OSet (ProposalProcedure era))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL ((OSet (ProposalProcedure era)
  -> Identity (OSet (ProposalProcedure era)))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> OSet (ProposalProcedure era)
-> TxBody SubTx era
-> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (OSet (ProposalProcedure era))
ProposalProcedure era
proposal]
                TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (VotingProcedures era -> Identity (VotingProcedures era))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (VotingProcedures era)
forall (l :: TxLevel). Lens' (TxBody l era) (VotingProcedures era)
votingProceduresTxBodyL ((VotingProcedures era -> Identity (VotingProcedures era))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> VotingProcedures era -> TxBody SubTx era -> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ VotingProcedures era
forall {era}. VotingProcedures era
votes
      submitTx_ $ mkTopTxWithSubTxs [subTx]
      newGas <- getGovActionState $ GovActionId (txIdTx subTx) (GovActionIx 0)
      gasProposalProcedure newGas `shouldBe` proposal
      expectVote existingGovActionId (DRepVoter drep) VoteYes

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"A phase-2 invalid top level transaction" (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
"raises no SUBGOV failure" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      account <- ImpTestM era AccountAddress
forall era. Era era => ImpTestM era AccountAddress
freshUnregisteredAccount
      proposal <- mkProposalWithAccountAddress InfoAction account
      topTx <- phase2InvalidTxWithSubTxs [proposeSubTx proposal]
      withNoFixup $ submitTx_ topTx

-- | Expect the given voter to have cast the given vote on a governance action.
expectVote :: (HasCallStack, DijkstraEraImp era) => GovActionId -> Voter -> Vote -> ImpTestM era ()
expectVote :: forall era.
(HasCallStack, DijkstraEraImp era) =>
GovActionId -> Voter -> Vote -> ImpTestM era ()
expectVote GovActionId
govActionId Voter
voter Vote
vote = do
  gas <- GovActionId -> ImpTestM era (GovActionState era)
forall era.
(HasCallStack, ConwayEraGov era) =>
GovActionId -> ImpTestM era (GovActionState era)
getGovActionState GovActionId
govActionId
  let castVote = case Voter
voter of
        CommitteeVoter Credential HotCommitteeRole
hotCredential -> Credential HotCommitteeRole
-> Map (Credential HotCommitteeRole) Vote -> Maybe Vote
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential HotCommitteeRole
hotCredential (Map (Credential HotCommitteeRole) Vote -> Maybe Vote)
-> Map (Credential HotCommitteeRole) Vote -> Maybe Vote
forall a b. (a -> b) -> a -> b
$ GovActionState era -> Map (Credential HotCommitteeRole) Vote
forall era.
GovActionState era -> Map (Credential HotCommitteeRole) Vote
gasCommitteeVotes GovActionState era
gas
        DRepVoter Credential DRepRole
drepCredential -> Credential DRepRole -> Map (Credential DRepRole) Vote -> Maybe Vote
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential DRepRole
drepCredential (Map (Credential DRepRole) Vote -> Maybe Vote)
-> Map (Credential DRepRole) Vote -> Maybe Vote
forall a b. (a -> b) -> a -> b
$ GovActionState era -> Map (Credential DRepRole) Vote
forall era. GovActionState era -> Map (Credential DRepRole) Vote
gasDRepVotes GovActionState era
gas
        StakePoolVoter KeyHash StakePool
poolId -> KeyHash StakePool -> Map (KeyHash StakePool) Vote -> Maybe Vote
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash StakePool
poolId (Map (KeyHash StakePool) Vote -> Maybe Vote)
-> Map (KeyHash StakePool) Vote -> Maybe Vote
forall a b. (a -> b) -> a -> b
$ GovActionState era -> Map (KeyHash StakePool) Vote
forall era. GovActionState era -> Map (KeyHash StakePool) Vote
gasStakePoolVotes GovActionState era
gas
  castVote `shouldBe` Just vote

-- | Voting procedures in which each of the given voters casts the same vote
-- on one governance action.
votingProceduresFor :: Vote -> [Voter] -> GovActionId -> VotingProcedures era
votingProceduresFor :: forall era. Vote -> [Voter] -> GovActionId -> VotingProcedures era
votingProceduresFor Vote
vote [Voter]
voters GovActionId
govActionId =
  Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
VotingProcedures (Map Voter (Map GovActionId (VotingProcedure era))
 -> VotingProcedures era)
-> ([(Voter, Map GovActionId (VotingProcedure era))]
    -> Map Voter (Map GovActionId (VotingProcedure era)))
-> [(Voter, Map GovActionId (VotingProcedure era))]
-> VotingProcedures era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Voter, Map GovActionId (VotingProcedure era))]
-> Map Voter (Map GovActionId (VotingProcedure era))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Voter, Map GovActionId (VotingProcedure era))]
 -> VotingProcedures era)
-> [(Voter, Map GovActionId (VotingProcedure era))]
-> VotingProcedures era
forall a b. (a -> b) -> a -> b
$
    [(Voter
voter, GovActionId
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall k a. k -> a -> Map k a
Map.singleton GovActionId
govActionId (Vote -> StrictMaybe Anchor -> VotingProcedure era
forall era. Vote -> StrictMaybe Anchor -> VotingProcedure era
VotingProcedure Vote
vote StrictMaybe Anchor
forall a. StrictMaybe a
SNothing)) | Voter
voter <- [Voter]
voters]

-- | A sub-transaction that submits a single proposal.
proposeSubTx :: DijkstraEraImp era => ProposalProcedure era -> Tx SubTx era
proposeSubTx :: forall era.
DijkstraEraImp era =>
ProposalProcedure era -> Tx SubTx era
proposeSubTx ProposalProcedure era
proposal = 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 -> Tx SubTx era)
-> TxBody SubTx era -> Tx SubTx era
forall a b. (a -> b) -> a -> b
$ TxBody SubTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody TxBody SubTx era
-> (TxBody SubTx era -> TxBody SubTx era) -> TxBody SubTx era
forall a b. a -> (a -> b) -> b
& (OSet (ProposalProcedure era)
 -> Identity (OSet (ProposalProcedure era)))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (OSet (ProposalProcedure era))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL ((OSet (ProposalProcedure era)
  -> Identity (OSet (ProposalProcedure era)))
 -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> OSet (ProposalProcedure era)
-> TxBody SubTx era
-> TxBody SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (OSet (ProposalProcedure era))
ProposalProcedure era
proposal]

-- | A sub-transaction that submits a single proposal, paired with the
-- `GovActionId` that proposal will be assigned.
--
-- The sub-transaction is given an input so that fixup leaves its body alone.
-- Fixup supplies an input to any sub-transaction that has none, which would
-- change the sub-transaction id and with it the ids of its proposals.
proposeSubTxWithStableId ::
  DijkstraEraImp era =>
  ProposalProcedure era ->
  ImpTestM era (Tx SubTx era, GovActionId)
proposeSubTxWithStableId :: forall era.
DijkstraEraImp era =>
ProposalProcedure era -> ImpTestM era (Tx SubTx era, GovActionId)
proposeSubTxWithStableId ProposalProcedure era
proposal = do
  txIn <- ImpTestM era TxIn
forall era. (ShelleyEraImp era, HasCallStack) => ImpTestM era TxIn
freshFundedTxIn
  let subTx = ProposalProcedure era -> Tx SubTx era
forall era.
DijkstraEraImp era =>
ProposalProcedure era -> Tx SubTx era
proposeSubTx ProposalProcedure era
proposal 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))
-> ((Set TxIn -> Identity (Set TxIn))
    -> TxBody SubTx era -> Identity (TxBody SubTx era))
-> (Set TxIn -> Identity (Set TxIn))
-> Tx SubTx era
-> Identity (Tx SubTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Identity (Set TxIn))
-> TxBody SubTx era -> Identity (TxBody SubTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> Tx SubTx era -> Identity (Tx SubTx era))
-> Set TxIn -> Tx SubTx era -> Tx SubTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
txIn]
  pure (subTx, GovActionId (txIdTx subTx) (GovActionIx 0))

-- | Point the constitution at a native guardrails script.
--
-- A proposal carrying a guardrails policy must witness that script, and fixup
-- can witness a native script inside a sub-transaction but not the Plutus
-- script the genesis constitution carries. A sub-transaction can therefore
-- only submit a `ParameterChange` or `TreasuryWithdrawals` once this has run.
useNativeGuardrailsScript :: DijkstraEraImp era => ImpTestM era ()
useNativeGuardrailsScript :: forall era. DijkstraEraImp era => ImpTestM era ()
useNativeGuardrailsScript = do
  scriptHash <- NativeScript era -> ImpTestM era ScriptHash
forall era.
EraScript era =>
NativeScript era -> ImpTestM era ScriptHash
impAddNativeScript (NativeScript era -> ImpTestM era ScriptHash)
-> (KeyHash Witness -> NativeScript era)
-> KeyHash Witness
-> ImpTestM era ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash Witness -> NativeScript era
forall era.
ShelleyEraScript era =>
KeyHash Witness -> NativeScript era
RequireSignature (KeyHash Witness -> ImpTestM era ScriptHash)
-> ImpM (LedgerSpec era) (KeyHash Witness)
-> ImpTestM era ScriptHash
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpM (LedgerSpec era) (KeyHash Witness)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  modifyNES $
    nesEsL . epochStateGovStateL . constitutionGovStateL . constitutionGuardrailsScriptHashL
      .~ SJust scriptHash