fix(users/Profpatsch/whatcd-resolver): show query error as html
We want the user thingy to see which error happened; it also gets logged in the traces as before. There’s another function which we should replace as well at one point. Change-Id: I3d49edccd0e2088a45ac0138af9536b40dfa6848 Reviewed-on: https://cl.tvl.fyi/c/depot/+/11660 Tested-by: BuildkiteCI Autosubmit: Profpatsch <mail@profpatsch.de> Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch
clbot
parent
c2f649f62e
commit
5c709131de
2 changed files with 60 additions and 38 deletions
|
|
@ -500,7 +500,6 @@ runPgFormat pool sqlStatement = do
|
|||
Pool.putResource localPool new
|
||||
)
|
||||
( \(pgFmt, _localPool) -> do
|
||||
putStderrLn "Running with warm pgformatter"
|
||||
ByteString.hPut pgFmt.stdinHdl sqlStatement
|
||||
-- close stdin to make pg_formatter format (it exits …)
|
||||
-- issue: https://github.com/darold/pgFormatter/issues/333
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@ import Control.Monad.Reader
|
|||
import Data.Aeson qualified as Json
|
||||
import Data.Aeson.BetterErrors qualified as Json
|
||||
import Data.Aeson.KeyMap qualified as KeyMap
|
||||
import Data.Error.Tree (prettyErrorTree)
|
||||
import Data.HashMap.Strict qualified as HashMap
|
||||
import Data.List qualified as List
|
||||
import Data.Map.Strict qualified as Map
|
||||
|
|
@ -105,9 +106,6 @@ htmlUi = do
|
|||
( do
|
||||
label @"torrentId" <$> Multipart.field "torrent-id" ((Field.utf8 >>> Field.signedDecimal >>> Field.bounded @Int "int"))
|
||||
)
|
||||
let parseQueryArgs span parser =
|
||||
Parse.runParse "Unable to find the right request query arguments" (lmap Wai.queryString parser) req
|
||||
& assertM span id
|
||||
|
||||
let parseQueryArgsNewSpan spanName parser =
|
||||
Parse.runParse "Unable to find the right request query arguments" (lmap Wai.queryString parser) req
|
||||
|
|
@ -196,27 +194,29 @@ htmlUi = do
|
|||
Just _torrent -> [hsx|Running|]
|
||||
),
|
||||
( "snips/jsonld/render",
|
||||
respond.html $ \span -> do
|
||||
qry <-
|
||||
parseQueryArgs
|
||||
span
|
||||
( label @"target"
|
||||
<$> ( (singleQueryArgument "target" Field.utf8 >>> textToURI)
|
||||
& Parse.andParse uriToHttpClientRequest
|
||||
)
|
||||
)
|
||||
jsonld <- httpGetJsonLd (qry.target)
|
||||
pure $ renderJsonld jsonld
|
||||
do
|
||||
let HandlerResponses {htmlWithQueryArgs} = respond
|
||||
htmlWithQueryArgs
|
||||
( label @"target"
|
||||
<$> ( (singleQueryArgument "target" Field.utf8 >>> textToURI)
|
||||
& Parse.andParse uriToHttpClientRequest
|
||||
)
|
||||
)
|
||||
( \qry _span -> do
|
||||
jsonld <- httpGetJsonLd (qry.target)
|
||||
pure $ renderJsonld jsonld
|
||||
)
|
||||
),
|
||||
( "artist",
|
||||
respond.html $ \span -> do
|
||||
qry <-
|
||||
parseQueryArgs
|
||||
span
|
||||
( label @"dbId"
|
||||
<$> (singleQueryArgument "db_id" Field.utf8)
|
||||
)
|
||||
artistPage qry
|
||||
do
|
||||
let HandlerResponses {htmlWithQueryArgs} = respond
|
||||
|
||||
htmlWithQueryArgs
|
||||
( label @"dbId"
|
||||
<$> (singleQueryArgument "db_id" Field.utf8)
|
||||
)
|
||||
$ \qry _span -> do
|
||||
artistPage qry
|
||||
),
|
||||
( "autorefresh",
|
||||
respond.plain $ do
|
||||
|
|
@ -316,7 +316,9 @@ type Handlers m = HandlerResponses m -> Map Text (m ResponseReceived)
|
|||
|
||||
data HandlerResponses m = HandlerResponses
|
||||
{ -- | render html
|
||||
html :: ((Otel.Span -> m Html) -> m ResponseReceived),
|
||||
html :: (Otel.Span -> m Html) -> m ResponseReceived,
|
||||
-- | render html after parsing some query arguments
|
||||
htmlWithQueryArgs :: forall a. (Parse Query a -> (a -> Otel.Span -> m Html) -> m ResponseReceived),
|
||||
-- | render a plain wai response
|
||||
plain :: (m Wai.Response -> m ResponseReceived)
|
||||
}
|
||||
|
|
@ -330,23 +332,44 @@ runHandlers ::
|
|||
m ResponseReceived
|
||||
runHandlers defaultHandler handlers req respond = withRunInIO $ \runInIO -> do
|
||||
let path = req & Wai.pathInfo & Text.intercalate "/"
|
||||
let html act =
|
||||
Otel.inSpan'
|
||||
[fmt|Route /{path}|]
|
||||
( Otel.defaultSpanArguments
|
||||
{ Otel.attributes =
|
||||
HashMap.fromList
|
||||
[ ("server.path", Otel.toAttribute @Text path)
|
||||
]
|
||||
}
|
||||
)
|
||||
( \span -> do
|
||||
res <- act span <&> (\h -> T2 (label @"html" h) (label @"extraHeaders" []))
|
||||
liftIO $ respond . Wai.responseLBS Http.ok200 ([("Content-Type", "text/html")] <> res.extraHeaders) . Html.renderHtml $ res.html
|
||||
)
|
||||
|
||||
let handlerResponses =
|
||||
( HandlerResponses
|
||||
{ plain = (\m -> liftIO $ runInIO m >>= respond),
|
||||
html = \act ->
|
||||
Otel.inSpan'
|
||||
[fmt|Route /{path}|]
|
||||
( Otel.defaultSpanArguments
|
||||
{ Otel.attributes =
|
||||
HashMap.fromList
|
||||
[ ("server.path", Otel.toAttribute @Text path)
|
||||
]
|
||||
}
|
||||
)
|
||||
( \span -> do
|
||||
res <- act span <&> (\html -> T2 (label @"html" html) (label @"extraHeaders" []))
|
||||
liftIO $ respond . Wai.responseLBS Http.ok200 ([("Content-Type", "text/html")] <> res.extraHeaders) . Html.renderHtml $ res.html
|
||||
)
|
||||
html,
|
||||
htmlWithQueryArgs = \parser act ->
|
||||
case req & Parse.runParse "Unable to find the right request query arguments" (lmap Wai.queryString parser) of
|
||||
Right a -> html (act a)
|
||||
Left err ->
|
||||
html
|
||||
( \span -> do
|
||||
recordException
|
||||
span
|
||||
( T2
|
||||
(label @"type_" "Query Parse Exception")
|
||||
(label @"message" (prettyErrorTree err))
|
||||
)
|
||||
|
||||
pure
|
||||
[hsx|
|
||||
<h1>Error:</h1>
|
||||
<pre>{err & prettyErrorTree}</pre>
|
||||
|]
|
||||
)
|
||||
}
|
||||
)
|
||||
let handler =
|
||||
|
|
|
|||
Loading…
Reference in a new issue