about summary refs log tree commit diff
path: root/users/Profpatsch/whatcd-resolver/src/AppT.hs
diff options
context:
space:
mode:
authorProfpatsch <mail@profpatsch.de>2024-03-17T01·26+0100
committerclbot <clbot@tvl.fyi>2024-03-17T01·36+0000
commit3b9fb1aa60d060d7cfd7634e532327086f0ef5f1 (patch)
treec28d841d4f94d2d23edd69abcffb2f0678ce2c57 /users/Profpatsch/whatcd-resolver/src/AppT.hs
parentefa5fe1239263ad49cbcdb0f0039e93b55686f36 (diff)
feat(users/Profpatsch/whatcd-resolver): add autorefresh r/7715
Adds a little polling mechanism that compares against an ID that is
generated anew every time the server is restarted.

Works well together with shortcuttable.

Change-Id: Icc6745b599e43881c14349794feaf5794cfe6777
Reviewed-on: https://cl.tvl.fyi/c/depot/+/11172
Autosubmit: Profpatsch <mail@profpatsch.de>
Reviewed-by: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
Diffstat (limited to 'users/Profpatsch/whatcd-resolver/src/AppT.hs')
-rw-r--r--users/Profpatsch/whatcd-resolver/src/AppT.hs16
1 files changed, 16 insertions, 0 deletions
diff --git a/users/Profpatsch/whatcd-resolver/src/AppT.hs b/users/Profpatsch/whatcd-resolver/src/AppT.hs
index 7bd38a733e..7afd430745 100644
--- a/users/Profpatsch/whatcd-resolver/src/AppT.hs
+++ b/users/Profpatsch/whatcd-resolver/src/AppT.hs
@@ -66,6 +66,17 @@ 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 ("_." <>)
 
+appThrowTreeNewSpan :: (MonadThrow m, MonadOtel m) => Text -> ErrorTree -> m a
+appThrowTreeNewSpan spanName exc = inSpan' spanName $ \span -> do
+  let msg = prettyErrorTree exc
+  recordException
+    span
+    ( T2
+        (label @"type_" "AppException")
+        (label @"message" msg)
+    )
+  throwM $ AppException msg
+
 appThrowTree :: (MonadThrow m, MonadIO m) => Otel.Span -> ErrorTree -> m a
 appThrowTree span exc = do
   let msg = prettyErrorTree exc
@@ -87,6 +98,11 @@ assertM span f v = case f v of
   Right a -> pure a
   Left err -> appThrowTree span err
 
+assertMNewSpan :: (MonadThrow f, MonadOtel f) => Text -> (t -> Either ErrorTree a) -> t -> f a
+assertMNewSpan spanName f v = case f v of
+  Right a -> pure a
+  Left err -> appThrowTreeNewSpan spanName err
+
 -- | A specialized variant of @addEvent@ that records attributes conforming to
 -- the OpenTelemetry specification's
 -- <https://github.com/open-telemetry/opentelemetry-specification/blob/49c2f56f3c0468ceb2b69518bcadadd96e0a5a8b/specification/trace/semantic_conventions/exceptions.md semantic conventions>