From 729a1983372ed23ec0ceeeb1acdadc6e6989b37a Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 7 Feb 2022 18:03:08 +0100
Subject: server: proper job handling

Note: the server will not check submissions for duplicates!
(nor does it do any kind of rate-limiting)
---
 server/Main.hs | 42 ++++++++++++++++++++++++------------------
 1 file changed, 24 insertions(+), 18 deletions(-)

(limited to 'server/Main.hs')

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)
-- 
cgit v1.2.3