From 5e6a9d55217893144ba59305b9a90ad5c96663c1 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Fri, 11 Feb 2022 22:25:23 +0100
Subject: server: admin interface

(for now, just a list of all maps and their current status)
---
 server/Main.hs | 14 ++++++++++----
 1 file changed, 10 insertions(+), 4 deletions(-)

(limited to 'server/Main.hs')

diff --git a/server/Main.hs b/server/Main.hs
index 00b4689..0f142de 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -16,8 +16,9 @@ import           Control.Concurrent         (MVar, newMVar)
 import           Control.Monad.IO.Class     (liftIO)
 import qualified Data.ByteString.Lazy.Char8 as C8
 import           Data.UUID                  (UUID)
-import           Handlers                   (App, relintImpl, statusImpl,
-                                             submitImpl)
+import           Handlers                   (App, adminOverviewImpl, relintImpl,
+                                             statusImpl, submitImpl)
+import           HtmlOrphans                ()
 import           Network.Wai.Handler.Warp   (run)
 import           Servant                    (Application, Capture, Get, Handler,
                                              HasServer (ServerT), JSON,
@@ -28,9 +29,10 @@ import           Servant                    (Application, Capture, Get, Handler,
                                              type (:<|>) (..), type (:>))
 import           Servant.HTML.Lucid         (HTML)
 import           Servant.Server.StaticFiles (serveDirectoryWebApp)
-import           Server                     (Config (..), JobStatus,
-                                             RemoteRef (..), State,
+import           Server                     (AdminOverview, Config (..),
+                                             JobStatus, RemoteRef (..), State,
                                              defaultState, loadConfig)
+
 {-
 Needed:
  - admin overview (perhaps on seperate port?)
@@ -48,10 +50,12 @@ type API format =
        "submit" :> ReqBody '[JSON] RemoteRef :> Post '[format] UUID
   :<|> "status" :> Capture "jobid" UUID :> Get '[format] JobStatus
   :<|> "relint" :> Capture "jobid" UUID :> Get '[format] NoContent
+  :<|> "admin" :> "overview" :> Get '[format] AdminOverview
 
 type Routes =
    "api" :> API JSON
   :<|> "status" :> Capture "jobid" UUID :> Get '[HTML] JobStatus
+  :<|> "admin" :> "overview" :> Get '[HTML] AdminOverview
   :<|> Raw
 
 -- | API's implementation
@@ -60,11 +64,13 @@ jsonAPI config state =
   submitImpl config state
   :<|> statusImpl state
   :<|> relintImpl config state
+  :<|> adminOverviewImpl state
 
 server :: Config True -> MVar State -> ServerT Routes App
 server config state =
   jsonAPI config state
   :<|> statusImpl state
+  :<|> adminOverviewImpl state
   :<|> serveDirectoryWebApp "./static"
 
 -- | make an application; convert any cli errors into a 500
-- 
cgit v1.2.3