hs-opentelemetry-instrumentation-wai 0.1.0.0 → 0.1.1.0
raw patch · 4 files changed
+149/−76 lines, 4 filesdep +unordered-containersdep −bytestringdep −hs-opentelemetry-instrumentation-waidep ~hs-opentelemetry-apinew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: unordered-containers
Dependencies removed: bytestring, hs-opentelemetry-instrumentation-wai
Dependency ranges changed: hs-opentelemetry-api
API changes (from Hackage documentation)
Files
- ChangeLog.md +3/−1
- hs-opentelemetry-instrumentation-wai.cabal +5/−26
- src/OpenTelemetry/Instrumentation/Wai.hs +141/−46
- test/Spec.hs +0/−3
ChangeLog.md view
@@ -1,6 +1,8 @@ # Changelog for hs-opentelemetry-instrumentation-wai -## Unreleased changes+## 0.1.1++- Bracket WAI middleware spans with detachChontext (#116). ## 0.1.0.0
hs-opentelemetry-instrumentation-wai.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: hs-opentelemetry-instrumentation-wai-version: 0.1.0.0+version: 0.1.1.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@@ -13,7 +13,7 @@ bug-reports: https://github.com/iand675/hs-opentelemetry/issues author: Ian Duncan, Jade Lovelace maintainer: ian@iankduncan.com-copyright: 2023 Ian Duncan, Mercury Technologies+copyright: 2024 Ian Duncan, Mercury Technologies license: BSD3 license-file: LICENSE build-type: Simple@@ -35,33 +35,12 @@ ghc-options: -Wall build-depends: base >=4.7 && <5- , bytestring- , hs-opentelemetry-api ==0.1.*- , http-types- , iproute- , network- , text- , 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- , bytestring- , hs-opentelemetry-api ==0.1.*- , hs-opentelemetry-instrumentation-wai+ , hs-opentelemetry-api ==0.2.* , http-types , iproute , network , text+ , unordered-containers , vault , wai default-language: Haskell2010
src/OpenTelemetry/Instrumentation/Wai.hs view
@@ -1,7 +1,14 @@ {-# LANGUAGE LambdaCase #-} {-# 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 ( newOpenTelemetryWaiMiddleware, newOpenTelemetryWaiMiddleware',@@ -10,11 +17,12 @@ import Control.Exception (bracket) import Control.Monad+import qualified Data.HashMap.Strict as H import Data.IP (fromHostAddress, fromHostAddress6) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Vault.Lazy as Vault-import GHC.Stack (HasCallStack, callStack, popCallStack)+import GHC.Stack (HasCallStack) import Network.HTTP.Types import Network.Socket import Network.Wai@@ -22,6 +30,7 @@ import qualified OpenTelemetry.Context as Context import OpenTelemetry.Context.ThreadLocal import OpenTelemetry.Propagator+import OpenTelemetry.SemanticsConfig import OpenTelemetry.Trace.Core import System.IO.Unsafe @@ -29,6 +38,7 @@ newOpenTelemetryWaiMiddleware :: (HasCallStack) => IO Middleware newOpenTelemetryWaiMiddleware = newOpenTelemetryWaiMiddleware' <$> getGlobalTracerProvider + newOpenTelemetryWaiMiddleware' :: (HasCallStack) => TracerProvider@@ -37,7 +47,7 @@ let waiTracer = makeTracer tp- "opentelemetry-instrumentation-wai"+ $detectInstrumentationLibrary (TracerOptions Nothing) in middleware waiTracer where@@ -51,49 +61,121 @@ attachContext ctxt let path_ = T.decodeUtf8 $ rawPathInfo req -- peer = remoteHost req- parentContextM- inSpan'' tracer path_ (defaultSpanArguments {kind = Server, attributes = usefulCallsite}) $ \requestSpan -> do++ semanticsOptions <- getSemanticsOptions+ let args =+ defaultSpanArguments+ { kind = Server+ , attributes =+ case httpOption semanticsOptions of+ Stable ->+ usefulCallsite+ `H.union` [+ ( "user_agent.original"+ , toAttribute $ maybe "" T.decodeUtf8 (lookup hUserAgent $ requestHeaders req)+ )+ ]+ StableAndOld ->+ usefulCallsite+ `H.union` [+ ( "user_agent.original"+ , toAttribute $ maybe "" T.decodeUtf8 (lookup hUserAgent $ requestHeaders req)+ )+ ]+ Old -> usefulCallsite+ }+ -- The cleanup action in this bracket is used to prevent propagated+ -- 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 ctxt <- getContext- 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))- ]+ 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") - -- 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)- ]+ ( "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)+ ]+ 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)+ ]++ case httpOption semanticsOptions of+ Stable -> addStableAttributes+ StableAndOld -> addOldAttributes >> addStableAttributes+ Old -> addOldAttributes+ let req' = req { vault =@@ -111,10 +193,23 @@ AttributeValue (TextAttribute route) -> updateName requestSpan route _ -> pure () - addAttributes- requestSpan- [ ("http.status_code", toAttribute $ statusCode $ responseStatus resp)- ]+ case httpOption semanticsOptions of+ Stable ->+ addAttributes+ requestSpan+ [ ("http.response.status_code", toAttribute $ statusCode $ responseStatus resp)+ ]+ StableAndOld ->+ addAttributes+ requestSpan+ [ ("http.response.status_code", toAttribute $ statusCode $ responseStatus resp)+ , ("http.status_code", toAttribute $ statusCode $ responseStatus resp)+ ]+ Old ->+ addAttributes+ requestSpan+ [ ("http.status_code", toAttribute $ statusCode $ responseStatus resp)+ ] when (statusCode (responseStatus resp) >= 500) $ do setStatus requestSpan (Error "") respReceived <- sendResp resp'
− test/Spec.hs
@@ -1,3 +0,0 @@--main :: IO ()-main = putStrLn "Test suite not yet implemented"