summaryrefslogtreecommitdiff
path: root/server/Handlers.hs
diff options
context:
space:
mode:
authorstuebinm2022-03-06 08:02:30 +0100
committerstuebinm2022-03-06 08:02:30 +0100
commitad7343815cc89d34c68f7d38239882bd3d36a577 (patch)
treeacea8af8cdcbef8739cb8f4648e8f5d4783dcf5a /server/Handlers.hs
parente0b01ceca72765246355662982ff35f19ad7dfbb (diff)
server: add a very simple relint button
Diffstat (limited to '')
-rw-r--r--server/Handlers.hs49
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"