[ADP-3086] Implement memory benchmark (#4027)

### Overview

This task is about creating a memory benchmark for cardano-wallet which

* has a predictable environment, i.e. does not depend on mainnet
* runs quickly, for fast turnaround times on space leak hypothesis
testing

### Implementation details

We implement an MVP: We use a `cardano-node` that has no peers to serve
an initial segment of predprod, and benchmark a `cardano-wallet`
connected to this node.

### Context

Previously, we have benchmarked memory as part of the nightly
restoration benchmark. However, when upgrading to compiler version GHC
9.2.8, this benchmark stopped working due to a memory leak.

### Issue number

ADP-3086

cabal.project

@@ -69,6 +69,7 @@ packages:
   , lib/text-class/
   , lib/wai-middleware-logging/
   , lib/wallet/
+  , lib/wallet-benchmarks/
 
 -- Using RDRAND instead of /dev/urandom as an entropy source for key
 -- generation is dubious. Set the flag so we use /dev/urandom by default.

lib/launcher/cardano-wallet-launcher.cabal

@@ -38,6 +38,7 @@ library
     , filepath
     , fmt
     , iohk-monitoring
+    , network
     , process
     , text
     , text-class
@@ -48,6 +49,7 @@ library
   exposed-modules:
       Cardano.Launcher
     , Cardano.Launcher.Node
+      Cardano.Launcher.Wallet
     , Cardano.Startup
   if os(windows)
     build-depends: Win32

lib/launcher/src/Cardano/Launcher/Wallet.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE RecordWildCards #-}
+
+-- |
+-- Copyright: © 2023-2023 IOHK
+-- License: Apache-2.0
+--
+-- Provides a function to launch @cardano-wallet@.
+module Cardano.Launcher.Wallet
+    ( -- * Startup
+      withCardanoWallet
+    , CardanoWalletConfig (..)
+    , NetworkConfig (..)
+
+    -- * Run
+    , CardanoWalletConn
+    , getWalletPort
+    ) where
+
+import Prelude
+
+import Cardano.Launcher
+    ( LauncherLog, ProcessHasExited, withBackendCreateProcess )
+import Cardano.Launcher.Node
+    ( CardanoNodeConn, nodeSocketFile )
+import Control.Tracer
+    ( Tracer (..) )
+import Data.Text.Class
+    ( FromText (..), ToText (..) )
+import Network.Socket
+    ( PortNumber )
+import UnliftIO.Process
+    ( CreateProcess (..), proc )
+
+{-----------------------------------------------------------------------------
+    Launching a `cardano-wallet` process
+------------------------------------------------------------------------------}
+-- | Parameters for connecting to the running wallet process.
+newtype CardanoWalletConn = CardanoWalletConn { getWalletPort :: PortNumber }
+    deriving (Show, Eq)
+
+instance ToText CardanoWalletConn where
+    toText = toText . fromEnum . getWalletPort
+
+instance FromText CardanoWalletConn where
+    fromText = fmap (CardanoWalletConn . toEnum) . fromText
+
+data NetworkConfig
+    = Mainnet
+    | Testnet { nodeByronGenesis :: FilePath }
+    deriving (Show, Eq)
+
+-- | A subset of the @cardano-wallet@ CLI parameters,
+-- used for starting the process.
+data CardanoWalletConfig = CardanoWalletConfig
+    { walletPort          :: PortNumber
+        -- ^ Port number for HTTP API. Good default: 8090.
+    , walletDatabaseDir   :: FilePath
+        -- ^ Path to the wallet database file.
+    , walletNetwork       :: NetworkConfig
+        -- ^ Network (mainnet or a testnet) that we connect to.
+    , extraArgs           :: [String]
+        -- ^ Extra arguments to be passed to the process
+    } deriving (Show, Eq)
+
+-- | Spawns a @cardano-wallet@ process.
+--
+-- IMPORTANT: @cardano-wallet@ must be available on the current path.
+withCardanoWallet
+    :: Tracer IO LauncherLog
+    -- ^ Trace for subprocess control logging
+    -> CardanoNodeConn
+    -> CardanoWalletConfig
+    -> (CardanoWalletConn -> IO a)
+    -- ^ Callback function with a socket filename and genesis params
+    -> IO (Either ProcessHasExited a)
+withCardanoWallet tr node cfg@CardanoWalletConfig{..} action =
+    withBackendCreateProcess tr (cardanoWallet cfg node) $
+        \_ _ -> action $ CardanoWalletConn walletPort
+
+cardanoWallet :: CardanoWalletConfig -> CardanoNodeConn -> CreateProcess
+cardanoWallet CardanoWalletConfig{..} node =
+    proc "cardano-wallet" $
+        [ "serve"
+        , "--node-socket", nodeSocketFile node
+        , "--database", walletDatabaseDir
+        , "--port", show walletPort
+        ]
+        <> case walletNetwork of
+            Mainnet -> ["--mainnet"]
+            Testnet path -> ["--testnet", path]
+        <> extraArgs

lib/wallet-benchmarks/bench/memory-benchmark.hs

@@ -0,0 +1,239 @@
+{-# LANGUAGE RecordWildCards #-}
+
+import Prelude
+
+import Cardano.BM.Data.Tracer
+    ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
+import Cardano.Startup
+    ( installSignalHandlers, withUtf8Encoding )
+import Control.Concurrent
+    ( threadDelay )
+import Control.Monad
+    ( unless, void, when )
+import Control.Tracer
+    ( Tracer (..), contramap, traceWith )
+import Data.List
+    ( intersperse )
+import Data.Maybe
+    ( fromMaybe )
+import Data.Text
+    ( Text )
+import Data.Text.Class
+    ( ToText (..) )
+import System.FilePath
+    ( takeBaseName, (</>) )
+import System.IO.Temp
+    ( withSystemTempDirectory )
+import Text.Read
+    ( readMaybe )
+
+import qualified Cardano.BM.Configuration.Model as Log
+import qualified Cardano.BM.Configuration.Static as Log
+import qualified Cardano.BM.Data.BackendKind as Log
+import qualified Cardano.BM.Data.LogItem as Log
+import qualified Cardano.BM.Data.Severity as Log
+import qualified Cardano.BM.Setup as Log
+import qualified Cardano.Launcher as C
+import qualified Cardano.Launcher.Node as C
+import qualified Cardano.Launcher.Wallet as C
+import qualified System.Process as S
+
+{-----------------------------------------------------------------------------
+    Configuration
+------------------------------------------------------------------------------}
+testSnapshot :: FilePath
+testSnapshot = "membench-snapshot.tgz"
+
+testBlockHeight :: Int
+testBlockHeight = 7280
+
+cabalDataDir :: FilePath
+cabalDataDir = "lib/wallet-benchmarks/data"
+
+testMnemonic :: [String]
+testMnemonic =
+    [ "slab","praise","suffer","rabbit","during","dream"
+    , "arch","harvest","culture","book","owner","loud"
+    , "wool","salon","table","animal","vivid","arrow"
+    , "dirt","divide","humble","tornado","solution","jungle"
+    ]
+
+{-----------------------------------------------------------------------------
+    Main
+------------------------------------------------------------------------------}
+main :: IO ()
+main = withUtf8Encoding $ do
+    requireExecutable "cardano-node" "--version"
+    requireExecutable "cardano-wallet" "version"
+    requireExecutable "curl" "--version"
+    requireExecutable "jq" "--version"
+
+    installSignalHandlers (pure ())
+    trText <- initLogging "memory-benchmark" Log.Debug
+    let tr = contramap toText trText
+
+    withSystemTempDirectory "wallet" $ \tmp -> do
+        cfg <- copyNodeSnapshot tmp
+        void $ withCardanoNode tr cfg $ \node -> do
+            sleep 2
+            withCardanoWallet tr cfg node $ \wallet -> void $ do
+                sleep 1
+                createWallet wallet testMnemonic
+                sleep 1
+                waitUntilSynchronized wallet
+
+waitUntilSynchronized :: C.CardanoWalletConn -> IO ()
+waitUntilSynchronized wallet = do
+    height <- getLatestBlockHeight wallet
+    when (height < testBlockHeight) $ do
+        sleep 1
+        waitUntilSynchronized wallet
+
+copyNodeSnapshot :: FilePath -> IO BenchmarkConfig
+copyNodeSnapshot tmp = do
+    copyFile (cabalDataDir </> testSnapshot) tmp
+    let dir = tmp </> takeBaseName testSnapshot
+    decompress (tmp </> testSnapshot) tmp
+    pure $ BenchmarkConfig
+        { nodeConfigDir = dir </> "config"
+        , nodeDatabaseDir = dir </> "db-node"
+        , walletDatabaseDir = dir </> "db-wallet"
+        }
+
+{-----------------------------------------------------------------------------
+    Cardano commands
+------------------------------------------------------------------------------}
+getLatestBlockHeight :: C.CardanoWalletConn -> IO Int
+getLatestBlockHeight wallet =
+    fmap (fromMaybe 0 . readMaybe)
+    . flip S.readCreateProcess ""
+    . S.shell
+    $ curlGetCommand wallet "/wallets"
+        <> " | jq '.[0].tip.height.quantity'"
+
+curlGetCommand
+    :: C.CardanoWalletConn -> String -> String
+curlGetCommand wallet path =
+    "curl -X GET " <> walletURL wallet <> path
+
+createWallet :: C.CardanoWalletConn -> [String] -> IO ()
+createWallet wallet mnemonic =
+    curlPostJSON wallet "/wallets" $ unwords
+        [ "{ \"mnemonic_sentence\": " <> showMnemonic mnemonic <> ","
+        , "  \"passphrase\": \"Secure Passphrase\","
+        , "  \"name\": \"Memory Benchmark\","
+        , "  \"address_pool_gap\": 20"
+        , "}"
+        ]
+  where
+    braces l r s = l <> s <> r
+    showMnemonic =
+        braces "[" "]" . unwords . intersperse "," . map (braces "\"" "\"")
+
+curlPostJSON :: C.CardanoWalletConn -> String -> String -> IO ()
+curlPostJSON wallet path json =
+    S.callProcess
+        "curl"
+        [ "-X", "POST"
+        , "-d", json
+        , "-H", "Content-Type: application/json"
+        , walletURL wallet <> path
+        ]
+
+walletURL :: C.CardanoWalletConn -> String
+walletURL wallet =
+    "http://localhost:" <> show (C.getWalletPort wallet) <> "/v2"
+
+data BenchmarkConfig = BenchmarkConfig
+    { nodeConfigDir :: FilePath
+    , nodeDatabaseDir :: FilePath
+    , walletDatabaseDir :: FilePath
+    }
+    deriving (Eq, Show)
+
+-- | Start a `cardano-wallet` process on the benchmark configuration.
+withCardanoWallet
+    :: Tracer IO C.LauncherLog
+    -> BenchmarkConfig
+    -> C.CardanoNodeConn
+    -> (C.CardanoWalletConn -> IO r)
+    -> IO (Either C.ProcessHasExited r)
+withCardanoWallet tr BenchmarkConfig{..} node =
+    C.withCardanoWallet tr node
+        C.CardanoWalletConfig
+            { C.walletPort =
+                8060
+            , C.walletNetwork =
+                C.Testnet $ nodeConfigDir </> "byron-genesis.json"
+            , C.walletDatabaseDir =
+                walletDatabaseDir
+            , C.extraArgs =
+                profilingOptions
+            }
+  where
+    profilingOptions = words "+RTS -N1 -qg -A1m -I0 -T -h -i0.01 -RTS"
+
+-- | Start a `cardano-node` process on the benchmark configuration.
+withCardanoNode
+    :: Tracer IO C.LauncherLog
+    -> BenchmarkConfig
+    -> (C.CardanoNodeConn -> IO r)
+    -> IO (Either C.ProcessHasExited r)
+withCardanoNode tr BenchmarkConfig{..} =
+    C.withCardanoNode tr
+        C.CardanoNodeConfig
+            { C.nodeDir = nodeDatabaseDir
+            , C.nodeConfigFile = nodeConfigDir </> "config.json"
+            , C.nodeTopologyFile = nodeConfigDir </> "topology.json"
+            , C.nodeDatabaseDir = nodeDatabaseDir
+            , C.nodeDlgCertFile = Nothing
+            , C.nodeSignKeyFile = Nothing
+            , C.nodeOpCertFile = Nothing
+            , C.nodeKesKeyFile = Nothing
+            , C.nodeVrfKeyFile = Nothing
+            , C.nodePort = Just (C.NodePort 8061)
+            , C.nodeLoggingHostname = Nothing
+            }
+
+{-----------------------------------------------------------------------------
+    Utilities
+------------------------------------------------------------------------------}
+sleep :: Int -> IO ()
+sleep seconds = threadDelay (seconds * 1000 * 1000)
+
+-- | Throw an exception if the executable is not in the `$PATH`.
+requireExecutable :: FilePath -> String -> IO ()
+requireExecutable name cmd = S.callProcess name [cmd]
+
+copyFile :: FilePath -> FilePath -> IO ()
+copyFile source destination = S.callProcess "cp" [source,destination]
+
+decompress :: FilePath -> FilePath -> IO ()
+decompress source destination =
+    S.callProcess "tar" ["-xzvf", source, "-C", destination]
+
+{-----------------------------------------------------------------------------
+    Logging
+------------------------------------------------------------------------------}
+initLogging :: Text -> Log.Severity -> IO (Tracer IO Text)
+initLogging name minSeverity = do
+    c <- Log.defaultConfigStdout
+    Log.setMinSeverity c minSeverity
+    Log.setSetupBackends c [Log.KatipBK, Log.AggregationBK]
+    (tr, _sb) <- Log.setupTrace_ c name
+    pure (trMessageText tr)
+
+-- | Tracer transformer which transforms traced items to their 'ToText'
+-- representation and further traces them as a 'Log.LogObject'.
+-- If the 'ToText' representation is empty, then no tracing happens.
+trMessageText
+    :: (ToText a, HasPrivacyAnnotation a, HasSeverityAnnotation a)
+    => Tracer IO (Log.LoggerName, Log.LogObject Text)
+    -> Tracer IO a
+trMessageText tr = Tracer $ \arg -> do
+    let msg = toText arg
+    unless (msg == mempty) $ do
+        meta <- Log.mkLOMeta
+            (getSeverityAnnotation arg)
+            (getPrivacyAnnotation arg)
+        traceWith tr (mempty, Log.LogObject mempty meta (Log.LogMessage msg))

lib/wallet-benchmarks/cardano-wallet-benchmarks.cabal

@@ -0,0 +1,43 @@
+cabal-version:       3.0
+name:                cardano-wallet-benchmarks
+version:             2023.4.14
+synopsis:            Benchmarks for the `cardano-wallet` exectuable.
+description:         This package is a collection of benchmarks
+                     for the `cardano-wallet` exectuable.
+                     It currently comprises a memory benchmark (heap profile).
+homepage:            https://github.com/cardano-foundation/cardano-wallet
+author:              High Assurance Lab at Cardano Foundation
+maintainer:          cardanofoundation.org
+copyright:           2023 Cardano Foundation
+license:             Apache-2.0
+category:            Web
+build-type:          Simple
+
+common language
+  ghc-options:        -threaded -Wall
+  default-language:   Haskell2010
+  default-extensions:
+    NamedFieldPuns
+    NoImplicitPrelude
+    OverloadedStrings
+
+benchmark memory
+  import:         language
+  type:           exitcode-stdio-1.0
+  hs-source-dirs: bench
+  main-is:        memory-benchmark.hs
+  build-depends:
+    , base
+    , cardano-wallet-launcher
+    , cardano-wallet-test-utils
+    , containers
+    , contra-tracer
+    , filepath
+    , fmt
+    , iohk-monitoring
+    , network
+    , process
+    , temporary
+    , text
+    , text-class
+    , transformers