{-# 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           Cardano.Crypto.Hash (HashAlgorithm)
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.Protocol.TPraos (TPraos)
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, MockShelley)
import           Test.QuickCheck
import           Test.ThreadNet.Infra.Shelley
import           Test.ThreadNet.TxGen (TxGen (..))

data ShelleyTxGenExtra h = ShelleyTxGenExtra
  { -- | Generator environment.
    forall h. ShelleyTxGenExtra h -> GenEnv (MockShelley h)
stgeGenEnv  :: Gen.GenEnv (MockShelley h)
    -- | Generate no transactions before this slot.
  , forall h. ShelleyTxGenExtra h -> SlotNo
stgeStartAt :: SlotNo
  }

instance HashAlgorithm h => TxGen (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)) where

  type TxGenExtra (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)) = ShelleyTxGenExtra h

  testGenTxs :: CoreNodeId
-> NumCoreNodes
-> SlotNo
-> TopLevelConfig
     (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
-> TxGenExtra
     (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
-> LedgerState
     (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
-> Gen
     [GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))]
testGenTxs CoreNodeId
_coreNodeId NumCoreNodes
_numCoreNodes SlotNo
curSlotNo TopLevelConfig
  (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
cfg TxGenExtra (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
extra LedgerState (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
lst
      | SlotNo
stgeStartAt SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
> SlotNo
curSlotNo = [GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))]
-> Gen
     [GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))]
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 h)) (MockShelley h))]
-> Gen
     [GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        else do
          Integer
n <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
20)
          [GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))]
-> Integer
-> TickedLedgerState
     (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
-> Gen
     [GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))]
go [] Integer
n (TickedLedgerState
   (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
 -> Gen
      [GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))])
-> TickedLedgerState
     (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
-> Gen
     [GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))]
forall a b. (a -> b) -> a -> b
$ LedgerCfg
  (LedgerState
     (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)))
-> SlotNo
-> LedgerState
     (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
-> TickedLedgerState
     (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
forall l. IsLedger l => LedgerCfg l -> SlotNo -> l -> Ticked l
applyChainTick LedgerCfg
  (LedgerState
     (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)))
lcfg SlotNo
curSlotNo LedgerState (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
lst
    where
      ShelleyTxGenExtra
        { GenEnv (MockShelley h)
stgeGenEnv :: forall h. ShelleyTxGenExtra h -> GenEnv (MockShelley h)
stgeGenEnv :: GenEnv (MockShelley h)
stgeGenEnv
        , SlotNo
stgeStartAt :: forall h. ShelleyTxGenExtra h -> SlotNo
stgeStartAt :: SlotNo
stgeStartAt
        } = TxGenExtra (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
extra

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

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

genTx ::
     forall h. HashAlgorithm h
  => TopLevelConfig (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
  -> SlotNo
  -> TickedLedgerState (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
  -> Gen.GenEnv (MockShelley h)
  -> Gen (Maybe (GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))))
genTx :: forall h.
HashAlgorithm h =>
TopLevelConfig
  (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
-> SlotNo
-> TickedLedgerState
     (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
-> GenEnv (MockShelley h)
-> Gen
     (Maybe
        (GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))))
genTx TopLevelConfig
  (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
_cfg SlotNo
slotNo TickedShelleyLedgerState { NewEpochState (MockShelley h)
tickedShelleyLedgerState :: NewEpochState (MockShelley h)
tickedShelleyLedgerState :: forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> NewEpochState era
tickedShelleyLedgerState } GenEnv (MockShelley h)
genEnv =
    GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
-> Maybe
     (GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)))
forall a. a -> Maybe a
Just (GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
 -> Maybe
      (GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))))
-> (ShelleyTx (MockShelley h)
    -> GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)))
-> ShelleyTx (MockShelley h)
-> Maybe
     (GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx (MockShelley h)
-> GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
ShelleyTx (MockShelley h)
-> GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx (ShelleyTx (MockShelley h)
 -> Maybe
      (GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))))
-> Gen (ShelleyTx (MockShelley h))
-> Gen
     (Maybe
        (GenTx (ShelleyBlock (TPraos (MockCrypto h)) (MockShelley h))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenEnv (MockShelley h)
-> LedgerEnv (MockShelley h)
-> LedgerState (MockShelley h)
-> Gen (Tx (MockShelley h))
forall era.
(EraGen era, EraUTxO era, Mock (EraCrypto 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) =>
GenEnv era -> LedgerEnv era -> LedgerState era -> Gen (Tx era)
Gen.genTx
      GenEnv (MockShelley h)
genEnv
      LedgerEnv (MockShelley h)
ledgerEnv
      (UTxOState (MockShelley h)
-> CertState (MockShelley h) -> LedgerState (MockShelley h)
forall era. UTxOState era -> CertState era -> LedgerState era
SL.LedgerState UTxOState (MockShelley h)
utxoSt CertState (MockShelley h)
dpState)
  where
    epochState :: SL.EpochState (MockShelley h)
    epochState :: EpochState (MockShelley h)
epochState = NewEpochState (MockShelley h) -> EpochState (MockShelley h)
forall era. NewEpochState era -> EpochState era
SL.nesEs NewEpochState (MockShelley h)
tickedShelleyLedgerState

    ledgerEnv :: SL.LedgerEnv (MockShelley h)
    ledgerEnv :: LedgerEnv (MockShelley h)
ledgerEnv = SL.LedgerEnv {
        ledgerSlotNo :: SlotNo
ledgerSlotNo   = SlotNo
slotNo
      , ledgerIx :: TxIx
ledgerIx       = TxIx
forall a. Bounded a => a
minBound
      , ledgerPp :: PParams (MockShelley h)
ledgerPp       = NewEpochState (MockShelley h) -> PParams (MockShelley h)
forall era. EraGov era => NewEpochState era -> PParams era
getPParams NewEpochState (MockShelley h)
tickedShelleyLedgerState
      , ledgerAccount :: AccountState
ledgerAccount  = EpochState (MockShelley h) -> AccountState
forall era. EpochState era -> AccountState
SL.esAccountState EpochState (MockShelley h)
epochState
      , ledgerMempool :: Bool
ledgerMempool  = Bool
True
      }

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

    dpState :: SL.CertState (MockShelley h)
    dpState :: CertState (MockShelley h)
dpState =
        LedgerState (MockShelley h) -> CertState (MockShelley h)
forall era. LedgerState era -> CertState era
SL.lsCertState
      (LedgerState (MockShelley h) -> CertState (MockShelley h))
-> (EpochState (MockShelley h) -> LedgerState (MockShelley h))
-> EpochState (MockShelley h)
-> CertState (MockShelley h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochState (MockShelley h) -> LedgerState (MockShelley h)
forall era. EpochState era -> LedgerState era
SL.esLState
      (EpochState (MockShelley h) -> CertState (MockShelley h))
-> EpochState (MockShelley h) -> CertState (MockShelley h)
forall a b. (a -> b) -> a -> b
$ EpochState (MockShelley h)
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 ::
     forall h. HashAlgorithm h
  => WhetherToGeneratePPUs
  -> [CoreNode (MockCrypto h)]
  -> Gen.GenEnv (MockShelley h)
mkGenEnv :: forall h.
HashAlgorithm h =>
WhetherToGeneratePPUs
-> [CoreNode (MockCrypto h)] -> GenEnv (MockShelley h)
mkGenEnv WhetherToGeneratePPUs
whetherPPUs [CoreNode (MockCrypto h)]
coreNodes = KeySpace (MockShelley h)
-> ScriptSpace (MockShelley h)
-> Constants
-> GenEnv (MockShelley h)
forall era.
KeySpace era -> ScriptSpace era -> Constants -> GenEnv era
Gen.GenEnv KeySpace (MockShelley h)
keySpace ScriptSpace (MockShelley h)
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 (MockShelley h)
    keySpace :: KeySpace (MockShelley h)
keySpace =
      [(GenesisKeyPair (EraCrypto (MockShelley h)),
  AllIssuerKeys (EraCrypto (MockShelley h)) 'GenesisDelegate)]
-> [AllIssuerKeys (EraCrypto (MockShelley h)) 'GenesisDelegate]
-> [AllIssuerKeys (EraCrypto (MockShelley h)) 'StakePool]
-> KeyPairs (EraCrypto (MockShelley h))
-> [(Script (MockShelley h), Script (MockShelley h))]
-> KeySpace (MockShelley h)
forall era.
ScriptClass era =>
[(GenesisKeyPair (EraCrypto era),
  AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
-> [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
-> [AllIssuerKeys (EraCrypto era) 'StakePool]
-> KeyPairs (EraCrypto era)
-> [(Script era, Script era)]
-> KeySpace era
Gen.KeySpace
        (CoreNodeKeyInfo (MockCrypto h)
-> (KeyPair 'Genesis (MockCrypto h),
    AllIssuerKeys (MockCrypto h) 'GenesisDelegate)
forall c.
CoreNodeKeyInfo c
-> (KeyPair 'Genesis c, AllIssuerKeys c 'GenesisDelegate)
cnkiCoreNode (CoreNodeKeyInfo (MockCrypto h)
 -> (KeyPair 'Genesis (MockCrypto h),
     AllIssuerKeys (MockCrypto h) 'GenesisDelegate))
-> [CoreNodeKeyInfo (MockCrypto h)]
-> [(KeyPair 'Genesis (MockCrypto h),
     AllIssuerKeys (MockCrypto h) 'GenesisDelegate)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CoreNodeKeyInfo (MockCrypto h)]
cn)
        [AllIssuerKeys (EraCrypto (MockShelley h)) 'GenesisDelegate]
ksGenesisDelegates
        [AllIssuerKeys (EraCrypto (MockShelley h)) 'StakePool]
ksStakePools
        (KeyPairs (EraCrypto (MockShelley h))
[(KeyPair 'Payment (MockCrypto h),
  KeyPair 'Staking (MockCrypto h))]
ksKeyPairs [(KeyPair 'Payment (MockCrypto h),
  KeyPair 'Staking (MockCrypto h))]
-> [(KeyPair 'Payment (MockCrypto h),
     KeyPair 'Staking (MockCrypto h))]
-> [(KeyPair 'Payment (MockCrypto h),
     KeyPair 'Staking (MockCrypto h))]
forall a. Semigroup a => a -> a -> a
<> (CoreNodeKeyInfo (MockCrypto h)
-> (KeyPair 'Payment (MockCrypto h),
    KeyPair 'Staking (MockCrypto h))
forall c.
CoreNodeKeyInfo c -> (KeyPair 'Payment c, KeyPair 'Staking c)
cnkiKeyPair (CoreNodeKeyInfo (MockCrypto h)
 -> (KeyPair 'Payment (MockCrypto h),
     KeyPair 'Staking (MockCrypto h)))
-> [CoreNodeKeyInfo (MockCrypto h)]
-> [(KeyPair 'Payment (MockCrypto h),
     KeyPair 'Staking (MockCrypto h))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CoreNodeKeyInfo (MockCrypto h)]
cn))
        [(Script (MockShelley h), Script (MockShelley h))]
ksMSigScripts
      where
        cn :: [CoreNodeKeyInfo (MockCrypto h)]
cn = CoreNode (MockCrypto h) -> CoreNodeKeyInfo (MockCrypto h)
forall c. PraosCrypto c => CoreNode c -> CoreNodeKeyInfo c
coreNodeKeys (CoreNode (MockCrypto h) -> CoreNodeKeyInfo (MockCrypto h))
-> [CoreNode (MockCrypto h)] -> [CoreNodeKeyInfo (MockCrypto h)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CoreNode (MockCrypto h)]
coreNodes
        Gen.KeySpace_
          { KeyPairs (EraCrypto (MockShelley h))
ksKeyPairs :: KeyPairs (EraCrypto (MockShelley h))
ksKeyPairs :: forall era. KeySpace era -> KeyPairs (EraCrypto era)
ksKeyPairs,
            [(Script (MockShelley h), Script (MockShelley h))]
ksMSigScripts :: [(Script (MockShelley h), Script (MockShelley h))]
ksMSigScripts :: forall era. KeySpace era -> [(Script era, Script era)]
ksMSigScripts,
            [AllIssuerKeys (EraCrypto (MockShelley h)) 'GenesisDelegate]
ksGenesisDelegates :: [AllIssuerKeys (EraCrypto (MockShelley h)) 'GenesisDelegate]
ksGenesisDelegates :: forall era.
KeySpace era -> [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
ksGenesisDelegates,
            [AllIssuerKeys (EraCrypto (MockShelley h)) 'StakePool]
ksStakePools :: [AllIssuerKeys (EraCrypto (MockShelley h)) 'StakePool]
ksStakePools :: forall era.
KeySpace era -> [AllIssuerKeys (EraCrypto era) 'StakePool]
ksStakePools
          } =
            forall era. EraGen era => Constants -> KeySpace era
Gen.Presets.keySpace @(MockShelley h) Constants
constants

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