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:
		
							parent
							
								
									0a9b5efac9
								
							
						
					
					
						commit
						3068cfd866
					
				
					 1 changed files with 18 additions and 12 deletions
				
			
		| 
						 | 
					@ -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)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue