diff options
Diffstat (limited to 'users/Profpatsch/whatcd-resolver/src/AppT.hs')
-rw-r--r-- | users/Profpatsch/whatcd-resolver/src/AppT.hs | 16 |
1 files changed, 14 insertions, 2 deletions
diff --git a/users/Profpatsch/whatcd-resolver/src/AppT.hs b/users/Profpatsch/whatcd-resolver/src/AppT.hs index 0c93cbaddb3a..4363e2dbb298 100644 --- a/users/Profpatsch/whatcd-resolver/src/AppT.hs +++ b/users/Profpatsch/whatcd-resolver/src/AppT.hs @@ -12,6 +12,8 @@ import Data.Pool (Pool) import Data.Text qualified as Text import Database.PostgreSQL.Simple qualified as Postgres import GHC.Stack qualified +import Json.Enc +import Json.Enc qualified as Enc import Label import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan, inSpan') import OpenTelemetry.Trace.Core qualified as Otel hiding (inSpan, inSpan') @@ -27,7 +29,8 @@ data Context = Context tracer :: Otel.Tracer, pgFormat :: PgFormatPool, pgConnPool :: Pool Postgres.Connection, - transmissionSessionId :: IORef (Maybe ByteString) + transmissionSessionId :: IORef (Maybe ByteString), + redactedApiKey :: ByteString } newtype AppT m a = AppT {unAppT :: ReaderT Context m a} @@ -67,6 +70,15 @@ addAttribute span key a = Otel.addAttribute span ("_." <> key) a addAttributes :: (MonadIO m) => Otel.Span -> HashMap Text Otel.Attribute -> m () addAttributes span attrs = Otel.addAttributes span $ attrs & HashMap.mapKeys ("_." <>) +-- | Create an otel attribute from a json encoder +jsonAttribute :: Enc -> Otel.Attribute +jsonAttribute e = e & Enc.encToTextPretty & Otel.toAttribute + +orThrowAppErrorNewSpan :: (MonadThrow m, MonadOtel m) => Text -> Either ErrorTree a -> m a +orThrowAppErrorNewSpan msg = \case + Left err -> appThrowTreeNewSpan msg err + Right a -> pure a + appThrowTreeNewSpan :: (MonadThrow m, MonadOtel m) => Text -> ErrorTree -> m a appThrowTreeNewSpan spanName exc = inSpan' spanName $ \span -> do let msg = prettyErrorTree exc @@ -127,7 +139,7 @@ recordException span dat = liftIO $ do HashMap.fromList [ ("exception.type", Otel.toAttribute @Text dat.type_), ("exception.message", Otel.toAttribute @Text dat.message), - ("exception.stacktrace", Otel.toAttribute @Text $ Text.unlines $ map stringToText callStack) + ("exception.stacktrace", Otel.toAttribute @Text $ Text.unlines $ Prelude.map stringToText callStack) ], .. } |