diff --git a/src/sut/dumblog/src/Dumblog/Journal/Main.hs b/src/sut/dumblog/src/Dumblog/Journal/Main.hs index e3c116f6..9c062e9e 100644 --- a/src/sut/dumblog/src/Dumblog/Journal/Main.hs +++ b/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 } diff --git a/src/sut/dumblog/src/Dumblog/Journal/Types.hs b/src/sut/dumblog/src/Dumblog/Journal/Types.hs index d8fc41ca..c6a08b43 100644 --- a/src/sut/dumblog/src/Dumblog/Journal/Types.hs +++ b/src/sut/dumblog/src/Dumblog/Journal/Types.hs @@ -10,6 +10,9 @@ import GHC.Generics (Generic) ------------------------------------------------------------------------ +class CommandName c where + commandName :: c -> String + data Input = ClientRequest ClientRequest | InternalMessageIn InternalMessage @@ -17,31 +20,57 @@ data Input 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"