zipkin (empty) → 0.1.0.0

raw patch · 6 files changed

+165/−0 lines, 6 filesdep +basedep +bytestringdep +mersenne-random-pure64setup-changed

Dependencies added: base, bytestring, mersenne-random-pure64, mtl, safe

Files

• LICENSE +20/−0
• Setup.hs +2/−0
• src/Control/Monad/Zipkin.hs +28/−0
• src/Data/Zipkin/Context.hs +36/−0
• src/Data/Zipkin/Types.hs +48/−0
• zipkin.cabal +31/−0

@@ -0,0 +1,20 @@+Copyright (c) 2015 Sam Rijs++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,28 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Control.Monad.Zipkin+  ( Identifier, parseIdentifier+  , TraceInfo(..), fromHeaders, toHeaders, newTraceInfo+  , TraceT, getTraceInfo, forkTraceInfo, runTraceT+  ) where++import Control.Monad.State.Strict+import System.Random.Mersenne.Pure64++import Data.Zipkin.Types+import qualified Data.Zipkin.Context as Ctx++newtype TraceT m a = TraceT { run :: StateT Ctx.TraceContext m a }+  deriving (Functor, Applicative, Monad, MonadTrans)++newTraceInfo :: IO TraceInfo+newTraceInfo = evalState Ctx.newTraceInfo <$> newPureMT++getTraceInfo :: Monad m => TraceT m TraceInfo+getTraceInfo = TraceT Ctx.getTraceInfo++forkTraceInfo :: Monad m => TraceT m TraceInfo+forkTraceInfo = TraceT Ctx.forkTraceInfo++runTraceT :: Monad m => TraceT m a -> TraceInfo -> m a+runTraceT m = evalStateT (run m) . Ctx.mkContext

@@ -0,0 +1,36 @@+{-# LANGUAGE FlexibleContexts #-}++module Data.Zipkin.Context where++import Data.Bits (xor)+import Control.Monad.State.Strict+import System.Random.Mersenne.Pure64++import Data.Zipkin.Types++data TraceContext = TraceContext+  { traceInfo :: TraceInfo+  , traceGen :: PureMT+  }++mkContext :: TraceInfo -> TraceContext+mkContext info = TraceContext+  { traceInfo = info+  , traceGen = pureMT $ hashTraceInfo info+  }++getTraceInfo :: MonadState TraceContext m => m TraceInfo+getTraceInfo = gets traceInfo++newTraceInfo :: MonadState PureMT m => m TraceInfo+newTraceInfo = do+  traceId <- Identifier <$> state randomWord64+  spanId <- Identifier <$> state randomWord64+  return $ TraceInfo traceId spanId Nothing++forkTraceInfo :: MonadState TraceContext m => m TraceInfo+forkTraceInfo = do+  (TraceContext info gen) <- get+  let (newId, gen') = randomWord64 gen+  put (TraceContext info gen')+  return $ TraceInfo (traceId info) (Identifier newId) (Just (spanId info))

@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Zipkin.Types where++import Data.Bits (xor)+import Data.ByteString (ByteString)+import Data.ByteString.Char8 (pack, unpack)+import Data.Maybe (maybeToList)+import Data.String (IsString)+import Data.Word (Word64)+import Numeric (showHex, readHex)+import Safe (readMay)+import System.Random.Mersenne.Pure64++newtype Identifier = Identifier { toWord64 :: Word64 }++instance Show Identifier where+  show (Identifier x) = let hex = showHex x "" in replicate (16 - length hex) '0' ++ hex++instance Read Identifier where+  readsPrec _ = fmap (fmap (\(x, s) -> (Identifier x, s))) readHex++parseIdentifier :: String -> Maybe Identifier+parseIdentifier = readMay++data TraceInfo = TraceInfo+  { traceId :: Identifier+  , spanId :: Identifier+  , parentSpanId :: Maybe Identifier+  }++hashTraceInfo :: TraceInfo -> Word64+hashTraceInfo (TraceInfo traceId spanId parentSpanId) = maybe h (xor h . toWord64) parentSpanId+  where h = toWord64 traceId `xor` toWord64 spanId++fromHeaders :: (Eq s, IsString s) => [(s, ByteString)] -> Maybe TraceInfo+fromHeaders hs = do+  traceId <- lookup "X-B3-TraceId" hs >>= parseIdentifier . unpack+  spanId <- lookup "X-B3-SpanId" hs >>= parseIdentifier . unpack+  let parentSpanId = lookup "X-B3-ParentSpanId" hs >>= parseIdentifier . unpack+  return $ TraceInfo traceId spanId parentSpanId++toHeaders :: IsString s => TraceInfo -> [(s, ByteString)]+toHeaders (TraceInfo traceId spanId parentSpanId) =+  [ Just ("X-B3-TraceId", pack (show traceId))+  , Just ("X-B3-SpanId", pack (show spanId))+  , (\x -> ("X-B3-ParentSpanId", pack (show x))) <$> parentSpanId+  ] >>= maybeToList

@@ -0,0 +1,31 @@+-- Initial trace-ids.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                zipkin+version:             0.1.0.0+synopsis:            Zipkin-style request tracing monad+-- description:         +homepage:            https://github.com/srijs/haskell-zipkin+license:             MIT+license-file:        LICENSE+author:              Sam Rijs+maintainer:          srijs@airpost.net+-- copyright:           +category:            Network+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Control.Monad.Zipkin+  other-modules:       Data.Zipkin.Context+                       Data.Zipkin.Types+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.8 && <4.9,+                       bytestring >=0.10,+                       mersenne-random-pure64 >=0.2,+                       mtl >=2.2,+                       safe >=0.3+  hs-source-dirs:      src+  default-language:    Haskell2010