Skip to content

Commit 1dd9454

Browse files
bwbushbwbush
authored
Reduced memory footprint of leios trace processor (#407)
* Reduced memory footprint of leios trace processor * Updated logbook
1 parent e309cb7 commit 1dd9454

File tree

6 files changed

+85
-88
lines changed

6 files changed

+85
-88
lines changed

‎Logbook.md‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,11 @@
11
# Leios logbook
22

3+
## 2025-06-15
4+
5+
### Reduced memory footprint for analyzing simulation traces
6+
7+
The [`leios-trace-processor`](analysis/sims/trace-processor/) was refactored in order to dramatically reduce the memory footprint of analyzing large simulation traces.
8+
39
## 2025-06-12
410

511
### "Miniature mainnet" topology

‎analysis/sims/trace-processor/src/Leios/Tracing/Cpu.hs‎

Lines changed: 11 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -10,18 +10,15 @@ module Leios.Tracing.Cpu (
1010
cpu,
1111
) where
1212

13-
import Control.Concurrent.Chan (Chan, readChan)
14-
import Control.Monad.IO.Class (liftIO)
15-
import Control.Monad.State.Strict (StateT, execStateT, modify')
13+
import Control.Concurrent.MVar (MVar, takeMVar)
1614
import Data.Aeson (Value (Object), withObject, (.:))
1715
import Data.Aeson.Types (Parser, parseMaybe)
1816
import Data.Function (on)
1917
import Data.List (intercalate)
20-
import Data.Map.Strict (Map)
2118
import Data.Monoid (Sum (..))
2219
import Data.Text (Text)
20+
import System.IO (IOMode (WriteMode), hClose, hPutStrLn, openFile)
2321

24-
import qualified Data.Map.Strict as M (insertWith, toList)
2522
import qualified Data.Text as T (unpack)
2623

2724
data ItemKey
@@ -88,27 +85,21 @@ parseMessage "Cpu" created =
8885
parseMessage _ _ =
8986
const $ fail "Ignore"
9087

91-
type Index = Map ItemKey ItemInfo
92-
93-
tally :: Monad m => Value -> StateT Index m ()
88+
tally :: Value -> Maybe String
9489
tally event =
95-
case parseMaybe parseEvent event of
96-
Just (itemKey, itemInfo) ->
97-
do
98-
-- Insert the generated items.
99-
modify' $ M.insertWith (<>) itemKey itemInfo
100-
Nothing -> pure ()
90+
uncurry toCSV <$> parseMaybe parseEvent event
10191

102-
cpu :: FilePath -> Chan (Maybe Value) -> IO ()
92+
cpu :: FilePath -> MVar (Maybe Value) -> IO ()
10393
cpu cpuFile events =
10494
do
95+
h <- openFile cpuFile WriteMode
96+
hPutStrLn h itemHeader
10597
let
10698
go =
10799
do
108-
liftIO (readChan events)
100+
takeMVar events
109101
>>= \case
110102
Nothing -> pure ()
111-
Just event -> tally event >> go
112-
index <- go `execStateT` mempty
113-
writeFile cpuFile . unlines . (itemHeader :) $
114-
uncurry toCSV <$> M.toList index
103+
Just event -> maybe (pure ()) (hPutStrLn h) (tally event) >> go
104+
go
105+
hClose h

‎analysis/sims/trace-processor/src/Leios/Tracing/Lifecycle.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ module Leios.Tracing.Lifecycle (
1010
lifecycle,
1111
) where
1212

13-
import Control.Concurrent.Chan (Chan, readChan)
13+
import Control.Concurrent.MVar (MVar, takeMVar)
1414
import Control.Monad ((<=<))
1515
import Control.Monad.IO.Class (liftIO)
1616
import Control.Monad.State.Strict (StateT, execStateT, gets, modify')
@@ -185,13 +185,13 @@ updateEBs itemKey = updateInclusions "EB" itemKey . inEBs
185185
updateIBs :: Monad m => ItemKey -> ItemInfo -> StateT Index m ()
186186
updateIBs itemKey = updateInclusions "IB" itemKey . inIBs
187187

188-
lifecycle :: FilePath -> Chan (Maybe Value) -> IO ()
188+
lifecycle :: FilePath -> MVar (Maybe Value) -> IO ()
189189
lifecycle lifecycleFile events =
190190
do
191191
let
192192
go =
193193
do
194-
liftIO (readChan events)
194+
liftIO (takeMVar events)
195195
>>= \case
196196
Nothing -> pure ()
197197
Just event -> tally event >> go

‎analysis/sims/trace-processor/src/Leios/Tracing/Processor.hs‎

Lines changed: 15 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -5,8 +5,8 @@ module Leios.Tracing.Processor (
55
) where
66

77
import Control.Concurrent.Async (concurrently_, mapConcurrently_)
8-
import Control.Concurrent.Chan (Chan, dupChan, newChan, writeChan)
9-
import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar)
8+
import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, readMVar)
9+
import Control.Monad (forM_)
1010
import Leios.Tracing.Cpu (cpu)
1111
import Leios.Tracing.Lifecycle (lifecycle)
1212
import Leios.Tracing.Receipt (receipt)
@@ -20,25 +20,28 @@ process :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> IO ()
2020
process logFile lifecycleFile cpuFile resourceFile receiptFile =
2121
do
2222
done <- newEmptyMVar
23-
chan <- newChan
23+
cpuMVar <- newEmptyMVar
24+
lifecycleMVar <- newEmptyMVar
25+
receiptMVar <- newEmptyMVar
26+
resourceMVar <- newEmptyMVar
2427
let reader =
2528
do
2629
logEntries <- LBS8.lines <$> LBS.readFile logFile
27-
nextEntry chan logEntries
30+
nextEntry [cpuMVar, lifecycleMVar, receiptMVar, resourceMVar] logEntries
2831
readMVar done
2932
concurrently_ reader $
3033
mapConcurrently_
3134
id
32-
[ lifecycle lifecycleFile chan
33-
, dupChan chan >>= cpu cpuFile
34-
, dupChan chan >>= resource resourceFile
35-
, dupChan chan >>= receipt receiptFile
35+
[ cpu cpuFile cpuMVar
36+
, lifecycle lifecycleFile lifecycleMVar
37+
, receipt receiptFile receiptMVar
38+
, resource resourceFile resourceMVar
3639
]
3740
>> putMVar done ()
3841

39-
nextEntry :: Chan (Maybe A.Value) -> [LBS8.ByteString] -> IO ()
40-
nextEntry eventChan [] = writeChan eventChan Nothing >> pure ()
41-
nextEntry eventChan (event : events) =
42+
nextEntry :: [MVar (Maybe A.Value)] -> [LBS8.ByteString] -> IO ()
43+
nextEntry eventMVars [] = forM_ eventMVars (`putMVar` Nothing) >> pure ()
44+
nextEntry eventMVars (event : events) =
4245
case A.eitherDecode event of
43-
Right event' -> writeChan eventChan (Just event') >> nextEntry eventChan events
46+
Right event' -> forM_ eventMVars (`putMVar` Just event') >> nextEntry eventMVars events
4447
Left message -> error $ "[" <> LBS8.unpack event <> "|" <> message <> "]"

‎analysis/sims/trace-processor/src/Leios/Tracing/Receipt.hs‎

Lines changed: 47 additions & 50 deletions
Original file line numberDiff line numberDiff line change
@@ -10,18 +10,20 @@ module Leios.Tracing.Receipt (
1010
receipt,
1111
) where
1212

13-
import Control.Concurrent.Chan (Chan, readChan)
13+
import Control.Concurrent.MVar (MVar, takeMVar)
14+
import Control.Monad (void)
1415
import Control.Monad.IO.Class (liftIO)
15-
import Control.Monad.State.Strict (StateT, execStateT, modify')
16+
import Control.Monad.State.Strict (StateT, execStateT, gets, modify')
1617
import Data.Aeson (Value (Object), withObject, (.:))
1718
import Data.Aeson.Types (Parser, parseMaybe)
1819
import Data.Function (on)
1920
import Data.List (intercalate)
2021
import Data.Map.Strict (Map)
2122
import Data.Text (Text)
2223
import Leios.Tracing.Util (Maximum (..), Minimum (..))
24+
import System.IO (IOMode (WriteMode), hClose, hPutStrLn, openFile)
2325

24-
import qualified Data.Map.Strict as M (insertWith, singleton, toAscList, toList)
26+
import qualified Data.Map.Strict as M (insertWith, (!))
2527
import qualified Data.Text as T (unpack)
2628

2729
data ItemKey
@@ -36,7 +38,6 @@ data ItemInfo
3638
= ItemInfo
3739
{ sent :: Minimum Double
3840
, size :: Maximum Double
39-
, receipts :: Map Text Double
4041
}
4142
deriving (Show)
4243

@@ -45,36 +46,26 @@ instance Semigroup ItemInfo where
4546
ItemInfo
4647
{ sent = on (<>) sent x y
4748
, size = on (<>) size x y
48-
, receipts = on (<>) receipts x y
4949
}
5050

5151
instance Monoid ItemInfo where
5252
mempty =
5353
ItemInfo
5454
{ sent = mempty
5555
, size = mempty
56-
, receipts = mempty
5756
}
5857

59-
toCSV :: ItemKey -> ItemInfo -> [String]
60-
toCSV ItemKey{..} ItemInfo{..} =
61-
let
62-
common =
63-
[ T.unpack kind
64-
, T.unpack item
65-
, T.unpack producer
66-
, show sent
67-
]
68-
receive :: Text -> Double -> String
69-
receive recipient received =
70-
intercalate sep $
71-
common
72-
++ [ T.unpack recipient
73-
, show received
74-
, show $ (received -) <$> sent
75-
]
76-
in
77-
uncurry receive <$> M.toAscList receipts
58+
toCSV :: ItemKey -> ItemInfo -> Text -> Double -> String
59+
toCSV ItemKey{..} ItemInfo{..} recipient received =
60+
intercalate sep $
61+
[ T.unpack kind
62+
, T.unpack item
63+
, T.unpack producer
64+
, show sent
65+
, T.unpack recipient
66+
, show received
67+
, show $ (received -) <$> sent
68+
]
7869

7970
itemHeader :: String
8071
itemHeader =
@@ -92,7 +83,7 @@ itemHeader =
9283
sep :: String
9384
sep = ","
9485

95-
parseEvent :: Value -> Parser (ItemKey, ItemInfo)
86+
parseEvent :: Value -> Parser (ItemKey, ItemInfo, Maybe (Text, Double))
9687
parseEvent =
9788
withObject "TraceEvent" $ \event ->
9889
do
@@ -102,101 +93,107 @@ parseEvent =
10293
item <- message .: "id"
10394
parseMessage typ item time $ Object message
10495

105-
parseMessage :: Text -> Text -> Double -> Value -> Parser (ItemKey, ItemInfo)
96+
parseMessage :: Text -> Text -> Double -> Value -> Parser (ItemKey, ItemInfo, Maybe (Text, Double))
10697
parseMessage "TXGenerated" item sent =
10798
withObject "TXGenerated" $ \message ->
10899
do
109100
let kind = "TX"
110101
producer <- message .: "publisher"
111102
size <- message .: "size_bytes"
112-
pure (ItemKey{..}, mempty{size, sent = Minimum $ Just sent})
103+
pure (ItemKey{..}, mempty{size, sent = Minimum $ Just sent}, Nothing)
113104
parseMessage "IBGenerated" item sent =
114105
withObject "IBGenerated" $ \message ->
115106
do
116107
let kind = "IB"
117108
producer <- message .: "producer"
118109
size <- message .: "size_bytes"
119-
pure (ItemKey{..}, mempty{size, sent = Minimum $ Just sent})
110+
pure (ItemKey{..}, mempty{size, sent = Minimum $ Just sent}, Nothing)
120111
parseMessage "EBGenerated" item sent =
121112
withObject "EBGenerated" $ \message ->
122113
do
123114
let kind = "EB"
124115
producer <- message .: "producer"
125116
size <- message .: "size_bytes"
126-
pure (ItemKey{..}, mempty{size, sent = Minimum $ Just sent})
117+
pure (ItemKey{..}, mempty{size, sent = Minimum $ Just sent}, Nothing)
127118
parseMessage "RBGenerated" item sent =
128119
withObject "RBGenerated" $ \message ->
129120
do
130121
let kind = "RB"
131122
producer <- message .: "producer"
132123
size <- message .: "size_bytes"
133-
pure (ItemKey{..}, mempty{size, sent = Minimum $ Just sent})
124+
pure (ItemKey{..}, mempty{size, sent = Minimum $ Just sent}, Nothing)
134125
parseMessage "VTBundleGenerated" item sent =
135126
withObject "VTBundleGenerated" $ \message ->
136127
do
137128
let kind = "VT"
138129
producer <- message .: "producer"
139130
size <- message .: "size_bytes"
140-
pure (ItemKey{..}, mempty{size, sent = Minimum $ Just sent})
131+
pure (ItemKey{..}, mempty{size, sent = Minimum $ Just sent}, Nothing)
141132
parseMessage "TXReceived" item received =
142133
withObject "TXReceived" $ \message ->
143134
do
144135
let kind = "TX"
145136
producer <- message .: "producer"
146137
recipient <- message .: "recipient"
147-
pure (ItemKey{..}, mempty{receipts = M.singleton recipient received})
138+
pure (ItemKey{..}, mempty, Just (recipient, received))
148139
parseMessage "IBReceived" item received =
149140
withObject "IBReceived" $ \message ->
150141
do
151142
let kind = "IB"
152143
producer <- message .: "producer"
153144
recipient <- message .: "recipient"
154-
pure (ItemKey{..}, mempty{receipts = M.singleton recipient received})
145+
pure (ItemKey{..}, mempty, Just (recipient, received))
155146
parseMessage "EBReceived" item received =
156147
withObject "EBReceived" $ \message ->
157148
do
158149
let kind = "EB"
159150
producer <- message .: "producer"
160151
recipient <- message .: "recipient"
161-
pure (ItemKey{..}, mempty{receipts = M.singleton recipient received})
152+
pure (ItemKey{..}, mempty, Just (recipient, received))
162153
parseMessage "RBReceived" item received =
163154
withObject "RBReceived" $ \message ->
164155
do
165156
let kind = "RB"
166157
producer <- message .: "producer"
167158
recipient <- message .: "recipient"
168-
pure (ItemKey{..}, mempty{receipts = M.singleton recipient received})
159+
pure (ItemKey{..}, mempty, Just (recipient, received))
169160
parseMessage "VTBundleReceived" item received =
170161
withObject "VTBundleReceived" $ \message ->
171162
do
172163
let kind = "VT"
173164
producer <- message .: "producer"
174165
recipient <- message .: "recipient"
175-
pure (ItemKey{..}, mempty{receipts = M.singleton recipient received})
166+
pure (ItemKey{..}, mempty, Just (recipient, received))
176167
parseMessage _ _ _ =
177168
const $ fail "Ignore"
178169

179170
type Index = Map ItemKey ItemInfo
180171

181-
tally :: Monad m => Value -> StateT Index m ()
172+
tally :: Monad m => Value -> StateT Index m (Maybe String)
182173
tally event =
183174
case parseMaybe parseEvent event of
184-
Just (itemKey, itemInfo) ->
175+
Just (itemKey, itemInfo, rec) ->
185176
do
186177
-- Insert the generated items.
187178
modify' $ M.insertWith (<>) itemKey itemInfo
188-
Nothing -> pure ()
179+
case rec of
180+
Just (recipient, received) ->
181+
do
182+
itemInfo' <- gets (M.! itemKey)
183+
pure . Just $ toCSV itemKey itemInfo' recipient received
184+
Nothing -> pure Nothing
185+
Nothing -> pure Nothing
189186

190-
receipt :: FilePath -> Chan (Maybe Value) -> IO ()
191-
receipt cpuFile events =
187+
receipt :: FilePath -> MVar (Maybe Value) -> IO ()
188+
receipt receiptFile events =
192189
do
190+
h <- openFile receiptFile WriteMode
191+
hPutStrLn h itemHeader
193192
let
194193
go =
195-
do
196-
liftIO (readChan events)
197-
>>= \case
198-
Nothing -> pure ()
199-
Just event -> tally event >> go
200-
index <- go `execStateT` mempty
201-
writeFile cpuFile . unlines . (itemHeader :) . concat $
202-
uncurry toCSV <$> M.toList index
194+
liftIO (takeMVar events)
195+
>>= \case
196+
Nothing -> pure ()
197+
Just event -> tally event >>= maybe (pure ()) (liftIO . hPutStrLn h) >> go
198+
void $ go `execStateT` mempty
199+
hClose h

‎analysis/sims/trace-processor/src/Leios/Tracing/Resource.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ module Leios.Tracing.Resource (
1010
resource,
1111
) where
1212

13-
import Control.Concurrent.Chan (Chan, readChan)
13+
import Control.Concurrent.MVar (MVar, takeMVar)
1414
import Control.Monad.IO.Class (liftIO)
1515
import Control.Monad.State.Strict (StateT, execStateT, modify')
1616
import Data.Aeson (Value (Object), withObject, (.:))
@@ -201,13 +201,13 @@ tally event =
201201
modify' $ M.insertWith (<>) itemKey itemInfo
202202
Nothing -> pure ()
203203

204-
resource :: FilePath -> Chan (Maybe Value) -> IO ()
204+
resource :: FilePath -> MVar (Maybe Value) -> IO ()
205205
resource resourceFile events =
206206
do
207207
let
208208
go =
209209
do
210-
liftIO (readChan events)
210+
liftIO (takeMVar events)
211211
>>= \case
212212
Nothing -> pure ()
213213
Just event -> tally event >> go

0 commit comments

Comments
 (0)