diff options
Diffstat (limited to '')
| -rw-r--r-- | server/Handlers.hs | 49 |
1 files changed, 32 insertions, 17 deletions
diff --git a/server/Handlers.hs b/server/Handlers.hs index 93a7ae2..a7c8395 100644 --- a/server/Handlers.hs +++ b/server/Handlers.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -10,21 +11,24 @@ module Handlers ( -- , relintImpl , stateImpl , AdminOverview(..) - , MapService(..)) where + , MapService(..),relintImpl) where import Universum -import CheckDir (DirResult (dirresultMaps)) -import CheckMap (MapResult (MapResult, mapresultBadges)) -import Data.Aeson (ToJSON (..), (.=)) -import qualified Data.Aeson as A -import qualified Data.Aeson.Key as A -import Data.Coerce (coerce) -import qualified Data.Map as M -import Servant (Handler, err404, throwError) -import Server (JobStatus (..), Org (orgUrl), - RemoteRef (RemoteRef, reponame), ServerState, - Sha1, adjustedPath, getJobStatus, unState) +import CheckDir (DirResult (dirresultMaps)) +import CheckMap (MapResult (MapResult, mapresultBadges)) +import Control.Concurrent.STM (TQueue, writeTQueue) +import Data.Aeson (ToJSON (..), (.=)) +import qualified Data.Aeson as A +import qualified Data.Aeson.Key as A +import Data.Coerce (coerce) +import qualified Data.Map as M +import Servant (Handler, err404, throwError) +import Server (JobStatus (..), Org (orgUrl), + RemoteRef (RemoteRef, reponame), + ServerState, Sha1, adjustedPath, + getJobStatus, unState) +import Worker (Job (Job)) -- | an info type wrapped around the server state, to carry serialisation instances. @@ -37,16 +41,19 @@ newtype MapService = instance ToJSON AdminOverview where toJSON (AdminOverview state) = - toJSON $ view unState state <&> \org -> flip map org $ \(ref, status) -> + toJSON $ view unState state <&> \org -> flip map (snd org) $ \(ref, status) -> A.object [ "remote" .= ref , "status" .= status ] instance ToJSON MapService where toJSON (MapService state) = - toJSON $ M.mapWithKey orgObject (view unState state) + toJSON . map orgObject $ view unState state where - orgObject org = A.object . mapMaybe worldObject . M.elems + orgObject (org, statuses) = + A.object + . mapMaybe worldObject + $ M.elems statuses where worldObject (RemoteRef {..}, job) = case job of Linted res rev -> @@ -64,8 +71,8 @@ statusImpl :: MVar ServerState -> Text -> Sha1 -> Handler JobStatus statusImpl state orgslug sha1 = do status <- liftIO $ getJobStatus state orgslug sha1 case status of - Just res -> pure $ snd res - Nothing -> throwError err404 + Just (_,_,jobstatus) -> pure jobstatus + Nothing -> throwError err404 -- | since there are multiple apis that just get state information … stateImpl @@ -74,3 +81,11 @@ stateImpl => MVar ServerState -> Handler s stateImpl state = readMVar state <&> coerce + +relintImpl :: TQueue Job -> MVar ServerState -> Text -> Sha1 -> Handler Text +relintImpl queue state orgslug sha1 = + liftIO $ getJobStatus state orgslug sha1 >>= \case + Nothing -> pure "something went wrong" + Just (org, ref, _oldjob) -> do + atomically $ writeTQueue queue (Job ref org) + pure "hello" |