diff options
Diffstat (limited to 'server/Main.hs')
| -rw-r--r-- | server/Main.hs | 25 |
1 files changed, 18 insertions, 7 deletions
diff --git a/server/Main.hs b/server/Main.hs index 0fbc4b4..00b4689 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -22,14 +22,15 @@ import Network.Wai.Handler.Warp (run) import Servant (Application, Capture, Get, Handler, HasServer (ServerT), JSON, NoContent, Post, Proxy (Proxy), - ReqBody, ServerError (errBody), - err500, hoistServer, serve, - throwError, type (:<|>) (..), - type (:>)) + Raw, ReqBody, + ServerError (errBody), err500, + hoistServer, serve, throwError, + type (:<|>) (..), type (:>)) +import Servant.HTML.Lucid (HTML) +import Servant.Server.StaticFiles (serveDirectoryWebApp) import Server (Config (..), JobStatus, RemoteRef (..), State, defaultState, loadConfig) - {- Needed: - admin overview (perhaps on seperate port?) @@ -48,6 +49,10 @@ type API format = :<|> "status" :> Capture "jobid" UUID :> Get '[format] JobStatus :<|> "relint" :> Capture "jobid" UUID :> Get '[format] NoContent +type Routes = + "api" :> API JSON + :<|> "status" :> Capture "jobid" UUID :> Get '[HTML] JobStatus + :<|> Raw -- | API's implementation jsonAPI :: Config True -> MVar State -> ServerT (API JSON) App @@ -56,11 +61,17 @@ jsonAPI config state = :<|> statusImpl state :<|> relintImpl config state +server :: Config True -> MVar State -> ServerT Routes App +server config state = + jsonAPI config state + :<|> statusImpl state + :<|> serveDirectoryWebApp "./static" + -- | make an application; convert any cli errors into a 500 app :: Config True -> MVar State -> Application app config = - serve api . hoistServer api conv . jsonAPI config - where api = Proxy @(API JSON) + serve api . hoistServer api conv . server config + where api = Proxy @Routes conv :: App a -> Handler a conv m = do config <- liftIO $ mkDefaultCliConfig [] |