@@ -1,6 +1,7 @@
11{-# LANGUAGE DataKinds #-}
22{-# LANGUAGE LambdaCase #-}
33{-# LANGUAGE NamedFieldPuns #-}
4+{-# LANGUAGE OverloadedStrings #-}
45{-# LANGUAGE PackageImports #-}
56{-# LANGUAGE ScopedTypeVariables #-}
67{-# LANGUAGE TypeOperators #-}
@@ -26,6 +27,7 @@ import "stm-chans" Control.Concurrent.STM.TBMQueue
2627import "aeson" Data.Aeson (Value)
2728import "text" Data.Text.Lazy (toStrict)
2829import "text" Data.Text.Lazy.Builder (toLazyText)
30+import "time" Data.Time.Clock (UTCTime)
2931import "katip" Katip
3032 ( LogItem
3133 , Scribe(Scribe, liPush, scribeFinalizer)
@@ -36,9 +38,12 @@ import "katip" Katip
3638 , permitItem
3739 , unLogStr
3840 , _itemEnv
41+ , _itemHost
3942 , _itemMessage
4043 , _itemSeverity
44+ , _itemTime
4145 )
46+import "hostname" Network.HostName (HostName)
4247import "http-client" Network.HTTP.Client (Manager)
4348import "rollbar-hs" Rollbar.AccessToken (AccessToken)
4449import "rollbar-hs" Rollbar.API (itemsPOST')
@@ -51,9 +56,16 @@ import "rollbar-hs" Rollbar.Item
5156 , warning
5257 )
5358import "rollbar-hs" Rollbar.Item.Body (MessageBody(MessageBody))
54−import "rollbar-hs" Rollbar.Item.Data (Data)
59+import "rollbar-hs" Rollbar.Item.CodeVersion (CodeVersion)
60+import "rollbar-hs" Rollbar.Item.Data
61+ ( Data(framework, server, timestamp)
62+ )
5563import "rollbar-hs" Rollbar.Item.Environment (Environment(Environment))
5664import "rollbar-hs" Rollbar.Item.MissingHeaders (RemoveHeaders)
65+import "rollbar-hs" Rollbar.Item.Server
66+ ( Branch
67+ , Server(Server, branch, host, root, serverCodeVersion)
68+ )
5769
5870import qualified "katip" Katip
5971
@@ -67,17 +79,19 @@ mkRollbarScribe ::
6779 RemoveHeaders headers =>
6880 proxy headers ->
6981 AccessToken ->
82+ Maybe Branch ->
83+ Maybe CodeVersion ->
7084 Manager ->
7185 Severity ->
7286 Verbosity ->
7387 IO Scribe
74−mkRollbarScribe proxy accessToken manager severity verbosity = do
88+mkRollbarScribe proxy accessToken branch codeVersion manager severity verbosity = do
7589 queue <- newTBMQueueIO queueSize
7690 finalize <- newEmptyMVar
7791 setupWorkers proxy queue finalize manager
7892 let liPush item = when (permitItem severity item) $
7993 atomically (writeTBMQueue queue $ rollbarItem' item)
80− rollbarItem' item = rollbarItem proxy accessToken verbosity item
94+ rollbarItem' item = rollbarItem proxy accessToken branch codeVersion verbosity item
8195 scribeFinalizer = do
8296 putMVar finalize ()
8397 takeMVar finalize
@@ -87,15 +101,26 @@ rollbarItem ::
87101 (LogItem a, RemoveHeaders headers) =>
88102 proxy headers ->
89103 AccessToken ->
104+ Maybe Branch ->
105+ Maybe CodeVersion ->
90106 Verbosity ->
91107 Katip.Item a ->
92108 Item Value ("Authorization" ': headers)
93−rollbarItem _ accessToken verbosity item = Item { accessToken, itemData }
109+rollbarItem _ accessToken branch serverCodeVersion verbosity item =
110+ Item { accessToken, itemData }
94111 where
95112 environment :: Environment
96113 environment = Environment (getEnvironment $ _itemEnv item)
114+ hostName :: HostName
115+ hostName = _itemHost item
97116 itemData :: Data Value ("Authorization" ': headers)
98− itemData = case severity of
117+ itemData = itemData'
118+ { framework = Just "katip"
119+ , server = Just server
120+ , timestamp = Just timestamp
121+ }
122+ itemData' :: Data Value ("Authorization" ': headers)
123+ itemData' = case severity of
99124 DebugS -> debug environment (Just messageBody) value
100125 InfoS -> info environment (Just messageBody) value
101126 NoticeS -> info environment (Just messageBody) value
@@ -105,8 +130,12 @@ rollbarItem _ accessToken verbosity item = Item { accessToken, itemData }
105130 messageBody :: MessageBody
106131 messageBody =
107132 MessageBody (toStrict $ toLazyText $ unLogStr $ _itemMessage item)
133+ server :: Server
134+ server = Server { branch, host = Just hostName, root = Nothing, serverCodeVersion }
108135 severity :: Severity
109136 severity = _itemSeverity item
137+ timestamp :: UTCTime
138+ timestamp = _itemTime item
110139 value :: Value
111140 value = itemJson verbosity item
112141