git.iko.soy/typeable/katip
on master help sign in
Bring in line with unreleased katip 0.8.0.0
9cc89fdMichael Xavier
katip-datadog/katip-datadog.cabal+1−1
compare with master
unifiedsplit
@@ -35,7 +35,7 @@ library
35 base >=4.4.0.0 && <5
35 base >=4.4.0.0 && <5
36 , aeson >= 1.0.0.0
36 , aeson >= 1.0.0.0
37 , bytestring
37 , bytestring
38− , katip >= 0.2.0.0 && < 0.8
38+ , katip >= 0.8.0.0
39 , text
39 , text
40 , connection
40 , connection
41 , resource-pool
41 , resource-pool
katip-datadog/src/Katip/Scribes/Datadog/TCP.hs+9−14
@@ -23,13 +23,11 @@ import qualified Control.Retry as Retry
23import qualified Data.Aeson as A
23import qualified Data.Aeson as A
24import qualified Data.Binary.Builder as BB
24import qualified Data.Binary.Builder as BB
25import qualified Data.ByteString.Lazy as BSL
25import qualified Data.ByteString.Lazy as BSL
26−import Data.Monoid
27import qualified Data.Pool as Pool
26import qualified Data.Pool as Pool
28import Data.Text (Text)
27import Data.Text (Text)
29import qualified Data.Text.Encoding as T
28import qualified Data.Text.Encoding as T
30import qualified Data.Text.Lazy.Builder as B
29import qualified Data.Text.Lazy.Builder as B
31import Data.Time (NominalDiffTime)
30import Data.Time (NominalDiffTime)
32−import Debug.Trace --TODO: drop
33import Katip
31import Katip
34import Katip.Core (LocJs (..))
32import Katip.Core (LocJs (..))
35import qualified Network as Net
33import qualified Network as Net
@@ -45,8 +43,6 @@ newtype APIKey = APIKey
45 } deriving (Show, Eq)
43 } deriving (Show, Eq)
46
44
47
45
48−--TODO: retry policy
49−
50data DataDogAuth =
46data DataDogAuth =
51 NoAuthLocal
47 NoAuthLocal
52 -- ^ Writing to the local agent, no auth required
48 -- ^ Writing to the local agent, no auth required
@@ -136,8 +132,9 @@ mkDataDogScribe settings sev verb = do
136 (dataDogScribeSettings_connectionKeepalive settings)
132 (dataDogScribeSettings_connectionKeepalive settings)
137 (dataDogScribeSettings_connsPerStripe settings)
133 (dataDogScribeSettings_connsPerStripe settings)
138 pure $ Scribe
134 pure $ Scribe
139− { liPush = pushPool (dataDogScribeSettings_retry settings) pool keyBuilder sev verb
135+ { liPush = pushPool (dataDogScribeSettings_retry settings) pool keyBuilder verb
140 , scribeFinalizer = Pool.destroyAllResources pool
136 , scribeFinalizer = Pool.destroyAllResources pool
137+ , scribePermitItem = permitItem sev
141 }
138 }
142 where
139 where
143 !keyBuilder = case dataDogScribeSettings_auth settings of
140 !keyBuilder = case dataDogScribeSettings_auth settings of
@@ -151,18 +148,16 @@ pushPool
151 -> Pool.Pool C.Connection
148 -> Pool.Pool C.Connection
152 -> Maybe BB.Builder
149 -> Maybe BB.Builder
153 -- ^ Rendered API key
150 -- ^ Rendered API key
154− -> Severity
155 -> Verbosity
151 -> Verbosity
156 -> Item a
152 -> Item a
157 -> IO ()
153 -> IO ()
158−pushPool retryPolicy pool token sev verb item
154+pushPool retryPolicy pool token verb item =
159− | permitItem sev item = void $ Retry.retrying retryPolicy (\_status shouldRetry -> pure (traceShowId shouldRetry)) $ \_status -> do
155+ void $ Retry.retrying retryPolicy (\_status shouldRetry -> pure shouldRetry) $ \_status -> do
160− res <- EX.tryAny $ Pool.withResource pool $ \conn -> do
156+ res <- EX.tryAny $ Pool.withResource pool $ \conn -> do
161− C.connectionPut conn rendered
157+ C.connectionPut conn rendered
162− pure $ case res of
158+ pure $ case res of
163− Left e -> traceShow e True
159+ Left _ -> True
164− Right _ -> False
160+ Right _ -> False
165− | otherwise = pure ()
166 where
161 where
167 payloadBuilder = A.fromEncoding (encodeDatadog verb item) <> "\n"
162 payloadBuilder = A.fromEncoding (encodeDatadog verb item) <> "\n"
168 messageBuilder = case token of
163 messageBuilder = case token of