@@ -3,6 +3,7 @@
33{-# LANGUAGE NamedFieldPuns #-}
44{-# LANGUAGE OverloadedStrings #-}
55{-# LANGUAGE PackageImports #-}
6+{-# LANGUAGE RankNTypes #-}
67{-# LANGUAGE ScopedTypeVariables #-}
78{-# LANGUAGE TypeOperators #-}
89
@@ -12,10 +13,10 @@ module Katip.Scribes.Rollbar
1213
1314import Prelude hiding (error)
1415
15−import "base" Control.Monad (replicateM, when)
16−import "base" Data.Foldable (for_)
17−import "base" Data.Functor (void)
18−import "base" GHC.Conc (atomically)
16+import "base" Control.Monad (replicateM, when)
17+import "base" Data.Foldable (for_)
18+import "base" Data.Functor (void)
19+import "base" GHC.Conc (atomically)
1920
2021import "async" Control.Concurrent.Async (async, waitCatch)
2122import "stm-chans" Control.Concurrent.STM.TBMQueue
@@ -31,8 +32,8 @@ import "text" Data.Text.Lazy.Builder (toLazyText)
3132import "time" Data.Time.Clock (UTCTime)
3233import "katip" Katip
3334 ( LogItem
34− , Scribe(Scribe, liPush, scribeFinalizer)
35− , Severity(DebugS, ErrorS, InfoS, NoticeS, WarningS)
35+ , Scribe(..)
36+ , Severity(..)
3637 , Verbosity
3738 , getEnvironment
3839 , itemJson
@@ -44,6 +45,7 @@ import "katip" Katip
4445 , _itemSeverity
4546 , _itemTime
4647 )
48+import "katip" Katip.Core (PermitFunc)
4749import "hostname" Network.HostName (HostName)
4850import "http-client" Network.HTTP.Client (Manager)
4951import "rollbar-hs" Rollbar.AccessToken (AccessToken)
@@ -76,26 +78,26 @@ queueSize = 4096
7678workerSize :: Int
7779workerSize = 10
7880
79−mkRollbarScribe ::
80− RemoveHeaders headers =>
81− proxy headers ->
82− AccessToken ->
83− Maybe Branch ->
84− Maybe CodeVersion ->
85− Manager -> -- ^ Must support TLS
86− Severity ->
87− Verbosity ->
88− IO Scribe
89−mkRollbarScribe proxy accessToken branch codeVersion manager severity verbosity = do
81+mkRollbarScribe
82+ :: RemoveHeaders headers
83+ => proxy headers
84+ -> AccessToken
85+ -> Maybe Branch
86+ -> Maybe CodeVersion
87+ -> Manager -- ^ Must support TLS
88+ -> PermitFunc
89+ -> Verbosity
90+ -> IO Scribe
91+mkRollbarScribe proxy accessToken branch codeVersion manager scribePermitItem verbosity = do
9092 queue <- newTBMQueueIO queueSize
9193 workers <- replicateM workerSize (async $ mkWorker proxy manager queue)
92− let liPush item = when (permitItem severity item) $
94+ let liPush item =
9395 atomically (writeTBMQueue queue $ rollbarItem' item)
9496 rollbarItem' item = rollbarItem proxy accessToken branch codeVersion verbosity item
9597 scribeFinalizer = do
9698 atomically (closeTBMQueue queue)
9799 for_ workers waitCatch
98− pure Scribe { liPush, scribeFinalizer }
100+ pure Scribe { liPush, scribeFinalizer, scribePermitItem }
99101
100102rollbarItem ::
101103 (LogItem a, RemoveHeaders headers) =>