summaryrefslogtreecommitdiff
path: root/server/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/Main.hs')
-rw-r--r--server/Main.hs25
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 []