{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Test.ThreadNet.TxGen.Shelley (
    ShelleyTxGenExtra (..)
  , WhetherToGeneratePPUs (..)
  , genTx
  , mkGenEnv
  ) where

import qualified Cardano.Ledger.Shelley.API as SL
import           Control.Monad.Except (runExcept)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Ledger.Tables.Utils
import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
import           Ouroboros.Consensus.Shelley.Eras (ShelleyEra)
import           Ouroboros.Consensus.Shelley.HFEras ()
import           Ouroboros.Consensus.Shelley.Ledger
import qualified Test.Cardano.Ledger.Shelley.Constants as Gen
import qualified Test.Cardano.Ledger.Shelley.Generator.Core as Gen
import           Test.Cardano.Ledger.Shelley.Generator.EraGen
                     (EraGen (genEraTwoPhase2Arg, genEraTwoPhase3Arg))
import qualified Test.Cardano.Ledger.Shelley.Generator.Presets as Gen.Presets
import           Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import qualified Test.Cardano.Ledger.Shelley.Generator.Utxo as Gen
import           Test.Consensus.Shelley.MockCrypto (MockCrypto)
import           Test.QuickCheck
import           Test.ThreadNet.Infra.Shelley
import           Test.ThreadNet.TxGen (TxGen (..))

data ShelleyTxGenExtra = ShelleyTxGenExtra
  { -- | Generator environment.
    ShelleyTxGenExtra -> GenEnv MockCrypto ShelleyEra
stgeGenEnv  :: Gen.GenEnv MockCrypto ShelleyEra
    -- | Generate no transactions before this slot.
  , ShelleyTxGenExtra -> SlotNo
stgeStartAt :: SlotNo
  }

instance TxGen (ShelleyBlock (TPraos MockCrypto) ShelleyEra) where

  type TxGenExtra (ShelleyBlock (TPraos MockCrypto) ShelleyEra) = ShelleyTxGenExtra

  testGenTxs :: CoreNodeId
-> NumCoreNodes
-> SlotNo
-> TopLevelConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> TxGenExtra (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> LedgerState
     (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
-> Gen [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
testGenTxs CoreNodeId
_coreNodeId NumCoreNodes
_numCoreNodes SlotNo
curSlotNo TopLevelConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
cfg TxGenExtra (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
extra LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
lst
      | SlotNo
stgeStartAt SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
> SlotNo
curSlotNo = [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
-> Gen [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

      -- TODO Temporarily disable the transaction generator until we fix the
      -- failing assertion in TxSubmission.Inbound, see #2680.
      --
      -- When fixed, remove the True case keepig the else case below to re-enable
      -- the transaction generator.

      | Bool
otherwise               =
      if Bool
True
        then [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
-> Gen [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        else do
          n <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
20)
          go [] n
            $ applyDiffs lst
            $ applyChainTick OmitLedgerEvents lcfg curSlotNo
            $ forgetLedgerTables lst
    where
      ShelleyTxGenExtra
        { GenEnv MockCrypto ShelleyEra
stgeGenEnv :: ShelleyTxGenExtra -> GenEnv MockCrypto ShelleyEra
stgeGenEnv :: GenEnv MockCrypto ShelleyEra
stgeGenEnv
        , SlotNo
stgeStartAt :: ShelleyTxGenExtra -> SlotNo
stgeStartAt :: SlotNo
stgeStartAt
        } = TxGenExtra (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
extra

      lcfg :: LedgerConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
      lcfg :: LedgerCfg
  (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
lcfg = TopLevelConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> LedgerCfg
     (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
cfg

      go :: [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]  -- ^ Accumulator
         -> Integer  -- ^ Number of txs to still produce
         -> TickedLedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
         -> Gen [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
      go :: [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
-> Integer
-> TickedLedgerState
     (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
-> Gen [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
go [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
acc Integer
0 TickedLedgerState
  (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
_  = [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
-> Gen [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
-> [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
forall a. [a] -> [a]
reverse [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
acc)
      go [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
acc Integer
n TickedLedgerState
  (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
st = do
        mbTx <- TopLevelConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> SlotNo
-> TickedLedgerState
     (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
-> GenEnv MockCrypto ShelleyEra
-> Gen
     (Maybe (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
genTx TopLevelConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
cfg SlotNo
curSlotNo TickedLedgerState
  (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
st GenEnv MockCrypto ShelleyEra
stgeGenEnv
        case mbTx of
          Maybe (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
Nothing -> [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
-> Gen [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ([GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
-> [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
forall a. [a] -> [a]
reverse [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
acc)  -- cannot afford more transactions
          Just GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
tx -> case Except
  (ApplyTxError ShelleyEra)
  (Ticked
     (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK)
-> Either
     (ApplyTxError ShelleyEra)
     (Ticked
        (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK)
forall e a. Except e a -> Either e a
runExcept (Except
   (ApplyTxError ShelleyEra)
   (Ticked
      (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK)
 -> Either
      (ApplyTxError ShelleyEra)
      (Ticked
         (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
         DiffMK))
-> Except
     (ApplyTxError ShelleyEra)
     (Ticked
        (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK)
-> Either
     (ApplyTxError ShelleyEra)
     (Ticked
        (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK)
forall a b. (a -> b) -> a -> b
$ (Ticked
   (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK,
 Validated (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
-> Ticked
     (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK
forall a b. (a, b) -> a
fst ((Ticked
    (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK,
  Validated (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
 -> Ticked
      (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK)
-> ExceptT
     (ApplyTxError ShelleyEra)
     Identity
     (Ticked
        (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK,
      Validated (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
-> Except
     (ApplyTxError ShelleyEra)
     (Ticked
        (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LedgerCfg
  (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
-> WhetherToIntervene
-> SlotNo
-> GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> TickedLedgerState
     (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
-> Except
     (ApplyTxErr (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
     (Ticked
        (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK,
      Validated (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk ValuesMK
-> Except
     (ApplyTxErr blk)
     (TickedLedgerState blk DiffMK, Validated (GenTx blk))
applyTx LedgerCfg
  (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
lcfg WhetherToIntervene
DoNotIntervene SlotNo
curSlotNo GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
tx TickedLedgerState
  (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
st of
              -- We don't mind generating invalid transactions
              Left  ApplyTxError ShelleyEra
_   -> [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
-> Integer
-> TickedLedgerState
     (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
-> Gen [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
go (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
txGenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
-> [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
forall a. a -> [a] -> [a]
:[GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
acc) (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) TickedLedgerState
  (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
st
              Right Ticked
  (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK
st' -> [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
-> Integer
-> TickedLedgerState
     (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
-> Gen [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
go (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
txGenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
-> [GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
forall a. a -> [a] -> [a]
:[GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)]
acc) (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) (TickedLedgerState
  (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
-> Ticked
     (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK
-> TickedLedgerState
     (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
forall (l :: MapKind -> *) (l' :: MapKind -> *).
(SameUtxoTypes l l', HasLedgerTables l, HasLedgerTables l') =>
l ValuesMK -> l' DiffMK -> l' ValuesMK
applyDiffs TickedLedgerState
  (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
st Ticked
  (LedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra)) DiffMK
st')

genTx ::
     TopLevelConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
  -> SlotNo
  -> TickedLedgerState (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
  -> Gen.GenEnv MockCrypto ShelleyEra
  -> Gen (Maybe (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
genTx :: TopLevelConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> SlotNo
-> TickedLedgerState
     (ShelleyBlock (TPraos MockCrypto) ShelleyEra) ValuesMK
-> GenEnv MockCrypto ShelleyEra
-> Gen
     (Maybe (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
genTx TopLevelConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
_cfg SlotNo
slotNo TickedShelleyLedgerState { NewEpochState ShelleyEra
tickedShelleyLedgerState :: NewEpochState ShelleyEra
tickedShelleyLedgerState :: forall proto era (mk :: MapKind).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> NewEpochState era
tickedShelleyLedgerState } GenEnv MockCrypto ShelleyEra
genEnv =
    GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Maybe (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
forall a. a -> Maybe a
Just (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
 -> Maybe (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
-> (ShelleyTx ShelleyEra
    -> GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
-> ShelleyTx ShelleyEra
-> Maybe (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx ShelleyEra
-> GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
ShelleyTx ShelleyEra
-> GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx (ShelleyTx ShelleyEra
 -> Maybe (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
-> Gen (ShelleyTx ShelleyEra)
-> Gen
     (Maybe (GenTx (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenEnv MockCrypto ShelleyEra
-> LedgerEnv ShelleyEra
-> LedgerState ShelleyEra
-> Gen (Tx ShelleyEra)
forall era c.
(EraGen era, EraUTxO era, Embed (EraRule "DELPL" era) (CERTS era),
 Environment (EraRule "DELPL" era) ~ DelplEnv era,
 State (EraRule "DELPL" era) ~ CertState era,
 Signal (EraRule "DELPL" era) ~ TxCert era, Crypto c) =>
GenEnv c era -> LedgerEnv era -> LedgerState era -> Gen (Tx era)
Gen.genTx
      GenEnv MockCrypto ShelleyEra
genEnv
      LedgerEnv ShelleyEra
ledgerEnv
      (UTxOState ShelleyEra
-> CertState ShelleyEra -> LedgerState ShelleyEra
forall era. UTxOState era -> CertState era -> LedgerState era
SL.LedgerState UTxOState ShelleyEra
utxoSt CertState ShelleyEra
dpState)
  where
    epochState :: SL.EpochState ShelleyEra
    epochState :: EpochState ShelleyEra
epochState = NewEpochState ShelleyEra -> EpochState ShelleyEra
forall era. NewEpochState era -> EpochState era
SL.nesEs NewEpochState ShelleyEra
tickedShelleyLedgerState

    ledgerEnv :: SL.LedgerEnv ShelleyEra
    ledgerEnv :: LedgerEnv ShelleyEra
ledgerEnv = SL.LedgerEnv
      { ledgerEpochNo :: Maybe EpochNo
ledgerEpochNo  = Maybe EpochNo
forall a. Maybe a
Nothing
      , ledgerSlotNo :: SlotNo
ledgerSlotNo   = SlotNo
slotNo
      , ledgerIx :: TxIx
ledgerIx       = TxIx
forall a. Bounded a => a
minBound
      , ledgerPp :: PParams ShelleyEra
ledgerPp       = NewEpochState ShelleyEra -> PParams ShelleyEra
forall era. EraGov era => NewEpochState era -> PParams era
getPParams NewEpochState ShelleyEra
tickedShelleyLedgerState
      , ledgerAccount :: AccountState
ledgerAccount  = EpochState ShelleyEra -> AccountState
forall era. EpochState era -> AccountState
SL.esAccountState EpochState ShelleyEra
epochState
      }

    utxoSt :: SL.UTxOState ShelleyEra
    utxoSt :: UTxOState ShelleyEra
utxoSt =
        LedgerState ShelleyEra -> UTxOState ShelleyEra
forall era. LedgerState era -> UTxOState era
SL.lsUTxOState
      (LedgerState ShelleyEra -> UTxOState ShelleyEra)
-> (EpochState ShelleyEra -> LedgerState ShelleyEra)
-> EpochState ShelleyEra
-> UTxOState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState ShelleyEra -> LedgerState ShelleyEra
forall era. EpochState era -> LedgerState era
SL.esLState
      (EpochState ShelleyEra -> UTxOState ShelleyEra)
-> EpochState ShelleyEra -> UTxOState ShelleyEra
forall a b. (a -> b) -> a -> b
$ EpochState ShelleyEra
epochState

    dpState :: SL.CertState ShelleyEra
    dpState :: CertState ShelleyEra
dpState =
        LedgerState ShelleyEra -> CertState ShelleyEra
forall era. LedgerState era -> CertState era
SL.lsCertState
      (LedgerState ShelleyEra -> CertState ShelleyEra)
-> (EpochState ShelleyEra -> LedgerState ShelleyEra)
-> EpochState ShelleyEra
-> CertState ShelleyEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState ShelleyEra -> LedgerState ShelleyEra
forall era. EpochState era -> LedgerState era
SL.esLState
      (EpochState ShelleyEra -> CertState ShelleyEra)
-> EpochState ShelleyEra -> CertState ShelleyEra
forall a b. (a -> b) -> a -> b
$ EpochState ShelleyEra
epochState

data WhetherToGeneratePPUs = DoNotGeneratePPUs | DoGeneratePPUs
  deriving (Int -> WhetherToGeneratePPUs -> ShowS
[WhetherToGeneratePPUs] -> ShowS
WhetherToGeneratePPUs -> String
(Int -> WhetherToGeneratePPUs -> ShowS)
-> (WhetherToGeneratePPUs -> String)
-> ([WhetherToGeneratePPUs] -> ShowS)
-> Show WhetherToGeneratePPUs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WhetherToGeneratePPUs -> ShowS
showsPrec :: Int -> WhetherToGeneratePPUs -> ShowS
$cshow :: WhetherToGeneratePPUs -> String
show :: WhetherToGeneratePPUs -> String
$cshowList :: [WhetherToGeneratePPUs] -> ShowS
showList :: [WhetherToGeneratePPUs] -> ShowS
Show)

mkGenEnv ::
     WhetherToGeneratePPUs
  -> [CoreNode MockCrypto]
  -> Gen.GenEnv MockCrypto ShelleyEra
mkGenEnv :: WhetherToGeneratePPUs
-> [CoreNode MockCrypto] -> GenEnv MockCrypto ShelleyEra
mkGenEnv WhetherToGeneratePPUs
whetherPPUs [CoreNode MockCrypto]
coreNodes = KeySpace MockCrypto ShelleyEra
-> ScriptSpace ShelleyEra
-> Constants
-> GenEnv MockCrypto ShelleyEra
forall c era.
KeySpace c era -> ScriptSpace era -> Constants -> GenEnv c era
Gen.GenEnv KeySpace MockCrypto ShelleyEra
keySpace ScriptSpace ShelleyEra
scriptSpace Constants
constants
  where
    -- Configuration of the transaction generator
    constants :: Gen.Constants
    constants :: Constants
constants =
        Constants -> Constants
setCerts (Constants -> Constants) -> Constants -> Constants
forall a b. (a -> b) -> a -> b
$
        Constants -> Constants
setPPUs (Constants -> Constants) -> Constants -> Constants
forall a b. (a -> b) -> a -> b
$
        Constants
Gen.defaultConstants
          { Gen.frequencyMIRCert = 0
          , Gen.genTxStableUtxoSize = 100
          , Gen.genTxUtxoIncrement = 3
          }
      where
        -- Testing with certificates requires additional handling in the
        -- testing framework, because, for example, they may transfer block
        -- issuance rights from one node to another, and we must have the
        -- relevant nodes brought online at that point.
        setCerts :: Constants -> Constants
setCerts Constants
cs = Constants
cs{ Gen.maxCertsPerTx = 0 }

        setPPUs :: Constants -> Constants
setPPUs Constants
cs = case WhetherToGeneratePPUs
whetherPPUs of
            WhetherToGeneratePPUs
DoGeneratePPUs    -> Constants
cs
            WhetherToGeneratePPUs
DoNotGeneratePPUs -> Constants
cs{ Gen.frequencyTxUpdates = 0 }

    keySpace :: Gen.KeySpace MockCrypto ShelleyEra
    keySpace :: KeySpace MockCrypto ShelleyEra
keySpace =
      [(GenesisKeyPair MockCrypto,
  AllIssuerKeys MockCrypto 'GenesisDelegate)]
-> [AllIssuerKeys MockCrypto 'GenesisDelegate]
-> [AllIssuerKeys MockCrypto 'StakePool]
-> KeyPairs
-> [(Script ShelleyEra, Script ShelleyEra)]
-> KeySpace MockCrypto ShelleyEra
forall c era.
ScriptClass era =>
[(GenesisKeyPair MockCrypto, AllIssuerKeys c 'GenesisDelegate)]
-> [AllIssuerKeys c 'GenesisDelegate]
-> [AllIssuerKeys c 'StakePool]
-> KeyPairs
-> [(Script era, Script era)]
-> KeySpace c era
Gen.KeySpace
        (CoreNodeKeyInfo MockCrypto
-> (GenesisKeyPair MockCrypto,
    AllIssuerKeys MockCrypto 'GenesisDelegate)
forall c.
CoreNodeKeyInfo c
-> (GenesisKeyPair MockCrypto, AllIssuerKeys c 'GenesisDelegate)
cnkiCoreNode (CoreNodeKeyInfo MockCrypto
 -> (GenesisKeyPair MockCrypto,
     AllIssuerKeys MockCrypto 'GenesisDelegate))
-> [CoreNodeKeyInfo MockCrypto]
-> [(GenesisKeyPair MockCrypto,
     AllIssuerKeys MockCrypto 'GenesisDelegate)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CoreNodeKeyInfo MockCrypto]
cn)
        [AllIssuerKeys MockCrypto 'GenesisDelegate]
ksGenesisDelegates
        [AllIssuerKeys MockCrypto 'StakePool]
ksStakePools
        (KeyPairs
ksKeyPairs KeyPairs -> KeyPairs -> KeyPairs
forall a. Semigroup a => a -> a -> a
<> (CoreNodeKeyInfo MockCrypto -> (KeyPair 'Payment, KeyPair 'Staking)
forall c. CoreNodeKeyInfo c -> (KeyPair 'Payment, KeyPair 'Staking)
cnkiKeyPair (CoreNodeKeyInfo MockCrypto
 -> (KeyPair 'Payment, KeyPair 'Staking))
-> [CoreNodeKeyInfo MockCrypto] -> KeyPairs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CoreNodeKeyInfo MockCrypto]
cn))
        [(Script ShelleyEra, Script ShelleyEra)]
[(MultiSig ShelleyEra, MultiSig ShelleyEra)]
ksMSigScripts
      where
        cn :: [CoreNodeKeyInfo MockCrypto]
cn = CoreNode MockCrypto -> CoreNodeKeyInfo MockCrypto
forall c. CoreNode c -> CoreNodeKeyInfo c
coreNodeKeys (CoreNode MockCrypto -> CoreNodeKeyInfo MockCrypto)
-> [CoreNode MockCrypto] -> [CoreNodeKeyInfo MockCrypto]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CoreNode MockCrypto]
coreNodes
        Gen.KeySpace_
          { KeyPairs
ksKeyPairs :: KeyPairs
ksKeyPairs :: forall c era. KeySpace c era -> KeyPairs
ksKeyPairs,
            [(Script ShelleyEra, Script ShelleyEra)]
ksMSigScripts :: [(Script ShelleyEra, Script ShelleyEra)]
ksMSigScripts :: forall c era. KeySpace c era -> [(Script era, Script era)]
ksMSigScripts,
            [AllIssuerKeys MockCrypto 'GenesisDelegate]
ksGenesisDelegates :: [AllIssuerKeys MockCrypto 'GenesisDelegate]
ksGenesisDelegates :: forall c era. KeySpace c era -> [AllIssuerKeys c 'GenesisDelegate]
ksGenesisDelegates,
            [AllIssuerKeys MockCrypto 'StakePool]
ksStakePools :: [AllIssuerKeys MockCrypto 'StakePool]
ksStakePools :: forall c era. KeySpace c era -> [AllIssuerKeys c 'StakePool]
ksStakePools
          } =
            forall era c. (EraGen era, Crypto c) => Constants -> KeySpace c era
Gen.Presets.keySpace @ShelleyEra Constants
constants

    scriptSpace :: Gen.ScriptSpace ShelleyEra
    scriptSpace :: ScriptSpace ShelleyEra
scriptSpace =
      forall era.
EraScript era =>
[TwoPhase3ArgInfo era] -> [TwoPhase2ArgInfo era] -> ScriptSpace era
Gen.Presets.scriptSpace @ShelleyEra
           (forall era. EraGen era => [TwoPhase3ArgInfo era]
genEraTwoPhase3Arg @ShelleyEra)
           (forall era. EraGen era => [TwoPhase2ArgInfo era]
genEraTwoPhase2Arg @ShelleyEra)