summaryrefslogtreecommitdiff
path: root/server/Handlers.hs
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--server/Handlers.hs13
1 files changed, 10 insertions, 3 deletions
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