hs-opentelemetry-instrumentation-gogol (empty) → 1.0.0.0

raw patch · 7 files changed

+329/−0 lines, 7 filesdep +basedep +bytestringdep +exceptionssetup-changed

Dependencies added: base, bytestring, exceptions, gogol-core, hs-opentelemetry-api, hs-opentelemetry-exporter-in-memory, hs-opentelemetry-instrumentation-gogol, hs-opentelemetry-sdk, hs-opentelemetry-semantic-conventions, hspec, http-types, resourcet, text, unordered-containers

Files

ChangeLog.md +13/−0
LICENSE +30/−0
README.md +46/−0
Setup.hs +4/−0
hs-opentelemetry-instrumentation-gogol.cabal +66/−0
src/OpenTelemetry/Instrumentation/Gogol.hs +168/−0
test/Spec.hs +2/−0

+ ChangeLog.md view

@@ -0,0 +1,13 @@+# Changelog for hs-opentelemetry-instrumentation-gogol++## 1.0.0.0 - 2026-05-29++- Promoted to 1.0.0.0 for the hs-opentelemetry 1.0 release.++## 0.1.0.0++- Initial release+- `tracedSend` and `tracedSendEither` wrappers for Gogol API calls+- RPC semantic convention attributes (rpc.system, rpc.service, rpc.method)+- GCP cloud provider attribute+- Error recording with HTTP status codes

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) Ian Duncan 2026++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,46 @@+# hs-opentelemetry-instrumentation-gogol++[![hs-opentelemetry-instrumentation-gogol](https://img.shields.io/hackage/v/hs-opentelemetry-instrumentation-gogol?style=flat-square&logo=haskell&label=hs-opentelemetry-instrumentation-gogol&labelColor=5D4F85)](https://hackage.haskell.org/package/hs-opentelemetry-instrumentation-gogol)++OpenTelemetry instrumentation for the [Gogol](https://hackage.haskell.org/package/gogol) Google Cloud SDK.++## Usage++Gogol does not have a hooks/middleware API, so instrumentation is provided as+wrapper functions. Replace `send` with `tracedSend` (or `sendEither` with+`tracedSendEither`):++```haskell+import Gogol+import OpenTelemetry.Instrumentation.Gogol (tracedSend)++main :: IO ()+main = do+  tracer <- ...+  env <- newEnv+  runResourceT . runGoogle env $ do+    -- Instead of: send (newObjectsGet bucket object)+    result <- tracedSend tracer send (newObjectsGet bucket object)+    ...+```++## Attributes++Each span includes:++| Attribute            | Example           |+|----------------------|-------------------|+| `rpc.system`         | `gcp-api`         |+| `rpc.service`        | `storage`         |+| `rpc.method`         | `ObjectsGet`      |+| `server.address`     | `storage.googleapis.com` |+| `cloud.provider`     | `gcp`             |+| `error.type`         | (on failure)      |+| `http.response.status_code` | (on failure) |++## Design++Because Gogol runs in a `Google` monad (essentially `ReaderT (Env s) (ResourceT IO)`)+without hook points, the wrappers take the `send` function as a parameter. This+avoids depending on the full `gogol` package (only `gogol-core`) and works with+any send-like function.

+ Setup.hs view

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

+ hs-opentelemetry-instrumentation-gogol.cabal view

@@ -0,0 +1,66 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.38.3.+--+-- see: https://github.com/sol/hpack++name:           hs-opentelemetry-instrumentation-gogol+version:        1.0.0.0+synopsis:       OpenTelemetry instrumentation for the Gogol Google Cloud SDK+description:    Tracing wrappers for Gogol Google Cloud SDK calls. Creates spans per Google API call with RPC semantic convention attributes.+category:       OpenTelemetry, Telemetry, Monitoring, Observability, Google Cloud+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++source-repository head+  type: git+  location: https://github.com/iand675/hs-opentelemetry++library+  exposed-modules:+      OpenTelemetry.Instrumentation.Gogol+  other-modules:+      Paths_hs_opentelemetry_instrumentation_gogol+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5+    , bytestring+    , exceptions+    , gogol-core ==1.0.*+    , hs-opentelemetry-api ==1.0.*+    , hs-opentelemetry-semantic-conventions >=1.40 && <2+    , http-types+    , resourcet+    , text+    , unordered-containers+  default-language: Haskell2010++test-suite hs-opentelemetry-instrumentation-gogol-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_hs_opentelemetry_instrumentation_gogol+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , gogol-core+    , hs-opentelemetry-api ==1.0.*+    , hs-opentelemetry-exporter-in-memory ==1.0.*+    , hs-opentelemetry-instrumentation-gogol ==1.0.*+    , hs-opentelemetry-sdk ==1.0.*+    , hspec+    , text+  default-language: Haskell2010

+ src/OpenTelemetry/Instrumentation/Gogol.hs view

@@ -0,0 +1,168 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module      :  OpenTelemetry.Instrumentation.Gogol+Copyright   :  (c) Ian Duncan, 2024+License     :  BSD-3+Description :  OpenTelemetry instrumentation for the Gogol Google Cloud SDK+Maintainer  :  Ian Duncan+Stability   :  experimental+Portability :  non-portable (GHC extensions)++Tracing wrappers for Gogol Google Cloud API calls. Unlike Amazonka, Gogol+does not have a hooks API, so instrumentation is provided as wrapper+functions that take the underlying @send@ as a parameter.++@+import Gogol+import OpenTelemetry.Instrumentation.Gogol ('tracedSend')++-- Instead of: send req+-- Write:+result <- runGoogle env $ 'tracedSend' tracer send req+@++Each call produces a span named @\"ServiceId.Operation\"@ (e.g.,+@\"storage.ObjectsGet\"@, @\"compute.InstancesList\"@) with standard RPC+attributes.++@since 0.1.0.0+-}+module OpenTelemetry.Instrumentation.Gogol (+  tracedSend,+  tracedSendEither,+) where++import Control.Exception (SomeException)+import Control.Monad.Catch (MonadCatch, catch, throwM)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Resource (MonadResource)+import qualified Data.HashMap.Strict as HM+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Data.Typeable (Proxy (..), Typeable, tyConName, typeRep, typeRepTyCon)+import qualified Gogol.Types as G+import qualified Network.HTTP.Types.Status as HTTP+import OpenTelemetry.Attributes (toAttribute)+import OpenTelemetry.Attributes.Key (unkey)+import OpenTelemetry.Context (insertSpan)+import OpenTelemetry.Context.ThreadLocal (getAndAdjustContext, getContext)+import qualified OpenTelemetry.SemanticConventions as SC+import OpenTelemetry.Trace.Core (+  Span,+  SpanArguments (..),+  SpanKind (Client),+  SpanStatus (..),+  Tracer,+  addAttributes,+  createSpanWithoutCallStack,+  defaultSpanArguments,+  endSpan,+  setStatus,+ )+++{- | Traced version of Gogol's @send@. Creates a client span for each+Google API call with RPC semantic convention attributes.++The span is named @\"ServiceId.TypeName\"@ — e.g., @\"storage.ObjectsGet\"@.++@since 0.1.0.0+-}+tracedSend+  :: forall a m+   . (MonadResource m, MonadIO m, MonadCatch m, G.GoogleRequest a, Typeable a)+  => Tracer+  -> (a -> m (G.Rs a))+  -> a+  -> m (G.Rs a)+tracedSend tracer sendFn req = do+  s <- liftIO $ startSpan tracer req+  result <-+    sendFn req `catch` \(e :: SomeException) -> do+      liftIO $ do+        let errText = T.pack (show e)+        addAttributes s $ HM.fromList [(unkey SC.error_type, toAttribute errText)]+        setStatus s (Error errText)+        endSpan s Nothing+      throwM e+  liftIO $ endSpan s Nothing+  pure result+++{- | Traced version of Gogol's @sendEither@. Preserves the 'Either'+result, recording errors on the span without throwing.++@since 0.1.0.0+-}+tracedSendEither+  :: forall a m+   . (MonadResource m, MonadIO m, MonadCatch m, G.GoogleRequest a, Typeable a)+  => Tracer+  -> (a -> m (Either G.Error (G.Rs a)))+  -> a+  -> m (Either G.Error (G.Rs a))+tracedSendEither tracer sendFn req = do+  s <- liftIO $ startSpan tracer req+  result <- sendFn req+  liftIO $ case result of+    Right _ -> endSpan s Nothing+    Left err -> do+      recordError s err+      endSpan s Nothing+  pure result+++startSpan+  :: forall a+   . (G.GoogleRequest a, Typeable a)+  => Tracer+  -> a+  -> IO Span+startSpan tracer req = do+  let client = G.requestClient req+      svc = G._cliService client+      G.ServiceId svcId = G._svcId svc+      opName = T.pack $ tyConName $ typeRepTyCon $ typeRep (Proxy @a)+      spanName = svcId <> "." <> opName+      host = TE.decodeUtf8 (G._svcHost svc)++  ctx <- getContext+  s <-+    createSpanWithoutCallStack tracer ctx spanName $+      defaultSpanArguments+        { kind = Client+        , attributes =+            HM.fromList+              [ (unkey SC.rpc_system, toAttribute ("gcp-api" :: T.Text))+              , (unkey SC.rpc_service, toAttribute svcId)+              , (unkey SC.rpc_method, toAttribute opName)+              , (unkey SC.server_address, toAttribute host)+              , (unkey SC.cloud_provider, toAttribute ("gcp" :: T.Text))+              ]+        }++  _ <- getAndAdjustContext (insertSpan s)+  pure s+++recordError :: Span -> G.Error -> IO ()+recordError s err = do+  let errDesc = describeError err+      statusAttr sc = [(unkey SC.http_response_statusCode, toAttribute (HTTP.statusCode sc))]+      attrs = case err of+        G.ServiceError svcErr -> statusAttr (G._serviceStatus svcErr)+        G.SerializeError serr -> statusAttr (G._serializeStatus serr)+        G.TransportError _ -> []+  addAttributes s $ HM.fromList $ (unkey SC.error_type, toAttribute errDesc) : attrs+  setStatus s (Error errDesc)+++describeError :: G.Error -> T.Text+describeError (G.TransportError _) = "transport_error"+describeError (G.SerializeError serr) = T.pack (G._serializeMessage serr)+describeError (G.ServiceError svcErr) =+  "http_" <> T.pack (show (HTTP.statusCode (G._serviceStatus svcErr)))

+ test/Spec.hs view

@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+