CAD-1285 WIP

Signed-off-by: Alexander Diemand <codieplusplus@apax.net>

bm-timeline/bm-timeline.cabal

@@ -50,3 +50,22 @@ executable bmtime2block
                        -rtsopts
                        "-with-rtsopts=-T"
 
+executable bmresources
+  main-is:             Resources.hs 
+  other-modules:       Cardano.BM.Common
+                     , Cardano.BM.Csv
+                     , Cardano.BM.CPUticks
+                     , Cardano.BM.MemResident
+                     , Cardano.BM.Stats
+  -- other-extensions:
+  build-depends:       base >=4.12 && <4.14
+                     , text
+                     , time
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  default-extensions:  OverloadedStrings
+
+  ghc-options:         -Wall -Werror
+                       -rtsopts
+                       "-with-rtsopts=-T"
+

bm-timeline/src/Cardano/BM/CPUticks.hs

@@ -0,0 +1,26 @@
+module Cardano.BM.CPUticks
+  (
+      CPUticks (..)
+    , parseline
+  )
+where
+
+import Data.Text.Lazy (unpack)
+
+import Cardano.BM.Common
+
+data CPUticks = CPUticks {
+     timestamp :: Timestamp,
+     ticks :: Int,
+     node :: NodeId
+  } deriving (Show)
+
+instance Lineparser CPUticks where
+    -- example:
+    -- "2020-06-29 16:06:21.85","Stat.cputicks",1252
+
+    itemFromArray [ts, _ev, t] = CPUticks
+                                    (parseTS (remquotes ts))
+                                    (read . unpack $ t)
+                                    (-1)
+    itemFromArray _ = CPUticks time0 (-1) (-1)

bm-timeline/src/Cardano/BM/Csv.hs

@@ -5,6 +5,7 @@ module Cardano.BM.Csv
       output_csv
     , named_columns
     , pairs_in_columns
+    , timestamp_with_list
     , list_to_columns
     , Range
     )
@@ -44,6 +45,9 @@ named_columns ls =
 pairs_in_columns :: (Show a, Show b) => [(a,b)] -> Range
 pairs_in_columns = map (\(a,b) -> [textify a, textify b])
 
+timestamp_with_list :: Show a => [(Text,[a])] -> Range
+timestamp_with_list = map (\(a,b) -> a : (map textify b))
+
 list_to_columns :: Show a => [a] -> Range
 list_to_columns ls = [ map textify ls ]
 

bm-timeline/src/Cardano/BM/MemResident.hs

@@ -0,0 +1,26 @@
+module Cardano.BM.MemResident
+  (
+      MemResident (..)
+    , parseline
+  )
+where
+
+import Data.Text.Lazy (unpack)
+
+import Cardano.BM.Common
+
+data MemResident = MemResident {
+     timestamp :: Timestamp,
+     memresident :: Int,
+     node :: NodeId
+  } deriving (Show)
+
+instance Lineparser MemResident where
+    -- example:
+    -- "2020-06-29 16:07:21.89","Mem.resident",112472064
+
+    itemFromArray [ts, _ev, mem] = MemResident
+                                    (parseTS (remquotes ts))
+                                    (read . unpack $ mem)
+                                    (-1)
+    itemFromArray _ = MemResident time0 (-1) (-1)

bm-timeline/src/Resources.hs

@@ -0,0 +1,152 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Main
+--   (
+--     main
+--   )
+where
+
+import Control.Monad (foldM)
+import Data.List (sortOn)
+import Data.Text.Lazy (Text, pack)
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.IO as TLIO
+import Data.Time.Clock (diffUTCTime)
+import System.Environment (getArgs)
+import System.IO (IOMode(..), withFile)
+import Text.Read (readMaybe)
+
+import Cardano.BM.Common
+import Cardano.BM.Csv
+-- import Cardano.BM.Stats
+import qualified Cardano.BM.CPUticks as CPUticks
+import qualified Cardano.BM.MemResident as MemResident
+
+
+{- data types -}
+type Milliseconds = Int
+
+-- type KeyTxAdopted = TxId
+-- type ValTxAdopted = TxAdopted.TxAdopted --(Timestamp, NodeId, SlotNum)
+-- type HMTxAdopted = HM.HashMap KeyTxAdopted ValTxAdopted
+
+-- type KeyTxMempool = TxId
+-- type ValTxMempool = (Timestamp, NodeId)
+-- type HMTxMempool = HM.HashMap KeyTxMempool ValTxMempool
+
+
+{- main procedure -}
+main :: IO ()
+main = do
+    (n, basep) <- parseArguments
+    let nodes = mknodes n
+    process basep nodes
+
+mknodes :: Int -> [NodeId]
+mknodes n = [0 .. n-1]
+
+parseArguments :: IO (Int, FilePath)
+parseArguments = do
+    parsed <- getArgs >>= return . parseArgs
+    case parsed of
+        Left m -> TLIO.putStrLn "call: reconstruct-time2block <basepath>" >> error m
+        Right res -> return res
+
+  where
+    parseArgs [] = Left "no arguments"
+    parseArgs (_a : []) = Left "not enough arguments"
+    parseArgs (n : bp : []) =
+        case readMaybe n of
+            Nothing -> Left $ "can't parse: " ++ n
+            Just v -> if v > 0
+              then Right (v, bp)
+              else Left $ "wrong value: " ++ n
+    parseArgs _ = Left "too many arguments"
+
+process :: FilePath -> [NodeId] -> IO ()
+process basep nodes = do
+--   let snodes = map (TL.pack . show) nodes
+  cputicks0 <- foldM (processCPUticks basep) [] nodes
+  memusage0 <- foldM (processMemory basep) [] nodes
+  withFile "resources.csv" WriteMode $ \_h -> do
+    --   let hm_txadopted = collect_txadopted txadopted
+      let cputicks1 = sortOn CPUticks.timestamp cputicks0
+      let memusage1 = sortOn MemResident.timestamp memusage0
+      let cpuusage = sortOn fst $ reverse $ process_cputicks (length nodes) cputicks0
+      -- TLIO.putStrLn . TL.pack . show $ hm_adopted
+      -- TLIO.putStrLn . TL.pack . show $ hm_leader
+      TLIO.putStrLn . TL.pack . show $ take 20 cputicks1
+      TLIO.putStrLn . TL.pack . show $ take 20 memusage1
+      TLIO.putStrLn . TL.pack . show $ take 20 cpuusage
+    --   let cdf = calc_cdf time2block
+    --   TLIO.putStrLn . TL.pack . show $ cdf
+    --   let boxplot = calc_boxplot time2block
+    --   TLIO.putStrLn . TL.pack . show $ boxplot
+      -- output_csv h
+      mapM_ (TLIO.putStrLn . TL.pack . show) $ named_columns [ ("timestamp" : (map (\nid -> "cpu " <> T.pack (show nid)) nodes), timestamp_with_list(cpuusage)) ]
+                                  --  , (["min","q1","median","q3","max"], list_to_columns(boxplot))]
+  return ()
+
+process_cputicks :: Int -> [CPUticks.CPUticks] -> [(Text, [Double])]
+process_cputicks _nnodes [] = []
+process_cputicks nnodes ticks = process_cputicks' ticks (replicate nnodes Nothing) [(pack "",replicate nnodes 0.0)]
+  where
+    process_cputicks' :: [CPUticks.CPUticks] -> [Maybe CPUticks.CPUticks] -> [(Text, [Double])] -> [(Text, [Double])]
+    process_cputicks' [] _ acc = acc
+    process_cputicks' (t : ts) lastticks acc =
+      let (ln, lastticks') = calc_cpuusage t lastticks
+      in
+      process_cputicks' ts lastticks' (ln : acc)
+    setAt :: Int -> a -> [a] -> [a]
+    setAt _ _val [] = []
+    setAt 0 val (_v : vs) = val : vs
+    setAt idx val (v : vs) = v : setAt (idx - 1) val vs
+    calc_cpuusage :: CPUticks.CPUticks -> [Maybe CPUticks.CPUticks] -> ((Text, [Double]), [Maybe CPUticks.CPUticks])
+    calc_cpuusage cputicks lastticks =
+      let nodeid = CPUticks.node cputicks
+          timestamp = CPUticks.timestamp cputicks
+          newticks = CPUticks.ticks cputicks
+      in case lastticks !! nodeid of
+        Nothing  -> ( (formatTS timestamp
+                      , setAt nodeid
+                          0.0  -- usage [%]
+                          (replicate (length lastticks) 0.0) )
+                    , setAt nodeid (Just cputicks) lastticks )
+        Just cpu -> let difftime = realToFrac $ 1000.0 * diffUTCTime timestamp (CPUticks.timestamp cpu)
+                        deltaticks = fromIntegral $ newticks - CPUticks.ticks cpu
+                    in
+                    ( (formatTS timestamp
+                      , setAt nodeid
+                          (deltaticks / difftime * 1000.0)  -- usage [%] since last
+                          (replicate (length lastticks) 0.0) )
+                    , setAt nodeid (Just cputicks) lastticks )
+
+
+{-
+let basep = "../benchmarks/shelley3pools/test-data/"
+(txadopted, txmempool) <- processCsv basep
+let hm_txadopted = collect_txadopted txadopted
+let time2block = calc_time2block hm_txadopted txmempool
+-- let time2block = filter (\t -> tm >= 0) time2block0
+-- let s_tms = sort time2block
+calc_cdf time2block
+
+-}
+
+processCPUticks :: FilePath -> [CPUticks.CPUticks] -> NodeId -> IO [CPUticks.CPUticks]
+processCPUticks basep acc nodeid = do
+  csv <- TLIO.readFile $ basep ++ "/cpu-" ++ show nodeid ++ ".csv"
+  ln <- mapLines csv
+  return $ acc ++ map (\mem -> mem{CPUticks.node = nodeid}) ln
+
+processMemory :: FilePath -> [MemResident.MemResident] -> NodeId -> IO [MemResident.MemResident]
+processMemory basep acc nodeid = do
+  csv <- TLIO.readFile $ basep ++ "/mem-" ++ show nodeid ++ ".csv"
+  ln <- mapLines csv
+  return $ acc ++ map (\mem -> mem{MemResident.node = nodeid}) ln
+
+mapLines :: Lineparser a => Text -> IO [a]
+mapLines csv =
+  return $ map parseline (TL.lines csv)