yam 0.5.4 → 0.5.5
raw patch · 4 files changed
+32/−27 lines, 4 filesdep ~basedep ~salak
Dependency ranges changed: base, salak
Files
- src/Data/Opentracing/Tracer.hs +7/−3
- src/Data/Opentracing/Types.hs +2/−3
- src/Yam/Middleware/Trace.hs +18/−16
- yam.cabal +5/−5
src/Data/Opentracing/Tracer.hs view
@@ -18,7 +18,7 @@ import qualified Data.HashMap.Lazy as HM import Data.Opentracing.Types import Data.Text (Text, justifyRight, pack)-import Data.Time+import Data.Time.Clock.POSIX import Data.Word import Numeric import System.Random@@ -42,10 +42,14 @@ context <- askSpanContext newSpan' name context [] ++getNow :: MonadIO m => m Int+getNow = liftIO $ (round . (* 1000)) <$> getPOSIXTime+ newSpan' :: MonadTracer m => SpanName -> SpanContext -> [SpanReference] -> m Span newSpan' name context references = do spanId <- if null references then return (traceId context) else newId- startTime <- liftIO getCurrentTime+ startTime <- getNow let finishTime = Nothing tags = HM.empty logs = HM.empty@@ -73,7 +77,7 @@ finishSpan :: MonadTracer m => Span -> m Span finishSpan Span{..} = do- ts <- liftIO getCurrentTime+ ts <- getNow return Span {finishTime = Just ts, ..} newContext :: MonadIO m => m SpanContext
src/Data/Opentracing/Types.hs view
@@ -3,7 +3,6 @@ import qualified Data.HashMap.Lazy as HM import Data.Scientific import Data.Text (Text)-import Data.Time data SpanTag = TagString Text@@ -29,8 +28,8 @@ data Span = Span { spanId :: Text , name :: Text- , startTime :: UTCTime- , finishTime :: Maybe UTCTime+ , startTime :: Int+ , finishTime :: Maybe Int , tags :: HM.HashMap Text SpanTag , logs :: HM.HashMap Text Text , context :: SpanContext
src/Yam/Middleware/Trace.hs view
@@ -78,14 +78,17 @@ hSampled :: HeaderName hSampled = "X-B3-Sampled" -parseSpan :: RequestHeaders -> Env -> Env+parseSpan :: RequestHeaders -> Env -> IO Env parseSpan headers env = let sc = fromMaybe (SpanContext "" HM.empty) $ getAttr spanContextKey env in case lookup hTraceId headers of Just tid -> let sc' = sc { traceId = decodeUtf8 tid }- in env & setAttr spanContextKey sc'- & go (maybe (traceId sc') decodeUtf8 $ lookup hSpanId headers) sc'- _ -> env+ in return $ env+ & setAttr spanContextKey sc'+ & go (maybe (traceId sc') decodeUtf8 $ lookup hSpanId headers) sc'+ _ -> do+ c <- newContext+ return $ setAttr spanContextKey c env where go spanId context env' = let name = "-"@@ -97,21 +100,20 @@ in setAttr spanKey Span{..} env' traceMw :: Env -> (Span -> App ()) -> Middleware-traceMw env notify app req resH = runApp (parseSpan (requestHeaders req) env) $- runInSpan ((decodeUtf8 $ requestMethod req) <> " /" <> T.intercalate "/" (pathInfo req)) notify $ \s@Span{..} -> do- let SpanContext{..} = context- tid = traceId <> "," <> spanId- v = L.insert extensionLogKey tid (vault req)- v' = L.insert spanKey s v- liftIO $ app req {vault = v'}- $ resH . mapResponseHeaders (\hs -> (hTraceId,encodeUtf8 traceId):(hSpanId, encodeUtf8 spanId):hs)+traceMw env' notify app req resH = do+ env <- parseSpan (requestHeaders req) env'+ runApp env $+ runInSpan ((decodeUtf8 $ requestMethod req) <> " /" <> T.intercalate "/" (pathInfo req)) notify $ \s@Span{..} -> do+ let SpanContext{..} = context+ tid = traceId <> "," <> spanId+ v = L.insert extensionLogKey tid (vault req)+ v' = L.insert spanKey s v+ liftIO $ app req {vault = v'}+ $ resH . mapResponseHeaders (\hs -> (hTraceId,encodeUtf8 traceId):(hSpanId, encodeUtf8 spanId):hs) traceMiddleware :: TraceConfig -> AppMiddleware traceMiddleware TraceConfig{..} = AppMiddleware $ \env f -> if enabled- then do- c <- newContext- let env' = setAttr spanContextKey c env- f (env', traceMw env' $ notifier method)+ then f (env, traceMw env $ notifier method) else f (env, id)
yam.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: yam-version: 0.5.4+version: 0.5.5 license: BSD3 license-file: LICENSE copyright: (c) 2018 Daniel YU@@ -50,7 +50,7 @@ -fno-warn-missing-signatures build-depends: aeson >=1.4.2.0 && <1.5,- base >=4.7 && <5,+ base >=4.11 && <5, bytestring >=0.10.8.2 && <0.11, data-default >=0.7.1.1 && <0.8, fast-logger >=2.4.13 && <2.5,@@ -60,7 +60,7 @@ mtl >=2.2.2 && <2.3, random ==1.1.*, reflection >=2.1.4 && <2.2,- salak >=0.1.4 && <0.2,+ salak >=0.1.4 && <0.3, scientific >=0.3.6.2 && <0.4, servant-server ==0.15.*, servant-swagger >=1.1.7 && <1.2,@@ -113,7 +113,7 @@ build-depends: QuickCheck >=2.12.6.1 && <2.13, aeson >=1.4.2.0 && <1.5,- base >=4.7 && <5,+ base >=4.11 && <5, bytestring >=0.10.8.2 && <0.11, data-default >=0.7.1.1 && <0.8, fast-logger >=2.4.13 && <2.5,@@ -124,7 +124,7 @@ mtl >=2.2.2 && <2.3, random ==1.1.*, reflection >=2.1.4 && <2.2,- salak >=0.1.4 && <0.2,+ salak >=0.1.4 && <0.3, scientific >=0.3.6.2 && <0.4, servant-server ==0.15.*, servant-swagger >=1.1.7 && <1.2,