diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 89e757ec20..241872930b 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -264,7 +264,7 @@ library gen , cardano-binary >= 1.6 && < 1.8 , cardano-crypto-class ^>= 2.1.2 , cardano-crypto-test ^>= 1.5 - , cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >= 1.5.0 + , cardano-ledger-alonzo:{cardano-ledger-alonzo} >= 1.5.0 , cardano-ledger-byron-test >= 1.5 , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8.0 , cardano-ledger-shelley >= 1.7.0 diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/ProtocolParameters.hs b/cardano-api/gen/Test/Gen/Cardano/Api/ProtocolParameters.hs new file mode 100644 index 0000000000..57538db646 --- /dev/null +++ b/cardano-api/gen/Test/Gen/Cardano/Api/ProtocolParameters.hs @@ -0,0 +1,118 @@ +module Test.Gen.Cardano.Api.ProtocolParameters where + +import Cardano.Api +import Cardano.Api.Ledger +import Cardano.Api.ProtocolParameters + +import Test.Gen.Cardano.Api.Typed (genCostModels) + +import Test.Cardano.Ledger.Alonzo.Arbitrary () +import Test.Cardano.Ledger.Conway.Arbitrary () + +import Hedgehog (MonadGen) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Gen.QuickCheck as Q + +genStrictMaybe :: MonadGen m => m a -> m (StrictMaybe a) +genStrictMaybe gen = + Gen.sized $ \n -> + Gen.frequency [ + (2, pure SNothing), + (1 + fromIntegral n, SJust<$> gen) + ] + +genCommonProtocolParametersUpdate :: MonadGen m => m CommonProtocolParametersUpdate +genCommonProtocolParametersUpdate = + CommonProtocolParametersUpdate + <$> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + +genDeprecatedAfterMaryPParams :: MonadGen m => m (DeprecatedAfterMaryPParams era) +genDeprecatedAfterMaryPParams = DeprecatedAfterMaryPParams <$> genStrictMaybe Q.arbitrary + +genShelleyToAlonzoPParams :: MonadGen m => m (ShelleyToAlonzoPParams era) +genShelleyToAlonzoPParams = + ShelleyToAlonzoPParams + <$> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + +genAlonzoOnwardsPParams :: MonadGen m => m (AlonzoOnwardsPParams era) +genAlonzoOnwardsPParams = + AlonzoOnwardsPParams + <$> genStrictMaybe genCostModels + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + +genIntroducedInBabbagePParams :: MonadGen m => m (IntroducedInBabbagePParams era) +genIntroducedInBabbagePParams = IntroducedInBabbagePParams <$> genStrictMaybe Q.arbitrary + +genIntroducedInConwayPParams :: MonadGen m => m (IntroducedInConwayPParams era) +genIntroducedInConwayPParams = + IntroducedInConwayPParams + <$> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + <*> genStrictMaybe Q.arbitrary + +genShelleyEraBasedProtocolParametersUpdate :: MonadGen m => m (EraBasedProtocolParametersUpdate ShelleyEra) +genShelleyEraBasedProtocolParametersUpdate = + ShelleyEraBasedProtocolParametersUpdate + <$> genCommonProtocolParametersUpdate + <*> genDeprecatedAfterMaryPParams + <*> genShelleyToAlonzoPParams + +genAllegraEraBasedProtocolParametersUpdate :: MonadGen m => m (EraBasedProtocolParametersUpdate AllegraEra) +genAllegraEraBasedProtocolParametersUpdate = + AllegraEraBasedProtocolParametersUpdate + <$> genCommonProtocolParametersUpdate + <*> genDeprecatedAfterMaryPParams + <*> genShelleyToAlonzoPParams + +genMaryEraBasedProtocolParametersUpdate :: MonadGen m => m (EraBasedProtocolParametersUpdate MaryEra) +genMaryEraBasedProtocolParametersUpdate = + MaryEraBasedProtocolParametersUpdate + <$> genCommonProtocolParametersUpdate + <*> genDeprecatedAfterMaryPParams + <*> genShelleyToAlonzoPParams + +genAlonzoEraBasedProtocolParametersUpdate :: MonadGen m => m (EraBasedProtocolParametersUpdate AlonzoEra) +genAlonzoEraBasedProtocolParametersUpdate = + AlonzoEraBasedProtocolParametersUpdate + <$> genCommonProtocolParametersUpdate + <*> genShelleyToAlonzoPParams + <*> genAlonzoOnwardsPParams + +genBabbageEraBasedProtocolParametersUpdate :: MonadGen m => m (EraBasedProtocolParametersUpdate BabbageEra) +genBabbageEraBasedProtocolParametersUpdate = + BabbageEraBasedProtocolParametersUpdate + <$> genCommonProtocolParametersUpdate + <*> genAlonzoOnwardsPParams + <*> genIntroducedInBabbagePParams + +genConwayEraBasedProtocolParametersUpdate :: MonadGen m => m (EraBasedProtocolParametersUpdate ConwayEra) +genConwayEraBasedProtocolParametersUpdate = + ConwayEraBasedProtocolParametersUpdate + <$> genCommonProtocolParametersUpdate + <*> genAlonzoOnwardsPParams + <*> genIntroducedInBabbagePParams + <*> genIntroducedInConwayPParams diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index c5b28ff7a0..676fcd6b4f 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -20,6 +20,7 @@ module Test.Gen.Cardano.Api.Typed , genAddressShelley , genCertificate , genCostModel + , genCostModels , genMaybePraosNonce , genPraosNonce , genValidProtocolParameters @@ -137,7 +138,6 @@ import qualified Cardano.Binary as CBOR import qualified Cardano.Crypto.Hash as Crypto import qualified Cardano.Crypto.Hash.Class as CRYPTO import qualified Cardano.Crypto.Seed as Crypto -import Cardano.Ledger.Alonzo.Language (Language (..)) import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.Core as Ledger import Cardano.Ledger.SafeHash (unsafeMakeSafeHash) @@ -148,7 +148,6 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Short as SBS import Data.Coerce import Data.Int (Int64) -import Data.Map.Strict (Map) import Data.Maybe import Data.Ratio (Ratio, (%)) import Data.String @@ -160,11 +159,10 @@ import Test.Gen.Cardano.Api.Metadata (genTxMetadata) import Test.Cardano.Chain.UTxO.Gen (genVKWitness) import Test.Cardano.Crypto.Gen (genProtocolMagicId) -import Test.Cardano.Ledger.Alonzo.Arbitrary (genValidCostModel) import Test.Cardano.Ledger.Conway.Arbitrary () import Test.Cardano.Ledger.Core.Arbitrary () -import Hedgehog (Gen, Range) +import Hedgehog (Gen, MonadGen, Range) import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Gen.QuickCheck as Q import qualified Hedgehog.Range as Range @@ -954,23 +952,11 @@ genUpdateProposal era = ) <*> genEpochNo -genCostModel :: Gen Alonzo.CostModel -genCostModel = do - lang <- genPlutusLanguage - cm <- Q.quickcheck (genValidCostModel lang) - pure cm +genCostModel :: MonadGen m => m Alonzo.CostModel +genCostModel = Q.arbitrary -genPlutusLanguage :: Gen Language -genPlutusLanguage = Gen.element [PlutusV1, PlutusV2, PlutusV3] - -_genCostModels :: Gen (Map AnyPlutusScriptVersion CostModel) -_genCostModels = - Gen.map (Range.linear 0 (length plutusScriptVersions)) - ((,) <$> Gen.element plutusScriptVersions - <*> (Api.fromAlonzoCostModel <$> genCostModel)) - where - plutusScriptVersions :: [AnyPlutusScriptVersion] - plutusScriptVersions = [minBound..maxBound] +genCostModels :: MonadGen m => m Alonzo.CostModels +genCostModels = Q.arbitrary genExecutionUnits :: Gen ExecutionUnits genExecutionUnits = ExecutionUnits <$> Gen.integral (Range.constant 0 1000)