conduit instrumentation, improve http client support

examples/yesod-minimal/src/Minimal.hs

@@ -20,7 +20,6 @@ import Database.Persist.Sql
 import Database.Persist.Sql.Raw.QQ
 import Data.Text (Text, pack)
 import Data.Text.Encoding (decodeUtf8)
-import Network.HTTP.Client
 import Network.HTTP.Types
 import Network.Wai.Handler.Warp (run)
 import OpenTelemetry.Exporters.Handle
@@ -99,13 +98,8 @@ getRootR = do
   let httpConfig = httpClientInstrumentationConfig
         { httpClientPropagator = propagator
         }
-  resp <- inSpan "http.request" (emptySpanArguments { startingKind = Client }) $ \span -> do
-    req <- parseUrlThrow "http://localhost:3000/api"
-    ctxt <- getContext
-    req' <- instrumentRequest httpConfig ctxt req
-    realResponse <- liftIO $ httpLbs req' m
-    _ <- instrumentResponse httpConfig ctxt realResponse
-    pure realResponse
+  req <- parseUrlThrow "http://localhost:3000/api"
+  resp <- httpLbs httpConfig req m
   pure $ decodeUtf8 $ L.toStrict $ responseBody resp
 
 getApiR :: Handler Text

instrumentation/conduit/.gitignore

@@ -0,0 +1,2 @@
+.stack-work/
+*~

instrumentation/conduit/ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for otel-instrumentation-conduit
+
+## Unreleased changes

instrumentation/conduit/LICENSE

@@ -0,0 +1,30 @@
+Copyright Ian Duncan (c) 2021
+
+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.

instrumentation/conduit/README.md

@@ -0,0 +1 @@
+# otel-instrumentation-conduit

instrumentation/conduit/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

instrumentation/conduit/otel-instrumentation-conduit.cabal

@@ -0,0 +1,54 @@
+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:           otel-instrumentation-conduit
+version:        0.1.0.0
+description:    Please see the README on GitHub at <https://github.com/iand675/otel-instrumentation-conduit#readme>
+homepage:       https://github.com/iand675/otel-instrumentation-conduit#readme
+bug-reports:    https://github.com/iand675/otel-instrumentation-conduit/issues
+author:         Ian Duncan
+maintainer:     [email protected]
+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/otel-instrumentation-conduit
+
+library
+  exposed-modules:
+      OpenTelemetry.Instrumentation.Conduit
+  other-modules:
+      Paths_otel_instrumentation_conduit
+  hs-source-dirs:
+      src
+  build-depends:
+      base >=4.7 && <5
+    , conduit
+    , otel-api
+    , text
+  default-language: Haskell2010
+
+test-suite otel-instrumentation-conduit-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_otel_instrumentation_conduit
+  hs-source-dirs:
+      test
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , conduit
+    , otel-api
+    , otel-instrumentation-conduit
+    , text
+  default-language: Haskell2010

instrumentation/conduit/package.yaml

@@ -0,0 +1,40 @@
+name:                otel-instrumentation-conduit
+version:             0.1.0.0
+github:              "iand675/otel-instrumentation-conduit"
+license:             BSD3
+author:              "Ian Duncan"
+maintainer:          "[email protected]"
+copyright:           "2021 Ian Duncan"
+
+extra-source-files:
+- README.md
+- ChangeLog.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README on GitHub at <https://github.com/iand675/otel-instrumentation-conduit#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+- conduit
+- text
+- otel-api
+
+library:
+  source-dirs: src
+
+tests:
+  otel-instrumentation-conduit-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - otel-instrumentation-conduit

instrumentation/conduit/src/OpenTelemetry/Instrumentation/Conduit.hs

@@ -0,0 +1,22 @@
+module OpenTelemetry.Instrumentation.Conduit where
+import Conduit
+import OpenTelemetry.Trace hiding (getTracer)
+import OpenTelemetry.Trace.Monad (MonadTracer(..), MonadGetContext(..))
+import Data.Text (Text)
+import Control.Exception (throwIO, SomeException)
+
+inSpan
+  :: (MonadTracer m, MonadGetContext m, MonadResource m, MonadUnliftIO m) => Text
+  -> CreateSpanArguments
+  -> (Span -> ConduitM i o m a)
+  -> ConduitM i o m a
+inSpan n args f = do
+  t <- lift getTracer
+  ctx <- lift getContext
+  bracketP
+    (createSpan t ctx n args)
+    (`endSpan` Nothing) $ \span -> do
+      catchC (f span) $ \e -> do
+        liftIO $ do
+          recordException span (e :: SomeException)
+          throwIO e

instrumentation/conduit/test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"

instrumentation/http-client/otel-instrumentation-http-client.cabal

@@ -27,19 +27,25 @@ library
   exposed-modules:
       OpenTelemetry.Instrumentation.HttpClient
       OpenTelemetry.Instrumentation.HttpClient.Raw
+      OpenTelemetry.Instrumentation.HttpClient.Simple
   other-modules:
       Paths_otel_instrumentation_http_client
   hs-source-dirs:
       src
   build-depends:
-      base >=4.7 && <5
+      aeson
+    , base >=4.7 && <5
     , bytestring
     , case-insensitive
+    , conduit
     , http-client
     , http-client-tls
+    , http-conduit
     , http-types
     , otel-api
+    , otel-instrumentation-conduit
     , text
+    , unliftio
   default-language: Haskell2010
 
 test-suite otel-instrumentation-http-client-test
@@ -51,13 +57,18 @@ test-suite otel-instrumentation-http-client-test
       test
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base >=4.7 && <5
+      aeson
+    , base >=4.7 && <5
     , bytestring
     , case-insensitive
+    , conduit
     , http-client
     , http-client-tls
+    , http-conduit
     , http-types
     , otel-api
+    , otel-instrumentation-conduit
     , otel-instrumentation-http-client
     , text
+    , unliftio
   default-language: Haskell2010

instrumentation/http-client/package.yaml

@@ -22,12 +22,17 @@ description:         Please see the README on GitHub at <https://github.com/iand
 dependencies:
 - base >= 4.7 && < 5
 - case-insensitive
+- conduit
 - http-client
 - http-client-tls
+- http-conduit
 - http-types
 - otel-api
 - text
 - bytestring
+- unliftio
+- aeson
+- otel-instrumentation-conduit
 
 library:
   source-dirs: src