datadog-tracing 1.3.1 → 1.3.2
raw patch · 5 files changed
+40/−28 lines, 5 filesdep +msgpackdep −data-msgpack
Dependencies added: msgpack
Dependencies removed: data-msgpack
Files
- datadog-tracing.cabal +3/−3
- exe/Main.hs +3/−1
- library/Data/MessagePack/Aeson.hs +22/−18
- library/Datadog/Client.hs +8/−1
- library/Servant/MsgPack.hs +4/−5
datadog-tracing.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: datadog-tracing-version: 1.3.1+version: 1.3.2 synopsis: Datadog tracing client and mock agent. license: BSD-3-Clause license-file: LICENSE@@ -50,10 +50,10 @@ , Datadog.Jaeger other-modules: Data.MessagePack.Aeson , Servant.MsgPack- build-depends: , data-msgpack ^>= 0.0.12- , ffunctor ^>= 1.1.0+ build-depends: , ffunctor ^>= 1.1.0 , generic-random ^>= 1.2.0.0 , http-media ^>= 0.7.1.3+ , msgpack ^>= 1.0.1.0 , refined ^>= 0.2.3.0 || ^>= 0.4 , prettyprinter ^>= 1.2.1 , servant-client ^>= 0.14
exe/Main.hs view
@@ -30,7 +30,9 @@ postTraces3 r t = (\_ -> NoContent) <$> postTraces4 r t postTraces4 :: IORef [Trace] -> [Trace] -> Handler TraceResponse-postTraces4 ref traces = liftIO $ (atomicModifyIORef' ref update)+postTraces4 ref traces = do+ liftIO . putStrLn $ "received " <> show (length traces) <> " traces"+ liftIO $ (atomicModifyIORef' ref update) where update store = ((reverse traces) <> store, TraceResponse M.empty) getTraces :: IORef [Trace] -> Handler Jaeger
library/Data/MessagePack/Aeson.hs view
@@ -2,11 +2,7 @@ -- http://hackage.haskell.org/package/msgpack-aeson-0.1.0.0/docs/src/Data-MessagePack-Aeson.html#toAeson -- with only minor changes to use the data-msgpack fork (mostly changing Vector to list). -{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE LambdaCase #-} -- | Aeson bridge for MessagePack --@@ -14,14 +10,15 @@ module Data.MessagePack.Aeson where import Control.Arrow-import Data.Aeson as A-import qualified Data.HashMap.Strict as HM-import Data.MessagePack as MP+import Data.Aeson as A+import Data.ByteString.Lazy (ByteString)+import qualified Data.HashMap.Strict as HM+import Data.MessagePack as MP import Data.Scientific-import qualified Data.Text.Encoding as T-import qualified Data.Vector as V+import qualified Data.Text.Encoding as T+import qualified Data.Vector as V -toAeson :: (Monad m) => MP.Object -> m Value+toAeson :: MP.Object -> A.Result Value toAeson = \case ObjectNil -> pure Null ObjectBool b -> pure . Bool $ b@@ -30,11 +27,12 @@ ObjectDouble d -> pure . Number $ realToFrac d ObjectStr t -> pure . String $ t ObjectBin b -> String <$> either (fail . show) pure (T.decodeUtf8' b)- ObjectArray (V.fromList -> v) -> Array <$> V.mapM toAeson v- ObjectMap (m) ->- A.Object . HM.fromList <$> mapM (\(k, v) -> (,) <$> fromObject k <*> toAeson v) m- ObjectExt _ _ -> fail "ObjectExt not supported"- ObjectWord _ -> fail "ObjectWord not supported"+ ObjectArray v -> Array <$> V.mapM toAeson v+ ObjectMap m ->+ A.Object . HM.fromList . V.toList+ <$> V.mapM (\(k, v) -> (,) <$> from k <*> toAeson v) m+ where from = maybe (fail "bad object") pure . MP.fromObject+ ObjectExt _ _ -> fail "ObjectExt is not supported" fromAeson :: Value -> MP.Object fromAeson = \case@@ -45,5 +43,11 @@ Left f -> ObjectDouble f Right n -> ObjectInt n String t -> ObjectStr t- Array (V.toList -> v) -> ObjectArray $ map fromAeson v- A.Object (HM.toList -> o) -> ObjectMap $ map (toObject *** fromAeson) o+ Array v -> ObjectArray $ V.map fromAeson v+ A.Object o -> ObjectMap $ V.fromList $ map (toObject *** fromAeson) $ HM.toList o++packToJSON :: ToJSON a => a -> ByteString+packToJSON = pack . fromAeson . toJSON++unpackFromJSON :: FromJSON a => ByteString -> Result a+unpackFromJSON b = fromJSON =<< toAeson =<< maybe (fail "msgpack") pure (unpack b)
library/Datadog/Client.hs view
@@ -25,11 +25,12 @@ , Trace(..) , TraceId(..) , newServantAgent+ , newServantAgent' ) where import Control.Monad (unless, void) import Control.Monad.Except (ExceptT, MonadError, MonadIO,- liftEither, liftIO)+ liftEither, liftIO, runExceptT) import Data.Char (isAlpha, isAsciiLower, isDigit) import Data.FFunctor (FFunctor, ffmap) import Data.Int (Int64)@@ -69,6 +70,12 @@ -- | An Agent (or AgentT) implemented by Servant. newServantAgent :: (MonadIO m, MonadError ServantError m) => ClientEnv -> Agent m newServantAgent env = ffmap (liftClientM env) (Agent traces)++-- | A fire-and-forget Agent implemented by Servant.+newServantAgent' :: MonadIO m => ClientEnv -> Agent m+newServantAgent' env =+ let agent = newServantAgent env+ in Agent (\t -> void . runExceptT $ putTraces agent t) type DDText = Refined.NonEmpty && (SizeLessThan 101)
library/Servant/MsgPack.hs view
@@ -11,7 +11,6 @@ import Data.Aeson import Data.List.NonEmpty-import Data.MessagePack (pack, unpack) import Data.MessagePack.Aeson import Network.HTTP.Media ((//)) import Servant.API.ContentTypes@@ -24,9 +23,9 @@ , "application" // "vnd.msgpack"] instance ToJSON a => MimeRender MsgPack a where- mimeRender _ = pack . fromAeson . toJSON+ mimeRender _ = packToJSON instance FromJSON a => MimeUnrender MsgPack a where- mimeUnrender _ b = case fromJSON =<< toAeson =<< unpack b of- Error str -> Left str- Success a -> Right a+ mimeUnrender _ b = case unpackFromJSON b of+ Error str -> Left str+ Success a -> Right a