diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog for cloudflare +## 1.0.0.0 - 2026-05-29 + +- Promoted to 1.0.0.0 for the hs-opentelemetry 1.0 release. + ## 0.2.0.2 - 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) 2022 +Copyright Ian Duncan (c) 2022-2026 All rights reserved. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,3 +1,9 @@ # Cloudflare OpenTelemetry Instrumentation -This instrumentation package can be used with the `hs-opentelemetry-instrumentation-wai` package to capture a number of interesting Cloudflare headers on incoming HTTP requests. +[![hs-opentelemetry-instrumentation-cloudflare](https://img.shields.io/hackage/v/hs-opentelemetry-instrumentation-cloudflare?style=flat-square&logo=haskell&label=hs-opentelemetry-instrumentation-cloudflare&labelColor=5D4F85)](https://hackage.haskell.org/package/hs-opentelemetry-instrumentation-cloudflare) + +Instrumentation for capturing a number of interesting Cloudflare headers on incoming HTTP requests for WAI applications. + +Intended to be used alongside [hs-opentelemetry-instrumentation-wai]. + +[hs-opentelemetry-instrumentation-wai]: ../wai diff --git a/hs-opentelemetry-instrumentation-cloudflare.cabal b/hs-opentelemetry-instrumentation-cloudflare.cabal --- a/hs-opentelemetry-instrumentation-cloudflare.cabal +++ b/hs-opentelemetry-instrumentation-cloudflare.cabal @@ -1,20 +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-cloudflare -version: 0.2.0.2 -description: Please see the README on GitHub at -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-cloudflare +version: 1.0.0.0 +synopsis: OpenTelemetry instrumentation for Cloudflare services +description: Please see the README on GitHub at +category: OpenTelemetry, Telemetry, Web, Cloudflare +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 @@ -33,9 +35,33 @@ build-depends: base >=4.7 && <5 , case-insensitive - , hs-opentelemetry-api ==0.3.* - , hs-opentelemetry-instrumentation-wai + , hs-opentelemetry-api ==1.0.* + , hs-opentelemetry-instrumentation-wai ==1.0.* + , hs-opentelemetry-semantic-conventions >=1.40 && <2 , text , unordered-containers + , wai + default-language: Haskell2010 + +test-suite cloudflare-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_hs_opentelemetry_instrumentation_cloudflare + 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-cloudflare ==1.0.* + , hs-opentelemetry-instrumentation-wai ==1.0.* + , hs-opentelemetry-sdk ==1.0.* + , hspec + , http-types + , network + , text + , vault , wai default-language: Haskell2010 diff --git a/src/OpenTelemetry/Instrumentation/Cloudflare.hs b/src/OpenTelemetry/Instrumentation/Cloudflare.hs --- a/src/OpenTelemetry/Instrumentation/Cloudflare.hs +++ b/src/OpenTelemetry/Instrumentation/Cloudflare.hs @@ -1,19 +1,26 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} +{- | +Module : OpenTelemetry.Instrumentation.Cloudflare +Description : OpenTelemetry instrumentation for Cloudflare Workers. +Stability : experimental + +Extracts trace context from Cloudflare request headers. +-} module OpenTelemetry.Instrumentation.Cloudflare where import Control.Monad (forM_) import qualified Data.CaseInsensitive as CI import qualified Data.HashMap.Strict as H import qualified Data.List -import Data.Maybe -import qualified Data.Text as T import qualified Data.Text.Encoding as T import Network.Wai -import OpenTelemetry.Attributes (PrimitiveAttribute (..), ToAttribute (..)) +import OpenTelemetry.Attributes (ToAttribute (..)) +import OpenTelemetry.Attributes.Key (unkey) import OpenTelemetry.Context import OpenTelemetry.Instrumentation.Wai (requestContext) +import qualified OpenTelemetry.SemanticConventions as SC import OpenTelemetry.Trace.Core (addAttributes) @@ -29,7 +36,7 @@ Nothing -> [] Just val -> [ - ( "http.request.header." <> T.decodeUtf8 (CI.foldedCase hn) + ( unkey (SC.http_request_header (T.decodeUtf8 (CI.foldedCase hn))) , toAttribute $ T.decodeUtf8 val ) ] diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Data.IORef +import qualified Data.Vault.Lazy as Vault +import Network.HTTP.Types (RequestHeaders, ok200) +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.Exporter.InMemory.Span (inMemoryListExporter) +import OpenTelemetry.Instrumentation.Cloudflare (cloudflareInstrumentationMiddleware) +import OpenTelemetry.Instrumentation.Wai (newOpenTelemetryWaiMiddleware') +import OpenTelemetry.Internal.Common.Types (instrumentationLibrary) +import OpenTelemetry.Metric.Core (noopMeter) +import OpenTelemetry.Trace.Core +import System.Environment (setEnv) +import Test.Hspec + + +main :: IO () +main = do + setEnv "OTEL_SEMCONV_STABILITY_OPT_IN" "http" + hspec spec + + +spec :: Spec +spec = describe "Cloudflare middleware" $ do + it "adds cf-connecting-ip header as attribute" $ do + spans <- + withCloudflareMiddleware + [("cf-connecting-ip", "203.0.113.50"), ("Host", "example.com")] + s <- firstSpan spans + hot <- readIORef (spanHot s) + lookupAttribute (hotAttributes hot) "http.request.header.cf-connecting-ip" + `shouldBe` Just (AttributeValue (TextAttribute "203.0.113.50")) + + it "adds cf-ray header as attribute" $ do + spans <- + withCloudflareMiddleware + [("cf-ray", "abc123-LAX"), ("Host", "example.com")] + s <- firstSpan spans + hot <- readIORef (spanHot s) + lookupAttribute (hotAttributes hot) "http.request.header.cf-ray" + `shouldBe` Just (AttributeValue (TextAttribute "abc123-LAX")) + + it "adds cf-ipcountry header as attribute" $ do + spans <- + withCloudflareMiddleware + [("cf-ipcountry", "US"), ("Host", "example.com")] + s <- firstSpan spans + hot <- readIORef (spanHot s) + lookupAttribute (hotAttributes hot) "http.request.header.cf-ipcountry" + `shouldBe` Just (AttributeValue (TextAttribute "US")) + + it "adds true-client-ip header as attribute" $ do + spans <- + withCloudflareMiddleware + [("true-client-ip", "198.51.100.42"), ("Host", "example.com")] + s <- firstSpan spans + hot <- readIORef (spanHot s) + lookupAttribute (hotAttributes hot) "http.request.header.true-client-ip" + `shouldBe` Just (AttributeValue (TextAttribute "198.51.100.42")) + + it "does not add attributes for missing CF headers" $ do + spans <- withCloudflareMiddleware [("Host", "example.com")] + s <- firstSpan spans + hot <- readIORef (spanHot s) + lookupAttribute (hotAttributes hot) "http.request.header.cf-connecting-ip" + `shouldBe` Nothing + lookupAttribute (hotAttributes hot) "http.request.header.cf-ray" + `shouldBe` Nothing + + +firstSpan :: [ImmutableSpan] -> IO ImmutableSpan +firstSpan (s : _) = pure s +firstSpan [] = expectationFailure "No spans recorded" >> pure (error "unreachable") + + +withCloudflareMiddleware :: RequestHeaders -> IO [ImmutableSpan] +withCloudflareMiddleware headers = do + (processor, ref) <- inMemoryListExporter + tp <- createTracerProvider [processor] emptyTracerProviderOptions + waiMw <- newOpenTelemetryWaiMiddleware' tp (noopMeter (instrumentationLibrary "test" "0.0.0")) + let cfMw = cloudflareInstrumentationMiddleware + app _req respond = respond $ responseLBS ok200 [] "ok" + req = + defaultRequest + { requestMethod = "GET" + , rawPathInfo = "/test" + , requestHeaders = headers + , remoteHost = SockAddrInet 12345 0x0100007f + , vault = Vault.empty + } + _ <- waiMw (cfMw app) req $ \_ -> pure ResponseReceived + _ <- shutdownTracerProvider tp Nothing + readIORef ref