diff options
Diffstat (limited to 'server/Handlers.hs')
| -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 |