{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Constrained.Preds.LedgerState where

import Cardano.Ledger.Alonzo.PParams (ppuMaxValSizeL)
import Cardano.Ledger.Babbage.PParams (ppuCoinsPerUTxOByteL)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Governance (
  GovAction (..),
  GovActionId (..),
  GovActionPurpose (..),
  GovActionState (..),
  ProposalProcedure (..),
  Proposals,
  gasAction,
  gasActionL,
  gasDeposit,
  gasIdL,
  pPropsL,
  proposalsActions,
 )
import Cardano.Ledger.Conway.PParams (
  ConwayEraPParams,
  ppuDRepDepositL,
  ppuMinFeeRefScriptCostPerByteL,
 )
import Cardano.Ledger.Core (
  Era (..),
  PParamsUpdate,
  ppuMaxTxSizeL,
  ppuMinFeeAL,
  ppuMinFeeBL,
 )
import Cardano.Ledger.DRep (drepDepositL)
import Cardano.Ledger.Shelley.Governance (FuturePParams (..))
import Control.Monad (when)
import Data.Default (Default (def))
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import qualified Data.OMap.Strict as OMap
import Data.Ratio ((%))
import Data.Set (Set)
import qualified Data.Set as Set
import Lens.Micro
import Test.Cardano.Ledger.Constrained.Ast
import Test.Cardano.Ledger.Constrained.Classes (OrdCond (..), genPParamsUpdate)
import Test.Cardano.Ledger.Constrained.Combinators (itemFromSet)
import Test.Cardano.Ledger.Constrained.Env
import Test.Cardano.Ledger.Constrained.Monad (monadTyped)
import Test.Cardano.Ledger.Constrained.Preds.CertState (dstateStage, pstateStage, vstateStage)
import Test.Cardano.Ledger.Constrained.Preds.PParams (pParamsStage)
import Test.Cardano.Ledger.Constrained.Preds.Repl (ReplMode (..), modeRepl)
import Test.Cardano.Ledger.Constrained.Preds.UTxO (utxoStage)
import Test.Cardano.Ledger.Constrained.Preds.Universes (UnivSize (..), universeStage)
import Test.Cardano.Ledger.Constrained.Rewrite (standardOrderInfo)
import Test.Cardano.Ledger.Constrained.Size (Size (..))
import Test.Cardano.Ledger.Constrained.Solver (toolChainSub)
import Test.Cardano.Ledger.Constrained.TypeRep
import Test.Cardano.Ledger.Constrained.Utils (testIO)
import Test.Cardano.Ledger.Constrained.Vars
import Test.Cardano.Ledger.Generic.PrettyCore (pcLedgerState)
import Test.Cardano.Ledger.Generic.Proof
import Test.QuickCheck
import Test.Tasty (TestTree, defaultMain)
import Type.Reflection (typeRep)

-- =========================================

prevGovActionIdsGenPreds :: Reflect era => Proof era -> [Pred era]
prevGovActionIdsGenPreds :: forall era. Reflect era => Proof era -> [Pred era]
prevGovActionIdsGenPreds Proof era
_ =
  [ Term era (GovRelation StrictMaybe era) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (GovRelation StrictMaybe era)
forall era. Reflect era => Term era (GovRelation StrictMaybe era)
prevGovActionIds
  , Term era (Set GovActionId) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
hardForkChildren
  , Term era (Set GovActionId) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
committeeChildren
  , Term era (Set GovActionId) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
constitutionChildren
  ]

prevGovActionIdsCheckPreds :: Proof era -> [Pred era]
prevGovActionIdsCheckPreds :: forall era. Proof era -> [Pred era]
prevGovActionIdsCheckPreds Proof era
_ = []

enactStateGenPreds :: Reflect era => Proof era -> [Pred era]
enactStateGenPreds :: forall era. Reflect era => Proof era -> [Pred era]
enactStateGenPreds Proof era
p =
  [ Term era (Maybe (Committee era)) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Maybe (Committee era))
forall era. Era era => Term era (Maybe (Committee era))
committeeVar
  , Term era (Constitution era) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Constitution era)
forall era. Era era => Term era (Constitution era)
constitution
  , Proof era -> Term era (PParamsF era)
forall era. EraGov era => Proof era -> Term era (PParamsF era)
prevPParams Proof era
p Term era (PParamsF era)
-> RootTarget era Void (PParamsF era) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (PParamsF era -> PParamsF era)
-> RootTarget era Void (PParamsF era -> PParamsF era)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"id" PParamsF era -> PParamsF era
forall a. a -> a
id RootTarget era Void (PParamsF era -> PParamsF era)
-> Term era (PParamsF era) -> RootTarget era Void (PParamsF era)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Proof era -> Term era (PParamsF era)
forall era. EraGov era => Proof era -> Term era (PParamsF era)
pparams Proof era
p)
  , Proof era -> Term era (PParamsF era)
forall era. Era era => Proof era -> Term era (PParamsF era)
currPParams Proof era
p Term era (PParamsF era)
-> RootTarget era Void (PParamsF era) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (PParamsF era -> PParamsF era)
-> RootTarget era Void (PParamsF era -> PParamsF era)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"id" PParamsF era -> PParamsF era
forall a. a -> a
id RootTarget era Void (PParamsF era -> PParamsF era)
-> Term era (PParamsF era) -> RootTarget era Void (PParamsF era)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Proof era -> Term era (PParamsF era)
forall era. EraGov era => Proof era -> Term era (PParamsF era)
pparams Proof era
p)
  , Term era Coin -> Pred era
forall era t. Term era t -> Pred era
Random Term era Coin
forall era. Era era => Term era Coin
enactTreasury
  , Term era (Map (Credential 'Staking) Coin) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Map (Credential 'Staking) Coin)
forall era. Era era => Term era (Map (Credential 'Staking) Coin)
enactWithdrawals
  , -- PrevGovActionsIds constraints
    Term era (Set (Credential 'DRepRole))
-> Term era (Set (Credential 'DRepRole)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset (Term era (Map (Credential 'DRepRole) DRepState)
-> Term era (Set (Credential 'DRepRole))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (Credential 'DRepRole) DRepState)
forall era.
Era era =>
Term era (Map (Credential 'DRepRole) DRepState)
prevDRepState) Term era (Set (Credential 'DRepRole))
forall era. Era era => Term era (Set (Credential 'DRepRole))
voteUniv
  , Term era (Set DRep) -> Term era (Set DRep) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset (Term era (Map DRep Coin) -> Term era (Set DRep)
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map DRep Coin)
forall era. Era era => Term era (Map DRep Coin)
partialDRepDistr) Term era (Set DRep)
forall era. Era era => Term era (Set DRep)
drepUniv
  ]
    [Pred era] -> [Pred era] -> [Pred era]
forall a. [a] -> [a] -> [a]
++ Proof era -> [Pred era]
forall era. Reflect era => Proof era -> [Pred era]
prevGovActionIdsGenPreds Proof era
p

enactStateCheckPreds :: Proof era -> [Pred era]
enactStateCheckPreds :: forall era. Proof era -> [Pred era]
enactStateCheckPreds Proof era
_ = []

ledgerStatePreds ::
  forall era.
  Reflect era =>
  UnivSize -> Proof era -> [Pred era]
ledgerStatePreds :: forall era. Reflect era => UnivSize -> Proof era -> [Pred era]
ledgerStatePreds UnivSize
_usize Proof era
p =
  [ Term era (Set (Credential 'Staking))
-> Term era (Set (Credential 'Staking)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset (Term era (Map (Credential 'Staking) Coin)
-> Term era (Set (Credential 'Staking))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (Credential 'Staking) Coin)
forall era. Era era => Term era (Map (Credential 'Staking) Coin)
enactWithdrawals) Term era (Set (Credential 'Staking))
forall era. Era era => Term era (Set (Credential 'Staking))
credsUniv
  , Term era Coin -> Pred era
forall era t. Term era t -> Pred era
Random Term era Coin
forall era. Era era => Term era Coin
enactTreasury
  , Term era (Constitution era) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Constitution era)
forall era. Era era => Term era (Constitution era)
constitution
  , Term era (Maybe (Committee era)) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Maybe (Committee era))
forall era. Era era => Term era (Maybe (Committee era))
committeeVar
  , Term era (Set GovActionId) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
ppUpdateChildren
  , Term era (Set GovActionId) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
hardForkChildren
  , Term era (Set GovActionId) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
committeeChildren
  , Term era (Set GovActionId) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
constitutionChildren
  , Term era Coin
forall era. Era era => Term era Coin
proposalDeposits
      Term era Coin -> RootTarget era Void Coin -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: ( String
-> (Proposals era -> Coin)
-> RootTarget era Void (Proposals era -> Coin)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"sumActionStateDeposits" ((GovActionState era -> Coin)
-> StrictSeq (GovActionState era) -> Coin
forall m a. Monoid m => (a -> m) -> StrictSeq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GovActionState era -> Coin
forall era. GovActionState era -> Coin
gasDeposit (StrictSeq (GovActionState era) -> Coin)
-> (Proposals era -> StrictSeq (GovActionState era))
-> Proposals era
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proposals era -> StrictSeq (GovActionState era)
forall era. Proposals era -> StrictSeq (GovActionState era)
proposalsActions)
               RootTarget era Void (Proposals era -> Coin)
-> RootTarget era Void (Proposals era) -> RootTarget era Void Coin
forall era root a t.
RootTarget era root (a -> t)
-> RootTarget era root a -> RootTarget era root t
:$ (Term era (Proposals era) -> RootTarget era Void (Proposals era)
forall era t. Term era t -> RootTarget era Void t
Simple (Term era (Proposals era) -> RootTarget era Void (Proposals era))
-> Term era (Proposals era) -> RootTarget era Void (Proposals era)
forall a b. (a -> b) -> a -> b
$ Proof era -> Term era (Proposals era)
forall era. Era era => Proof era -> Term era (Proposals era)
currProposals Proof era
p)
           )
  , -- TODO, introduce ProjList so we can write: SumsTo (Right (Coin 1)) proposalDeposits  EQL [ProjList CoinR gasDepositL currProposals]
    Direct Coin
-> Term era Coin -> OrdCond -> [Sum era Coin] -> Pred era
forall era c.
(Era era, Adds c) =>
Direct c -> Term era c -> OrdCond -> [Sum era c] -> Pred era
SumsTo
      (Coin -> Direct Coin
forall a b. b -> Either a b
Right (Integer -> Coin
Coin Integer
1))
      Term era Coin
forall era. Era era => Term era Coin
deposits
      OrdCond
EQL
      ( case Proof era -> CertStateWit era
forall era. Proof era -> CertStateWit era
whichCertState Proof era
p of
          CertStateWit era
CertStateShelleyToBabbage ->
            [ Term era (Map (Credential 'Staking) Coin) -> Sum era Coin
forall c era a. Adds c => Term era (Map a c) -> Sum era c
SumMap Term era (Map (Credential 'Staking) Coin)
forall era.
EraCertState era =>
Term era (Map (Credential 'Staking) Coin)
stakeDeposits
            , Term era (Map (KeyHash 'StakePool) Coin) -> Sum era Coin
forall c era a. Adds c => Term era (Map a c) -> Sum era c
SumMap Term era (Map (KeyHash 'StakePool) Coin)
forall era.
EraCertState era =>
Term era (Map (KeyHash 'StakePool) Coin)
poolDeposits
            , Term era Coin -> Sum era Coin
forall era c. Term era c -> Sum era c
One Term era Coin
forall era. Era era => Term era Coin
proposalDeposits
            ]
          CertStateWit era
CertStateConwayToConway ->
            [ Term era (Map (Credential 'Staking) Coin) -> Sum era Coin
forall c era a. Adds c => Term era (Map a c) -> Sum era c
SumMap Term era (Map (Credential 'Staking) Coin)
forall era.
EraCertState era =>
Term era (Map (Credential 'Staking) Coin)
stakeDeposits
            , Term era (Map (KeyHash 'StakePool) Coin) -> Sum era Coin
forall c era a. Adds c => Term era (Map a c) -> Sum era c
SumMap Term era (Map (KeyHash 'StakePool) Coin)
forall era.
EraCertState era =>
Term era (Map (KeyHash 'StakePool) Coin)
poolDeposits
            , Term era Coin -> Sum era Coin
forall era c. Term era c -> Sum era c
One Term era Coin
forall era. Era era => Term era Coin
proposalDeposits
            , Rep era Coin
-> Lens' DRepState Coin
-> Term era (Map (Credential 'DRepRole) DRepState)
-> Sum era Coin
forall x c a era.
Adds c =>
Rep era c -> Lens' x c -> Term era (Map a x) -> Sum era c
ProjMap Rep era Coin
forall era. Rep era Coin
CoinR (Coin -> f Coin) -> DRepState -> f DRepState
Lens' DRepState Coin
drepDepositL Term era (Map (Credential 'DRepRole) DRepState)
forall era.
ConwayEraCertState era =>
Term era (Map (Credential 'DRepRole) DRepState)
currentDRepState
            ]
      )
  , -- Some things we might want in the future.
    -- , SumsTo (Right (Coin 1)) utxoCoin EQL [ProjMap CoinR outputCoinL (utxo p)]
    -- , SumsTo (Right (Coin 1)) totalAda EQL [One utxoCoin, One treasury, One reserves, One fees, One deposits, SumMap rewards]
    Term era Coin -> Pred era
forall era t. Term era t -> Pred era
Random Term era Coin
forall era. Era era => Term era Coin
fees
  , Term era (LedgerState era)
forall era. Reflect era => Term era (LedgerState era)
ledgerState Term era (LedgerState era)
-> RootTarget era (LedgerState era) (LedgerState era) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (Proof era -> RootTarget era (LedgerState era) (LedgerState era)
forall era.
Reflect era =>
Proof era -> RootTarget era (LedgerState era) (LedgerState era)
ledgerStateT Proof era
p)
  , Term era Size -> Term era Coin -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
1 Int
10) Term era Coin
forall era. Era era => Term era Coin
donation
  , Proof era -> Term era (PParamsF era)
forall era. EraGov era => Proof era -> Term era (PParamsF era)
prevPParams Proof era
p Term era (PParamsF era)
-> RootTarget era Void (PParamsF era) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (PParamsF era -> PParamsF era)
-> RootTarget era Void (PParamsF era -> PParamsF era)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"id" PParamsF era -> PParamsF era
forall a. a -> a
id RootTarget era Void (PParamsF era -> PParamsF era)
-> Term era (PParamsF era) -> RootTarget era Void (PParamsF era)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (Proof era -> Term era (PParamsF era)
forall era. EraGov era => Proof era -> Term era (PParamsF era)
pparams Proof era
p))
  , Proof era -> Term era (PParamsF era)
forall era. Era era => Proof era -> Term era (PParamsF era)
currPParams Proof era
p Term era (PParamsF era)
-> RootTarget era Void (PParamsF era) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (PParamsF era -> PParamsF era)
-> RootTarget era Void (PParamsF era -> PParamsF era)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"id" PParamsF era -> PParamsF era
forall a. a -> a
id RootTarget era Void (PParamsF era -> PParamsF era)
-> Term era (PParamsF era) -> RootTarget era Void (PParamsF era)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (Proof era -> Term era (PParamsF era)
forall era. EraGov era => Proof era -> Term era (PParamsF era)
pparams Proof era
p))
  , -- We need the poolDistr to generate a valid Pulser
    Term era (Map (KeyHash 'StakePool) PoolParams)
-> Term era (Set (KeyHash 'StakePool))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (KeyHash 'StakePool) PoolParams)
forall era.
EraCertState era =>
Term era (Map (KeyHash 'StakePool) PoolParams)
regPools Term era (Set (KeyHash 'StakePool))
-> Term era (Set (KeyHash 'StakePool)) -> Pred era
forall a era. Eq a => Term era a -> Term era a -> Pred era
:=: Term era (Map (KeyHash 'StakePool) IndividualPoolStake)
-> Term era (Set (KeyHash 'StakePool))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (KeyHash 'StakePool) IndividualPoolStake)
forall era.
Era era =>
Term era (Map (KeyHash 'StakePool) IndividualPoolStake)
poolDistr
  , Direct (Ratio Integer)
-> Term era (Ratio Integer)
-> OrdCond
-> [Sum era (Ratio Integer)]
-> Pred era
forall era c.
(Era era, Adds c) =>
Direct c -> Term era c -> OrdCond -> [Sum era c] -> Pred era
SumsTo (Ratio Integer -> Direct (Ratio Integer)
forall a b. a -> Either a b
Left (Integer
1 Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
1000)) (Rep era (Ratio Integer)
-> Ratio Integer -> Term era (Ratio Integer)
forall era t. Rep era t -> t -> Term era t
Lit Rep era (Ratio Integer)
forall era. Rep era (Ratio Integer)
RationalR Ratio Integer
1) OrdCond
EQL [Rep era (Ratio Integer)
-> Lens' IndividualPoolStake (Ratio Integer)
-> Term era (Map (KeyHash 'StakePool) IndividualPoolStake)
-> Sum era (Ratio Integer)
forall x c a era.
Adds c =>
Rep era c -> Lens' x c -> Term era (Map a x) -> Sum era c
ProjMap Rep era (Ratio Integer)
forall era. Rep era (Ratio Integer)
RationalR (Ratio Integer -> f (Ratio Integer))
-> IndividualPoolStake -> f IndividualPoolStake
Lens' IndividualPoolStake (Ratio Integer)
individualPoolStakeL Term era (Map (KeyHash 'StakePool) IndividualPoolStake)
forall era.
Era era =>
Term era (Map (KeyHash 'StakePool) IndividualPoolStake)
poolDistr]
  ]
    [Pred era] -> [Pred era] -> [Pred era]
forall a. [a] -> [a] -> [a]
++ ( case Proof era -> GovStateWit era
forall era. Proof era -> GovStateWit era
whichGovState Proof era
p of
           GovStateWit era
GovStateConwayToConway ->
             [ Term era (Proposals era) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Proposals era)
randomProposals
             , Proof era -> Term era (Proposals era)
forall era. Era era => Proof era -> Term era (Proposals era)
currProposals Proof era
p Term era (Proposals era)
-> RootTarget era Void (Proposals era) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> (Proposals era -> Proposals era)
-> RootTarget era Void (Proposals era -> Proposals era)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"reasonable" Proposals era -> Proposals era
forall era. ConwayEraPParams era => Proposals era -> Proposals era
reasonable RootTarget era Void (Proposals era -> Proposals era)
-> Term era (Proposals era) -> RootTarget era Void (Proposals era)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Proposals era)
randomProposals)
             , Term era Size
-> Term era [FuturePParams era]
-> [(Int, Target era (FuturePParams era), [Pred era])]
-> Pred era
forall era t.
(Era era, Eq t) =>
Term era Size
-> Term era [t] -> [(Int, Target era t, [Pred era])] -> Pred era
Choose
                 (Int -> Term era Size
forall era. Era era => Int -> Term era Size
ExactSize Int
1)
                 Term era [FuturePParams era]
futurepps
                 [
                   ( Int
1
                   , String
-> (PParamsF era -> FuturePParams era)
-> RootTarget era Void (PParamsF era -> FuturePParams era)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"DefinitePParamsUpdate" (forall era. PParams era -> FuturePParams era
DefinitePParamsUpdate @era (PParams era -> FuturePParams era)
-> (PParamsF era -> PParams era)
-> PParamsF era
-> FuturePParams era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParamsF era -> PParams era
forall era. PParamsF era -> PParams era
unPParams) RootTarget era Void (PParamsF era -> FuturePParams era)
-> Term era (PParamsF era) -> Target era (FuturePParams era)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (PParamsF era)
ppx
                   , [Term era (PParamsF era)
ppx Term era (PParamsF era) -> Term era (PParamsF era) -> Pred era
forall a era. Eq a => Term era a -> Term era a -> Pred era
:=: Proof era -> Term era (PParamsF era)
forall era. Era era => Proof era -> Term era (PParamsF era)
currPParams Proof era
p]
                   )
                 , (Int
1, String
-> (() -> FuturePParams era)
-> RootTarget era Void (() -> FuturePParams era)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"NoPParamsUpdate" (FuturePParams era -> () -> FuturePParams era
forall a b. a -> b -> a
const (forall era. FuturePParams era
NoPParamsUpdate @era)) RootTarget era Void (() -> FuturePParams era)
-> Term era () -> Target era (FuturePParams era)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era ()
unit, [Term era () -> Pred era
forall era t. Term era t -> Pred era
Random Term era ()
unit])
                 ]
             , Proof era -> Term era (FuturePParams era)
forall era. Era era => Proof era -> Term era (FuturePParams era)
futurePParams Proof era
p Term era (FuturePParams era)
-> Target era (FuturePParams era) -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> ([FuturePParams era] -> FuturePParams era)
-> RootTarget era Void ([FuturePParams era] -> FuturePParams era)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"head" [FuturePParams era] -> FuturePParams era
forall {era}. [FuturePParams era] -> FuturePParams era
getOne RootTarget era Void ([FuturePParams era] -> FuturePParams era)
-> Term era [FuturePParams era] -> Target era (FuturePParams era)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era [FuturePParams era]
futurepps)
             ]
               -- TODO: yuck... This whole function should be refactored.
               [Pred era] -> [Pred era] -> [Pred era]
forall a. [a] -> [a] -> [a]
++ case forall era. Reflect era => Proof era
reify @era of
                 Proof era
Conway -> Proof era -> [Pred era]
forall era.
(RunConwayRatify era, Reflect era, ConwayEraCertState era) =>
Proof era -> [Pred era]
prevPulsingPreds Proof era
p -- Constraints to generate a valid Pulser
           GovStateWit era
GovStateShelleyToBabbage ->
             [ Term era Size
-> Term era (Map (KeyHash 'Genesis) (PParamsUpdateF era))
-> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
0 Int
1) (Proof era -> Term era (Map (KeyHash 'Genesis) (PParamsUpdateF era))
forall era.
Era era =>
Proof era -> Term era (Map (KeyHash 'Genesis) (PParamsUpdateF era))
pparamProposals Proof era
p)
             , Term era Size
-> Term era (Map (KeyHash 'Genesis) (PParamsUpdateF era))
-> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
0 Int
1) (Proof era -> Term era (Map (KeyHash 'Genesis) (PParamsUpdateF era))
forall era.
Era era =>
Proof era -> Term era (Map (KeyHash 'Genesis) (PParamsUpdateF era))
futurePParamProposals Proof era
p)
             , Rep era (FuturePParams era)
-> FuturePParams era -> Term era (FuturePParams era)
forall era t. Rep era t -> t -> Term era t
Lit (Proof era -> Rep era (FuturePParams era)
forall era. Era era => Proof era -> Rep era (FuturePParams era)
FuturePParamsR Proof era
p) FuturePParams era
forall era. FuturePParams era
NoPParamsUpdate Term era (FuturePParams era)
-> Term era (FuturePParams era) -> Pred era
forall a era. Eq a => Term era a -> Term era a -> Pred era
:=: Proof era -> Term era (FuturePParams era)
forall era. Era era => Proof era -> Term era (FuturePParams era)
futurePParams Proof era
p
             ]
       )
  where
    randomProposals :: Term era (Proposals era)
randomProposals = V era (Proposals era) -> Term era (Proposals era)
forall era t. V era t -> Term era t
Var (Proof era
-> String
-> Rep era (Proposals era)
-> Access era Any (Proposals era)
-> V era (Proposals era)
forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"randomProposals" (Proof era -> Rep era (Proposals era)
forall era. Era era => Proof era -> Rep era (Proposals era)
ProposalsR Proof era
p) Access era Any (Proposals era)
forall era s t. Access era s t
No)
    ppx :: Term era (PParamsF era)
ppx = V era (PParamsF era) -> Term era (PParamsF era)
forall era t. V era t -> Term era t
Var (Proof era
-> String
-> Rep era (PParamsF era)
-> Access era Any (PParamsF era)
-> V era (PParamsF era)
forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"ppx" (Proof era -> Rep era (PParamsF era)
forall era. Era era => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) Access era Any (PParamsF era)
forall era s t. Access era s t
No)
    unit :: Term era ()
unit = V era () -> Term era ()
forall era t. V era t -> Term era t
Var (Proof era -> String -> Rep era () -> Access era Any () -> V era ()
forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"unit" Rep era ()
forall era. Rep era ()
UnitR Access era Any ()
forall era s t. Access era s t
No)
    futurepps :: Term era [FuturePParams era]
futurepps = V era [FuturePParams era] -> Term era [FuturePParams era]
forall era t. V era t -> Term era t
Var (Proof era
-> String
-> Rep era [FuturePParams era]
-> Access era Any [FuturePParams era]
-> V era [FuturePParams era]
forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"futurepps" (Rep era (FuturePParams era) -> Rep era [FuturePParams era]
forall era a. Rep era a -> Rep era [a]
ListR (Proof era -> Rep era (FuturePParams era)
forall era. Era era => Proof era -> Rep era (FuturePParams era)
FuturePParamsR Proof era
p)) Access era Any [FuturePParams era]
forall era s t. Access era s t
No)
    getOne :: [FuturePParams era] -> FuturePParams era
getOne (FuturePParams era
x : [FuturePParams era]
_) = FuturePParams era
x
    getOne [] = FuturePParams era
forall era. FuturePParams era
NoPParamsUpdate

ledgerStateStage ::
  Reflect era =>
  UnivSize ->
  Proof era ->
  Subst era ->
  Gen (Subst era)
ledgerStateStage :: forall era.
Reflect era =>
UnivSize -> Proof era -> Subst era -> Gen (Subst era)
ledgerStateStage UnivSize
usize Proof era
proof Subst era
subst0 = do
  let preds :: [Pred era]
preds = UnivSize -> Proof era -> [Pred era]
forall era. Reflect era => UnivSize -> Proof era -> [Pred era]
ledgerStatePreds UnivSize
usize Proof era
proof
  Subst era
subst <- Proof era
-> OrderInfo -> [Pred era] -> Subst era -> Gen (Subst era)
forall era.
Era era =>
Proof era
-> OrderInfo -> [Pred era] -> Subst era -> Gen (Subst era)
toolChainSub Proof era
proof OrderInfo
standardOrderInfo [Pred era]
preds Subst era
subst0
  (Any
_env, Maybe String
status) <- (Any, Maybe String) -> Gen (Any, Maybe String)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Any
forall a. HasCallStack => String -> a
error String
"not used in ledgerStateStage", Maybe String
forall a. Maybe a
Nothing) -- monadTyped $ checkForSoundness preds subst
  case Maybe String
status of
    Maybe String
Nothing -> Subst era -> Gen (Subst era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Subst era
subst
    Just String
msg -> String -> Gen (Subst era)
forall a. HasCallStack => String -> a
error String
msg

demo ::
  Reflect era =>
  Proof era -> ReplMode -> IO ()
demo :: forall era. Reflect era => Proof era -> ReplMode -> IO ()
demo Proof era
proof ReplMode
mode = do
  Env era
env <-
    Gen (Env era) -> IO (Env era)
forall a. Gen a -> IO a
generate
      ( Subst era -> Gen (Subst era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Subst era
forall era. Subst era
emptySubst
          Gen (Subst era)
-> (Subst era -> Gen (Subst era)) -> Gen (Subst era)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Proof era -> Subst era -> Gen (Subst era)
forall era.
Reflect era =>
Proof era -> Subst era -> Gen (Subst era)
pParamsStage Proof era
proof
          Gen (Subst era)
-> (Subst era -> Gen (Subst era)) -> Gen (Subst era)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnivSize -> Proof era -> Subst era -> Gen (Subst era)
forall era.
Reflect era =>
UnivSize -> Proof era -> Subst era -> Gen (Subst era)
universeStage UnivSize
forall a. Default a => a
def Proof era
proof
          Gen (Subst era)
-> (Subst era -> Gen (Subst era)) -> Gen (Subst era)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnivSize -> Proof era -> Subst era -> Gen (Subst era)
forall era.
Reflect era =>
UnivSize -> Proof era -> Subst era -> Gen (Subst era)
utxoStage UnivSize
forall a. Default a => a
def Proof era
proof
          Gen (Subst era)
-> (Subst era -> Gen (Subst era)) -> Gen (Subst era)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Proof era -> Subst era -> Gen (Subst era)
forall era.
Reflect era =>
Proof era -> Subst era -> Gen (Subst era)
vstateStage Proof era
proof
          Gen (Subst era)
-> (Subst era -> Gen (Subst era)) -> Gen (Subst era)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Proof era -> Subst era -> Gen (Subst era)
forall era.
Reflect era =>
Proof era -> Subst era -> Gen (Subst era)
pstateStage Proof era
proof
          Gen (Subst era)
-> (Subst era -> Gen (Subst era)) -> Gen (Subst era)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Proof era -> Subst era -> Gen (Subst era)
forall era.
Reflect era =>
Proof era -> Subst era -> Gen (Subst era)
dstateStage Proof era
proof
          Gen (Subst era)
-> (Subst era -> Gen (Subst era)) -> Gen (Subst era)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnivSize -> Proof era -> Subst era -> Gen (Subst era)
forall era.
Reflect era =>
UnivSize -> Proof era -> Subst era -> Gen (Subst era)
ledgerStateStage UnivSize
forall a. Default a => a
def Proof era
proof
          Gen (Subst era) -> (Subst era -> Gen (Env era)) -> Gen (Env era)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Subst era
subst -> Typed (Env era) -> Gen (Env era)
forall (m :: * -> *) t. (HasCallStack, Monad m) => Typed t -> m t
monadTyped (Typed (Env era) -> Gen (Env era))
-> Typed (Env era) -> Gen (Env era)
forall a b. (a -> b) -> a -> b
$ Subst era -> Env era -> Typed (Env era)
forall era. Subst era -> Env era -> Typed (Env era)
substToEnv Subst era
subst Env era
forall era. Env era
emptyEnv)
      )
  LedgerState era
lstate <- Typed (LedgerState era) -> IO (LedgerState era)
forall (m :: * -> *) t. (HasCallStack, Monad m) => Typed t -> m t
monadTyped (Typed (LedgerState era) -> IO (LedgerState era))
-> Typed (LedgerState era) -> IO (LedgerState era)
forall a b. (a -> b) -> a -> b
$ Env era
-> RootTarget era (LedgerState era) (LedgerState era)
-> Typed (LedgerState era)
forall era x t. Env era -> RootTarget era x t -> Typed t
runTarget Env era
env (Proof era -> RootTarget era (LedgerState era) (LedgerState era)
forall era.
Reflect era =>
Proof era -> RootTarget era (LedgerState era) (LedgerState era)
ledgerStateT Proof era
proof)
  let env2 :: Env era
env2 = LedgerState era
-> RootTarget era (LedgerState era) (LedgerState era)
-> Env era
-> Env era
forall era root t.
root -> RootTarget era root t -> Env era -> Env era
getTarget LedgerState era
lstate (Proof era -> RootTarget era (LedgerState era) (LedgerState era)
forall era.
Reflect era =>
Proof era -> RootTarget era (LedgerState era) (LedgerState era)
ledgerStateT Proof era
proof) Env era
env
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ReplMode
mode ReplMode -> ReplMode -> Bool
forall a. Eq a => a -> a -> Bool
== ReplMode
Interactive) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (PDoc -> String
forall a. Show a => a -> String
show (Proof era -> LedgerState era -> PDoc
forall era. Reflect era => Proof era -> LedgerState era -> PDoc
pcLedgerState Proof era
proof LedgerState era
lstate))
  ReplMode -> Proof era -> Env era -> String -> IO ()
forall era. ReplMode -> Proof era -> Env era -> String -> IO ()
modeRepl ReplMode
mode Proof era
proof Env era
env2 String
""

demoTest :: TestTree
demoTest :: TestTree
demoTest = String -> IO () -> TestTree
forall a. String -> IO a -> TestTree
testIO String
"Testing LedgerState Stage" (Proof ConwayEra -> ReplMode -> IO ()
forall era. Reflect era => Proof era -> ReplMode -> IO ()
demo Proof ConwayEra
Conway ReplMode
CI)

main :: IO ()
main :: IO ()
main = TestTree -> IO ()
defaultMain (TestTree -> IO ()) -> TestTree -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO () -> TestTree
forall a. String -> IO a -> TestTree
testIO String
"Testing LedgerState Stage" (Proof ConwayEra -> ReplMode -> IO ()
forall era. Reflect era => Proof era -> ReplMode -> IO ()
demo Proof ConwayEra
Conway ReplMode
Interactive)

-- =============================================
-- Contraint based approach to generating Proposals

-- | Generate the (parent,child) pairs in a Tree.
--   Be sure the list of 'a' are unique, because each node should appear in the Tree only once.
--   The first one will be the root of the tree
--   and have parent Nothing.
genTree :: Ord a => [a] -> Gen [(Maybe a, a)]
genTree :: forall a. Ord a => [a] -> Gen [(Maybe a, a)]
genTree [] = [(Maybe a, a)] -> Gen [(Maybe a, a)]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
genTree (a
root : [a]
others) = [a] -> [(Maybe a, a)] -> Set a -> Gen [(Maybe a, a)]
forall a.
Ord a =>
[a] -> [(Maybe a, a)] -> Set a -> Gen [(Maybe a, a)]
genTreeHelp [a
root] [(Maybe a
forall a. Maybe a
Nothing, a
root)] ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
others)
  where
    genTreeHelp :: Ord a => [a] -> [(Maybe a, a)] -> Set a -> Gen [(Maybe a, a)]
    genTreeHelp :: forall a.
Ord a =>
[a] -> [(Maybe a, a)] -> Set a -> Gen [(Maybe a, a)]
genTreeHelp [a]
_ [(Maybe a, a)]
edges Set a
nodes | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
nodes = [(Maybe a, a)] -> Gen [(Maybe a, a)]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Maybe a, a)] -> [(Maybe a, a)]
forall a. [a] -> [a]
reverse [(Maybe a, a)]
edges)
    genTreeHelp [a]
roots [(Maybe a, a)]
edges Set a
nodes = do
      (a
x, Set a
more) <- [String] -> Set a -> Gen (a, Set a)
forall a. [String] -> Set a -> Gen (a, Set a)
itemFromSet [] Set a
nodes
      Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
roots Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      [a] -> [(Maybe a, a)] -> Set a -> Gen [(Maybe a, a)]
forall a.
Ord a =>
[a] -> [(Maybe a, a)] -> Set a -> Gen [(Maybe a, a)]
genTreeHelp (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
roots) ((a -> Maybe a
forall a. a -> Maybe a
Just ([a]
roots [a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!! Int
n), a
x) (Maybe a, a) -> [(Maybe a, a)] -> [(Maybe a, a)]
forall a. a -> [a] -> [a]
: [(Maybe a, a)]
edges) Set a
more

{-
One might test genTree, something like this
go :: IO [(Maybe Int, Int)]
go = generate (genTree [1, 2, 3, 4, 5, 6, 7 :: Int])
-}

-- | Tie together GovActionState and GovAction using the (parent,child) links
--   that describe the shape of the Tree
useTriples ::
  [(Maybe GovActionId, GovActionId)] ->
  [GovAction era] ->
  [GovActionState era] ->
  [GovActionState era]
useTriples :: forall era.
[(Maybe GovActionId, GovActionId)]
-> [GovAction era] -> [GovActionState era] -> [GovActionState era]
useTriples [(Maybe GovActionId, GovActionId)]
pairs [GovAction era]
as [GovActionState era]
gs = ((Maybe GovActionId, GovActionId)
 -> GovAction era -> GovActionState era -> GovActionState era)
-> [(Maybe GovActionId, GovActionId)]
-> [GovAction era]
-> [GovActionState era]
-> [GovActionState era]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (Maybe GovActionId, GovActionId)
-> GovAction era -> GovActionState era -> GovActionState era
forall {era}.
(Maybe GovActionId, GovActionId)
-> GovAction era -> GovActionState era -> GovActionState era
help [(Maybe GovActionId, GovActionId)]
pairs [GovAction era]
as [GovActionState era]
gs
  where
    help :: (Maybe GovActionId, GovActionId)
-> GovAction era -> GovActionState era -> GovActionState era
help (Maybe GovActionId
parent, GovActionId
idx) GovAction era
a GovActionState era
g =
      GovActionState era
g
        GovActionState era
-> (GovActionState era -> GovActionState era) -> GovActionState era
forall a b. a -> (a -> b) -> b
& (GovActionId -> Identity GovActionId)
-> GovActionState era -> Identity (GovActionState era)
forall era (f :: * -> *).
Functor f =>
(GovActionId -> f GovActionId)
-> GovActionState era -> f (GovActionState era)
gasIdL ((GovActionId -> Identity GovActionId)
 -> GovActionState era -> Identity (GovActionState era))
-> GovActionId -> GovActionState era -> GovActionState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GovActionId
idx
        GovActionState era
-> (GovActionState era -> GovActionState era) -> GovActionState era
forall a b. a -> (a -> b) -> b
& (GovAction era -> Identity (GovAction era))
-> GovActionState era -> Identity (GovActionState era)
forall era (f :: * -> *).
Functor f =>
(GovAction era -> f (GovAction era))
-> GovActionState era -> f (GovActionState era)
gasActionL ((GovAction era -> Identity (GovAction era))
 -> GovActionState era -> Identity (GovActionState era))
-> GovAction era -> GovActionState era -> GovActionState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GovAction era -> Maybe GovActionId -> GovAction era
forall era. GovAction era -> Maybe GovActionId -> GovAction era
setActionId GovAction era
a Maybe GovActionId
parent

-- | [Pred era] that generate a valid (Map GovActionId GovActionState)
govStatePreds :: forall era. (ConwayEraPParams era, Reflect era) => Proof era -> [Pred era]
govStatePreds :: forall era.
(ConwayEraPParams era, Reflect era) =>
Proof era -> [Pred era]
govStatePreds Proof era
p =
  [ Size -> Term era Size -> Pred era
forall era. Size -> Term era Size -> Pred era
MetaSize (Int -> Int -> Size
SzRng Int
2 Int
5) Term era Size
numActions
  , Term era Size -> Term era (Set GovActionId) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized Term era Size
numActions Term era (Set GovActionId)
gaids
  , Term era (Set GovActionId)
-> Term era (Set GovActionId) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset Term era (Set GovActionId)
gaids Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
govActionIdUniv
  , Term era [(Maybe GovActionId, GovActionId)]
-> RootTarget era Void (Gen [(Maybe GovActionId, GovActionId)])
-> Pred era
forall era t r. Term era t -> RootTarget era r (Gen t) -> Pred era
GenFrom Term era [(Maybe GovActionId, GovActionId)]
pairs (String
-> (Set GovActionId -> Gen [(Maybe GovActionId, GovActionId)])
-> RootTarget
     era
     Void
     (Set GovActionId -> Gen [(Maybe GovActionId, GovActionId)])
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"genTree" ([GovActionId] -> Gen [(Maybe GovActionId, GovActionId)]
forall a. Ord a => [a] -> Gen [(Maybe a, a)]
genTree ([GovActionId] -> Gen [(Maybe GovActionId, GovActionId)])
-> (Set GovActionId -> [GovActionId])
-> Set GovActionId
-> Gen [(Maybe GovActionId, GovActionId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set GovActionId -> [GovActionId]
forall a. Set a -> [a]
Set.toList) RootTarget
  era
  Void
  (Set GovActionId -> Gen [(Maybe GovActionId, GovActionId)])
-> Term era (Set GovActionId)
-> RootTarget era Void (Gen [(Maybe GovActionId, GovActionId)])
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set GovActionId)
gaids)
  , Term era Size
-> Term era [GovActionState era]
-> RootTarget era (GovActionState era) (GovActionState era)
-> [Pred era]
-> Pred era
forall era t.
(Era era, Eq t) =>
Term era Size
-> Term era [t] -> RootTarget era t t -> [Pred era] -> Pred era
ListWhere
      Term era Size
numActions
      Term era [GovActionState era]
preGovstates
      RootTarget era (GovActionState era) (GovActionState era)
forall era.
Era era =>
RootTarget era (GovActionState era) (GovActionState era)
govActionStateTarget
      [ Direct (Term era GovActionId)
-> Term era (Set GovActionId) -> Pred era
forall a era.
Ord a =>
Direct (Term era a) -> Term era (Set a) -> Pred era
Member (Term era GovActionId -> Direct (Term era GovActionId)
forall a b. a -> Either a b
Left Term era GovActionId
forall era. Era era => Term era GovActionId
idV) Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
govActionIdUniv
      , Term era (Set (Credential 'HotCommitteeRole))
-> Term era (Set (Credential 'HotCommitteeRole)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset (Term era (Map (Credential 'HotCommitteeRole) Vote)
-> Term era (Set (Credential 'HotCommitteeRole))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (Credential 'HotCommitteeRole) Vote)
forall era.
Era era =>
Term era (Map (Credential 'HotCommitteeRole) Vote)
committeeVotesV) Term era (Set (Credential 'HotCommitteeRole))
forall era.
Era era =>
Term era (Set (Credential 'HotCommitteeRole))
hotCommitteeCredsUniv
      , Term era Size
-> Term era (Set (Credential 'HotCommitteeRole)) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
0 Int
3) (Term era (Map (Credential 'HotCommitteeRole) Vote)
-> Term era (Set (Credential 'HotCommitteeRole))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (Credential 'HotCommitteeRole) Vote)
forall era.
Era era =>
Term era (Map (Credential 'HotCommitteeRole) Vote)
committeeVotesV)
      , Term era (Set (Credential 'DRepRole))
-> Term era (Set (Credential 'DRepRole)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset (Term era (Map (Credential 'DRepRole) Vote)
-> Term era (Set (Credential 'DRepRole))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (Credential 'DRepRole) Vote)
forall era. Era era => Term era (Map (Credential 'DRepRole) Vote)
drepVotesV) Term era (Set (Credential 'DRepRole))
forall era. Era era => Term era (Set (Credential 'DRepRole))
voteUniv
      , Term era Size -> Term era (Set (Credential 'DRepRole)) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
0 Int
3) (Term era (Map (Credential 'DRepRole) Vote)
-> Term era (Set (Credential 'DRepRole))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (Credential 'DRepRole) Vote)
forall era. Era era => Term era (Map (Credential 'DRepRole) Vote)
drepVotesV)
      , Term era (Set (KeyHash 'StakePool))
-> Term era (Set (KeyHash 'StakePool)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset (Term era (Map (KeyHash 'StakePool) Vote)
-> Term era (Set (KeyHash 'StakePool))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (KeyHash 'StakePool) Vote)
forall era. Era era => Term era (Map (KeyHash 'StakePool) Vote)
stakePoolVotesV) Term era (Set (KeyHash 'StakePool))
forall era. Era era => Term era (Set (KeyHash 'StakePool))
poolHashUniv
      , Term era Size -> Term era (Set (KeyHash 'StakePool)) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
0 Int
3) (Term era (Map (KeyHash 'StakePool) Vote)
-> Term era (Set (KeyHash 'StakePool))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (KeyHash 'StakePool) Vote)
forall era. Era era => Term era (Map (KeyHash 'StakePool) Vote)
stakePoolVotesV)
      , Proof era -> Term era Coin
forall era. ConwayEraPParams era => Proof era -> Term era Coin
proposalDeposit Proof era
p Term era Coin -> Term era Coin -> Pred era
forall a era. Eq a => Term era a -> Term era a -> Pred era
:=: Term era Coin
forall era. Era era => Term era Coin
depositV
      , Term era RewardAccount -> Pred era
forall era t. Term era t -> Pred era
Random Term era RewardAccount
forall era. Era era => Term era RewardAccount
returnAddrV
      , Term era Anchor -> Pred era
forall era t. Term era t -> Pred era
Random Term era Anchor
forall era. Era era => Term era Anchor
anchorV
      , Term era (GovAction era)
-> [(Int, RootTarget era (GovAction era) (GovAction era),
     [Pred era])]
-> Pred era
forall t era.
(Eq t, Era era) =>
Term era t -> [(Int, RootTarget era t t, [Pred era])] -> Pred era
Oneof
          Term era (GovAction era)
forall era. Era era => Term era (GovAction era)
actionV
          [ (Int
1, RootTarget era (GovAction era) (GovAction era)
forall era.
Reflect era =>
RootTarget era (GovAction era) (GovAction era)
noConfidenceT, [Term era (Maybe GovActionId) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Maybe GovActionId)
forall era. Era era => Term era (Maybe GovActionId)
gaPrevId])
          ,
            ( Int
1
            , RootTarget era (GovAction era) (GovAction era)
forall era.
Reflect era =>
RootTarget era (GovAction era) (GovAction era)
updateCommitteeT
            ,
              [ Term era (Maybe GovActionId) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Maybe GovActionId)
forall era. Era era => Term era (Maybe GovActionId)
gaPrevId
              , Term era Size
-> Term era (Set (Credential 'ColdCommitteeRole)) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
0 Int
3) Term era (Set (Credential 'ColdCommitteeRole))
forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole))
gaRemMember
              , Term era (Set (Credential 'ColdCommitteeRole))
-> Term era (Set (Credential 'ColdCommitteeRole)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset Term era (Set (Credential 'ColdCommitteeRole))
forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole))
gaRemMember Term era (Set (Credential 'ColdCommitteeRole))
forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole))
coldCommitteeCredsUniv
              , Term era Size
-> Term era (Set (Credential 'ColdCommitteeRole)) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
0 Int
3) (Term era (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Term era (Set (Credential 'ColdCommitteeRole))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (Credential 'ColdCommitteeRole) EpochNo)
forall era.
Era era =>
Term era (Map (Credential 'ColdCommitteeRole) EpochNo)
gaAddMember)
              , Term era (Set (Credential 'ColdCommitteeRole))
-> Term era (Set (Credential 'ColdCommitteeRole)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset (Term era (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Term era (Set (Credential 'ColdCommitteeRole))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (Credential 'ColdCommitteeRole) EpochNo)
forall era.
Era era =>
Term era (Map (Credential 'ColdCommitteeRole) EpochNo)
gaAddMember) Term era (Set (Credential 'ColdCommitteeRole))
forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole))
coldCommitteeCredsUniv
              , Term era UnitInterval -> Pred era
forall era t. Term era t -> Pred era
Random Term era UnitInterval
forall era. Era era => Term era UnitInterval
gaThreshold
              ]
            )
          ]
      , Term era EpochNo
forall era. Era era => Term era EpochNo
currentEpoch Term era EpochNo -> Term era EpochNo -> Pred era
forall a era. Eq a => Term era a -> Term era a -> Pred era
:=: Term era EpochNo
forall era. Era era => Term era EpochNo
proposedInV
      , Term era EpochNo -> Pred era
forall era t. Term era t -> Pred era
Random Term era EpochNo
forall era. Era era => Term era EpochNo
expiresAfterV
      , Term era Size -> Term era (Set GovActionId) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
0 Int
3) Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
childrenV
      , Term era (Set GovActionId)
-> Term era (Set GovActionId) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
childrenV Term era (Set GovActionId)
forall era. Era era => Term era (Set GovActionId)
govActionIdUniv
      ]
  , Term era Size
-> Term era [GovAction era]
-> RootTarget era (GovAction era) (GovAction era)
-> [Pred era]
-> Pred era
forall era t.
(Era era, Eq t) =>
Term era Size
-> Term era [t] -> RootTarget era t t -> [Pred era] -> Pred era
ListWhere
      Term era Size
numActions
      Term era [GovAction era]
govActions
      (String
-> TypeRep (GovAction era)
-> (GovAction era -> GovAction era)
-> RootTarget era (GovAction era) (GovAction era -> GovAction era)
forall root a b era.
String -> TypeRep root -> (a -> b) -> RootTarget era root (a -> b)
Invert String
"GovAction" (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovAction era)) GovAction era -> GovAction era
forall a. a -> a
id RootTarget era (GovAction era) (GovAction era -> GovAction era)
-> RootTarget era (GovAction era) (GovAction era)
-> RootTarget era (GovAction era) (GovAction era)
forall era root a t.
RootTarget era root (a -> t)
-> RootTarget era root a -> RootTarget era root t
:$ Term era (GovAction era)
-> (GovAction era -> Maybe (GovAction era))
-> RootTarget era (GovAction era) (GovAction era)
forall era t root.
Term era t -> (root -> Maybe t) -> RootTarget era root t
Partial Term era (GovAction era)
govAction GovAction era -> Maybe (GovAction era)
forall a. a -> Maybe a
Just)
      [ Term era (GovAction era)
-> [(Int, RootTarget era (GovAction era) (GovAction era),
     [Pred era])]
-> Pred era
forall t era.
(Eq t, Era era) =>
Term era t -> [(Int, RootTarget era t t, [Pred era])] -> Pred era
Oneof
          Term era (GovAction era)
govAction
          [ (Int
1, RootTarget era (GovAction era) (GovAction era)
forall era.
Reflect era =>
RootTarget era (GovAction era) (GovAction era)
noConfidenceT, [Term era (Maybe GovActionId) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Maybe GovActionId)
forall era. Era era => Term era (Maybe GovActionId)
gaPrevId])
          ,
            ( Int
1
            , RootTarget era (GovAction era) (GovAction era)
forall era.
Reflect era =>
RootTarget era (GovAction era) (GovAction era)
updateCommitteeT
            ,
              [ Term era (Maybe GovActionId) -> Pred era
forall era t. Term era t -> Pred era
Random Term era (Maybe GovActionId)
forall era. Era era => Term era (Maybe GovActionId)
gaPrevId
              , Term era Size
-> Term era (Set (Credential 'ColdCommitteeRole)) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
0 Int
3) Term era (Set (Credential 'ColdCommitteeRole))
forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole))
gaRemMember
              , Term era (Set (Credential 'ColdCommitteeRole))
-> Term era (Set (Credential 'ColdCommitteeRole)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset Term era (Set (Credential 'ColdCommitteeRole))
forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole))
gaRemMember Term era (Set (Credential 'ColdCommitteeRole))
forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole))
coldCommitteeCredsUniv
              , Term era Size
-> Term era (Set (Credential 'ColdCommitteeRole)) -> Pred era
forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (Int -> Int -> Term era Size
forall era. Era era => Int -> Int -> Term era Size
Range Int
0 Int
3) (Term era (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Term era (Set (Credential 'ColdCommitteeRole))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (Credential 'ColdCommitteeRole) EpochNo)
forall era.
Era era =>
Term era (Map (Credential 'ColdCommitteeRole) EpochNo)
gaAddMember)
              , Term era (Set (Credential 'ColdCommitteeRole))
-> Term era (Set (Credential 'ColdCommitteeRole)) -> Pred era
forall a era.
Ord a =>
Term era (Set a) -> Term era (Set a) -> Pred era
Subset (Term era (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Term era (Set (Credential 'ColdCommitteeRole))
forall a era b. Ord a => Term era (Map a b) -> Term era (Set a)
Dom Term era (Map (Credential 'ColdCommitteeRole) EpochNo)
forall era.
Era era =>
Term era (Map (Credential 'ColdCommitteeRole) EpochNo)
gaAddMember) Term era (Set (Credential 'ColdCommitteeRole))
forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole))
coldCommitteeCredsUniv
              , Term era UnitInterval -> Pred era
forall era t. Term era t -> Pred era
Random Term era UnitInterval
forall era. Era era => Term era UnitInterval
gaThreshold
              ]
            )
          ]
      ]
  , Term era [GovActionState era]
govActionStates Term era [GovActionState era]
-> RootTarget era Void [GovActionState era] -> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> ([(Maybe GovActionId, GovActionId)]
    -> [GovAction era] -> [GovActionState era] -> [GovActionState era])
-> RootTarget
     era
     Void
     ([(Maybe GovActionId, GovActionId)]
      -> [GovAction era] -> [GovActionState era] -> [GovActionState era])
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"useTriples" [(Maybe GovActionId, GovActionId)]
-> [GovAction era] -> [GovActionState era] -> [GovActionState era]
forall era.
[(Maybe GovActionId, GovActionId)]
-> [GovAction era] -> [GovActionState era] -> [GovActionState era]
useTriples RootTarget
  era
  Void
  ([(Maybe GovActionId, GovActionId)]
   -> [GovAction era] -> [GovActionState era] -> [GovActionState era])
-> Term era [(Maybe GovActionId, GovActionId)]
-> Target
     era
     ([GovAction era] -> [GovActionState era] -> [GovActionState era])
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era [(Maybe GovActionId, GovActionId)]
pairs Target
  era
  ([GovAction era] -> [GovActionState era] -> [GovActionState era])
-> Term era [GovAction era]
-> Target era ([GovActionState era] -> [GovActionState era])
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era [GovAction era]
govActions Target era ([GovActionState era] -> [GovActionState era])
-> Term era [GovActionState era]
-> RootTarget era Void [GovActionState era]
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era [GovActionState era]
preGovstates)
  , Term era (Map GovActionId (GovActionState era))
govActionMap Term era (Map GovActionId (GovActionState era))
-> RootTarget era Void (Map GovActionId (GovActionState era))
-> Pred era
forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (String
-> ([GovActionState era] -> Map GovActionId (GovActionState era))
-> RootTarget
     era
     Void
     ([GovActionState era] -> Map GovActionId (GovActionState era))
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"toProposalMap" [GovActionState era] -> Map GovActionId (GovActionState era)
forall era.
[GovActionState era] -> Map GovActionId (GovActionState era)
toProposalMap RootTarget
  era
  Void
  ([GovActionState era] -> Map GovActionId (GovActionState era))
-> Term era [GovActionState era]
-> RootTarget era Void (Map GovActionId (GovActionState era))
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era [GovActionState era]
govActionStates)
  ]
  where
    gaids :: Term era (Set GovActionId)
gaids = V era (Set GovActionId) -> Term era (Set GovActionId)
forall era t. V era t -> Term era t
Var (Proof era
-> String
-> Rep era (Set GovActionId)
-> Access era Any (Set GovActionId)
-> V era (Set GovActionId)
forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"gaids" (Rep era GovActionId -> Rep era (Set GovActionId)
forall a era. Ord a => Rep era a -> Rep era (Set a)
SetR Rep era GovActionId
forall era. Era era => Rep era GovActionId
GovActionIdR) Access era Any (Set GovActionId)
forall era s t. Access era s t
No)
    pairs :: Term era [(Maybe GovActionId, GovActionId)]
pairs = V era [(Maybe GovActionId, GovActionId)]
-> Term era [(Maybe GovActionId, GovActionId)]
forall era t. V era t -> Term era t
Var (Proof era
-> String
-> Rep era [(Maybe GovActionId, GovActionId)]
-> Access era Any [(Maybe GovActionId, GovActionId)]
-> V era [(Maybe GovActionId, GovActionId)]
forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"pairs" (Rep era (Maybe GovActionId, GovActionId)
-> Rep era [(Maybe GovActionId, GovActionId)]
forall era a. Rep era a -> Rep era [a]
ListR (Rep era (Maybe GovActionId)
-> Rep era GovActionId -> Rep era (Maybe GovActionId, GovActionId)
forall era a b. Rep era a -> Rep era b -> Rep era (a, b)
PairR (Rep era GovActionId -> Rep era (Maybe GovActionId)
forall era t1. Rep era t1 -> Rep era (Maybe t1)
MaybeR Rep era GovActionId
forall era. Era era => Rep era GovActionId
GovActionIdR) Rep era GovActionId
forall era. Era era => Rep era GovActionId
GovActionIdR)) Access era Any [(Maybe GovActionId, GovActionId)]
forall era s t. Access era s t
No)
    numActions :: Term era Size
numActions = V era Size -> Term era Size
forall era t. V era t -> Term era t
Var (Proof era
-> String -> Rep era Size -> Access era Any Size -> V era Size
forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"numActions" Rep era Size
forall era. Rep era Size
SizeR Access era Any Size
forall era s t. Access era s t
No)
    preGovstates :: Term era [GovActionState era]
preGovstates = V era [GovActionState era] -> Term era [GovActionState era]
forall era t. V era t -> Term era t
Var (String
-> Rep era [GovActionState era]
-> Access era Any [GovActionState era]
-> V era [GovActionState era]
forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"preGovstates" (Rep era (GovActionState era) -> Rep era [GovActionState era]
forall era a. Rep era a -> Rep era [a]
ListR Rep era (GovActionState era)
forall era. Era era => Rep era (GovActionState era)
GovActionStateR) Access era Any [GovActionState era]
forall era s t. Access era s t
No)
    govActionStates :: Term era [GovActionState era]
govActionStates = V era [GovActionState era] -> Term era [GovActionState era]
forall era t. V era t -> Term era t
Var (Proof era
-> String
-> Rep era [GovActionState era]
-> Access era Any [GovActionState era]
-> V era [GovActionState era]
forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"govActionStates" (Rep era (GovActionState era) -> Rep era [GovActionState era]
forall era a. Rep era a -> Rep era [a]
ListR Rep era (GovActionState era)
forall era. Era era => Rep era (GovActionState era)
GovActionStateR) Access era Any [GovActionState era]
forall era s t. Access era s t
No)
    govAction :: Term era (GovAction era)
govAction = V era (GovAction era) -> Term era (GovAction era)
forall era t. V era t -> Term era t
Var (Proof era
-> String
-> Rep era (GovAction era)
-> Access era Any (GovAction era)
-> V era (GovAction era)
forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"govAction" Rep era (GovAction era)
forall era. Era era => Rep era (GovAction era)
GovActionR Access era Any (GovAction era)
forall era s t. Access era s t
No)
    govActions :: Term era [GovAction era]
govActions = V era [GovAction era] -> Term era [GovAction era]
forall era t. V era t -> Term era t
Var (Proof era
-> String
-> Rep era [GovAction era]
-> Access era Any [GovAction era]
-> V era [GovAction era]
forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"govActions" (Rep era (GovAction era) -> Rep era [GovAction era]
forall era a. Rep era a -> Rep era [a]
ListR Rep era (GovAction era)
forall era. Era era => Rep era (GovAction era)
GovActionR) Access era Any [GovAction era]
forall era s t. Access era s t
No)
    govActionMap :: Term era (Map GovActionId (GovActionState era))
govActionMap = V era (Map GovActionId (GovActionState era))
-> Term era (Map GovActionId (GovActionState era))
forall era t. V era t -> Term era t
Var (Proof era
-> String
-> Rep era (Map GovActionId (GovActionState era))
-> Access era Any (Map GovActionId (GovActionState era))
-> V era (Map GovActionId (GovActionState era))
forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"govActionMap" (Rep era GovActionId
-> Rep era (GovActionState era)
-> Rep era (Map GovActionId (GovActionState era))
forall a era b.
Ord a =>
Rep era a -> Rep era b -> Rep era (Map a b)
MapR Rep era GovActionId
forall era. Era era => Rep era GovActionId
GovActionIdR Rep era (GovActionState era)
forall era. Era era => Rep era (GovActionState era)
GovActionStateR) Access era Any (Map GovActionId (GovActionState era))
forall era s t. Access era s t
No)

toProposalMap ::
  forall era. [GovActionState era] -> Map.Map GovActionId (GovActionState era)
toProposalMap :: forall era.
[GovActionState era] -> Map GovActionId (GovActionState era)
toProposalMap [GovActionState era]
xs = [(GovActionId, GovActionState era)]
-> Map GovActionId (GovActionState era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((GovActionState era -> (GovActionId, GovActionState era))
-> [GovActionState era] -> [(GovActionId, GovActionState era)]
forall a b. (a -> b) -> [a] -> [b]
map GovActionState era -> (GovActionId, GovActionState era)
forall {era}.
GovActionState era -> (GovActionId, GovActionState era)
pairup [GovActionState era]
xs)
  where
    pairup :: GovActionState era -> (GovActionId, GovActionState era)
pairup GovActionState era
gas = (GovActionState era -> GovActionId
forall era. GovActionState era -> GovActionId
gasId GovActionState era
gas, GovActionState era
gas)

demoGov :: (ConwayEraPParams era, Reflect era) => Proof era -> ReplMode -> IO ()
demoGov :: forall era.
(ConwayEraPParams era, Reflect era) =>
Proof era -> ReplMode -> IO ()
demoGov Proof era
proof ReplMode
mode = do
  Env era
env <-
    Gen (Env era) -> IO (Env era)
forall a. Gen a -> IO a
generate
      ( Subst era -> Gen (Subst era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Subst era
forall era. Subst era
emptySubst
          Gen (Subst era)
-> (Subst era -> Gen (Subst era)) -> Gen (Subst era)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Proof era -> Subst era -> Gen (Subst era)
forall era.
Reflect era =>
Proof era -> Subst era -> Gen (Subst era)
pParamsStage Proof era
proof
          Gen (Subst era)
-> (Subst era -> Gen (Subst era)) -> Gen (Subst era)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnivSize -> Proof era -> Subst era -> Gen (Subst era)
forall era.
Reflect era =>
UnivSize -> Proof era -> Subst era -> Gen (Subst era)
universeStage UnivSize
forall a. Default a => a
def Proof era
proof
          Gen (Subst era)
-> (Subst era -> Gen (Subst era)) -> Gen (Subst era)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Proof era
-> OrderInfo -> [Pred era] -> Subst era -> Gen (Subst era)
forall era.
Era era =>
Proof era
-> OrderInfo -> [Pred era] -> Subst era -> Gen (Subst era)
toolChainSub Proof era
proof OrderInfo
standardOrderInfo (Proof era -> [Pred era]
forall era.
(ConwayEraPParams era, Reflect era) =>
Proof era -> [Pred era]
govStatePreds Proof era
proof)
          Gen (Subst era) -> (Subst era -> Gen (Env era)) -> Gen (Env era)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Subst era
subst -> Typed (Env era) -> Gen (Env era)
forall (m :: * -> *) t. (HasCallStack, Monad m) => Typed t -> m t
monadTyped (Typed (Env era) -> Gen (Env era))
-> Typed (Env era) -> Gen (Env era)
forall a b. (a -> b) -> a -> b
$ Subst era -> Env era -> Typed (Env era)
forall era. Subst era -> Env era -> Typed (Env era)
substToEnv Subst era
subst Env era
forall era. Env era
emptyEnv)
      )
  ReplMode -> Proof era -> Env era -> String -> IO ()
forall era. ReplMode -> Proof era -> Env era -> String -> IO ()
modeRepl ReplMode
mode Proof era
proof Env era
env String
""

mainGov :: IO ()
mainGov :: IO ()
mainGov = Proof ConwayEra -> ReplMode -> IO ()
forall era.
(ConwayEraPParams era, Reflect era) =>
Proof era -> ReplMode -> IO ()
demoGov Proof ConwayEra
Conway ReplMode
Interactive

setActionId :: GovAction era -> Maybe GovActionId -> GovAction era
setActionId :: forall era. GovAction era -> Maybe GovActionId -> GovAction era
setActionId (ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
_ PParamsUpdate era
pp StrictMaybe ScriptHash
p) Maybe GovActionId
x = StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange (Maybe GovActionId
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall (p :: GovActionPurpose) era.
Maybe GovActionId -> StrictMaybe (GovPurposeId p era)
liftId Maybe GovActionId
x) PParamsUpdate era
pp StrictMaybe ScriptHash
p
setActionId (HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
_ ProtVer
y) Maybe GovActionId
x = StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation (Maybe GovActionId
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall (p :: GovActionPurpose) era.
Maybe GovActionId -> StrictMaybe (GovPurposeId p era)
liftId Maybe GovActionId
x) ProtVer
y
setActionId (UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
_ Set (Credential 'ColdCommitteeRole)
w Map (Credential 'ColdCommitteeRole) EpochNo
y UnitInterval
z) Maybe GovActionId
x = StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee (Maybe GovActionId
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall (p :: GovActionPurpose) era.
Maybe GovActionId -> StrictMaybe (GovPurposeId p era)
liftId Maybe GovActionId
x) Set (Credential 'ColdCommitteeRole)
w Map (Credential 'ColdCommitteeRole) EpochNo
y UnitInterval
z
setActionId (NewConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
_ Constitution era
y) Maybe GovActionId
x = StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
NewConstitution (Maybe GovActionId
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall (p :: GovActionPurpose) era.
Maybe GovActionId -> StrictMaybe (GovPurposeId p era)
liftId Maybe GovActionId
x) Constitution era
y
setActionId GovAction era
InfoAction Maybe GovActionId
_ = GovAction era
forall era. GovAction era
InfoAction
setActionId (NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose era)
_) Maybe GovActionId
x = StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (Maybe GovActionId
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall (p :: GovActionPurpose) era.
Maybe GovActionId -> StrictMaybe (GovPurposeId p era)
liftId Maybe GovActionId
x)
setActionId x :: GovAction era
x@(TreasuryWithdrawals Map RewardAccount Coin
_ StrictMaybe ScriptHash
_) Maybe GovActionId
_ = GovAction era
x

actionIdL :: Lens' (GovAction era) (Maybe GovActionId)
actionIdL :: forall era (f :: * -> *).
Functor f =>
(Maybe GovActionId -> f (Maybe GovActionId))
-> GovAction era -> f (GovAction era)
actionIdL = (GovAction era -> Maybe GovActionId)
-> (GovAction era -> Maybe GovActionId -> GovAction era)
-> Lens
     (GovAction era)
     (GovAction era)
     (Maybe GovActionId)
     (Maybe GovActionId)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GovAction era -> Maybe GovActionId
forall {era}. GovAction era -> Maybe GovActionId
getter GovAction era -> Maybe GovActionId -> GovAction era
forall era. GovAction era -> Maybe GovActionId -> GovAction era
setter
  where
    getter :: GovAction era -> Maybe GovActionId
getter (ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
x PParamsUpdate era
_ StrictMaybe ScriptHash
_) = StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> Maybe GovActionId
forall (p :: GovActionPurpose) era.
StrictMaybe (GovPurposeId p era) -> Maybe GovActionId
dropId StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
x
    getter (HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
x ProtVer
_) = StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Maybe GovActionId
forall (p :: GovActionPurpose) era.
StrictMaybe (GovPurposeId p era) -> Maybe GovActionId
dropId StrictMaybe (GovPurposeId 'HardForkPurpose era)
x
    getter (UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
x Set (Credential 'ColdCommitteeRole)
_ Map (Credential 'ColdCommitteeRole) EpochNo
_ UnitInterval
_) = StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Maybe GovActionId
forall (p :: GovActionPurpose) era.
StrictMaybe (GovPurposeId p era) -> Maybe GovActionId
dropId StrictMaybe (GovPurposeId 'CommitteePurpose era)
x
    getter (NewConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
x Constitution era
_) = StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Maybe GovActionId
forall (p :: GovActionPurpose) era.
StrictMaybe (GovPurposeId p era) -> Maybe GovActionId
dropId StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
x
    getter (NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose era)
x) = StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Maybe GovActionId
forall (p :: GovActionPurpose) era.
StrictMaybe (GovPurposeId p era) -> Maybe GovActionId
dropId StrictMaybe (GovPurposeId 'CommitteePurpose era)
x
    getter (TreasuryWithdrawals Map RewardAccount Coin
_ StrictMaybe ScriptHash
_) = Maybe GovActionId
forall a. Maybe a
Nothing
    getter GovAction era
InfoAction = Maybe GovActionId
forall a. Maybe a
Nothing
    setter :: GovAction era -> Maybe GovActionId -> GovAction era
setter GovAction era
ga Maybe GovActionId
mid = GovAction era -> Maybe GovActionId -> GovAction era
forall era. GovAction era -> Maybe GovActionId -> GovAction era
setActionId GovAction era
ga Maybe GovActionId
mid

children :: GovActionId -> [(Maybe GovActionId, GovActionId)] -> Set GovActionId
children :: GovActionId
-> [(Maybe GovActionId, GovActionId)] -> Set GovActionId
children GovActionId
x [(Maybe GovActionId, GovActionId)]
ys = (Set GovActionId
 -> (Maybe GovActionId, GovActionId) -> Set GovActionId)
-> Set GovActionId
-> [(Maybe GovActionId, GovActionId)]
-> Set GovActionId
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Set GovActionId
-> (Maybe GovActionId, GovActionId) -> Set GovActionId
accum Set GovActionId
forall a. Set a
Set.empty [(Maybe GovActionId, GovActionId)]
ys
  where
    accum :: Set GovActionId
-> (Maybe GovActionId, GovActionId) -> Set GovActionId
accum Set GovActionId
ans (Just GovActionId
y, GovActionId
z) | GovActionId
x GovActionId -> GovActionId -> Bool
forall a. Eq a => a -> a -> Bool
== GovActionId
y = GovActionId -> Set GovActionId -> Set GovActionId
forall a. Ord a => a -> Set a -> Set a
Set.insert GovActionId
z Set GovActionId
ans
    accum Set GovActionId
ans (Maybe GovActionId, GovActionId)
_ = Set GovActionId
ans

genGovActionStates ::
  forall era.
  Era era =>
  Proof era ->
  Set GovActionId ->
  Gen (Map.Map GovActionId (GovActionState era))
genGovActionStates :: forall era.
Era era =>
Proof era
-> Set GovActionId -> Gen (Map GovActionId (GovActionState era))
genGovActionStates Proof era
proof Set GovActionId
gaids = do
  [(Maybe GovActionId, GovActionId)]
pairs <- [GovActionId] -> Gen [(Maybe GovActionId, GovActionId)]
forall a. Ord a => [a] -> Gen [(Maybe a, a)]
genTree (Set GovActionId -> [GovActionId]
forall a. Set a -> [a]
Set.toList Set GovActionId
gaids)
  let genGovState :: (Maybe GovActionId, GovActionId) -> Gen (GovActionState era)
genGovState (Maybe GovActionId
parent, GovActionId
idx) = do
        GovActionState era
state <-
          GovActionId
-> Map (Credential 'HotCommitteeRole) Vote
-> Map (Credential 'DRepRole) Vote
-> Map (KeyHash 'StakePool) Vote
-> ProposalProcedure era
-> EpochNo
-> EpochNo
-> GovActionState era
forall era.
GovActionId
-> Map (Credential 'HotCommitteeRole) Vote
-> Map (Credential 'DRepRole) Vote
-> Map (KeyHash 'StakePool) Vote
-> ProposalProcedure era
-> EpochNo
-> EpochNo
-> GovActionState era
GovActionState
            (GovActionId
 -> Map (Credential 'HotCommitteeRole) Vote
 -> Map (Credential 'DRepRole) Vote
 -> Map (KeyHash 'StakePool) Vote
 -> ProposalProcedure era
 -> EpochNo
 -> EpochNo
 -> GovActionState era)
-> Gen GovActionId
-> Gen
     (Map (Credential 'HotCommitteeRole) Vote
      -> Map (Credential 'DRepRole) Vote
      -> Map (KeyHash 'StakePool) Vote
      -> ProposalProcedure era
      -> EpochNo
      -> EpochNo
      -> GovActionState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GovActionId -> Gen GovActionId
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GovActionId
idx
            Gen
  (Map (Credential 'HotCommitteeRole) Vote
   -> Map (Credential 'DRepRole) Vote
   -> Map (KeyHash 'StakePool) Vote
   -> ProposalProcedure era
   -> EpochNo
   -> EpochNo
   -> GovActionState era)
-> Gen (Map (Credential 'HotCommitteeRole) Vote)
-> Gen
     (Map (Credential 'DRepRole) Vote
      -> Map (KeyHash 'StakePool) Vote
      -> ProposalProcedure era
      -> EpochNo
      -> EpochNo
      -> GovActionState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map (Credential 'HotCommitteeRole) Vote
-> Gen (Map (Credential 'HotCommitteeRole) Vote)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (Credential 'HotCommitteeRole) Vote
forall k a. Map k a
Map.empty
            Gen
  (Map (Credential 'DRepRole) Vote
   -> Map (KeyHash 'StakePool) Vote
   -> ProposalProcedure era
   -> EpochNo
   -> EpochNo
   -> GovActionState era)
-> Gen (Map (Credential 'DRepRole) Vote)
-> Gen
     (Map (KeyHash 'StakePool) Vote
      -> ProposalProcedure era
      -> EpochNo
      -> EpochNo
      -> GovActionState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map (Credential 'DRepRole) Vote
-> Gen (Map (Credential 'DRepRole) Vote)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (Credential 'DRepRole) Vote
forall k a. Map k a
Map.empty
            Gen
  (Map (KeyHash 'StakePool) Vote
   -> ProposalProcedure era
   -> EpochNo
   -> EpochNo
   -> GovActionState era)
-> Gen (Map (KeyHash 'StakePool) Vote)
-> Gen
     (ProposalProcedure era -> EpochNo -> EpochNo -> GovActionState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map (KeyHash 'StakePool) Vote
-> Gen (Map (KeyHash 'StakePool) Vote)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (KeyHash 'StakePool) Vote
forall k a. Map k a
Map.empty
            Gen
  (ProposalProcedure era -> EpochNo -> EpochNo -> GovActionState era)
-> Gen (ProposalProcedure era)
-> Gen (EpochNo -> EpochNo -> GovActionState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Coin
-> RewardAccount
-> GovAction era
-> Anchor
-> ProposalProcedure era
forall era.
Coin
-> RewardAccount
-> GovAction era
-> Anchor
-> ProposalProcedure era
ProposalProcedure
                    (Coin
 -> RewardAccount
 -> GovAction era
 -> Anchor
 -> ProposalProcedure era)
-> Gen Coin
-> Gen
     (RewardAccount -> GovAction era -> Anchor -> ProposalProcedure era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era b. Rep era b -> Gen b
genRep @era Rep era Coin
forall era. Rep era Coin
CoinR
                    Gen
  (RewardAccount -> GovAction era -> Anchor -> ProposalProcedure era)
-> Gen RewardAccount
-> Gen (GovAction era -> Anchor -> ProposalProcedure era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen RewardAccount
forall a. Arbitrary a => Gen a
arbitrary
                    Gen (GovAction era -> Anchor -> ProposalProcedure era)
-> Gen (GovAction era) -> Gen (Anchor -> ProposalProcedure era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proof era
-> GovActionPurpose -> Maybe GovActionId -> Gen (GovAction era)
forall era.
Era era =>
Proof era
-> GovActionPurpose -> Maybe GovActionId -> Gen (GovAction era)
genGovAction Proof era
proof GovActionPurpose
CommitteePurpose Maybe GovActionId
parent
                    Gen (Anchor -> ProposalProcedure era)
-> Gen Anchor -> Gen (ProposalProcedure era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Anchor
forall a. Arbitrary a => Gen a
arbitrary
                )
            Gen (EpochNo -> EpochNo -> GovActionState era)
-> Gen EpochNo -> Gen (EpochNo -> GovActionState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen EpochNo
forall a. Arbitrary a => Gen a
arbitrary
            Gen (EpochNo -> GovActionState era)
-> Gen EpochNo -> Gen (GovActionState era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen EpochNo
forall a. Arbitrary a => Gen a
arbitrary
        GovActionState era -> Gen (GovActionState era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GovActionState era
state GovActionState era
-> (GovActionState era -> GovActionState era) -> GovActionState era
forall a b. a -> (a -> b) -> b
& (GovAction era -> Identity (GovAction era))
-> GovActionState era -> Identity (GovActionState era)
forall era (f :: * -> *).
Functor f =>
(GovAction era -> f (GovAction era))
-> GovActionState era -> f (GovActionState era)
gasActionL ((GovAction era -> Identity (GovAction era))
 -> GovActionState era -> Identity (GovActionState era))
-> GovAction era -> GovActionState era -> GovActionState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GovAction era -> Maybe GovActionId -> GovAction era
forall era. GovAction era -> Maybe GovActionId -> GovAction era
setActionId (GovActionState era -> GovAction era
forall era. GovActionState era -> GovAction era
gasAction GovActionState era
state) Maybe GovActionId
parent)
  [GovActionState era]
states <- ((Maybe GovActionId, GovActionId) -> Gen (GovActionState era))
-> [(Maybe GovActionId, GovActionId)] -> Gen [GovActionState era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Maybe GovActionId, GovActionId) -> Gen (GovActionState era)
genGovState [(Maybe GovActionId, GovActionId)]
pairs
  Map GovActionId (GovActionState era)
-> Gen (Map GovActionId (GovActionState era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(GovActionId, GovActionState era)]
-> Map GovActionId (GovActionState era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((GovActionState era -> (GovActionId, GovActionState era))
-> [GovActionState era] -> [(GovActionId, GovActionState era)]
forall a b. (a -> b) -> [a] -> [b]
map (\GovActionState era
x -> (GovActionState era -> GovActionId
forall era. GovActionState era -> GovActionId
gasId GovActionState era
x, GovActionState era
x)) [GovActionState era]
states))

genGovAction ::
  forall era.
  Era era =>
  Proof era ->
  GovActionPurpose ->
  Maybe GovActionId ->
  Gen (GovAction era)
genGovAction :: forall era.
Era era =>
Proof era
-> GovActionPurpose -> Maybe GovActionId -> Gen (GovAction era)
genGovAction Proof era
proof GovActionPurpose
purpose Maybe GovActionId
gaid = case GovActionPurpose
purpose of
  GovActionPurpose
PParamUpdatePurpose -> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange (Maybe GovActionId
-> StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
forall (p :: GovActionPurpose) era.
Maybe GovActionId -> StrictMaybe (GovPurposeId p era)
liftId Maybe GovActionId
gaid) (PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era)
-> Gen (PParamsUpdate era)
-> Gen (StrictMaybe ScriptHash -> GovAction era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PParamsUpdateF era -> PParamsUpdate era
forall era. PParamsUpdateF era -> PParamsUpdate era
unPParamsUpdate (PParamsUpdateF era -> PParamsUpdate era)
-> Gen (PParamsUpdateF era) -> Gen (PParamsUpdate era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proof era -> Gen (PParamsUpdateF era)
forall era. Proof era -> Gen (PParamsUpdateF era)
genPParamsUpdate Proof era
proof) Gen (StrictMaybe ScriptHash -> GovAction era)
-> Gen (StrictMaybe ScriptHash) -> Gen (GovAction era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictMaybe ScriptHash)
forall a. Arbitrary a => Gen a
arbitrary
  GovActionPurpose
HardForkPurpose -> StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation (Maybe GovActionId
-> StrictMaybe (GovPurposeId 'HardForkPurpose era)
forall (p :: GovActionPurpose) era.
Maybe GovActionId -> StrictMaybe (GovPurposeId p era)
liftId Maybe GovActionId
gaid) (ProtVer -> GovAction era) -> Gen ProtVer -> Gen (GovAction era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ProtVer
forall a. Arbitrary a => Gen a
arbitrary
  GovActionPurpose
CommitteePurpose ->
    [(Int, Gen (GovAction era))] -> Gen (GovAction era)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
1, GovAction era -> Gen (GovAction era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (Maybe GovActionId
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall (p :: GovActionPurpose) era.
Maybe GovActionId -> StrictMaybe (GovPurposeId p era)
liftId Maybe GovActionId
gaid)))
      ,
        ( Int
1
        , StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole)
-> Map (Credential 'ColdCommitteeRole) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee (Maybe GovActionId
-> StrictMaybe (GovPurposeId 'CommitteePurpose era)
forall (p :: GovActionPurpose) era.
Maybe GovActionId -> StrictMaybe (GovPurposeId p era)
liftId Maybe GovActionId
gaid)
            (Set (Credential 'ColdCommitteeRole)
 -> Map (Credential 'ColdCommitteeRole) EpochNo
 -> UnitInterval
 -> GovAction era)
-> Gen (Set (Credential 'ColdCommitteeRole))
-> Gen
     (Map (Credential 'ColdCommitteeRole) EpochNo
      -> UnitInterval -> GovAction era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t. Int -> Rep era t -> Gen t
genSizedRep @era Int
2 (Rep era (Credential 'ColdCommitteeRole)
-> Rep era (Set (Credential 'ColdCommitteeRole))
forall a era. Ord a => Rep era a -> Rep era (Set a)
SetR Rep era (Credential 'ColdCommitteeRole)
forall era. Era era => Rep era (Credential 'ColdCommitteeRole)
CommColdCredR)
            Gen
  (Map (Credential 'ColdCommitteeRole) EpochNo
   -> UnitInterval -> GovAction era)
-> Gen (Map (Credential 'ColdCommitteeRole) EpochNo)
-> Gen (UnitInterval -> GovAction era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall era t. Int -> Rep era t -> Gen t
genSizedRep @era Int
3 (Rep era (Credential 'ColdCommitteeRole)
-> Rep era EpochNo
-> Rep era (Map (Credential 'ColdCommitteeRole) EpochNo)
forall a era b.
Ord a =>
Rep era a -> Rep era b -> Rep era (Map a b)
MapR Rep era (Credential 'ColdCommitteeRole)
forall era. Era era => Rep era (Credential 'ColdCommitteeRole)
CommColdCredR Rep era EpochNo
forall era. Rep era EpochNo
EpochR)
            Gen (UnitInterval -> GovAction era)
-> Gen UnitInterval -> Gen (GovAction era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UnitInterval
forall a. Arbitrary a => Gen a
arbitrary
        )
      ]
  GovActionPurpose
ConstitutionPurpose -> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
NewConstitution (Maybe GovActionId
-> StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
forall (p :: GovActionPurpose) era.
Maybe GovActionId -> StrictMaybe (GovPurposeId p era)
liftId Maybe GovActionId
gaid) (Constitution era -> GovAction era)
-> Gen (Constitution era) -> Gen (GovAction era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Constitution era)
forall a. Arbitrary a => Gen a
arbitrary

-- ===========================================================================================
-- Make sure that any PParamsUpdate in a Proposal does not change certain crucial parameters
-- We currently generate well formed, but unreasonable ParameterChange GovActions.
-- depending on what kind of Tx you generate, you might want to ensure some PParam fields
-- take on reasonable values for your Tx generator.

mapOMap :: OMap.HasOKey k v => (v -> v) -> OMap.OMap k v -> OMap.OMap k v
mapOMap :: forall k v. HasOKey k v => (v -> v) -> OMap k v -> OMap k v
mapOMap v -> v
f OMap k v
x = (v -> OMap k v -> OMap k v) -> OMap k v -> OMap k v -> OMap k v
forall a b. (a -> b -> b) -> b -> OMap k a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr v -> OMap k v -> OMap k v
accum OMap k v
forall k v. OMap k v
OMap.empty OMap k v
x
  where
    accum :: v -> OMap k v -> OMap k v
accum v
y OMap k v
ys = v -> v
f v
y v -> OMap k v -> OMap k v
forall k v. HasOKey k v => v -> OMap k v -> OMap k v
OMap.<| OMap k v
ys

updateProposals :: (GovAction era -> GovAction era) -> Proposals era -> Proposals era
updateProposals :: forall era.
(GovAction era -> GovAction era) -> Proposals era -> Proposals era
updateProposals GovAction era -> GovAction era
f Proposals era
x = Proposals era
x Proposals era -> (Proposals era -> Proposals era) -> Proposals era
forall a b. a -> (a -> b) -> b
& (OMap GovActionId (GovActionState era)
 -> Identity (OMap GovActionId (GovActionState era)))
-> Proposals era -> Identity (Proposals era)
forall era (f :: * -> *).
Functor f =>
(OMap GovActionId (GovActionState era)
 -> f (OMap GovActionId (GovActionState era)))
-> Proposals era -> f (Proposals era)
pPropsL ((OMap GovActionId (GovActionState era)
  -> Identity (OMap GovActionId (GovActionState era)))
 -> Proposals era -> Identity (Proposals era))
-> (OMap GovActionId (GovActionState era)
    -> OMap GovActionId (GovActionState era))
-> Proposals era
-> Proposals era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((GovActionState era -> GovActionState era)
-> OMap GovActionId (GovActionState era)
-> OMap GovActionId (GovActionState era)
forall k v. HasOKey k v => (v -> v) -> OMap k v -> OMap k v
mapOMap (\GovActionState era
y -> GovActionState era
y GovActionState era
-> (GovActionState era -> GovActionState era) -> GovActionState era
forall a b. a -> (a -> b) -> b
& (GovAction era -> Identity (GovAction era))
-> GovActionState era -> Identity (GovActionState era)
forall era (f :: * -> *).
Functor f =>
(GovAction era -> f (GovAction era))
-> GovActionState era -> f (GovActionState era)
gasActionL ((GovAction era -> Identity (GovAction era))
 -> GovActionState era -> Identity (GovActionState era))
-> (GovAction era -> GovAction era)
-> GovActionState era
-> GovActionState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ GovAction era -> GovAction era
f))

updateGovAction :: (PParamsUpdate era -> PParamsUpdate era) -> GovAction era -> GovAction era
updateGovAction :: forall era.
(PParamsUpdate era -> PParamsUpdate era)
-> GovAction era -> GovAction era
updateGovAction PParamsUpdate era -> PParamsUpdate era
g (ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
x PParamsUpdate era
y StrictMaybe ScriptHash
z) = StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era -> StrictMaybe ScriptHash -> GovAction era
ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
x (PParamsUpdate era -> PParamsUpdate era
g PParamsUpdate era
y) StrictMaybe ScriptHash
z
updateGovAction PParamsUpdate era -> PParamsUpdate era
_ GovAction era
x = GovAction era
x

-- | What is reasonable for a Tx generated in Conway by 'drepCertTx'
-- Well parameters that affect the Fee, the Tx Size, TxOuts, and DRep Deposits
reasonable :: ConwayEraPParams era => Proposals era -> Proposals era
reasonable :: forall era. ConwayEraPParams era => Proposals era -> Proposals era
reasonable =
  (GovAction era -> GovAction era) -> Proposals era -> Proposals era
forall era.
(GovAction era -> GovAction era) -> Proposals era -> Proposals era
updateProposals
    ( (PParamsUpdate era -> PParamsUpdate era)
-> GovAction era -> GovAction era
forall era.
(PParamsUpdate era -> PParamsUpdate era)
-> GovAction era -> GovAction era
updateGovAction
        ( \PParamsUpdate era
x ->
            PParamsUpdate era
x
              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)
ppuMaxTxSizeL ((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
.~ StrictMaybe Word32
forall a. StrictMaybe a
SNothing
              PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
forall a. StrictMaybe a
SNothing
              PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeBL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
forall a. StrictMaybe a
SNothing
              PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Nat -> Identity (StrictMaybe Nat))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Nat)
Lens' (PParamsUpdate era) (StrictMaybe Nat)
ppuMaxValSizeL ((StrictMaybe Nat -> Identity (StrictMaybe Nat))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Nat -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Nat
forall a. StrictMaybe a
SNothing
              PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe CoinPerByte -> Identity (StrictMaybe CoinPerByte))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
BabbageEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CoinPerByte)
Lens' (PParamsUpdate era) (StrictMaybe CoinPerByte)
ppuCoinsPerUTxOByteL ((StrictMaybe CoinPerByte -> Identity (StrictMaybe CoinPerByte))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe CoinPerByte
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe CoinPerByte
forall a. StrictMaybe a
SNothing
              PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe NonNegativeInterval
 -> Identity (StrictMaybe NonNegativeInterval))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
ppuMinFeeRefScriptCostPerByteL ((StrictMaybe NonNegativeInterval
  -> Identity (StrictMaybe NonNegativeInterval))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe NonNegativeInterval
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe NonNegativeInterval
forall a. StrictMaybe a
SNothing
              PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
forall a. StrictMaybe a
SNothing
        )
    )