{-# 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
  { ShelleyTxGenExtra -> GenEnv MockCrypto ShelleyEra
stgeGenEnv :: Gen.GenEnv MockCrypto ShelleyEra
  -- ^ Generator environment.
  , ShelleyTxGenExtra -> SlotNo
stgeStartAt :: SlotNo
  -- ^ Generate no transactions before this slot.
  }

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)
tx GenTx (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)
tx GenTx (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 :: ChainAccountState
ledgerAccount = EpochState ShelleyEra -> ChainAccountState
forall era. EpochState era -> ChainAccountState
SL.esChainAccountState 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)