feat(dumblog): fix debug-file support for internal-messages/admin

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

@@ -53,7 +53,7 @@ import qualified Dumblog.Journal.Logger as DLogger
 import Dumblog.Journal.Snapshot (Snapshot)
 import qualified Dumblog.Journal.Snapshot as Snapshot
 import Dumblog.Journal.StateMachine (InMemoryDumblog, initState)
-import Dumblog.Journal.Types (ClientRequest(..), Input(..))
+import Dumblog.Journal.Types (ClientRequest(..), Input(..), CommandName(..))
 import Dumblog.Journal.Versions (dUMBLOG_CURRENT_VERSION, runCommand)
 import Dumblog.Journal.Worker (WorkerInfo(..), worker)
 
@@ -101,14 +101,11 @@ replayDebug originCommands originState = do
       (s', r) <- runCommand v (DLogger.queueLogger logger) s cmd
       logLines <- DLogger.flushQueue logger
       let
-        ev = case cmd of
-          ClientRequest (Read {}) -> "read"
-          ClientRequest (Write {})-> "write"
         msg = show cmd
         ce = DebEvent
           { from = "client"
           , to = "dumblog"
-          , event = ev
+          , event = commandName cmd
           , receivedLogical = logTime
           , message = msg
           }
@@ -120,7 +117,7 @@ replayDebug originCommands originState = do
              , sent = [ DebEvent
                         { from = "dumblog"
                         , to = "client"
-                        , event = ev
+                        , event = commandName r
                         , receivedLogical = logTime
                         , message = show r
                         }

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

@@ -10,38 +10,67 @@ import GHC.Generics (Generic)
 
 ------------------------------------------------------------------------
 
+class CommandName c where
+  commandName :: c -> String
+
 data Input
   = ClientRequest ClientRequest
   | InternalMessageIn InternalMessage
   | AdminCommand AdminCommand
   deriving stock (Generic, Show)
   deriving anyclass Binary
 
+instance CommandName Input where
+  commandName c = case c of
+    ClientRequest cr -> commandName cr
+    InternalMessageIn im -> commandName im
+    AdminCommand ac -> commandName ac
+
 data ClientRequest
   = Write ByteString
   | Read Int
   deriving stock (Generic, Show)
   deriving anyclass Binary
 
+instance CommandName ClientRequest where
+  commandName (Read {})  = "read"
+  commandName (Write {}) = "write"
+
 data AdminCommand
   = Connect Int
   deriving stock (Generic, Show)
   deriving anyclass Binary
 
+instance CommandName AdminCommand where
+  commandName (Connect{}) = "connect"
+
 data Output
   = ClientResponse ClientResponse
   | InternalMessageOut InternalMessage
   | AdminResponse
   deriving stock Show
 
+instance CommandName Output where
+  commandName c = case c of
+    ClientResponse cr -> commandName cr
+    InternalMessageOut im -> commandName im
+    AdminResponse -> "admin" -- maybe not the nicest name
+
 data ClientResponse
   = OK ByteString
   | NotFound
   | Error ByteString
   deriving stock Show
 
+instance CommandName ClientResponse where
+  commandName _ = "client" -- maybe not the nicest name
+
 data InternalMessage
   = Backup Int ByteString
   | Ack Int
   deriving stock (Generic, Show)
   deriving anyclass Binary
+
+instance CommandName InternalMessage where
+  commandName (Backup {}) = "backup"
+  commandName (Ack {}) = "ack"