diff --git a/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/ApplyTx.hs b/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/ApplyTx.hs index d58a4e2caa9..bb8d326480c 100644 --- a/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/ApplyTx.hs +++ b/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/ApplyTx.hs @@ -1,9 +1,12 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE TypeApplications #-} @@ -13,9 +16,11 @@ -- | Benchmarks for transaction application module Bench.Cardano.Ledger.ApplyTx (applyTxBenchmarks) where +import Bench.Cardano.Ledger.ApplyTx.Gen (generateForEra) import Cardano.Binary import Cardano.Ledger.Allegra (AllegraEra) import Cardano.Ledger.Alonzo (AlonzoEra) +import Cardano.Ledger.Alonzo.Rules.Ledger () import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Era (Era, ValidateScript) import Cardano.Ledger.Mary (MaryEra) @@ -28,12 +33,16 @@ import Cardano.Ledger.Shelley.API LedgerEnv (..), MempoolEnv, MempoolState, + ShelleyBasedEra, Tx, applyTxsTransition, ) import Cardano.Ledger.Shelley.LedgerState (DPState, UTxOState) +import Cardano.Ledger.Shelley.PParams (PParams' (..)) import Cardano.Ledger.Slot (SlotNo (SlotNo)) import Control.DeepSeq (NFData (..)) +import Control.State.Transition (State) +import Control.State.Transition.Trace.Generator.QuickCheck (BaseEnv, HasTrace) import Criterion import qualified Data.ByteString.Lazy as BSL import Data.Default.Class (Default, def) @@ -42,7 +51,11 @@ import qualified Data.Sequence as Seq import Data.Sharing (fromNotSharedCBOR) import Data.Typeable (typeRep) import GHC.Generics (Generic) +import Test.Cardano.Ledger.Alonzo.AlonzoEraGen () +import Test.Cardano.Ledger.MaryEraGen () import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (C_Crypto) +import Test.Cardano.Ledger.Shelley.Generator.Core (GenEnv) +import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen) import Test.Cardano.Ledger.Shelley.Utils (testGlobals) type ShelleyBench = ShelleyEra C_Crypto @@ -66,7 +79,7 @@ type AlonzoBench = AlonzoEra C_Crypto applyTxMempoolEnv :: Default (Core.PParams era) => MempoolEnv era applyTxMempoolEnv = LedgerEnv - { ledgerSlotNo = SlotNo 71, + { ledgerSlotNo = SlotNo 0, ledgerIx = 0, ledgerPp = def, ledgerAccount = AccountState (Coin 45000000000) (Coin 45000000000) @@ -83,42 +96,35 @@ data ApplyTxRes era = ApplyTxRes instance NFData (ApplyTxRes era) where rnf (ApplyTxRes g me s t) = seq g (seq me (seq s (seq t ()))) -resource_n_ledgerstate :: Int -> FilePath -resource_n_ledgerstate n = "bench/resources/" <> show n <> "_ledgerstate.cbor" +-------------------------------------------------------------------------------- +-- Fixed generators +-------------------------------------------------------------------------------- -resource_n_tx :: Int -> FilePath -resource_n_tx n = "bench/resources/" <> show n <> "_tx.cbor" +benchmarkSeed :: Int +benchmarkSeed = 24601 --- | Apply the transaction as if it's a transaction from a given era. -applyTxEra :: +benchApplyTx :: forall era. ( Era era, + EraGen era, ApplyTx era, - Default (Core.PParams era), - FromCBOR (MempoolState era) + ShelleyBasedEra era, + HasTrace (Core.EraRule "LEDGER" era) (GenEnv era), + BaseEnv (Core.EraRule "LEDGER" era) ~ Globals, + Default (State (Core.EraRule "PPUP" era)) ) => Proxy era -> - FilePath -> - FilePath -> Benchmark -applyTxEra p lsFile txFile = env loadRes go +benchApplyTx p = env genRes go where - loadRes :: IO (ApplyTxRes era) - loadRes = do - state <- - either (\err -> error $ "Failed to decode state: " <> show err) id - . decodeFullDecoder "state" fromCBOR - <$> BSL.readFile lsFile - tx <- - either (\err -> error $ "Failed to decode tx: " <> show err) id - . decodeAnnotator "tx" fromCBOR - <$> BSL.readFile txFile + genRes = do + (state, tx) <- pure $ generateForEra p benchmarkSeed pure $! ApplyTxRes testGlobals applyTxMempoolEnv state tx go :: ApplyTxRes era -> Benchmark go ~ApplyTxRes {atrGlobals, atrMempoolEnv, atrState, atrTx} = bench (show $ typeRep p) $ whnf - ( either (error . show) id + ( either (error . show) (\(x, y) -> x `seq` y `seq` (x, y)) . applyTxsTransition @era @(Either _) atrGlobals atrMempoolEnv @@ -126,23 +132,12 @@ applyTxEra p lsFile txFile = env loadRes go ) atrState -applyTxGroup :: Benchmark -applyTxGroup = - bgroup - "Apply Shelley Tx" - [ withRes 0, - withRes 1 - ] - where - withRes n = - let ls = resource_n_ledgerstate n - tx = resource_n_tx n - in bgroup - (show n) - [ applyTxEra (Proxy @ShelleyBench) ls tx, - applyTxEra (Proxy @AllegraBench) ls tx, - applyTxEra (Proxy @MaryBench) ls tx - ] +-------------------------------------------------------------------------------- +-- Deserialising resources from disk +-------------------------------------------------------------------------------- + +resource_n_tx :: Int -> FilePath +resource_n_tx n = "bench/resources/" <> show n <> "_tx.cbor" -- | Benchmark deserialising a shelley transaction as if it comes from the given -- era. @@ -163,11 +158,21 @@ deserialiseTxEra p = . decodeAnnotator "tx" fromCBOR <$> BSL.readFile (resource_n_tx 0) +-------------------------------------------------------------------------------- +-- Benchmark suite +-------------------------------------------------------------------------------- + applyTxBenchmarks :: Benchmark applyTxBenchmarks = bgroup "applyTxBenchmarks" - [ applyTxGroup, + [ bgroup + "ApplyTxInEra" + [ benchApplyTx (Proxy @ShelleyBench), + benchApplyTx (Proxy @AllegraBench), + benchApplyTx (Proxy @MaryBench) + -- benchApplyTx (Proxy @AlonzoBench) + ], bgroup "Deserialise Shelley Tx" [ deserialiseTxEra (Proxy @ShelleyBench), diff --git a/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/ApplyTx/Gen.hs b/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/ApplyTx/Gen.hs new file mode 100644 index 00000000000..4154f2f37d8 --- /dev/null +++ b/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/ApplyTx/Gen.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +-- | Generates fixed transaction/state pairs for benchmarking. +module Bench.Cardano.Ledger.ApplyTx.Gen (generateForEra) where + +import Cardano.Ledger.Core (EraRule) +import qualified Cardano.Ledger.Core as Core +import Cardano.Ledger.Era (Crypto) +import Cardano.Ledger.Shelley.API (Globals, ShelleyBasedEra) +import Cardano.Ledger.Shelley.LedgerState (DPState, UTxOState) +import Control.State.Transition (State) +import Control.State.Transition.Trace +import Control.State.Transition.Trace.Generator.QuickCheck +import Data.Default.Class (Default) +import Data.Proxy +import Test.Cardano.Ledger.AllegraEraGen () +import Test.Cardano.Ledger.Shelley.Generator.Core (GenEnv) +import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen) +import Test.Cardano.Ledger.Shelley.Generator.Presets +import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen () +import Test.Cardano.Ledger.Shelley.Generator.Trace.Ledger (mkGenesisLedgerState) +import Test.Cardano.Ledger.Shelley.Utils (testGlobals) +import Test.QuickCheck.Gen (unGen) +import Test.QuickCheck.Random (mkQCGen) + +-- | Generate a ledger state and transaction in a given era, given a seed. +generateForEra :: + forall era. + ( EraGen era, + HasTrace (EraRule "LEDGER" era) (GenEnv era), + Default (State (EraRule "PPUP" era)), + BaseEnv (EraRule "LEDGER" era) ~ Globals, + ShelleyBasedEra era + ) => + Proxy era -> + Int -> + ((UTxOState era, DPState (Crypto era)), Core.Tx era) +generateForEra eraProxy seed = + let ge = genEnv eraProxy + qcSeed = mkQCGen seed + tr = + unGen + ( traceFromInitState + @(EraRule "LEDGER" era) + testGlobals + 20 + ge + (Just $ mkGenesisLedgerState ge) + ) + qcSeed + 30 + sst = last $ sourceSignalTargets tr + in (source sst, signal sst) diff --git a/libs/cardano-ledger-test/bench/resources/DESCRIPTION.md b/libs/cardano-ledger-test/bench/resources/DESCRIPTION.md index cb462bd0254..99fdef9343f 100644 --- a/libs/cardano-ledger-test/bench/resources/DESCRIPTION.md +++ b/libs/cardano-ledger-test/bench/resources/DESCRIPTION.md @@ -40,3 +40,37 @@ let sst = last $ sourceSignalTargets tr BS.writeFile "/tmp/0_ledgerstate.cbor" $ serialize' (source sst) BS.writeFile "/tmp/0_tx.cbor" $ serialize' (signal sst) ``` +``` +:set -XTypeApplications + +import Data.Proxy + +import Cardano.Binary +import Control.State.Transition.Trace +import Control.State.Transition.Trace.Generator.QuickCheck +import qualified Data.ByteString as BS +import Cardano.Ledger.Shelley.Rules.Ledger +import Cardano.Ledger.Shelley +import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes + +import Test.Cardano.Ledger.Shelley.Utils +import Test.Cardano.Ledger.Shelley.Generator.Presets +import Test.Cardano.Ledger.Shelley.Generator.Trace.Ledger () +import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen () +import Cardano.Ledger.Shelley.PParams (PParams'(..)) +import Test.QuickCheck (generate) + +import Test.Cardano.Ledger.Shelley.Generator.Trace.Ledger + +import Cardano.Ledger.Allegra +import Test.Cardano.Ledger.AllegraEraGen () + + +let ge = genEnv (Proxy @(AllegraEra C_Crypto)) +initLs <- generate $ mkGenesisLedgerState @([LedgerPredicateFailure (AllegraEra C_Crypto)]) ge undefined +tr <- generate $ traceFromInitState @(LEDGER (AllegraEra C_Crypto)) testGlobals 20 ge (Just $ \_ -> pure initLs) + +let sst = last $ sourceSignalTargets tr +BS.writeFile "/tmp/0_ledgerstate.cbor" $ serialize' (source sst) +BS.writeFile "/tmp/0_tx.cbor" $ serialize' (signal sst) +``` diff --git a/libs/cardano-ledger-test/cardano-ledger-test.cabal b/libs/cardano-ledger-test/cardano-ledger-test.cabal index 56ffb3e9771..3671e9032db 100644 --- a/libs/cardano-ledger-test/cardano-ledger-test.cabal +++ b/libs/cardano-ledger-test/cardano-ledger-test.cabal @@ -91,7 +91,7 @@ test-suite cardano-ledger-test cardano-ledger-test, cardano-ledger-shelley-test, tasty, - + benchmark bench @@ -103,6 +103,7 @@ benchmark bench main-is: Main.hs other-modules: Bench.Cardano.Ledger.ApplyTx + Bench.Cardano.Ledger.ApplyTx.Gen Bench.Cardano.Ledger.EpochBoundary Bench.Cardano.Ledger.Serialisation.Generators build-depends: @@ -110,6 +111,7 @@ benchmark bench cardano-binary, cardano-crypto-class, cardano-ledger-alonzo, + cardano-ledger-alonzo-test, cardano-ledger-core, cardano-ledger-shelley-ma-test, cardano-ledger-shelley-ma, @@ -121,6 +123,7 @@ benchmark bench cardano-ledger-shelley, cardano-ledger-shelley-test, small-steps, + small-steps-test ghc-options: -threaded -rtsopts