Add requestHandler field to Request

src/AFRP.hs

@@ -103,9 +103,10 @@ mergeCodec (Codec agetter aputter) (Codec bgetter bputter) = Codec (mergeGet age
 data Pair a b = Pair !a !b
 
 data Request = Request
-  { requestTime :: !UTCTime
-  , requestTimeZone :: !TimeZone
-  , requestTraceId :: !UUID
+  { requestTime     :: !UTCTime
+  , requestTimeZone  :: !TimeZone
+  , requestTraceId  :: !UUID
+  , requestHandler  :: !T.Text
   } deriving (Show, Eq)
 
 

src/HomeAssistant/Runtime.hs

@@ -43,11 +43,11 @@ import HomeAssistant.Runtime.Supervisor (supervised)
 import HomeAssistant.Controller.Hallway (hallwayLightsController)
 import qualified HttpServer
 
-step :: (MonadIO m) => FilePath -> UUID -> Auto m a b -> a -> m (b, Auto m a b)
-step path trace st a = do
+step :: (MonadIO m) => FilePath -> T.Text -> UUID -> Auto m a b -> a -> m (b, Auto m a b)
+step path name trace st a = do
   now <- liftIO getCurrentTime
   tz <- liftIO getCurrentTimeZone
-  let req = Request now tz trace
+  let req = Request now tz trace name
   stepAutoSerializing path st req a
 
 data Controller = forall b. Controller Bool T.Text (HASS (Event Value) b)
@@ -83,7 +83,7 @@ runController rootDir bus (Controller _enabled name machine ) = liftIO $ do
     go path inbound f = do
       msg <- atomically (readTChan inbound)
       uuid <- UUID.V4.nextRandom
-      (_, next) <- step path uuid f msg
+      (_, next) <- step path name uuid f msg
       go path inbound next
 
 lookupPort :: IO Int