{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# 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.Transition (TransitionConfig (..)) 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 arbitrary :: Gen (BabbageContextError era) arbitrary = Gen (BabbageContextError era) forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a genericArbitraryU 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 deriving newtype instance Arbitrary (TransitionConfig BabbageEra)