summaryrefslogtreecommitdiff
path: root/server/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/Main.hs')
-rw-r--r--server/Main.hs45
1 files changed, 21 insertions, 24 deletions
diff --git a/server/Main.hs b/server/Main.hs
index 77c8fde..33c2c5c 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -1,15 +1,8 @@
{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
@@ -18,16 +11,20 @@
-- | simple server offering linting "as a service"
module Main where
-import CheckDir (DirResult)
import Cli.Extras (mkDefaultCliConfig, runCli)
+import Control.Concurrent (MVar, newMVar)
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString.Lazy.Char8 as C8
-import Data.Text (Text)
-import Git (App, submitImpl)
+import Handlers (App, statusImpl, submitImpl)
import Network.Wai.Handler.Warp (run)
-import Servant
-import Serverconfig (Config (..), RemoteRef (..),
- loadConfig)
+import Servant (Application, Get, Handler,
+ HasServer (ServerT), JSON,
+ Proxy (Proxy), ReqBody,
+ ServerError (errBody), err500,
+ hoistServer, serve, throwError,
+ type (:<|>) (..), type (:>), Post)
+import Server (Config (..), JobStatus,
+ RemoteRef (..), State, loadConfig)
{-
Needed:
@@ -43,21 +40,20 @@ Needed:
-}
-- | Main API type
type API format =
- "submit" :> ReqBody '[JSON] RemoteRef :> Get '[format] DirResult
- :<|> "status" :> Capture "sha1" Text :> Get '[format] [Int]
+ "submit" :> ReqBody '[JSON] RemoteRef :> Post '[format] ()
+ :<|> "status" :> ReqBody '[JSON] RemoteRef :> Get '[format] JobStatus
+
-- | API's implementation
-jsonAPI :: Config True -> ServerT (API JSON) App
-jsonAPI config =
- submitImpl config
- :<|> (\sha -> do
- liftIO $ print sha
- pure [1])
+jsonAPI :: Config True -> MVar State -> ServerT (API JSON) App
+jsonAPI config state =
+ submitImpl config state
+ :<|> statusImpl state
-- | make an application; convert any cli errors into a 500
-app :: Config True -> Application
+app :: Config True -> MVar State -> Application
app config =
- serve api $ hoistServer api conv (jsonAPI config)
+ serve api . hoistServer api conv . jsonAPI config
where api = Proxy @(API JSON)
conv :: App a -> Handler a
conv m = do
@@ -69,6 +65,7 @@ app config =
main :: IO ()
main = do
+ state <- newMVar (mempty :: State)
let config = Config "/tmp" 8080 "main.json" "./config.json"
config' <- loadConfig config
- run (port config) (app config')
+ run (port config) (app config' state)