Merge pull request #2532 from input-output-hk/lehins/ledger-state-ana…

…lyzer

Add initial working implementation of `ledger-state` benchmarking tool

cabal.project

@@ -19,6 +19,7 @@ packages:
   libs/cardano-ledger-test
   libs/cardano-protocol-tpraos
   libs/plutus-preprocessor
+  libs/ledger-state
   libs/non-integral
   libs/small-steps
   libs/small-steps-test

eras/alonzo/impl/cardano-ledger-alonzo.cabal

@@ -66,7 +66,6 @@ library
     cardano-ledger-core,
     cardano-ledger-shelley-ma,
     cardano-prelude,
-    cardano-protocol-tpraos,
     cardano-slotting,
     containers,
     data-default,

libs/ledger-state/ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for ledegr-state
+
+## Unreleased changes

libs/ledger-state/README.md

@@ -0,0 +1,58 @@
+# ledger-state
+
+This tool allows loading the ledger state from binary encoded CBOR format into
+sqlite database in order to perform various analysis. In particular benchmark
+the memory overhead.
+
+## Dumping LedgerState
+
+In order to be able to use the tool we need to get ahold of current ledger
+state. For this we need to start a cardano node and wait for it to sync.
+
+```haskell
+$ export CARDANO_DATA="${HOME}/iohk/chain/mainnet"
+$ mkdir -p "${CARDANO_DATA}"/db
+$ cd "${CARDANO_DATA}"
+```
+
+Download all the [mainnet related config files](https://developers.cardano.org/docs/get-started/running-cardano/#mainnet--production):
+```
+curl -O -J https://hydra.iohk.io/build/7370192/download/1/mainnet-config.json
+curl -O -J https://hydra.iohk.io/build/7370192/download/1/mainnet-byron-genesis.json
+curl -O -J https://hydra.iohk.io/build/7370192/download/1/mainnet-shelley-genesis.json
+curl -O -J https://hydra.iohk.io/build/7370192/download/1/mainnet-alonzo-genesis.json
+curl -O -J https://hydra.iohk.io/build/7370192/download/1/mainnet-topology.json
+```
+
+Start the node and wait for it to fully sync
+
+```
+$ export CARDANO_NODE_SOCKET_PATH="${CARDANO_DATA}/db/node.socket"
+$ cardano-node run
+  --topology "${CARDANO_DATA}/mainnet-topology.json" \
+  --database-path "${CARDANO_DATA}/db" \
+  --socket-path "${CARDANO_NODE_SOCKET_PATH}" \
+  --host-addr 127.0.0.1 \
+  --port 3001 \
+  --config "${CARDANO_DATA}/mainnet-config.json" &
+```
+
+Dump the ledger state and focus back onto the node:
+
+```shell
+$ cardano-cli query ledger-state --mainnet --out-file "${CARDANO_DATA}/ledger-state.bin"
+$ fg
+```
+Hit Ctr-C to stop the node
+
+## Populate sqlite db
+
+```shell
+$ cabal run ledger-state --new-epoch-state-cbor="${CARDANO_DATA}/ledger-state.bin" --new-epoch-state-sqlite="${CARDANO_DATA}/ledger-state.sqlite"
+```
+
+## Running benchmarks
+
+```shell
+$ cabal bench ledger-state --benchmark-options="--new-epoch-state-cbor=\"${CARDANO_DATA}/ledger-state.bin\" --new-epoch-state-sqlite=\"${CARDANO_DATA}/ledger-state.sqlite\""
+```

libs/ledger-state/Setup.hs

@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain

libs/ledger-state/app/Main.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Cardano.Ledger.Shelley.LedgerState
+import Cardano.Ledger.State.Query
+import Cardano.Ledger.State.UTxO
+import Control.Monad
+import Data.Text as T (pack)
+import Options.Applicative
+import System.IO
+
+data Opts = Opts
+  { -- | Path to the CBOR encoded NewEpochState data type, which will be used to
+    -- load into sqlite database
+    optsLedgerStateBinaryFile :: Maybe FilePath,
+    -- | Path to Sqlite database file.
+    optsSqliteDbFile :: Maybe FilePath
+  }
+  deriving (Show)
+
+optsParser :: Parser Opts
+optsParser =
+  Opts
+    <$> option
+      (Just <$> str)
+      ( long "new-epoch-state-cbor"
+          <> value Nothing
+          <> help
+            ( "Path to the CBOR encoded NewEpochState data type. "
+                <> "Can be produced by `cardano-cli query ledger-state` command. "
+                <> "When supplied stats about the state will be printed to stdout"
+            )
+      )
+    <*> option
+      (Just <$> str)
+      ( long "new-epoch-state-sqlite"
+          <> value Nothing
+          <> help
+            ( "Path to Sqlite database file. When supplied then new-epoch-state "
+                <> "will be loaded into the databse. Requires --new-epoch-state-cbor"
+            )
+      )
+
+main :: IO ()
+main = do
+  hSetBuffering stdout LineBuffering
+  opts <-
+    execParser $
+      info
+        ( optsParser
+            <* abortOption
+              (ShowHelpText Nothing)
+              (long "help" <> short 'h' <> help "Display this message.")
+        )
+        (header "ledger-state - Tool for analyzing ledger state")
+  forM_ (optsLedgerStateBinaryFile opts) $ \binFp -> do
+    nes <- loadNewEpochState binFp
+    forM_ (optsSqliteDbFile opts) $ \dbFpStr -> do
+      let dbFp = T.pack dbFpStr
+      storeEpochState dbFp $ nesEs nes
+      putStrLn "Loaded EpochState into the database"
+    printNewEpochStateStats $ countNewEpochStateStats nes
+  forM_ (optsSqliteDbFile opts) $ \dbFpStr -> do
+    let dbFp = T.pack dbFpStr
+    km <- loadDbUTxO txIdSharingKeyMap dbFp
+    m <- loadDbUTxO noSharing dbFp
+    testKeyMap km m

libs/ledger-state/bench/Memory.hs

@@ -0,0 +1,86 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Cardano.Ledger.State.Query
+import Cardano.Ledger.State.UTxO
+import Control.Monad
+import qualified Data.Text as T
+import Options.Applicative as O
+import Weigh
+
+data Opts = Opts
+  { -- | Path to the CBOR encoded NewEpochState data type, which will be used to
+    -- load into sqlite database
+    optsLedgerStateBinaryFile :: Maybe FilePath,
+    -- | Path to Sqlite database file.
+    optsSqliteDbFile :: Maybe FilePath
+  }
+  deriving (Show)
+
+optsParser :: Parser Opts
+optsParser =
+  Opts
+    <$> option
+      (Just <$> str)
+      ( long "new-epoch-state-cbor"
+          <> O.value Nothing
+          <> help
+            ("Benchmark loading CBOR encoded NewEpochState into memory.")
+      )
+    <*> option
+      (Just <$> str)
+      ( long "new-epoch-state-sqlite"
+          <> O.value Nothing
+          <> help
+            ("Run various benchmarks on LedgerState representations")
+      )
+
+main :: IO ()
+main = do
+  opts <-
+    execParser $
+      info
+        ( optsParser
+            <* abortOption
+              (ShowHelpText Nothing)
+              (long "help" <> short 'h' <> help "Display this message.")
+        )
+        (header "ledger-state:memory - Tool for analyzing memory consumption of ledger state")
+  let cols = [Case, Max, MaxOS, Live, Allocated, GCs]
+  !mEpochStateEntity <- mapM (loadEpochStateEntity . T.pack) (optsSqliteDbFile opts)
+  mainWith $ do
+    setColumns cols
+    forM_ (optsLedgerStateBinaryFile opts) $ \binFp -> do
+      io "NewEpochState" loadNewEpochState binFp
+    forM_ (optsSqliteDbFile opts) $ \dbFpStr -> do
+      let dbFp = T.pack dbFpStr
+      forM_ mEpochStateEntity $ \ese ->
+        wgroup "EpochState" $ do
+          io "SnapShots - no sharing" (loadSnapShotsNoSharing dbFp) ese
+          io "SnapShots - with sharing" (loadSnapShotsWithSharing dbFp) ese
+      wgroup "Baseline" $ do
+        io "DState" loadDStateNoSharing dbFp
+        io "UTxO" loadUTxONoSharing dbFp
+        io "LedgerState" getLedgerStateNoSharing dbFp
+      wgroup "UTxO (No TxOut)" $ do
+        io "IntMap (KeyMap TxId ())" (loadDbUTxO txIxSharingKeyMap_) dbFp
+        io "KeyMap TxId (IntMap TxId ())" (loadDbUTxO txIdSharingKeyMap_) dbFp
+        io "IntMap (Map TxId ())" (loadDbUTxO txIxSharing_) dbFp
+        io "Map TxIn ()" (loadDbUTxO noSharing_) dbFp
+      wgroup "LedgerState" $ do
+        wgroup "UTxO (Share DState)" $ do
+          io "IntMap (KeyMap TxId TxOut)" getLedgerStateDStateTxIxSharingKeyMap dbFp
+          io "KeyMap TxId (IntMap TxOut)" getLedgerStateDStateTxIdSharingKeyMap dbFp
+          io "IntMap (Map TxId TxOut)" getLedgerStateDStateTxIxSharing dbFp
+          io "Map TxIn TxOut" getLedgerStateDStateSharing dbFp
+
+--   wgroup "Share TxOut StakeCredential" $ do
+--     io "Map TxIn TxOut'" getLedgerStateDStateTxOutSharing dbFp
+-- wgroup "Share TxOut StakeCredential" $ do
+--   io "Map TxIn TxOut'" getLedgerStateTxOutSharing dbFp
+-- wgroup "No Sharing" $ do
+-- wgroup "Share TxOut StakeCredential" $ do
+--   io "IntMap (KeyMap TxId TxOut')" getLedgerStateWithSharingKeyMap dbFp
+--   io "IntMap (Map TxId TxOut')" getLedgerStateWithSharing dbFp

libs/ledger-state/ledger-state.cabal

@@ -0,0 +1,89 @@
+cabal-version: 2.2
+
+name:                ledger-state
+version:             0.1.0.0
+license:             Apache-2.0
+author:              IOHK Formal Methods Team
+maintainer:          formal.methods@iohk.io
+description:         This is a tool that helps us experiment with the UTxO map
+build-type:          Simple
+
+extra-source-files:
+  README.md
+  ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/input-output-hk/cardano-ledger-specs.git
+  subdir:   libs/utxo-state
+
+common project-config
+  default-language:   Haskell2010
+  build-depends:      base >= 4.12 && < 4.15
+
+  ghc-options:        -Wall
+                      -Wcompat
+                      -Wincomplete-record-updates
+                      -Wincomplete-uni-patterns
+                      -Wredundant-constraints
+                      -Wunused-packages
+
+library
+  import:             project-config
+  build-depends:      bytestring
+                    , cardano-binary
+                    , cardano-crypto-class
+                    , cardano-ledger-core
+                    , cardano-ledger-alonzo
+                    , cardano-ledger-shelley
+                    , cardano-ledger-shelley-ma
+                    , cardano-protocol-tpraos
+                    , cborg
+                    , conduit
+                    , containers
+                    , compact-map
+                    , deepseq
+                    , foldl
+                    , persistent
+                    , persistent-sqlite
+                    , persistent-template
+                    , prettyprinter
+                    , strict-containers
+                    , small-steps
+                    , text
+                    , transformers
+  exposed-modules:    Cardano.Ledger.State
+                    , Cardano.Ledger.State.UTxO
+                    , Cardano.Ledger.State.Orphans
+                    , Cardano.Ledger.State.Schema
+                    , Cardano.Ledger.State.Transform
+                    , Cardano.Ledger.State.Query
+  hs-source-dirs:     src
+
+executable ledger-state
+  import:              project-config
+  hs-source-dirs:      app
+  main-is:             Main.hs
+  ghc-options:         -O2
+                       -threaded
+                       -rtsopts
+  build-depends:       cardano-ledger-shelley
+                     , ledger-state
+                     , optparse-applicative
+                     , text
+
+
+benchmark memory
+  type:           exitcode-stdio-1.0
+  main-is:        Memory.hs
+  hs-source-dirs: bench
+  build-depends:  base
+                , weigh
+                , ledger-state
+                , optparse-applicative
+                , text
+  ghc-options:   -Wall
+                 -O2
+                 -rtsopts
+                 -with-rtsopts=-T
+  default-language:   Haskell2010

libs/ledger-state/src/Cardano/Ledger/State.hs

@@ -0,0 +1 @@
+module Cardano.Ledger.State where