summaryrefslogtreecommitdiff
path: root/server/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--server/Main.hs42
1 files changed, 24 insertions, 18 deletions
diff --git a/server/Main.hs b/server/Main.hs
index 33c2c5c..ecaf6b7 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -1,11 +1,11 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
-- | simple server offering linting "as a service"
@@ -15,16 +15,20 @@ 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 Handlers (App, statusImpl, submitImpl)
+import Data.UUID (UUID)
+import Handlers (App, relintImpl, statusImpl,
+ submitImpl)
import Network.Wai.Handler.Warp (run)
-import Servant (Application, Get, Handler,
+import Servant (Application, Capture, Get, Handler,
HasServer (ServerT), JSON,
- Proxy (Proxy), ReqBody,
- ServerError (errBody), err500,
- hoistServer, serve, throwError,
- type (:<|>) (..), type (:>), Post)
+ NoContent, Post, Proxy (Proxy),
+ ReqBody, ServerError (errBody),
+ err500, hoistServer, serve,
+ throwError, type (:<|>) (..),
+ type (:>))
import Server (Config (..), JobStatus,
- RemoteRef (..), State, loadConfig)
+ RemoteRef (..), State,
+ defaultState, loadConfig)
{-
Needed:
@@ -40,8 +44,9 @@ Needed:
-}
-- | Main API type
type API format =
- "submit" :> ReqBody '[JSON] RemoteRef :> Post '[format] ()
- :<|> "status" :> ReqBody '[JSON] RemoteRef :> Get '[format] JobStatus
+ "submit" :> ReqBody '[JSON] RemoteRef :> Post '[format] UUID
+ :<|> "status" :> Capture "jobid" UUID :> Get '[format] JobStatus
+ :<|> "relint" :> Capture "jobid" UUID :> Get '[format] NoContent
-- | API's implementation
@@ -49,6 +54,7 @@ jsonAPI :: Config True -> MVar State -> ServerT (API JSON) App
jsonAPI config state =
submitImpl config state
:<|> statusImpl state
+ :<|> relintImpl config state
-- | make an application; convert any cli errors into a 500
app :: Config True -> MVar State -> Application
@@ -65,7 +71,7 @@ app config =
main :: IO ()
main = do
- state <- newMVar (mempty :: State)
+ state <- newMVar defaultState
let config = Config "/tmp" 8080 "main.json" "./config.json"
config' <- loadConfig config
run (port config) (app config' state)