feat(sut): add write size and metrics memory usage to metrics output

src/sut/dumblog/bench/Common.hs

@@ -23,6 +23,7 @@ import System.Random (StdGen, mkStdGen, randomR)
 import Text.Printf (printf)
 
 import Dumblog.Common.HttpClient
+import Dumblog.Common.Utils (showBytes)
 
 ------------------------------------------------------------------------
 
@@ -39,10 +40,10 @@ rEAD_FREQUENCY :: Int
 rEAD_FREQUENCY = 80
 
 nUM_OF_CLIENTS :: Int
-nUM_OF_CLIENTS = 512
+nUM_OF_CLIENTS = 5000
 
 iTERATIONS :: Int
-iTERATIONS = 200
+iTERATIONS = 50
 
 vALUE_TO_WRITE :: ByteString
 vALUE_TO_WRITE = LBS.pack "Dumblog"
@@ -98,28 +99,6 @@ commonBenchmark (_a, hc) = do
   printf "%-25.25s%10s\n"         "Max mem"        (showBytes
                                                      (max endMaxMemInUse startMaxMemInUse))
 
--- Stolen from `tasty-bench`.
-showBytes :: Word64 -> String
-showBytes i
-  | t < 1000                 = printf "%3.0f B " t
-  | t < 10189                = printf "%3.1f KB" (t / 1024)
-  | t < 1023488              = printf "%3.0f KB" (t / 1024)
-  | t < 10433332             = printf "%3.1f MB" (t / 1048576)
-  | t < 1048051712           = printf "%3.0f MB" (t / 1048576)
-  | t < 10683731149          = printf "%3.1f GB" (t / 1073741824)
-  | t < 1073204953088        = printf "%3.0f GB" (t / 1073741824)
-  | t < 10940140696372       = printf "%3.1f TB" (t / 1099511627776)
-  | t < 1098961871962112     = printf "%3.0f TB" (t / 1099511627776)
-  | t < 11202704073084108    = printf "%3.1f PB" (t / 1125899906842624)
-  | t < 1125336956889202624  = printf "%3.0f PB" (t / 1125899906842624)
-  | t < 11471568970838126592 = printf "%3.1f EB" (t / 1152921504606846976)
-  | otherwise                = printf "%3.0f EB" (t / 1152921504606846976)
-  where
-    t = word64ToDouble i
-
-    word64ToDouble :: Word64 -> Double
-    word64ToDouble = fromIntegral
-
 commonClient :: HttpClient -> StdGen -> IO ()
 commonClient hc gen = go iTERATIONS 0 gen
   where

src/sut/dumblog/dumblog.cabal

@@ -64,6 +64,7 @@ library
 
   exposed-modules:
     Dumblog.Common.HttpClient
+    Dumblog.Common.Utils
     Dumblog.Journal.Blocker
     Dumblog.Journal.Codec
     Dumblog.Journal.FrontEnd

src/sut/dumblog/src/Dumblog/Common/HttpClient.hs

@@ -13,12 +13,14 @@ import Network.HTTP.Client
        , RequestBody(RequestBodyLBS)
        , defaultManagerSettings
        , httpLbs
+       , managerResponseTimeout
        , method
        , newManager
        , parseRequest
        , path
        , requestBody
        , responseBody
+       , responseTimeoutMicro
        )
 import Network.Wai.Handler.Warp (Port)
 import Text.Read (readMaybe)
@@ -36,6 +38,7 @@ data HttpClient = HttpClient
 newHttpClient :: String -> Port -> IO HttpClient
 newHttpClient host port = do
   mgr <- newManager defaultManagerSettings
+                      { managerResponseTimeout = responseTimeoutMicro (30 * 1000 * 1000) }
   initReq <- parseRequest ("http://" ++ host ++ ":" ++ show port)
 
   let writeReq :: ByteString -> Request
@@ -56,7 +59,7 @@ writeHttp hc bs = do
   case eResp of
     Left (HttpExceptionRequest _req exceptCtx) -> do
       -- XXX: increment hcErrors
-      putStrLn ("writeHttp, exception context: " ++ show exceptCtx)
+      -- putStrLn ("writeHttp, exception context: " ++ show exceptCtx)
       return Nothing
     Left InvalidUrlException {} -> error "writeHttp, impossible: invalid url"
     Right resp -> return (readMaybe (LBSChar8.unpack (responseBody resp)))

src/sut/dumblog/src/Dumblog/Common/Utils.hs

@@ -0,0 +1,28 @@
+module Dumblog.Common.Utils where
+
+import Data.Word (Word64)
+import Text.Printf (printf)
+
+------------------------------------------------------------------------
+
+-- Stolen from `tasty-bench`.
+showBytes :: Word64 -> String
+showBytes i
+  | t < 1000                 = printf "%3.0f B " t
+  | t < 10189                = printf "%3.1f KB" (t / 1024)
+  | t < 1023488              = printf "%3.0f KB" (t / 1024)
+  | t < 10433332             = printf "%3.1f MB" (t / 1048576)
+  | t < 1048051712           = printf "%3.0f MB" (t / 1048576)
+  | t < 10683731149          = printf "%3.1f GB" (t / 1073741824)
+  | t < 1073204953088        = printf "%3.0f GB" (t / 1073741824)
+  | t < 10940140696372       = printf "%3.1f TB" (t / 1099511627776)
+  | t < 1098961871962112     = printf "%3.0f TB" (t / 1099511627776)
+  | t < 11202704073084108    = printf "%3.1f PB" (t / 1125899906842624)
+  | t < 1125336956889202624  = printf "%3.0f PB" (t / 1125899906842624)
+  | t < 11471568970838126592 = printf "%3.1f EB" (t / 1152921504606846976)
+  | otherwise                = printf "%3.0f EB" (t / 1152921504606846976)
+  where
+    t = word64ToDouble i
+
+    word64ToDouble :: Word64 -> Double
+    word64ToDouble = fromIntegral

src/sut/dumblog/src/Dumblog/Journal/FrontEnd.hs

@@ -69,7 +69,7 @@ httpFrontend journal metrics (FrontEndInfo blocker) req respond = do
           respond $ Wai.responseLBS status400 [] (LBS8.pack (show err))
         Right () -> do
           incrCounter metrics QueueDepth 1
-          mResp <- timeout (3*1000*1000) (blockUntil key)
+          mResp <- timeout (30*1000*1000) (blockUntil key)
           -- Journal.dumpJournal journal
           case mResp of
             Nothing -> do

src/sut/dumblog/src/Dumblog/Journal/Metrics.hs

@@ -16,6 +16,7 @@ data DumblogHistograms
   | ServiceTimeReads
   | ServiceTimeWrites
   | ResponseTime
+  | WriteSize
   deriving (Eq, Show, Enum, Bounded)
 
 type DumblogMetrics = Metrics DumblogCounters DumblogHistograms

src/sut/dumblog/src/Dumblog/Journal/Worker.hs

@@ -6,6 +6,7 @@ module Dumblog.Journal.Worker where
 import Control.Concurrent (threadDelay)
 import Control.Monad (unless)
 
+import qualified Data.ByteString as BS
 import qualified Journal.Internal.Metrics as Metrics
 import qualified Journal.MP as Journal
 import Journal.Types
@@ -76,6 +77,9 @@ worker journal metrics (WorkerInfo blocker logger snapshotFile eventCount untilS
                                        Write {} -> ServiceTimeWrites
                                        Read {}  -> ServiceTimeReads) serviceTime
             Metrics.measure metrics ResponseTime (latency + serviceTime)
+            case cmd of
+              Write bs   -> Metrics.measure metrics WriteSize (realToFrac (BS.length bs))
+              _otherwise -> return ()
             return (succ ev, s')
 
         }

src/sut/dumblog/src/Dumblog/Metrics/Main.hs

@@ -11,6 +11,7 @@ import GHC.IO.Encoding (setLocaleEncoding, utf8)
 import System.Directory (removePathForcibly)
 import Text.Printf (printf)
 
+import Dumblog.Common.Utils (showBytes)
 import Dumblog.Journal.Main
 import Dumblog.Journal.Metrics
 import Journal (journalMetadata)
@@ -56,8 +57,10 @@ metricsMain = do
       ts' <- displayThroughput metrics ts
       displayUtilisation metrics ts'
       displayJournalMetadata eMeta
+      displayWriteSize metrics
       displayConcurrentConnections metrics
       displayErrors metrics
+      displayMetricsSize
 
       threadDelay 1_000_000
       go ts'
@@ -128,7 +131,7 @@ displayTimings metrics = do
     (latencySum / 1e6) (writeSum / 1e6) (readSum / 1e6) (respTimeSum / 1e6)
   let totalCnt :: Double
       totalCnt = realToFrac (writeCnt + readCnt)
-  printf "  count %7d %17d (%2.0f%%) %17d (%2.0f%%) %21d\n"
+  printf "  count %7d %17d (%2.0f%%) %16d (%2.0f%%) %21d\n"
     latencyCnt
     writeCnt (realToFrac writeCnt / totalCnt * 100)
     readCnt  (realToFrac readCnt  / totalCnt * 100)
@@ -188,22 +191,35 @@ displayJournalMetadata (Right meta) = do
     printf "  %d bytes consumed\n" consumed
     printf "  %d bytes difference\n" (produced - fromIntegral consumed)
 
+displayWriteSize :: DumblogMetrics -> IO ()
+displayWriteSize metrics = do
+  mMin  <- percentile metrics WriteSize 0
+  mMed  <- percentile metrics WriteSize 50
+  mMax  <- percentile metrics WriteSize 100
+  printf "\nWrite size, "
+  printf "min:   %10.0f bytes, med:  %10.0f bytes, max:  %10.0f bytes\n"
+    (fromMaybe 0 mMin) (fromMaybe 0 mMed)  (fromMaybe 0 mMax)
+
 displayConcurrentConnections :: DumblogMetrics -> IO ()
 displayConcurrentConnections metrics = do
   putStr "\nConcurrent number of transactions:"
   cnt <- getCounter metrics CurrentNumberTransactions
   printf " %d\n" cnt
 
-displayErrors :: DumblogMetrics -> IO ()
-displayErrors metrics = do
-  putStr "\nErrors:"
-  errors <- getCounter metrics ErrorsEncountered
-  printf " %d\n" errors
-
 displayUtilisation :: DumblogMetrics -> ThroughputState -> IO ()
 displayUtilisation metrics ts = do
   serviceTimeWAvg <- metricsAvg metrics ServiceTimeWrites
   serviceTimeRAvg <- metricsAvg metrics ServiceTimeReads
   printf "\nUtilisation: %.2f\n"
     -- Throughput uses seconds and service time uses µs, hence the `* 10^-6`.
     (throughputAvg ts * (serviceTimeWAvg + serviceTimeRAvg) * 1e-6)
+
+displayErrors :: DumblogMetrics -> IO ()
+displayErrors metrics = do
+  putStr "\nErrors:"
+  errors <- getCounter metrics ErrorsEncountered
+  printf " %d\n" errors
+
+displayMetricsSize :: IO ()
+displayMetricsSize =
+  printf "\n(Metrics' memory use: %s)\n" (showBytes (fromIntegral (metricSize dumblogSchema)))