diff options
author | stuebinm | 2022-02-11 22:25:23 +0100 |
---|---|---|
committer | stuebinm | 2022-02-11 22:25:23 +0100 |
commit | 5e6a9d55217893144ba59305b9a90ad5c96663c1 (patch) | |
tree | 1d76c1f5477fc2508016abde11fee3bb87379a54 /server/Handlers.hs | |
parent | a50ad3901377b30c5188ff3ebd519f8b0457c5eb (diff) |
server: admin interface
(for now, just a list of all maps and their current status)
Diffstat (limited to '')
-rw-r--r-- | server/Handlers.hs | 13 |
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 |