{-# LANGUAGE DataKinds #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Handlers ( -- , submitImpl statusImpl -- , relintImpl , stateImpl , AdminOverview(..) , MapService(..)) 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) -- | an info type wrapped around the server state, to carry serialisation instances. newtype AdminOverview = AdminOverview { unAdminOverview :: ServerState } newtype MapService = MapService { unMapService :: ServerState } instance ToJSON AdminOverview where toJSON (AdminOverview state) = toJSON $ view unState state <&> \org -> flip map org $ \(ref, status) -> A.object [ "remote" .= ref , "status" .= status ] instance ToJSON MapService where toJSON (MapService state) = toJSON $ M.mapWithKey orgObject (view unState state) where orgObject org = A.object . mapMaybe worldObject . M.elems where worldObject (RemoteRef {..}, job) = case job of Linted res rev -> Just (A.fromText reponame .= M.mapWithKey (mapInfo rev) (dirresultMaps res)) _ -> Nothing mapInfo rev mappath MapResult { .. } = A.object [ "badges" .= mapresultBadges -- TODO: type-safe url library for adding the slash? , "url" .= (orgUrl org <> adjustedPath rev org <> "/" <> toText mappath) ] 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 -- | since there are multiple apis that just get state information … stateImpl :: forall s . Coercible s ServerState => MVar ServerState -> Handler s stateImpl state = readMVar state <&> coerce