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

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
This commit is contained in:
Profpatsch 2024-08-18 17:30:29 +02:00
parent e9f1bb9917
commit b800bf2bd4
7 changed files with 84 additions and 70 deletions

View file

@ -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)