@@ -23,13 +23,11 @@ import qualified Control.Retry as Retry
2323import qualified Data.Aeson as A
2424import qualified Data.Binary.Builder as BB
2525import qualified Data.ByteString.Lazy as BSL
26−import Data.Monoid
2726import qualified Data.Pool as Pool
2827import Data.Text (Text)
2928import qualified Data.Text.Encoding as T
3029import qualified Data.Text.Lazy.Builder as B
3130import Data.Time (NominalDiffTime)
32−import Debug.Trace --TODO: drop
3331import Katip
3432import Katip.Core (LocJs (..))
3533import qualified Network as Net
@@ -45,8 +43,6 @@ newtype APIKey = APIKey
4543 } deriving (Show, Eq)
4644
4745
48−--TODO: retry policy
49−
5046data DataDogAuth =
5147 NoAuthLocal
5248 -- ^ Writing to the local agent, no auth required
@@ -136,8 +132,9 @@ mkDataDogScribe settings sev verb = do
136132 (dataDogScribeSettings_connectionKeepalive settings)
137133 (dataDogScribeSettings_connsPerStripe settings)
138134 pure $ Scribe
139− { liPush = pushPool (dataDogScribeSettings_retry settings) pool keyBuilder sev verb
135+ { liPush = pushPool (dataDogScribeSettings_retry settings) pool keyBuilder verb
140136 , scribeFinalizer = Pool.destroyAllResources pool
137+ , scribePermitItem = permitItem sev
141138 }
142139 where
143140 !keyBuilder = case dataDogScribeSettings_auth settings of
@@ -151,18 +148,16 @@ pushPool
151148 -> Pool.Pool C.Connection
152149 -> Maybe BB.Builder
153150 -- ^ Rendered API key
154− -> Severity
155151 -> Verbosity
156152 -> Item a
157153 -> IO ()
158−pushPool retryPolicy pool token sev verb item
159− | permitItem sev item = void $ Retry.retrying retryPolicy (\_status shouldRetry -> pure (traceShowId shouldRetry)) $ \_status -> do
160− res <- EX.tryAny $ Pool.withResource pool $ \conn -> do
161− C.connectionPut conn rendered
162− pure $ case res of
163− Left e -> traceShow e True
164− Right _ -> False
165− | otherwise = pure ()
154+pushPool retryPolicy pool token verb item =
155+ void $ Retry.retrying retryPolicy (\_status shouldRetry -> pure shouldRetry) $ \_status -> do
156+ res <- EX.tryAny $ Pool.withResource pool $ \conn -> do
157+ C.connectionPut conn rendered
158+ pure $ case res of
159+ Left _ -> True
160+ Right _ -> False
166161 where
167162 payloadBuilder = A.fromEncoding (encodeDatadog verb item) <> "\n"
168163 messageBuilder = case token of