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/Handlers.hs | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

(limited to 'server/Handlers.hs')

diff --git a/server/Handlers.hs b/server/Handlers.hs
index 382af64..d89d2c5 100644
--- a/server/Handlers.hs
+++ b/server/Handlers.hs
@@ -5,7 +5,7 @@
 {-# LANGUAGE LambdaCase       #-}
 {-# LANGUAGE TypeApplications #-}
 
-module Handlers (App, submitImpl,statusImpl,relintImpl) where
+module Handlers (App, submitImpl,statusImpl,relintImpl,adminOverviewImpl) where
 
 import           Bindings.Cli.Git       (gitProc)
 import           CheckDir               (recursiveCheckDir)
@@ -13,7 +13,8 @@ import           Cli.Extras             (CliConfig, CliT, ProcessFailure,
                                          Severity (..), callProcessAndLogOutput,
                                          getCliConfig, prettyProcessFailure,
                                          runCli)
-import           Control.Concurrent     (MVar, ThreadId, forkIO, withMVar)
+import           Control.Concurrent     (MVar, ThreadId, forkIO, readMVar,
+                                         withMVar)
 import           Control.Monad.Extra    (ifM)
 import           Control.Monad.IO.Class (liftIO)
 import           Control.Monad.Trans    (lift)
@@ -25,7 +26,8 @@ import qualified Data.UUID.V4           as UUID
 import           Lens.Micro.Extras      (view)
 import           Servant                (Handler, NoContent (NoContent), err404,
                                          err500, throwError)
-import           Server                 (Config (entrypoint, lintconfig, tmpdir),
+import           Server                 (AdminOverview (AdminOverview),
+                                         Config (entrypoint, lintconfig, tmpdir),
                                          JobStatus (..),
                                          RemoteRef (reporef, repourl), State,
                                          jobs, registry, setJobStatus,
@@ -74,6 +76,11 @@ statusImpl state uuid = do
      Nothing  -> lift $ throwError err404
 
 
+adminOverviewImpl :: MVar State -> App AdminOverview
+adminOverviewImpl state = do
+  state <- liftIO $ readMVar state
+  pure (AdminOverview state)
+
 -- | the actual check function. forks, calls out to git to update the
 -- repository, create a new worktree, lints it, then tells git to
 -- delete that tree again
-- 
cgit v1.2.3