{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Babbage.Arbitrary () where

import Cardano.Ledger.Babbage
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.PParams
import Cardano.Ledger.Babbage.Rules (BabbageUtxoPredFailure (..), BabbageUtxowPredFailure (..))
import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..))
import Cardano.Ledger.Babbage.TxInfo (BabbageContextError (..))
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Plutus
import Control.State.Transition (STS (PredicateFailure))
import Data.Functor.Identity (Identity)
import Generic.Random (genericArbitraryU)
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
import Test.Cardano.Ledger.Core.Arbitrary (genValidCostModels)
import Test.QuickCheck

deriving instance Arbitrary CoinPerByte

instance Arbitrary (BabbagePParams Identity era) where
  arbitrary :: Gen (BabbagePParams Identity era)
arbitrary =
    HKD Identity Coin
-> HKD Identity Coin
-> HKD Identity Word32
-> HKD Identity Word32
-> HKD Identity Word16
-> HKD Identity Coin
-> HKD Identity Coin
-> HKD Identity EpochInterval
-> HKD Identity Word16
-> HKD Identity NonNegativeInterval
-> HKD Identity UnitInterval
-> HKD Identity UnitInterval
-> HKD Identity ProtVer
-> HKD Identity Coin
-> HKD Identity CoinPerByte
-> HKD Identity CostModels
-> HKD Identity Prices
-> HKD Identity OrdExUnits
-> HKD Identity OrdExUnits
-> HKD Identity Natural
-> HKD Identity Natural
-> HKD Identity Natural
-> BabbagePParams Identity era
Coin
-> Coin
-> Word32
-> Word32
-> Word16
-> Coin
-> Coin
-> EpochInterval
-> Word16
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> ProtVer
-> Coin
-> CoinPerByte
-> CostModels
-> Prices
-> OrdExUnits
-> OrdExUnits
-> Natural
-> Natural
-> Natural
-> BabbagePParams Identity era
forall (f :: * -> *) era.
HKD f Coin
-> HKD f Coin
-> HKD f Word32
-> HKD f Word32
-> HKD f Word16
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochInterval
-> HKD f Word16
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f ProtVer
-> HKD f Coin
-> HKD f CoinPerByte
-> HKD f CostModels
-> HKD f Prices
-> HKD f OrdExUnits
-> HKD f OrdExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> BabbagePParams f era
BabbagePParams
      (Coin
 -> Coin
 -> Word32
 -> Word32
 -> Word16
 -> Coin
 -> Coin
 -> EpochInterval
 -> Word16
 -> NonNegativeInterval
 -> UnitInterval
 -> UnitInterval
 -> ProtVer
 -> Coin
 -> CoinPerByte
 -> CostModels
 -> Prices
 -> OrdExUnits
 -> OrdExUnits
 -> Natural
 -> Natural
 -> Natural
 -> BabbagePParams Identity era)
-> Gen Coin
-> Gen
     (Coin
      -> Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen Coin
-> Gen
     (Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen Word32
-> Gen
     (Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 Word32
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen Word32
-> Gen
     (Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 Word32
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen Word16
-> Gen
     (Coin
      -> Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 Word16
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen Coin
-> Gen
     (Coin
      -> EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen Coin
-> Gen
     (EpochInterval
      -> Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (EpochInterval
   -> Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen EpochInterval
-> Gen
     (Word16
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 EpochInterval
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Word16
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen Word16
-> Gen
     (NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 Word16
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen NonNegativeInterval
-> Gen
     (UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 NonNegativeInterval
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen UnitInterval
-> Gen
     (UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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
      Gen
  (UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen UnitInterval
-> Gen
     (ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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
      Gen
  (ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen ProtVer
-> Gen
     (Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 ProtVer
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen Coin
-> Gen
     (CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen CoinPerByte
-> Gen
     (CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 CoinPerByte
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen CostModels
-> Gen
     (Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Language -> Gen CostModels
genValidCostModels [Item (Set Language)
Language
PlutusV1, Item (Set Language)
Language
PlutusV2]
      Gen
  (Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen Prices
-> Gen
     (OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> BabbagePParams Identity 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 Prices
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> BabbagePParams Identity era)
-> Gen OrdExUnits
-> Gen
     (OrdExUnits
      -> Natural -> Natural -> Natural -> BabbagePParams Identity 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 OrdExUnits
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (OrdExUnits
   -> Natural -> Natural -> Natural -> BabbagePParams Identity era)
-> Gen OrdExUnits
-> Gen
     (Natural -> Natural -> Natural -> BabbagePParams Identity 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 OrdExUnits
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Natural -> Natural -> Natural -> BabbagePParams Identity era)
-> Gen Natural
-> Gen (Natural -> Natural -> BabbagePParams Identity 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 Natural
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Natural -> Natural -> BabbagePParams Identity era)
-> Gen Natural -> Gen (Natural -> BabbagePParams Identity 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 Natural
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Natural -> BabbagePParams Identity era)
-> Gen Natural -> Gen (BabbagePParams Identity 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 Natural
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (BabbagePParams StrictMaybe era) where
  arbitrary :: Gen (BabbagePParams StrictMaybe era)
arbitrary =
    StrictMaybe Coin
-> StrictMaybe Coin
-> StrictMaybe Word32
-> StrictMaybe Word32
-> StrictMaybe Word16
-> StrictMaybe Coin
-> StrictMaybe Coin
-> StrictMaybe EpochInterval
-> StrictMaybe Word16
-> StrictMaybe NonNegativeInterval
-> StrictMaybe UnitInterval
-> StrictMaybe UnitInterval
-> StrictMaybe ProtVer
-> StrictMaybe Coin
-> StrictMaybe CoinPerByte
-> StrictMaybe CostModels
-> StrictMaybe Prices
-> StrictMaybe OrdExUnits
-> StrictMaybe OrdExUnits
-> StrictMaybe Natural
-> StrictMaybe Natural
-> StrictMaybe Natural
-> BabbagePParams StrictMaybe era
HKD StrictMaybe Coin
-> HKD StrictMaybe Coin
-> HKD StrictMaybe Word32
-> HKD StrictMaybe Word32
-> HKD StrictMaybe Word16
-> HKD StrictMaybe Coin
-> HKD StrictMaybe Coin
-> HKD StrictMaybe EpochInterval
-> HKD StrictMaybe Word16
-> HKD StrictMaybe NonNegativeInterval
-> HKD StrictMaybe UnitInterval
-> HKD StrictMaybe UnitInterval
-> HKD StrictMaybe ProtVer
-> HKD StrictMaybe Coin
-> HKD StrictMaybe CoinPerByte
-> HKD StrictMaybe CostModels
-> HKD StrictMaybe Prices
-> HKD StrictMaybe OrdExUnits
-> HKD StrictMaybe OrdExUnits
-> HKD StrictMaybe Natural
-> HKD StrictMaybe Natural
-> HKD StrictMaybe Natural
-> BabbagePParams StrictMaybe era
forall (f :: * -> *) era.
HKD f Coin
-> HKD f Coin
-> HKD f Word32
-> HKD f Word32
-> HKD f Word16
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochInterval
-> HKD f Word16
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f ProtVer
-> HKD f Coin
-> HKD f CoinPerByte
-> HKD f CostModels
-> HKD f Prices
-> HKD f OrdExUnits
-> HKD f OrdExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> BabbagePParams f era
BabbagePParams
      (StrictMaybe Coin
 -> StrictMaybe Coin
 -> StrictMaybe Word32
 -> StrictMaybe Word32
 -> StrictMaybe Word16
 -> StrictMaybe Coin
 -> StrictMaybe Coin
 -> StrictMaybe EpochInterval
 -> StrictMaybe Word16
 -> StrictMaybe NonNegativeInterval
 -> StrictMaybe UnitInterval
 -> StrictMaybe UnitInterval
 -> StrictMaybe ProtVer
 -> StrictMaybe Coin
 -> StrictMaybe CoinPerByte
 -> StrictMaybe CostModels
 -> StrictMaybe Prices
 -> StrictMaybe OrdExUnits
 -> StrictMaybe OrdExUnits
 -> StrictMaybe Natural
 -> StrictMaybe Natural
 -> StrictMaybe Natural
 -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Coin)
-> Gen
     (StrictMaybe Coin
      -> StrictMaybe Word32
      -> StrictMaybe Word32
      -> StrictMaybe Word16
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe EpochInterval
      -> StrictMaybe Word16
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (StrictMaybe Coin)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe Coin
   -> StrictMaybe Word32
   -> StrictMaybe Word32
   -> StrictMaybe Word16
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe EpochInterval
   -> StrictMaybe Word16
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Coin)
-> Gen
     (StrictMaybe Word32
      -> StrictMaybe Word32
      -> StrictMaybe Word16
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe EpochInterval
      -> StrictMaybe Word16
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 Coin)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe Word32
   -> StrictMaybe Word32
   -> StrictMaybe Word16
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe EpochInterval
   -> StrictMaybe Word16
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Word32)
-> Gen
     (StrictMaybe Word32
      -> StrictMaybe Word16
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe EpochInterval
      -> StrictMaybe Word16
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 Word32)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe Word32
   -> StrictMaybe Word16
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe EpochInterval
   -> StrictMaybe Word16
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Word32)
-> Gen
     (StrictMaybe Word16
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe EpochInterval
      -> StrictMaybe Word16
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 Word32)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe Word16
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe EpochInterval
   -> StrictMaybe Word16
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Word16)
-> Gen
     (StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe EpochInterval
      -> StrictMaybe Word16
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 Word16)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe EpochInterval
   -> StrictMaybe Word16
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Coin)
-> Gen
     (StrictMaybe Coin
      -> StrictMaybe EpochInterval
      -> StrictMaybe Word16
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 Coin)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe Coin
   -> StrictMaybe EpochInterval
   -> StrictMaybe Word16
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Coin)
-> Gen
     (StrictMaybe EpochInterval
      -> StrictMaybe Word16
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 Coin)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe EpochInterval
   -> StrictMaybe Word16
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe EpochInterval)
-> Gen
     (StrictMaybe Word16
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 EpochInterval)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe Word16
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Word16)
-> Gen
     (StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 Word16)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe NonNegativeInterval)
-> Gen
     (StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 NonNegativeInterval)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe UnitInterval)
-> Gen
     (StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 UnitInterval)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe UnitInterval)
-> Gen
     (StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 UnitInterval)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe ProtVer)
-> Gen
     (StrictMaybe Coin
      -> StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 ProtVer)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe Coin
   -> StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Coin)
-> Gen
     (StrictMaybe CoinPerByte
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 Coin)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe CoinPerByte
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe CoinPerByte)
-> Gen
     (StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 CoinPerByte)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe CostModels)
-> Gen
     (StrictMaybe Prices
      -> StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 CostModels)] -> Gen (StrictMaybe CostModels)
forall a. HasCallStack => [Gen a] -> Gen a
oneof [StrictMaybe CostModels -> Gen (StrictMaybe CostModels)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe CostModels
forall a. StrictMaybe a
SNothing, CostModels -> StrictMaybe CostModels
forall a. a -> StrictMaybe a
SJust (CostModels -> StrictMaybe CostModels)
-> Gen CostModels -> Gen (StrictMaybe CostModels)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Language -> Gen CostModels
genValidCostModels [Item (Set Language)
Language
PlutusV1, Item (Set Language)
Language
PlutusV2]]
      Gen
  (StrictMaybe Prices
   -> StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Prices)
-> Gen
     (StrictMaybe OrdExUnits
      -> StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 Prices)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe OrdExUnits
   -> StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe OrdExUnits)
-> Gen
     (StrictMaybe OrdExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 OrdExUnits)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe OrdExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe OrdExUnits)
-> Gen
     (StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> BabbagePParams StrictMaybe 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 OrdExUnits)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Natural)
-> Gen
     (StrictMaybe Natural
      -> StrictMaybe Natural -> BabbagePParams StrictMaybe 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 Natural)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe Natural
   -> StrictMaybe Natural -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Natural)
-> Gen (StrictMaybe Natural -> BabbagePParams StrictMaybe 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 Natural)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (StrictMaybe Natural -> BabbagePParams StrictMaybe era)
-> Gen (StrictMaybe Natural)
-> Gen (BabbagePParams StrictMaybe 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 Natural)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary TxOutSource where
  arbitrary :: Gen TxOutSource
arbitrary = Gen TxOutSource
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU

instance
  ( Era era
  , Arbitrary (PlutusPurpose AsIx era)
  ) =>
  Arbitrary (BabbageContextError era)
  where
  -- Switch to this implementation once #4110 is taken care of
  -- arbitrary = genericArbitraryU
  arbitrary :: Gen (BabbageContextError era)
arbitrary =
    [Gen (BabbageContextError era)] -> Gen (BabbageContextError era)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ AlonzoContextError era -> BabbageContextError era
forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError (AlonzoContextError era -> BabbageContextError era)
-> Gen (AlonzoContextError era) -> Gen (BabbageContextError era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (AlonzoContextError era)
forall a. Arbitrary a => Gen a
arbitrary
      , TxOutSource -> BabbageContextError era
forall era. TxOutSource -> BabbageContextError era
ByronTxOutInContext (TxOutSource -> BabbageContextError era)
-> Gen TxOutSource -> Gen (BabbageContextError era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxOutSource
forall a. Arbitrary a => Gen a
arbitrary
      , -- , RedeemerPointerPointsToNothing <$> arbitrary -- see #4110
        TxOutSource -> BabbageContextError era
forall era. TxOutSource -> BabbageContextError era
InlineDatumsNotSupported (TxOutSource -> BabbageContextError era)
-> Gen TxOutSource -> Gen (BabbageContextError era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxOutSource
forall a. Arbitrary a => Gen a
arbitrary
      , TxOutSource -> BabbageContextError era
forall era. TxOutSource -> BabbageContextError era
ReferenceScriptsNotSupported (TxOutSource -> BabbageContextError era)
-> Gen TxOutSource -> Gen (BabbageContextError era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxOutSource
forall a. Arbitrary a => Gen a
arbitrary
      , Set TxIn -> BabbageContextError era
forall era. Set TxIn -> BabbageContextError era
ReferenceInputsNotSupported (Set TxIn -> BabbageContextError era)
-> Gen (Set TxIn) -> Gen (BabbageContextError era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set TxIn)
forall a. Arbitrary a => Gen a
arbitrary
      ]

instance
  ( EraTxOut era
  , Arbitrary (Value era)
  , Arbitrary (TxOut era)
  , Arbitrary (PredicateFailure (EraRule "UTXOS" era))
  ) =>
  Arbitrary (BabbageUtxoPredFailure era)
  where
  arbitrary :: Gen (BabbageUtxoPredFailure era)
arbitrary = Gen (BabbageUtxoPredFailure era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU

instance
  ( Era era
  , Arbitrary (PredicateFailure (EraRule "UTXO" era))
  , Arbitrary (TxCert era)
  , Arbitrary (PlutusPurpose AsItem era)
  , Arbitrary (PlutusPurpose AsIx era)
  ) =>
  Arbitrary (BabbageUtxowPredFailure era)
  where
  arbitrary :: Gen (BabbageUtxowPredFailure era)
arbitrary = Gen (BabbageUtxowPredFailure era)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU

instance
  ( EraTxOut era
  , Arbitrary (Value era)
  , Arbitrary (Script era)
  ) =>
  Arbitrary (BabbageTxOut era)
  where
  arbitrary :: Gen (BabbageTxOut era)
arbitrary =
    Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut
      (Addr
 -> Value era
 -> Datum era
 -> StrictMaybe (Script era)
 -> BabbageTxOut era)
-> Gen Addr
-> Gen
     (Value era
      -> Datum era -> StrictMaybe (Script era) -> BabbageTxOut era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Addr
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Value era
   -> Datum era -> StrictMaybe (Script era) -> BabbageTxOut era)
-> Gen (Value era)
-> Gen (Datum era -> StrictMaybe (Script era) -> BabbageTxOut era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int) -> Gen (Value era) -> Gen (Value era)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
15) Gen (Value era)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Datum era -> StrictMaybe (Script era) -> BabbageTxOut era)
-> Gen (Datum era)
-> Gen (StrictMaybe (Script era) -> BabbageTxOut 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 (Datum era)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (StrictMaybe (Script era) -> BabbageTxOut era)
-> Gen (StrictMaybe (Script era)) -> Gen (BabbageTxOut 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 (Script era))
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (TxBody BabbageEra) where
  arbitrary :: Gen (TxBody BabbageEra)
arbitrary =
    Set TxIn
-> Set TxIn
-> Set TxIn
-> StrictSeq (Sized (TxOut BabbageEra))
-> StrictMaybe (Sized (TxOut BabbageEra))
-> StrictMaybe Coin
-> StrictSeq (TxCert BabbageEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update BabbageEra)
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> TxBody BabbageEra
Set TxIn
-> Set TxIn
-> Set TxIn
-> StrictSeq (Sized (BabbageTxOut BabbageEra))
-> StrictMaybe (Sized (BabbageTxOut BabbageEra))
-> StrictMaybe Coin
-> StrictSeq (ShelleyTxCert BabbageEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update BabbageEra)
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> TxBody BabbageEra
BabbageTxBody
      (Set TxIn
 -> Set TxIn
 -> Set TxIn
 -> StrictSeq (Sized (BabbageTxOut BabbageEra))
 -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
 -> StrictMaybe Coin
 -> StrictSeq (ShelleyTxCert BabbageEra)
 -> Withdrawals
 -> Coin
 -> ValidityInterval
 -> StrictMaybe (Update BabbageEra)
 -> Set (KeyHash 'Witness)
 -> MultiAsset
 -> StrictMaybe ScriptIntegrityHash
 -> StrictMaybe TxAuxDataHash
 -> StrictMaybe Network
 -> TxBody BabbageEra)
-> Gen (Set TxIn)
-> Gen
     (Set TxIn
      -> Set TxIn
      -> StrictSeq (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe Coin
      -> StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set TxIn)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Set TxIn
   -> Set TxIn
   -> StrictSeq (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe Coin
   -> StrictSeq (ShelleyTxCert BabbageEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (Set TxIn)
-> Gen
     (Set TxIn
      -> StrictSeq (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe Coin
      -> StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Set TxIn)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Set TxIn
   -> StrictSeq (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe Coin
   -> StrictSeq (ShelleyTxCert BabbageEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (Set TxIn)
-> Gen
     (StrictSeq (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe Coin
      -> StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Set TxIn)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictSeq (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe Coin
   -> StrictSeq (ShelleyTxCert BabbageEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (StrictSeq (Sized (BabbageTxOut BabbageEra)))
-> Gen
     (StrictMaybe (Sized (BabbageTxOut BabbageEra))
      -> StrictMaybe Coin
      -> StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictSeq (Sized (BabbageTxOut BabbageEra)))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe (Sized (BabbageTxOut BabbageEra))
   -> StrictMaybe Coin
   -> StrictSeq (ShelleyTxCert BabbageEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (StrictMaybe (Sized (BabbageTxOut BabbageEra)))
-> Gen
     (StrictMaybe Coin
      -> StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
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 (Sized (BabbageTxOut BabbageEra)))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe Coin
   -> StrictSeq (ShelleyTxCert BabbageEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (StrictMaybe Coin)
-> Gen
     (StrictSeq (ShelleyTxCert BabbageEra)
      -> Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
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 Coin)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictSeq (ShelleyTxCert BabbageEra)
   -> Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (StrictSeq (ShelleyTxCert BabbageEra))
-> Gen
     (Withdrawals
      -> Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StrictSeq (ShelleyTxCert BabbageEra))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Withdrawals
   -> Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen Withdrawals
-> Gen
     (Coin
      -> ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Withdrawals
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Coin
   -> ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen Coin
-> Gen
     (ValidityInterval
      -> StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (ValidityInterval
   -> StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen ValidityInterval
-> Gen
     (StrictMaybe (Update BabbageEra)
      -> Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ValidityInterval
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe (Update BabbageEra)
   -> Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (StrictMaybe (Update BabbageEra))
-> Gen
     (Set (KeyHash 'Witness)
      -> MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int)
-> Gen (StrictMaybe (Update BabbageEra))
-> Gen (StrictMaybe (Update BabbageEra))
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
15) Gen (StrictMaybe (Update BabbageEra))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Set (KeyHash 'Witness)
   -> MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (Set (KeyHash 'Witness))
-> Gen
     (MultiAsset
      -> StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Set (KeyHash 'Witness))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (MultiAsset
   -> StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen MultiAsset
-> Gen
     (StrictMaybe ScriptIntegrityHash
      -> StrictMaybe TxAuxDataHash
      -> StrictMaybe Network
      -> TxBody BabbageEra)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int) -> Gen MultiAsset -> Gen MultiAsset
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
15) Gen MultiAsset
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe ScriptIntegrityHash
   -> StrictMaybe TxAuxDataHash
   -> StrictMaybe Network
   -> TxBody BabbageEra)
-> Gen (StrictMaybe ScriptIntegrityHash)
-> Gen
     (StrictMaybe TxAuxDataHash
      -> StrictMaybe Network -> TxBody BabbageEra)
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 ScriptIntegrityHash)
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (StrictMaybe TxAuxDataHash
   -> StrictMaybe Network -> TxBody BabbageEra)
-> Gen (StrictMaybe TxAuxDataHash)
-> Gen (StrictMaybe Network -> TxBody BabbageEra)
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 TxAuxDataHash)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (StrictMaybe Network -> TxBody BabbageEra)
-> Gen (StrictMaybe Network) -> Gen (TxBody BabbageEra)
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 Network)
forall a. Arbitrary a => Gen a
arbitrary