core-webserver-warp 0.1.1.0 → 0.1.1.3

raw patch · 2 files changed

+31/−5 lines, 2 filesdep ~core-programdep ~core-telemetryPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: core-program, core-telemetry

API changes (from Hackage documentation)

Files

• core-webserver-warp.cabal +4/−4
• lib/Core/Webserver/Warp.hs +27/−1

@@ -5,13 +5,13 @@ -- see: https://github.com/sol/hpack  name:           core-webserver-warp-version:        0.1.1.0+version:        0.1.1.3 synopsis:       Interoperability with Wai/Warp description:    This is part of a library to help build command-line programs, both tools and                 longer-running daemons.                 .                 This package in particular adds wrappers around the __wai__ (Web Application-                Interface) and __warp__ (Web Server to facilitate integrating this commonly+                Interface) and __warp__ (Web Server) to facilitate integrating this commonly                 used webserver combination with the Program monad from __core-program__. category:       System stability:      experimental@@ -41,8 +41,8 @@     , base >=4.11 && <5     , bytestring     , core-data-    , core-program-    , core-telemetry >=0.1.8+    , core-program >=0.4.6+    , core-telemetry >=0.2.0     , core-text     , http-types     , http2

@@ -84,9 +84,11 @@ import Core.Program.Context import Core.Program.Logging import Core.System.Base+import Core.Telemetry.Identifiers import Core.Telemetry.Observability import Core.Text.Rope import qualified Data.ByteString.Lazy as L+import qualified Data.List as List import qualified Data.Vault.Lazy as Vault import Network.HTTP.Types (     hContentType,@@ -137,7 +139,7 @@     let path = intoRope (rawPathInfo request)      subProgram context0 $ do-        beginTrace $ do+        resumeTraceIf request $ do             encloseSpan path $ do                 context1 <- getContext @@ -234,3 +236,27 @@             Just request ->                 let line = intoRope (requestMethod request) <> " " <> intoRope (rawPathInfo request) <> intoRope (rawQueryString request)                  in debug "request" line++{- |+Pull the Trace identifier and parent Span identifier out of the request+headers, if present. Resume using those values, otherwise start a new trace.+-}+resumeTraceIf :: Request -> Program z a -> Program z a+resumeTraceIf request action =+    case extractTraceParent request of+        Nothing -> do+            beginTrace action+        Just (trace, unique) -> do+            usingTrace trace unique action++--+-- This is wildly inefficient. Surely warp must provide a better way to search+-- header values?!?+--+extractTraceParent :: Request -> Maybe (Trace, Span)+extractTraceParent request =+    let headers = requestHeaders request+        possibleValue = List.lookup "traceparent" headers+     in case possibleValue of+            Nothing -> Nothing+            Just value -> parseTraceParentHeader (intoRope value)