simulation: short-leios --shared-log-format now takes CBOR|JSON arg

Author: Saizan

simulation/src/LeiosProtocol/Short/DataSimP2P.hs

@@ -44,6 +44,7 @@ import Data.Ord
 import qualified Data.Set as Set
 import Diffusion
 import GHC.Generics
+import LeiosEvents (encodeCBOR)
 import LeiosProtocol.Common hiding (Point)
 import qualified LeiosProtocol.Config as OnDisk
 import LeiosProtocol.Short
@@ -230,13 +231,14 @@ accumDataTransmitted _msg TcpMsgForecast{..} = [(start, end, msgSize)]
   !start = realToFrac msgSendLeadingEdge.unTime
   !end = realToFrac msgSendTrailingEdge.unTime
 
+data LogFormat = Shared {cbor :: Bool} | Legacy {verbosity :: Int}
+
 data SimOutputConfig = SimOutputConfig
   { logFile :: Maybe FilePath
-  , logVerbosity :: Int
   , dataFile :: Maybe FilePath
   , analize :: Bool
   , stop :: Time
-  , sharedFormat :: Bool
+  , logFormat :: LogFormat
   }
 
 rawDataFromState :: OnDisk.Config -> P2PNetwork -> LeiosSimState -> Time -> RawLeiosData
@@ -336,9 +338,11 @@ exampleSim seed cfg p2pNetwork@P2PNetwork{..} SimOutputConfig{..} = do
   runModel model =
     runSampleModel' logFile logEvent model stop $
       exampleTrace2 seed cfg p2pNetwork
-  logEvent = case sharedFormat of
-    False -> logLeiosTraceEvent p2pNodeNames logVerbosity
-    True -> (fmap toEncoding .) . sharedTraceEvent p2pNodeNames
+  logEvent = case logFormat of
+    Legacy{..} -> jsonlLog $ logLeiosTraceEvent p2pNodeNames verbosity
+    Shared{cbor}
+      | cbor -> binaryLog $ (fmap (encodeCBOR . (: [])) .) . sharedTraceEvent p2pNodeNames
+      | otherwise -> jsonlLog $ (fmap toEncoding .) . sharedTraceEvent p2pNodeNames
   renderState fp st = do
     let diffusionData = maybeAnalizeRawData analize (rawDataFromState cfg p2pNetwork st stop)
     encodeFile fp diffusionData

simulation/src/Main.hs

@@ -13,7 +13,7 @@ import Data.Aeson (eitherDecodeFileStrict')
 import Data.Default (Default (..))
 import Data.List (find)
 import qualified Data.Map as Map
-import Data.Maybe (fromMaybe, listToMaybe)
+import Data.Maybe (fromMaybe, isJust)
 import qualified Data.Yaml as Yaml
 import qualified ExamplesRelay
 import qualified ExamplesRelayP2P
@@ -374,12 +374,17 @@ runSimOptions SimOptions{..} = case simCommand of
     p2pNetwork <- execTopologyOptions rng1 topologyOptions
     let outputCfg =
           DataShortLeiosP2P.SimOutputConfig
-            { logFile = listToMaybe [dropExtension simOutputFile <.> "log" | logVerbosity > 0 || sharedFormat]
-            , logVerbosity
-            , dataFile = guard (takeExtension simOutputFile == ".json") >> pure simOutputFile
+            { logFile = do
+                guard (logVerbosity > 0 || isJust sharedFormat)
+                pure $ dropExtension simOutputFile <.> "log"
+            , dataFile = do
+                guard (takeExtension simOutputFile == ".json")
+                pure simOutputFile
             , analize
             , stop = simOutputSeconds
-            , sharedFormat
+            , logFormat = case sharedFormat of
+                Just x -> DataShortLeiosP2P.Shared (x == CBOR)
+                Nothing -> DataShortLeiosP2P.Legacy logVerbosity
             }
     DataShortLeiosP2P.exampleSim rng2 config p2pNetwork outputCfg
 
@@ -415,7 +420,7 @@ data SimCommand
       , topologyOptions :: TopologyOptions
       , logVerbosity :: Int
       , analize :: Bool
-      , sharedFormat :: Bool
+      , sharedFormat :: Maybe OutputFormat
       }
 
 parserSimCommand :: Parser SimCommand
@@ -443,7 +448,7 @@ parserShortLeios =
     <*> parserTopologyOptions
     <*> logVerbosity
     <*> switch (long "analize" <> help "Calculate metrics and statistics.")
-    <*> switch (long "shared-log-format" <> help "Use log format documented in trace.haskell.d.ts. Ignores --log-verbosity.")
+    <*> optional sharedLogFormat
  where
   logVerbosity =
     option
@@ -453,6 +458,18 @@ parserShortLeios =
           <> help "0: no log; 1: major events; 2: debug; 3: all."
           <> shownDefValue 1
       )
+  sharedLogFormat =
+    option
+      auto
+      ( long "shared-log-format"
+          <> metavar "OUTPUT"
+          <> help "Log format documented in trace.haskell.d.ts. OUTPUT can be `CBOR` or `JSON`."
+      )
+
+data OutputFormat
+  = JSON
+  | CBOR
+  deriving (Eq, Read, Show)
 
 data ConfigOptions
   = LeiosConfigFile FilePath

simulation/src/Sample.hs

@@ -9,7 +9,7 @@ import Data.Aeson.Encoding
 import qualified Data.ByteString.Lazy as BSL
 import Data.List (foldl')
 import GHC.Generics
-import System.IO (IOMode (WriteMode), hFlush, stdout, withFile)
+import System.IO (Handle, IOMode (WriteMode), hFlush, stdout, withFile)
 import TimeCompat
 import VizSim
 
@@ -31,12 +31,12 @@ runSampleModel ::
   [(Time, event)] ->
   IO ()
 runSampleModel traceFile logEvent =
-  runSampleModel' (Just traceFile) (\t -> fmap (toEncoding . SampleEvent t) . logEvent)
+  runSampleModel' (Just traceFile) (jsonlLog (\t -> fmap (toEncoding . SampleEvent t) . logEvent))
 
 runSampleModel' ::
   forall event state.
   Maybe FilePath ->
-  (DiffTime -> event -> Maybe Encoding) ->
+  (Handle -> DiffTime -> event -> IO ()) ->
   SampleModel event state ->
   Time ->
   [(Time, event)] ->
@@ -63,9 +63,17 @@ runSampleModel' traceFile logEvent (SampleModel s0 accum render) stop =
           render st'
   writeEvents _h (SimVizModel [] st) = return st
   writeEvents h (SimVizModel ((t'@(Time t), e) : es) st) = do
-    case logEvent t e of
-      Nothing -> return ()
-      Just x -> do
-        BSL.hPutStr h (encodingToLazyByteString x)
-        BSL.hPutStr h "\n"
+    logEvent h t e
     writeEvents h (SimVizModel es (accum t' e st))
+
+jsonlLog :: (t1 -> t2 -> Maybe (Encoding' a)) -> Handle -> t1 -> t2 -> IO ()
+jsonlLog logEvent h t e = case logEvent t e of
+  Nothing -> return ()
+  Just x -> do
+    BSL.hPutStr h (encodingToLazyByteString x)
+    BSL.hPutStr h "\n"
+
+binaryLog :: (t1 -> t2 -> Maybe BSL.ByteString) -> Handle -> t1 -> t2 -> IO ()
+binaryLog logEvent h t e = case logEvent t e of
+  Nothing -> return ()
+  Just x -> BSL.hPutStr h x