Works

src/HomeAssistant/Runtime/Connection.hs

@@ -28,6 +28,9 @@ import HomeAssistant.Controller (Service (..), Target (..))
 import HomeAssistant.Runtime.Bus
 import HomeAssistant.Runtime.Supervisor (Fatal (..))
 import qualified Network.WebSockets as WS
+import Katip (runKatipContextT, sl, logFM, Severity (..), ls)
+import Data.UUID (toText)
+import AFRP (Request(..))
 
 -- | Connect, authenticate, subscribe, then receive and broadcast forever.
 -- Restarting this action reconnects. All setup sends happen before the
@@ -86,10 +89,13 @@ receiveJSON conn = do
 
 writerAction :: Bus -> IO Void
 writerAction bus = forever $ do
-  svc <- atomically $ readTChan (busOutbound bus)
+  (request, svc) <- atomically $ readTChan (busOutbound bus)
   conn <- atomically $ readTVar (busConn bus) >>= maybe retry pure
   callId <- generateCallId (busGen bus)
-  WS.sendTextData conn $ encode $ encodeService callId svc
+  let textData = encode $ encodeService callId svc
+  runKatipContextT (busLogEnv bus) (sl "traceId" (toText (requestTraceId request))) "connection" $
+    logFM DebugS (ls textData)
+  WS.sendTextData conn textData
 
 encodeService :: Int -> Service -> Value
 encodeService callId Service{..} = object $