diff options
Diffstat (limited to 'server/Main.hs')
-rw-r--r-- | server/Main.hs | 45 |
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) |