diff options
Diffstat (limited to 'server/Main.hs')
| -rw-r--r-- | server/Main.hs | 26 |
1 files changed, 15 insertions, 11 deletions
diff --git a/server/Main.hs b/server/Main.hs index d9a8db7..7109583 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -20,7 +20,8 @@ import qualified Data.Text as T import Fmt ((+|), (|+)) import Handlers (AdminOverview (AdminOverview), MapService (MapService), - stateImpl, statusImpl) + relintImpl, stateImpl, + statusImpl) import HtmlOrphans () import Network.HTTP.Client (defaultManagerSettings, newManager) @@ -43,13 +44,14 @@ import Server (JobStatus, Org (..), emptyState, exneuland, interval, loadConfig, orgs, port, token, - unState, verbose) + verbose) import Worker (Job (Job), linterThread) +import Control.Monad.Logger (logInfoN, + runStdoutLoggingT) import Servant.API (Header) import Servant.Client (ClientM, client, mkClientEnv, runClientM) -import Control.Monad.Logger (logInfoN, runStdoutLoggingT) type family PolyEndpoint method format payload where PolyEndpoint Get format payload = @@ -64,6 +66,7 @@ type MapServiceAPI method = -- | abstract api type API format = "status" :> Capture "org" Text :> Capture "jobid" Sha1 :> Get '[format] JobStatus + :<|> "status" :> Capture "org" Text :> Capture "jobid" Sha1 :> "relint" :> Post '[format] Text :<|> "admin" :> "overview" :> Get '[format] AdminOverview -- | actual set of routes: api for json & html + static pages from disk @@ -73,19 +76,20 @@ type Routes = "api" :> API JSON :<|> Raw -- | API's implementation -jsonAPI :: forall format. MVar ServerState -> Server (API format) -jsonAPI state = statusImpl state +jsonAPI :: forall format. TQueue Job -> MVar ServerState -> Server (API format) +jsonAPI queue state = statusImpl state + :<|> relintImpl queue state :<|> stateImpl @AdminOverview state -- | Complete set of routes: API + HTML sites -server :: MVar ServerState -> Server Routes -server state = jsonAPI @JSON state +server :: TQueue Job -> MVar ServerState -> Server Routes +server queue state = jsonAPI @JSON queue state :<|> stateImpl @MapService state - :<|> jsonAPI @HTML state + :<|> jsonAPI @HTML queue state :<|> serveDirectoryWebApp "./static" -app :: MVar ServerState -> Application -app = serve (Proxy @Routes) . server +app :: TQueue Job -> MVar ServerState -> Application +app queue = serve (Proxy @Routes) . server queue postNewMaps :: Maybe Text -> MapService -> ClientM Text postNewMaps = client (Proxy @(MapServiceAPI Post)) @@ -133,7 +137,7 @@ main = do putTextLn $ "starting server on port " <> show (view port config) runSettings warpsettings . loggerMiddleware - $ app state + $ app queue state waitEither_ linter poker where |