diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -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 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Ian Duncan (c) 2021 +Copyright Ian Duncan (c) 2021-2026 All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,1 +1,3 @@ # hs-opentelemetry-instrumentation-wai + +[![hs-opentelemetry-instrumentation-wai](https://img.shields.io/hackage/v/hs-opentelemetry-instrumentation-wai?style=flat-square&logo=haskell&label=hs-opentelemetry-instrumentation-wai&labelColor=5D4F85)](https://hackage.haskell.org/package/hs-opentelemetry-instrumentation-wai) diff --git a/hs-opentelemetry-instrumentation-wai.cabal b/hs-opentelemetry-instrumentation-wai.cabal --- a/hs-opentelemetry-instrumentation-wai.cabal +++ b/hs-opentelemetry-instrumentation-wai.cabal @@ -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 -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 +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 diff --git a/src/OpenTelemetry/Instrumentation/Wai.hs b/src/OpenTelemetry/Instrumentation/Wai.hs --- a/src/OpenTelemetry/Instrumentation/Wai.hs +++ b/src/OpenTelemetry/Instrumentation/Wai.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -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))