hs-opentelemetry-instrumentation-wai 0.1.1.1 → 1.0.0.0
raw patch · 6 files changed
+444/−130 lines, 6 filesdep +case-insensitivedep +hs-opentelemetry-exporter-in-memorydep +hs-opentelemetry-instrumentation-waidep ~hs-opentelemetry-apiPVP ok
version bump matches the API change (PVP)
Dependencies added: case-insensitive, hs-opentelemetry-exporter-in-memory, hs-opentelemetry-instrumentation-wai, hs-opentelemetry-sdk, hs-opentelemetry-semantic-conventions, hspec
Dependency ranges changed: hs-opentelemetry-api
API changes (from Hackage documentation)
- OpenTelemetry.Instrumentation.Wai: newOpenTelemetryWaiMiddleware' :: HasCallStack => TracerProvider -> Middleware
+ OpenTelemetry.Instrumentation.Wai: newOpenTelemetryWaiMiddleware' :: HasCallStack => TracerProvider -> Meter -> IO Middleware
Files
- ChangeLog.md +10/−0
- LICENSE +1/−1
- README.md +2/−0
- hs-opentelemetry-instrumentation-wai.cabal +41/−15
- src/OpenTelemetry/Instrumentation/Wai.hs +207/−114
- test/Spec.hs +183/−0
ChangeLog.md view
@@ -1,5 +1,15 @@ # Changelog for hs-opentelemetry-instrumentation-wai +## Unreleased++## 1.0.0.0 - 2026-05-29++- **Fix: initial span name is now low-cardinality.** Previously used `{method} {raw_path}`+ which includes IDs, UUIDs, etc. Now uses just `{method}` (e.g. `GET`) until a framework+ sets the `http.route` attribute, at which point the name updates to `{method} {route}`.+- Add `error.type` attribute on 5xx responses (required by stable HTTP server conventions).+- Default `server.port` to 80/443 (based on scheme) when `Host` header omits port.+ ## 0.1.1.1 - Relax `hs-opentelemetry-api` bounds to support 0.3.x
LICENSE view
@@ -1,4 +1,4 @@-Copyright Ian Duncan (c) 2021+Copyright Ian Duncan (c) 2021-2026 All rights reserved.
README.md view
@@ -1,1 +1,3 @@ # hs-opentelemetry-instrumentation-wai++[](https://hackage.haskell.org/package/hs-opentelemetry-instrumentation-wai)
hs-opentelemetry-instrumentation-wai.cabal view
@@ -1,22 +1,22 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack -name: hs-opentelemetry-instrumentation-wai-version: 0.1.1.1-synopsis: WAI instrumentation middleware for OpenTelemetry-description: Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/instrumentation/wai#readme>-category: OpenTelemetry, Web-homepage: https://github.com/iand675/hs-opentelemetry#readme-bug-reports: https://github.com/iand675/hs-opentelemetry/issues-author: Ian Duncan, Jade Lovelace-maintainer: ian@iankduncan.com-copyright: 2024 Ian Duncan, Mercury Technologies-license: BSD3-license-file: LICENSE-build-type: Simple+name: hs-opentelemetry-instrumentation-wai+version: 1.0.0.0+synopsis: WAI instrumentation middleware for OpenTelemetry+description: Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/instrumentation/wai#readme>+category: OpenTelemetry, Web+homepage: https://github.com/iand675/hs-opentelemetry#readme+bug-reports: https://github.com/iand675/hs-opentelemetry/issues+author: Ian Duncan, Jade Lovelace+maintainer: ian@iankduncan.com+copyright: 2024 Ian Duncan, Mercury Technologies+license: BSD3+license-file: LICENSE+build-type: Simple extra-source-files: README.md ChangeLog.md@@ -35,9 +35,35 @@ ghc-options: -Wall build-depends: base >=4.7 && <5- , hs-opentelemetry-api ==0.3.*+ , case-insensitive+ , hs-opentelemetry-api ==1.0.*+ , hs-opentelemetry-semantic-conventions >=1.40 && <2 , http-types , iproute+ , network+ , text+ , unordered-containers+ , vault+ , wai+ default-language: Haskell2010++test-suite hs-opentelemetry-instrumentation-wai-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_hs_opentelemetry_instrumentation_wai+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , hs-opentelemetry-api ==1.0.*+ , hs-opentelemetry-exporter-in-memory ==1.0.*+ , hs-opentelemetry-instrumentation-wai ==1.0.*+ , hs-opentelemetry-sdk ==1.0.*+ , hs-opentelemetry-semantic-conventions >=1.40 && <2+ , hspec+ , http-types , network , text , unordered-containers
src/OpenTelemetry/Instrumentation/Wai.hs view
@@ -1,13 +1,58 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {- |-[New HTTP semantic conventions have been declared stable.](https://opentelemetry.io/blog/2023/http-conventions-declared-stable/#migration-plan) Opt-in by setting the environment variable OTEL_SEMCONV_STABILITY_OPT_IN to-- "http" - to use the stable conventions-- "http/dup" - to emit both the old and the stable conventions-Otherwise, the old conventions will be used. The stable conventions will replace the old conventions in the next major release of this library.+Module : OpenTelemetry.Instrumentation.Wai+Copyright : (c) Ian Duncan, 2021-2026+License : BSD-3+Description : WAI middleware for automatic HTTP server tracing+Stability : experimental++= Overview++Middleware that automatically creates a span for every incoming HTTP request+handled by a WAI application. Extracts trace context from request headers+(via the global propagator) so that spans are properly linked to upstream+callers.++= Quick example++@+import Network.Wai.Handler.Warp (run)+import OpenTelemetry.Instrumentation.Wai (newOpenTelemetryWaiMiddleware)+import OpenTelemetry.Trace (withTracerProvider)++main :: IO ()+main = withTracerProvider $ \_ -> do+ otelMiddleware <- newOpenTelemetryWaiMiddleware+ run 8080 $ otelMiddleware myApp+@++The example imports 'OpenTelemetry.Trace.withTracerProvider' from+@hs-opentelemetry-sdk@ (this package depends only on the API).++= What gets traced++Each request creates a @Server@ span with:++* Span name derived from the HTTP method and route+* @http.request.method@, @url.path@, @url.scheme@, @http.response.status_code@+* @server.address@, @server.port@ when available+* @user_agent.original@ from the User-Agent header+* Span status set to Error for 5xx responses++= Configuration++Use 'newOpenTelemetryWaiMiddleware'' with a specific 'TracerProvider' when+you cannot rely on the process-global tracer provider.++[HTTP semantic conventions migration:](https://opentelemetry.io/blog/2023/http-conventions-declared-stable/#migration-plan)+set @OTEL_SEMCONV_STABILITY_OPT_IN@ to @http@ for stable names only, @http/dup@+for stable and legacy, or leave unset for legacy-only (until the next major+release of this library). -} module OpenTelemetry.Instrumentation.Wai ( newOpenTelemetryWaiMiddleware,@@ -15,52 +60,80 @@ requestContext, ) where -import Control.Exception (bracket)+import Control.Exception (bracket, finally) import Control.Monad+import qualified Data.CaseInsensitive as CI import qualified Data.HashMap.Strict as H import Data.IP (fromHostAddress, fromHostAddress6)+import Data.Int (Int64) import qualified Data.Text as T import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import Data.Text.Lazy.Builder (toLazyText)+import Data.Text.Lazy.Builder.Int (decimal) import qualified Data.Vault.Lazy as Vault import GHC.Stack (HasCallStack) import Network.HTTP.Types import Network.Socket import Network.Wai-import OpenTelemetry.Attributes (lookupAttribute)+import OpenTelemetry.Attributes (lookupAttribute, lookupAttributeByKey)+import qualified OpenTelemetry.Attributes as A+import OpenTelemetry.Attributes.Key (unkey) import qualified OpenTelemetry.Context as Context import OpenTelemetry.Context.ThreadLocal-import OpenTelemetry.Propagator+import OpenTelemetry.Metric.Core+import OpenTelemetry.Propagator (emptyTextMap, extract, getGlobalTextMapPropagator, inject, textMapFromList, textMapToList)+import qualified OpenTelemetry.SemanticConventions as SC import OpenTelemetry.SemanticsConfig import OpenTelemetry.Trace.Core import System.IO.Unsafe+import Text.Read (readMaybe) newOpenTelemetryWaiMiddleware :: (HasCallStack) => IO Middleware-newOpenTelemetryWaiMiddleware = newOpenTelemetryWaiMiddleware' <$> getGlobalTracerProvider+newOpenTelemetryWaiMiddleware = do+ tp <- getGlobalTracerProvider+ mp <- getGlobalMeterProvider+ meter <- getMeter mp "hs-opentelemetry-instrumentation-wai"+ newOpenTelemetryWaiMiddleware' tp meter newOpenTelemetryWaiMiddleware' :: (HasCallStack) => TracerProvider- -> Middleware-newOpenTelemetryWaiMiddleware' tp =+ -> Meter+ -> IO Middleware+newOpenTelemetryWaiMiddleware' tp meter = do+ dur <-+ meterCreateHistogram+ meter+ "http.server.request.duration"+ (Just "s")+ (Just "Duration of inbound HTTP requests")+ defaultAdvisoryParameters+ { advisoryExplicitBucketBoundaries =+ Just [0.005, 0.01, 0.025, 0.05, 0.075, 0.1, 0.25, 0.5, 0.75, 1.0, 2.5, 5.0, 7.5, 10.0]+ }+ active <- meterCreateUpDownCounterInt64 meter "http.server.active_requests" (Just "{request}") (Just "Number of active HTTP server requests") defaultAdvisoryParameters+ reqCount <- meterCreateCounterInt64 meter "http.server.request.count" (Just "{request}") (Just "Total number of HTTP server requests") defaultAdvisoryParameters let waiTracer = makeTracer tp $detectInstrumentationLibrary- (TracerOptions Nothing)- in middleware waiTracer+ tracerOptions+ pure $ middleware waiTracer dur active reqCount where usefulCallsite = callerAttributes- middleware :: Tracer -> Middleware- middleware tracer app req sendResp = do- let propagator = getTracerProviderPropagators $ getTracerTracerProvider tracer+ middleware :: Tracer -> Histogram -> UpDownCounter Int64 -> Counter Int64 -> Middleware+ middleware tracer dur active reqCount app req sendResp = do+ propagator <- getGlobalTextMapPropagator let parentContextM = do ctx <- getContext- ctxt <- extract propagator (requestHeaders req) ctx+ let tm = textMapFromList $ map (\(k, v) -> (T.decodeUtf8 (CI.foldedCase k), T.decodeUtf8 v)) (requestHeaders req)+ ctxt <- extract propagator tm ctx attachContext ctxt- let path_ = T.decodeUtf8 $ rawPathInfo req- -- peer = remoteHost req+ let method_ = T.decodeUtf8 $ requestMethod req+ spanName_ = method_ semanticsOptions <- getSemanticsOptions let args =@@ -71,14 +144,14 @@ Stable -> usefulCallsite `H.union` [- ( "user_agent.original"+ ( unkey SC.userAgent_original , toAttribute $ maybe "" T.decodeUtf8 (lookup hUserAgent $ requestHeaders req) ) ] StableAndOld -> usefulCallsite `H.union` [- ( "user_agent.original"+ ( unkey SC.userAgent_original , toAttribute $ maybe "" T.decodeUtf8 (lookup hUserAgent $ requestHeaders req) ) ]@@ -88,88 +161,82 @@ -- context from being inherited by any subsequent requests served by the -- same thread. Warp supports HTTP keep-alive/persistent connections, -- which means a thread can handle multiple requests before exiting.- bracket parentContextM (const $ void detachContext) $ \_ -> inSpan'' tracer path_ args $ \requestSpan -> do+ let metricReqAttrs =+ A.addAttribute+ A.defaultAttributeLimits+ (A.addAttribute A.defaultAttributeLimits A.emptyAttributes (unkey SC.http_request_method) (T.decodeUtf8 (requestMethod req)))+ (unkey SC.url_scheme)+ (if isSecure req then ("https" :: T.Text) else "http")+ upDownCounterAdd active 1 metricReqAttrs+ startNs <- getTimestamp+ bracket parentContextM detachContext $ \_ -> inSpan'' tracer spanName_ args $ \requestSpan -> do ctxt <- getContext let addStableAttributes = do- addAttributes- requestSpan- [ ("http.request.method", toAttribute $ T.decodeUtf8 $ requestMethod req)- , -- , ( "url.full",- -- toAttribute $- -- T.decodeUtf8- -- ((if secure req then "https://" else "http://") <> host req <> ":" <> B.pack (show $ port req) <> path req <> queryString req)- -- )- ("url.path", toAttribute $ T.decodeUtf8 $ rawPathInfo req)- , ("url.query", toAttribute $ T.decodeUtf8 $ rawQueryString req)- , -- , ( "http.host", toAttribute $ T.decodeUtf8 $ host req)- -- , ( "url.scheme", toAttribute $ TextAttribute $ if secure req then "https" else "http")-- ( "network.protocol.version"- , toAttribute $ case httpVersion req of- (HttpVersion major minor) ->- T.pack $- if minor == 0- then show major- else show major <> "." <> show minor- )- , -- TODO HTTP/3 will require detecting this dynamically- ("net.transport", toAttribute ("ip_tcp" :: T.Text))- ]-- addAttributes requestSpan $ case remoteHost req of- SockAddrInet port addr ->- [ ("server.port", toAttribute (fromIntegral port :: Int))- , ("server.address", toAttribute $ T.pack $ show $ fromHostAddress addr)- ]- SockAddrInet6 port _ addr _ ->- [ ("server.port", toAttribute (fromIntegral port :: Int))- , ("server.address", toAttribute $ T.pack $ show $ fromHostAddress6 addr)- ]- SockAddrUnix path ->- [ ("server.address", toAttribute $ T.pack path)+ let hostAttrs = case lookup "Host" $ requestHeaders req of+ Nothing -> []+ Just hostHeader ->+ let hostText = T.decodeUtf8 hostHeader+ (hostName, portSuffix) = T.breakOn ":" hostText+ portAttr = case T.stripPrefix ":" portSuffix of+ Just portStr | not (T.null portStr) ->+ case readMaybe (T.unpack portStr) :: Maybe Int of+ Just p -> [(unkey SC.server_port, toAttribute p)]+ Nothing -> [(unkey SC.server_port, toAttribute (if isSecure req then 443 :: Int else 80))]+ _ -> [(unkey SC.server_port, toAttribute (if isSecure req then 443 :: Int else 80))]+ in (unkey SC.server_address, toAttribute hostName) : portAttr+ clientAttrs = case remoteHost req of+ SockAddrInet port addr ->+ [ (unkey SC.client_port, toAttribute (fromIntegral port :: Int))+ , (unkey SC.client_address, toAttribute $ T.pack $ show $ fromHostAddress addr)+ ]+ SockAddrInet6 port _ addr _ ->+ [ (unkey SC.client_port, toAttribute (fromIntegral port :: Int))+ , (unkey SC.client_address, toAttribute $ T.pack $ show $ fromHostAddress6 addr)+ ]+ SockAddrUnix path ->+ [ (unkey SC.client_address, toAttribute $ T.pack path)+ ]+ addAttributes requestSpan $+ H.fromList $+ [ (unkey SC.http_request_method, toAttribute method_)+ , (unkey SC.url_path, toAttribute $ T.decodeUtf8 $ rawPathInfo req)+ , (unkey SC.url_query, toAttribute $ T.decodeUtf8 $ rawQueryString req)+ , (unkey SC.url_scheme, toAttribute (if isSecure req then "https" :: T.Text else "http"))+ ,+ ( unkey SC.network_protocol_version+ , toAttribute $ case httpVersion req of+ (HttpVersion major minor) ->+ T.pack $+ if minor == 0+ then show major+ else show major <> "." <> show minor+ ) ]+ <> hostAttrs+ <> clientAttrs addOldAttributes = do- addAttributes- requestSpan- [ ("http.method", toAttribute $ T.decodeUtf8 $ requestMethod req)- , -- , ( "http.url",- -- toAttribute $- -- T.decodeUtf8- -- ((if secure req then "https://" else "http://") <> host req <> ":" <> B.pack (show $ port req) <> path req <> queryString req)- -- )- ("http.target", toAttribute $ T.decodeUtf8 (rawPathInfo req <> rawQueryString req))- , -- , ( "http.host", toAttribute $ T.decodeUtf8 $ host req)- -- , ( "http.scheme", toAttribute $ TextAttribute $ if secure req then "https" else "http")-- ( "http.flavor"- , toAttribute $ case httpVersion req of- (HttpVersion major minor) -> T.pack (show major <> "." <> show minor)- )- ,- ( "http.user_agent"- , toAttribute $ maybe "" T.decodeUtf8 (lookup hUserAgent $ requestHeaders req)- )- , -- TODO HTTP/3 will require detecting this dynamically- ("net.transport", toAttribute ("ip_tcp" :: T.Text))- ]-- -- TODO this is warp dependent, probably.- -- , ( "net.host.ip")- -- , ( "net.host.port")- -- , ( "net.host.name")- addAttributes requestSpan $ case remoteHost req of- SockAddrInet port addr ->- [ ("net.peer.port", toAttribute (fromIntegral port :: Int))- , ("net.peer.ip", toAttribute $ T.pack $ show $ fromHostAddress addr)- ]- SockAddrInet6 port _ addr _ ->- [ ("net.peer.port", toAttribute (fromIntegral port :: Int))- , ("net.peer.ip", toAttribute $ T.pack $ show $ fromHostAddress6 addr)- ]- SockAddrUnix path ->- [ ("net.peer.name", toAttribute $ T.pack path)+ let peerAttrs = case remoteHost req of+ SockAddrInet port addr ->+ [ (unkey SC.net_peer_port, toAttribute (fromIntegral port :: Int))+ , (unkey SC.net_peer_ip, toAttribute $ T.pack $ show $ fromHostAddress addr)+ ]+ SockAddrInet6 port _ addr _ ->+ [ (unkey SC.net_peer_port, toAttribute (fromIntegral port :: Int))+ , (unkey SC.net_peer_ip, toAttribute $ T.pack $ show $ fromHostAddress6 addr)+ ]+ SockAddrUnix path ->+ [ (unkey SC.net_peer_name, toAttribute $ T.pack path)+ ]+ addAttributes requestSpan $+ H.fromList $+ [ (unkey SC.http_method, toAttribute $ T.decodeUtf8 $ requestMethod req)+ , (unkey SC.http_target, toAttribute $ T.decodeUtf8 (rawPathInfo req <> rawQueryString req))+ , (unkey SC.http_flavor, toAttribute $ httpVersionText (httpVersion req))+ , (unkey SC.http_userAgent, toAttribute $ maybe "" T.decodeUtf8 (lookup hUserAgent $ requestHeaders req))+ , (unkey SC.net_transport, toAttribute ("ip_tcp" :: T.Text)) ]+ <> peerAttrs case httpOption semanticsOptions of Stable -> addStableAttributes@@ -186,38 +253,59 @@ } app req' $ \resp -> do ctxt' <- getContext- hs <- inject propagator (Context.insertSpan requestSpan ctxt') []+ tm <- inject propagator (Context.insertSpan requestSpan ctxt') emptyTextMap+ let hs = map (\(k, v) -> (CI.mk (T.encodeUtf8 k), T.encodeUtf8 v)) (textMapToList tm) let resp' = mapResponseHeaders (hs ++) resp attrs <- spanGetAttributes requestSpan- forM_ (lookupAttribute attrs "http.route") $ \case- AttributeValue (TextAttribute route) -> updateName requestSpan route+ forM_ (lookupAttribute attrs (unkey SC.http_route)) $ \case+ AttributeValue (TextAttribute route) -> updateName requestSpan (method_ <> " " <> route) _ -> pure () + let sc = statusCode (responseStatus resp)+ errorAttrs+ | sc >= 500 = [(unkey SC.error_type, toAttribute (T.pack $ show sc))]+ | otherwise = [] case httpOption semanticsOptions of Stable ->- addAttributes- requestSpan- [ ("http.response.status_code", toAttribute $ statusCode $ responseStatus resp)- ]+ addAttributes requestSpan $+ H.fromList $+ (unkey SC.http_response_statusCode, toAttribute sc)+ : errorAttrs StableAndOld ->- addAttributes- requestSpan- [ ("http.response.status_code", toAttribute $ statusCode $ responseStatus resp)- , ("http.status_code", toAttribute $ statusCode $ responseStatus resp)- ]+ addAttributes requestSpan $+ H.fromList $+ [ (unkey SC.http_response_statusCode, toAttribute sc)+ , (unkey SC.http_statusCode, toAttribute sc)+ ]+ <> errorAttrs Old ->- addAttributes- requestSpan- [ ("http.status_code", toAttribute $ statusCode $ responseStatus resp)- ]- when (statusCode (responseStatus resp) >= 500) $ do+ addAttributes requestSpan $+ H.fromList $+ (unkey SC.http_statusCode, toAttribute sc)+ : errorAttrs+ when (sc >= 500) $ setStatus requestSpan (Error "") respReceived <- sendResp resp' ts <- getTimestamp endSpan requestSpan (Just ts)- pure respReceived + flip finally (upDownCounterAdd active (-1) metricReqAttrs) $ do+ let durationSec = fromIntegral (timestampNanoseconds ts - timestampNanoseconds startNs) / 1_000_000_000 :: Double+ mRoute = lookupAttributeByKey attrs SC.http_route+ withRoute = case mRoute of+ Just route -> A.addAttribute A.defaultAttributeLimits metricReqAttrs (unkey SC.http_route) route+ Nothing -> metricReqAttrs+ metricRespAttrs =+ let a1 = A.addAttribute A.defaultAttributeLimits withRoute (unkey SC.http_response_statusCode) sc+ a2 = A.addAttribute A.defaultAttributeLimits a1 (unkey SC.network_protocol_version) (httpVersionText (httpVersion req))+ in if sc >= 500+ then A.addAttribute A.defaultAttributeLimits a2 (unkey SC.error_type) (T.pack (show sc))+ else a2+ histogramRecord dur durationSec metricRespAttrs+ counterAdd reqCount 1 metricRespAttrs+ pure respReceived + contextKey :: Vault.Key Context.Context contextKey = unsafePerformIO Vault.newKey {-# NOINLINE contextKey #-}@@ -227,3 +315,8 @@ requestContext = Vault.lookup contextKey . vault+++httpVersionText :: HttpVersion -> T.Text+httpVersionText (HttpVersion major minor) =+ TL.toStrict $ toLazyText $ decimal major <> "." <> decimal minor
+ test/Spec.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.IORef+import Data.Text (Text)+import qualified Data.Vault.Lazy as Vault+import Network.HTTP.Types+import Network.Socket (SockAddr (..))+import Network.Wai (defaultRequest, responseLBS)+import Network.Wai.Internal (Request (..), ResponseReceived (..))+import OpenTelemetry.Attributes (lookupAttribute)+import OpenTelemetry.Attributes.Attribute (Attribute (..), PrimitiveAttribute (..))+import OpenTelemetry.Attributes.Key (unkey)+import qualified OpenTelemetry.Context as Context+import OpenTelemetry.Context.ThreadLocal (getContext)+import OpenTelemetry.Exporter.InMemory.Span (inMemoryListExporter)+import OpenTelemetry.Instrumentation.Wai (newOpenTelemetryWaiMiddleware')+import OpenTelemetry.Internal.Common.Types (instrumentationLibrary)+import OpenTelemetry.Metric.Core (Meter, noopMeter)+import qualified OpenTelemetry.SemanticConventions as SC+import OpenTelemetry.Trace.Core+import System.Environment (setEnv)+import Test.Hspec+++main :: IO ()+main = do+ setEnv "OTEL_SEMCONV_STABILITY_OPT_IN" "http"+ hspec spec+++mkRequest :: StdMethod -> [Header] -> Request+mkRequest method_ headers =+ defaultRequest+ { requestMethod = renderStdMethod method_+ , rawPathInfo = "/users/123"+ , requestHeaders = headers+ , remoteHost = SockAddrInet 12345 0x0100007f+ , vault = Vault.empty+ }+++withTestMiddleware :: (TracerProvider -> Meter -> IO ResponseReceived) -> IO [ImmutableSpan]+withTestMiddleware action = do+ (processor, ref) <- inMemoryListExporter+ tp <- createTracerProvider [processor] emptyTracerProviderOptions+ let meter = noopMeter (instrumentationLibrary "test" "0.0.0")+ _ <- action tp meter+ _ <- shutdownTracerProvider tp Nothing+ readIORef ref+++firstSpan :: [ImmutableSpan] -> ImmutableSpan+firstSpan (s : _) = s+firstSpan [] = error "No spans recorded"+++spec :: Spec+spec = describe "WAI middleware" $ do+ describe "span naming" $ do+ it "initial span name is just the HTTP method (low cardinality)" $ do+ spans <- withTestMiddleware $ \tp meter -> do+ mw <- newOpenTelemetryWaiMiddleware' tp meter+ let app _req respond = respond $ responseLBS ok200 [] "ok"+ req = mkRequest GET [("Host", "example.com")]+ mw app req $ \_ -> pure ResponseReceived+ hot <- readIORef (spanHot (firstSpan spans))+ hotName hot `shouldBe` "GET"++ it "updates span name to {method} {route} when http.route is set" $ do+ spans <- withTestMiddleware $ \tp meter -> do+ mw <- newOpenTelemetryWaiMiddleware' tp meter+ let app _req respond = do+ ctx <- getContext+ case Context.lookupSpan ctx of+ Just s -> addAttribute s (unkey SC.http_route) ("/users/:id" :: Text)+ Nothing -> pure ()+ respond $ responseLBS ok200 [] "ok"+ req = mkRequest GET [("Host", "example.com")]+ mw app req $ \_ -> pure ResponseReceived+ hot <- readIORef (spanHot (firstSpan spans))+ hotName hot `shouldBe` "GET /users/:id"++ describe "error.type attribute" $ do+ it "sets error.type on 5xx responses" $ do+ spans <- withTestMiddleware $ \tp meter -> do+ mw <- newOpenTelemetryWaiMiddleware' tp meter+ let app _req respond = respond $ responseLBS internalServerError500 [] "err"+ req = mkRequest GET [("Host", "example.com")]+ mw app req $ \_ -> pure ResponseReceived+ hot <- readIORef (spanHot (firstSpan spans))+ lookupAttribute (hotAttributes hot) (unkey SC.error_type)+ `shouldBe` Just (AttributeValue (TextAttribute "500"))++ it "does not set error.type on 2xx responses" $ do+ spans <- withTestMiddleware $ \tp meter -> do+ mw <- newOpenTelemetryWaiMiddleware' tp meter+ let+ app _req respond = respond $ responseLBS ok200 [] "ok"+ req = mkRequest GET [("Host", "example.com")]+ mw app req $ \_ -> pure ResponseReceived+ hot <- readIORef (spanHot (firstSpan spans))+ lookupAttribute (hotAttributes hot) (unkey SC.error_type)+ `shouldBe` Nothing++ it "does not set error.type on 4xx responses" $ do+ spans <- withTestMiddleware $ \tp meter -> do+ mw <- newOpenTelemetryWaiMiddleware' tp meter+ let+ app _req respond = respond $ responseLBS notFound404 [] "nope"+ req = mkRequest GET [("Host", "example.com")]+ mw app req $ \_ -> pure ResponseReceived+ hot <- readIORef (spanHot (firstSpan spans))+ lookupAttribute (hotAttributes hot) (unkey SC.error_type)+ `shouldBe` Nothing++ describe "stable HTTP attributes (OTEL_SEMCONV_STABILITY_OPT_IN=http)" $ do+ it "sets http.request.method" $ do+ spans <- withTestMiddleware $ \tp meter -> do+ mw <- newOpenTelemetryWaiMiddleware' tp meter+ let+ app _req respond = respond $ responseLBS ok200 [] "ok"+ req = mkRequest POST [("Host", "example.com")]+ mw app req $ \_ -> pure ResponseReceived+ hot <- readIORef (spanHot (firstSpan spans))+ lookupAttribute (hotAttributes hot) (unkey SC.http_request_method)+ `shouldBe` Just (AttributeValue (TextAttribute "POST"))++ it "sets url.path" $ do+ spans <- withTestMiddleware $ \tp meter -> do+ mw <- newOpenTelemetryWaiMiddleware' tp meter+ let+ app _req respond = respond $ responseLBS ok200 [] "ok"+ req = mkRequest GET [("Host", "example.com")]+ mw app req $ \_ -> pure ResponseReceived+ hot <- readIORef (spanHot (firstSpan spans))+ lookupAttribute (hotAttributes hot) (unkey SC.url_path)+ `shouldBe` Just (AttributeValue (TextAttribute "/users/123"))++ it "sets server.address from Host header" $ do+ spans <- withTestMiddleware $ \tp meter -> do+ mw <- newOpenTelemetryWaiMiddleware' tp meter+ let+ app _req respond = respond $ responseLBS ok200 [] "ok"+ req = mkRequest GET [("Host", "example.com:8080")]+ mw app req $ \_ -> pure ResponseReceived+ hot <- readIORef (spanHot (firstSpan spans))+ lookupAttribute (hotAttributes hot) (unkey SC.server_address)+ `shouldBe` Just (AttributeValue (TextAttribute "example.com"))++ it "sets http.response.status_code" $ do+ spans <- withTestMiddleware $ \tp meter -> do+ mw <- newOpenTelemetryWaiMiddleware' tp meter+ let+ app _req respond = respond $ responseLBS ok200 [] "ok"+ req = mkRequest GET [("Host", "example.com")]+ mw app req $ \_ -> pure ResponseReceived+ hot <- readIORef (spanHot (firstSpan spans))+ lookupAttribute (hotAttributes hot) (unkey SC.http_response_statusCode)+ `shouldBe` Just (AttributeValue (IntAttribute 200))++ it "sets url.scheme" $ do+ spans <- withTestMiddleware $ \tp meter -> do+ mw <- newOpenTelemetryWaiMiddleware' tp meter+ let+ app _req respond = respond $ responseLBS ok200 [] "ok"+ req = mkRequest GET [("Host", "example.com")]+ mw app req $ \_ -> pure ResponseReceived+ hot <- readIORef (spanHot (firstSpan spans))+ lookupAttribute (hotAttributes hot) (unkey SC.url_scheme)+ `shouldBe` Just (AttributeValue (TextAttribute "http"))++ it "sets server.port default 80 for non-secure" $ do+ spans <- withTestMiddleware $ \tp meter -> do+ mw <- newOpenTelemetryWaiMiddleware' tp meter+ let+ app _req respond = respond $ responseLBS ok200 [] "ok"+ req = mkRequest GET [("Host", "example.com")]+ mw app req $ \_ -> pure ResponseReceived+ hot <- readIORef (spanHot (firstSpan spans))+ lookupAttribute (hotAttributes hot) (unkey SC.server_port)+ `shouldBe` Just (AttributeValue (IntAttribute 80))