fix(users/Profpatsch/whatcd-resolver): pretty AppException r/8675

AppException would be a console-pretty-printed version for http
errors, which would print all the escape codes in the jaeger traces of
the exception, making it more-or-less unreadable.

So instead, let’s make AppException two cases, an ErrorTree case which
is printed as-is (no color), and a “Pretty” case which is printed
using the pretty module (colors on console, no colors in otel).

Somewhat involved, I guess this is temporary until I figure out what
is really needed.

Change-Id: Iff4a8651c5f5368a5b798541efc19cc7ab9de34b
Reviewed-on: https://cl.tvl.fyi/c/depot/+/12232
Reviewed-by: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI

1 files changed, 4 insertions, 4 deletions

diff --git a/users/Profpatsch/whatcd-resolver/src/Transmission.hs b/users/Profpatsch/whatcd-resolver/src/Transmission.hs
index acbab001621c..b36c14d74378 100644
--- a/users/Profpatsch/whatcd-resolver/src/Transmission.hs
+++ b/users/Profpatsch/whatcd-resolver/src/Transmission.hs
@@ -205,9 +205,9 @@ doTransmissionRequest' req = inSpan' "Transmission Request" $ \span -> do
       transmissionConnectionConfig
       req
   case resp.result of
-    TransmissionResponseFailure err -> appThrowTree span (nestedError "Transmission RPC error" $ singleError $ newError err)
+    TransmissionResponseFailure err -> appThrow span (AppExceptionTree $ nestedError "Transmission RPC error" $ singleError $ newError err)
     TransmissionResponseSuccess -> case resp.arguments of
-      Nothing -> appThrowTree span "Transmission RPC error: No `arguments` field in response"
+      Nothing -> appThrow span "Transmission RPC error: No `arguments` field in response"
       Just out -> pure out
 
 -- | Contact the transmission RPC, and do the CSRF protection dance.
@@ -305,8 +305,8 @@ doTransmissionRequest span dat (req, parser) = do
             case Json.eitherDecodeStrict' @Json.Value (resp & Http.getResponseBody) of
               Left _err -> pure ()
               Right val -> logInfo [fmt|failing transmission response: {showPrettyJson val}|]
-            appThrowTree span err
-    _ -> liftIO $ unwrapIOError $ Left [fmt|Non-200 response: {showPretty resp}|]
+            appThrow span (AppExceptionTree err)
+    _ -> appThrow span $ AppExceptionPretty [[fmt|Non-200 response:|], pretty resp]
 
 class MonadTransmission m where
   getCurrentTransmissionSessionId :: m (Maybe ByteString)