packages feed

hs-opentelemetry-instrumentation-cloudflare (empty) → 0.1.0.0

raw patch · 7 files changed

+141/−0 lines, 7 filesdep +basedep +case-insensitivedep +hs-opentelemetry-apisetup-changed

Dependencies added: base, case-insensitive, hs-opentelemetry-api, hs-opentelemetry-instrumentation-conduit, hs-opentelemetry-instrumentation-wai, http-types, text, wai

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for cloudflare++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Ian Duncan (c) 2022++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ian Duncan nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,3 @@+# 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hs-opentelemetry-instrumentation-cloudflare.cabal view
@@ -0,0 +1,60 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           hs-opentelemetry-instrumentation-cloudflare+version:        0.1.0.0+description:    Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/instrumentation/cloudflare#readme>+homepage:       https://github.com/iand675/hs-opentelemetry#readme+bug-reports:    https://github.com/iand675/hs-opentelemetry/issues+author:         Ian Duncan+maintainer:     ian@iankduncan.com+copyright:      2021 Ian Duncan+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/iand675/hs-opentelemetry++library+  exposed-modules:+      OpenTelemetry.Instrumentation.Cloudflare+  other-modules:+      Paths_hs_opentelemetry_instrumentation_cloudflare+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , case-insensitive+    , hs-opentelemetry-api ==0.0.3.*+    , hs-opentelemetry-instrumentation-wai+    , http-types+    , text+    , 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+    , case-insensitive+    , hs-opentelemetry-api ==0.0.3.*+    , hs-opentelemetry-instrumentation-conduit+    , hs-opentelemetry-instrumentation-wai+    , http-types+    , text+    , wai+  default-language: Haskell2010
+ src/OpenTelemetry/Instrumentation/Cloudflare.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+module OpenTelemetry.Instrumentation.Cloudflare where++import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Network.Wai+import OpenTelemetry.Attributes (PrimitiveAttribute(..), ToAttribute (..))+import OpenTelemetry.Context+import OpenTelemetry.Instrumentation.Wai (requestContext)+import OpenTelemetry.Trace.Core (addAttributes)+import Control.Monad (forM_)+import Data.Maybe+import qualified Data.List+import qualified Data.CaseInsensitive as CI++cloudflareInstrumentationMiddleware :: Middleware+cloudflareInstrumentationMiddleware app req sendResp = do+  let mCtxt = requestContext req+  forM_ mCtxt $ \ctxt -> do+    forM_ (lookupSpan ctxt) $ \span_ -> do+      addAttributes span_ $ concatMap+        (\hn -> case Data.List.lookup hn $ requestHeaders req of+            Nothing -> []+            Just val -> +              [ ("http.request.header." <> T.decodeUtf8 (CI.foldedCase hn)+                , toAttribute $ T.decodeUtf8 val+                )+              ]+        )+        headers+  app req sendResp+  where+    headers =+      [ "cf-connecting-ip"+      , "true-client-ip"+      , "cf-ray"+      -- CF-Visitor+      , "cf-ipcountry"+      -- CDN-Loop+      , "cf-worker"+      ]
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"