summaryrefslogtreecommitdiff
path: root/server/Main.hs
diff options
context:
space:
mode:
authorstuebinm2022-03-06 13:58:42 +0100
committerstuebinm2022-03-06 13:58:42 +0100
commite495931e6126896b09a5e95db8ba6f56fda42808 (patch)
treebb4ce4bb076f894ebef193c143f200c396cfb3d9 /server/Main.hs
parentad7343815cc89d34c68f7d38239882bd3d36a577 (diff)
server: websocket for updates & auto-reload
todo: find a better solution than writing javascript in haskell strings. SERIOUSLY.
Diffstat (limited to '')
-rw-r--r--server/Main.hs15
1 files changed, 9 insertions, 6 deletions
diff --git a/server/Main.hs b/server/Main.hs
index 7109583..60098b6 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -20,8 +20,8 @@ import qualified Data.Text as T
import Fmt ((+|), (|+))
import Handlers (AdminOverview (AdminOverview),
MapService (MapService),
- relintImpl, stateImpl,
- statusImpl)
+ realtimeImpl, relintImpl,
+ stateImpl, statusImpl)
import HtmlOrphans ()
import Network.HTTP.Client (defaultManagerSettings,
newManager)
@@ -50,6 +50,7 @@ import Worker (Job (Job), linterThread)
import Control.Monad.Logger (logInfoN,
runStdoutLoggingT)
import Servant.API (Header)
+import Servant.API.WebSocket (WebSocketPending)
import Servant.Client (ClientM, client,
mkClientEnv, runClientM)
@@ -67,11 +68,12 @@ type MapServiceAPI method =
type API format =
"status" :> Capture "org" Text :> Capture "jobid" Sha1 :> Get '[format] JobStatus
:<|> "status" :> Capture "org" Text :> Capture "jobid" Sha1 :> "relint" :> Post '[format] Text
+ :<|> "status" :> Capture "org" Text :> Capture "jobid" Sha1 :> "realtime" :> WebSocketPending
:<|> "admin" :> "overview" :> Get '[format] AdminOverview
-- | actual set of routes: api for json & html + static pages from disk
-type Routes = "api" :> API JSON
- :<|> MapServiceAPI Get
+type Routes = -- "api" :> API JSON
+ MapServiceAPI Get
:<|> API HTML -- websites mirror the API exactly
:<|> Raw
@@ -79,12 +81,13 @@ type Routes = "api" :> API JSON
jsonAPI :: forall format. TQueue Job -> MVar ServerState -> Server (API format)
jsonAPI queue state = statusImpl state
:<|> relintImpl queue state
+ :<|> realtimeImpl state
:<|> stateImpl @AdminOverview state
-- | Complete set of routes: API + HTML sites
server :: TQueue Job -> MVar ServerState -> Server Routes
-server queue state = jsonAPI @JSON queue state
- :<|> stateImpl @MapService state
+server queue state = -- jsonAPI @JSON queue state
+ stateImpl @MapService state
:<|> jsonAPI @HTML queue state
:<|> serveDirectoryWebApp "./static"