tracing 0.0.1.1 → 0.0.1.2

raw patch · 4 files changed

+41/−46 lines, 4 filesdep +networkPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: network

API changes (from Hackage documentation)

Files

• app/ZipkinExample.hs +15/−20
• src/Monitor/Tracing.hs +2/−15
• src/Monitor/Tracing/Zipkin.hs +22/−10
• tracing.cabal +2/−1

@@ -3,29 +3,24 @@ {-| A simple tracing example which publishes traces to a local Zipkin server. -} module Main where -import Control.Concurrent (threadDelay) import Control.Monad (void) import Monitor.Tracing-import qualified Monitor.Tracing.Zipkin as Zipkin+import qualified Monitor.Tracing.Zipkin as ZPK+import UnliftIO (MonadUnliftIO, liftIO)+import UnliftIO.Concurrent (forkIO, threadDelay)  example :: (MonadTrace m, MonadUnliftIO m) => m ()-example = Zipkin.rootSpan Zipkin.Accept "something" $ do-  Zipkin.annotate "log2"-  Zipkin.tag "tag2" "def"-  liftIO $ threadDelay 100000-  Zipkin.localSpan "A" $ do-    void $ tracedForkIO $ Zipkin.localSpan "aa" $ do-      liftIO $ threadDelay 20000-      Zipkin.annotate "log1"-      Zipkin.tag "tag1" "def"-    liftIO $ threadDelay 10000-  Zipkin.localSpan "B" $ liftIO $ threadDelay 30000+example = ZPK.rootSpan ZPK.Accept "something" $ do+  ZPK.tag "tag.key1" "a tag value"+  threadDelay 100000+  ZPK.localSpan "nested1" $ do+    void $ forkIO $ ZPK.localSpan "concurrent" $ do+      threadDelay 20000+      ZPK.tag "tag.key2" "another tag value"+    ZPK.annotate "launched concurrent"+    threadDelay 10000+  ZPK.annotate "nested1 ended"+  ZPK.localSpan "nested2" $ threadDelay 30000  main :: IO ()-main = do-  zipkin <- Zipkin.new $ Zipkin.defaultSettings-    { Zipkin.settingsEndpoint = Just $ Zipkin.defaultEndpoint-      { Zipkin.endpointService = Just "print-spans" }-    , Zipkin.settingsHost = "localhost" }-  Zipkin.run zipkin example-  Zipkin.publish zipkin+main = ZPK.with ZPK.defaultSettings $ flip ZPK.run example

@@ -31,25 +31,12 @@ qualified. For example:  > import Monitor.Tracing-> import qualified Monitor.Tracing.Zipkin as Zipkin+> import qualified Monitor.Tracing.Zipkin as ZPK  -} module Monitor.Tracing (   -- * Overview-  MonadTrace, tracedForkIO,-  -- * Convenience exports-  MonadIO, liftIO, MonadUnliftIO, withRunInIO+  MonadTrace ) where  import Control.Monad.Trace.Class--import Control.Concurrent (forkIO, ThreadId)-import Control.Monad.IO.Class (MonadIO, liftIO)-import UnliftIO (MonadUnliftIO, withRunInIO)---- | Starts a new span inside a new thread, returning the newly created thread's ID.------ This convenience method around 'forkIO' and 'withRunInIO' is provided since getting insights into--- concurrent calls is one of the main benefits of tracing.-tracedForkIO :: (MonadTrace m, MonadUnliftIO m) => m () -> m ThreadId-tracedForkIO actn = withRunInIO $ \run -> forkIO $ run actn

@@ -6,7 +6,9 @@ {-| <https://zipkin.apache.org/ Zipkin> trace publisher. -} module Monitor.Tracing.Zipkin (   -- * Set up the trace collector-  Zipkin, new, Settings(..), defaultSettings, Endpoint(..), defaultEndpoint, run, publish,+  Zipkin,+  new, Settings(..), defaultSettings, Endpoint(..), defaultEndpoint,+  run, publish, with,   -- * Record in-process spans   rootSpan, Sampling(..), localSpan,   -- * Record cross-process spans@@ -26,6 +28,7 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Data.Aeson as JSON import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS import Data.Time.Clock (NominalDiffTime) import Data.Foldable (toList) import Data.Int (Int64)@@ -43,17 +46,20 @@ import Net.IPv6 (IPv6) import Network.HTTP.Client (Manager, Request) import qualified Network.HTTP.Client as HTTP+import Network.Socket (HostName, PortNumber)+import UnliftIO (MonadUnliftIO)+import UnliftIO.Exception (finally)  -- | Zipkin creating settings. data Settings = Settings-  { settingsManager :: !(Maybe Manager)-  -- ^ An optional HTTP manager to use for publishing spans on the Zipkin server.-  , settingsHost :: !ByteString-  -- ^ The Zipkin server host.-  , settingsPort :: !Int+  { settingsHostname :: !HostName+  -- ^ The Zipkin server's hostname.+  , settingsPort :: !PortNumber   -- ^ The port the Zipkin server is listening on.   , settingsEndpoint :: !(Maybe Endpoint)   -- ^ Local endpoint used for all published spans.+  , settingsManager :: !(Maybe Manager)+  -- ^ An optional HTTP manager to use for publishing spans on the Zipkin server.   , settingsPublishPeriod :: !NominalDiffTime   -- ^ If set to a positive value, traces will be flushed in the background every such period.   }@@ -61,7 +67,7 @@ -- | Creates 'Settings' pointing to a Zikpin server at host @"localhost"@ and port @9411@, without -- background flushing. defaultSettings :: Settings-defaultSettings = Settings Nothing "localhost" 9411 Nothing 0+defaultSettings = Settings "localhost" 9411 Nothing Nothing 0  -- | A Zipkin trace publisher. data Zipkin = Zipkin@@ -85,15 +91,15 @@  -- | Creates a 'Zipkin' publisher for the input 'Settings'. new :: MonadIO m => Settings -> m Zipkin-new (Settings mbMgr host port mbEpt prd) = liftIO $ do+new (Settings hostname port mbEpt mbMgr prd) = liftIO $ do   mgr <- maybe (HTTP.newManager HTTP.defaultManagerSettings) pure mbMgr   tracer <- newTracer   let     req = HTTP.defaultRequest       { HTTP.method = "POST"-      , HTTP.host = host+      , HTTP.host = BS.pack hostname       , HTTP.path = "/api/v2/spans"-      , HTTP.port = port }+      , HTTP.port = fromIntegral port }   void $ if prd <= 0     then pure Nothing     else fmap Just $ forkIO $ forever $ do@@ -111,6 +117,12 @@ publish :: MonadIO m => Zipkin -> m () publish z =   liftIO $ flushSpans (zipkinEndpoint z) (zipkinTracer z) (zipkinRequest z) (zipkinManager z)++-- | Convenience method to start a 'Zipkin', run an action, and publish all spans before returning.+with :: MonadUnliftIO m => Settings -> (Zipkin -> m a) -> m a+with settings f = do+  zipkin <- new settings+  f zipkin `finally` publish zipkin  -- | Adds a tag to the active span. tag :: MonadTrace m => Text -> Text -> m ()

@@ -1,5 +1,5 @@ name:                tracing-version:             0.0.1.1+version:             0.0.1.2 synopsis:            Distributed tracing description:         https://github.com/mtth/tracing homepage:            https://github.com/mtth/tracing@@ -29,6 +29,7 @@                      , http-client >= 0.5 && < 0.6                      , ip >= 1.4 && < 1.5                      , mtl >= 2.2 && < 2.3+                     , network >= 2.8 && < 2.9                      , random >= 1.1 && < 1.2                      , stm >= 2.5 && < 2.6                      , text >= 1.2 && < 1.3