refactor(users/Profpatsch/whatcd-resolver): handler response struct

Change-Id: I3224ccc5ccaea9eb26c60a65f048ca64024a7b9b
Reviewed-on: https://cl.tvl.fyi/c/depot/+/11641
Tested-by: BuildkiteCI
Autosubmit: Profpatsch <mail@profpatsch.de>
Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
Profpatsch 2024-05-11 11:39:59 +02:00 committed by clbot
parent 0a9b5efac9
commit 3068cfd866

View file

@ -118,9 +118,9 @@ htmlUi = do
let handlers :: Handlers (AppT IO) let handlers :: Handlers (AppT IO)
handlers respond = handlers respond =
Map.fromList Map.fromList
[ ("", respond.h (mainHtml uniqueRunId)), [ ("", respond.html (mainHtml uniqueRunId)),
( "snips/redacted/search", ( "snips/redacted/search",
respond.h $ respond.html $
\span -> do \span -> do
dat <- dat <-
mp mp
@ -131,12 +131,12 @@ htmlUi = do
snipsRedactedSearch dat snipsRedactedSearch dat
), ),
( "snips/redacted/torrentDataJson", ( "snips/redacted/torrentDataJson",
respond.h $ \span -> do respond.html $ \span -> do
dat <- torrentIdMp span dat <- torrentIdMp span
Html.mkVal <$> (runTransaction $ getTorrentById dat) Html.mkVal <$> (runTransaction $ getTorrentById dat)
), ),
( "snips/redacted/getTorrentFile", ( "snips/redacted/getTorrentFile",
respond.h $ \span -> do respond.html $ \span -> do
dat <- torrentIdMp span dat <- torrentIdMp span
runTransaction $ do runTransaction $ do
inserted <- redactedGetTorrentFileAndInsert dat inserted <- redactedGetTorrentFileAndInsert dat
@ -156,7 +156,7 @@ htmlUi = do
), ),
-- TODO: this is bad duplication?? -- TODO: this is bad duplication??
( "snips/redacted/startTorrentFile", ( "snips/redacted/startTorrentFile",
respond.h $ \span -> do respond.html $ \span -> do
dat <- torrentIdMp span dat <- torrentIdMp span
runTransaction $ do runTransaction $ do
file <- file <-
@ -179,7 +179,7 @@ htmlUi = do
"Starting" "Starting"
), ),
( "snips/transmission/getTorrentState", ( "snips/transmission/getTorrentState",
respond.h $ \span -> do respond.html $ \span -> do
dat <- mp span $ label @"torrentHash" <$> Multipart.field "torrent-hash" Field.utf8 dat <- mp span $ label @"torrentHash" <$> Multipart.field "torrent-hash" Field.utf8
status <- status <-
doTransmissionRequest' doTransmissionRequest'
@ -198,7 +198,7 @@ htmlUi = do
Just _torrent -> [hsx|Running|] Just _torrent -> [hsx|Running|]
), ),
( "snips/jsonld/render", ( "snips/jsonld/render",
respond.h $ \span -> do respond.html $ \span -> do
qry <- qry <-
parseQueryArgs parseQueryArgs
span span
@ -233,7 +233,7 @@ htmlUi = do
runInIO $ runInIO $
runHandlers runHandlers
debug debug
(\respond -> respond.h $ (mainHtml uniqueRunId)) (\respond -> respond.html $ (mainHtml uniqueRunId))
handlers handlers
req req
respond respond
@ -301,7 +301,12 @@ htmlUi = do
type Handlers m = HandlerResponses m -> Map Text (m ResponseReceived) type Handlers m = HandlerResponses m -> Map Text (m ResponseReceived)
type HandlerResponses m = T2 "h" ((Otel.Span -> m Html) -> m ResponseReceived) "plain" (m Wai.Response -> m ResponseReceived) data HandlerResponses m = HandlerResponses
{ -- | render html
html :: ((Otel.Span -> m Html) -> m ResponseReceived),
-- | render a plain wai response
plain :: (m Wai.Response -> m ResponseReceived)
}
runHandlers :: runHandlers ::
(MonadOtel m) => (MonadOtel m) =>
@ -330,9 +335,10 @@ runHandlers debug defaultHandler handlers req respond = withRunInIO $ \runInIO -
let path = [fmt|/{req & Wai.pathInfo & Text.intercalate "/"}|] let path = [fmt|/{req & Wai.pathInfo & Text.intercalate "/"}|]
let handlerResponses = let handlerResponses =
( T2 ( HandlerResponses
(label @"h" (h path)) { html = h path,
(label @"plain" (\m -> liftIO $ runInIO m >>= respond)) plain = (\m -> liftIO $ runInIO m >>= respond)
}
) )
let handler = let handler =
(handlers handlerResponses) (handlers handlerResponses)