Skip to content

Commit

Permalink
Use Handler to provide Swagger TOC page
Browse files Browse the repository at this point in the history
The error throwing/catching/rendering flow doesn't seem to work anymore
for the case where the handler is matched. Use a regular handler
instead, because that's cleaner anyways.
  • Loading branch information
supersven committed Dec 12, 2024
1 parent 23fe1f2 commit bdf2d1f
Show file tree
Hide file tree
Showing 2 changed files with 16 additions and 9 deletions.
6 changes: 6 additions & 0 deletions libs/wai-utilities/src/Network/Wai/Utilities/Response.hs
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,12 @@ json = responseLBS status200 [jsonContent] . encode
jsonContent :: Header
jsonContent = (hContentType, "application/json")

html :: Lazy.ByteString -> Response
html = responseLBS status200 [htmlContent]

htmlContent :: Header
htmlContent = (hContentType, "text/html; charset=UTF-8")

errorRs :: Error -> Response
errorRs e = setStatus (code e) (json e)

Expand Down
19 changes: 10 additions & 9 deletions services/brig/src/Brig/API/Public.hs
Original file line number Diff line number Diff line change
Expand Up @@ -61,9 +61,8 @@ import Control.Lens ((.~), (?~))
import Control.Monad.Catch (throwM)
import Control.Monad.Except
import Data.Aeson hiding (json)
import Data.ByteString (fromStrict, toStrict)
import Data.ByteString (fromStrict)
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.ByteString.UTF8 qualified as UTF8
import Data.Code qualified as Code
import Data.CommaSeparatedList
import Data.Default
Expand Down Expand Up @@ -233,14 +232,16 @@ versionedSwaggerDocsAPI (Just (VersionNumber V3)) = swaggerPregenUIServer $(preg
versionedSwaggerDocsAPI (Just (VersionNumber V2)) = swaggerPregenUIServer $(pregenSwagger V2)
versionedSwaggerDocsAPI (Just (VersionNumber V1)) = swaggerPregenUIServer $(pregenSwagger V1)
versionedSwaggerDocsAPI (Just (VersionNumber V0)) = swaggerPregenUIServer $(pregenSwagger V0)
versionedSwaggerDocsAPI Nothing = allroutes (throwError listAllVersionsResp)
versionedSwaggerDocsAPI Nothing = tocPage
where
allroutes ::
(forall a. Servant.Handler a) ->
Servant.Server (SwaggerSchemaUI "swagger-ui" "swagger.json")
allroutes action =
-- why? see 'SwaggerSchemaUI' type.
action :<|> action :<|> action :<|> error (UTF8.toString . toStrict $ listAllVersionsHTML)
-- Renders and returns a table-of-contents page
tocPage :: Servant.Server (SwaggerSchemaUI "swagger-ui" "swagger.json")
tocPage =
let throwingHandler :: forall a. Servant.Handler a
throwingHandler = (throwError listAllVersionsResp)
handler = Tagged @Servant.Handler (\_req k -> k (Utilities.html listAllVersionsHTML))
in -- why? see 'SwaggerSchemaUI' type.
throwingHandler :<|> throwingHandler :<|> throwingHandler :<|> handler

listAllVersionsResp :: ServerError
listAllVersionsResp = ServerError 200 mempty listAllVersionsHTML [("Content-Type", "text/html;charset=utf-8")]
Expand Down

0 comments on commit bdf2d1f

Please sign in to comment.