From 7b101b8c3c0481d76733c77008b5b763ceb3b535 Mon Sep 17 00:00:00 2001
From: LLLL Colonq <llll@colonq>
Date: Sun, 4 Aug 2024 02:09:37 -0400
Subject: Live monitor endpoint

---
 fig-frontend/src/Fig/Frontend/Utils.hs | 12 ++++++++++++
 1 file changed, 12 insertions(+)

(limited to 'fig-frontend/src/Fig/Frontend')

diff --git a/fig-frontend/src/Fig/Frontend/Utils.hs b/fig-frontend/src/Fig/Frontend/Utils.hs
index 3081ddb..090c6ba 100644
--- a/fig-frontend/src/Fig/Frontend/Utils.hs
+++ b/fig-frontend/src/Fig/Frontend/Utils.hs
@@ -5,12 +5,17 @@ module Fig.Frontend.Utils
   ( FigFrontendException(..)
   , loadConfig
   , Config(..)
+  , websocket
   , module Network.HTTP.Types.Status
   ) where
 
 import Fig.Prelude
 
 import Network.HTTP.Types.Status
+import qualified Network.Wai.Handler.WebSockets as Wai.WS
+import qualified Network.WebSockets as WS
+
+import qualified Web.Scotty as Sc
 
 import qualified Toml
 
@@ -39,3 +44,10 @@ loadConfig :: FilePath -> IO Config
 loadConfig path = Toml.decodeFileEither configCodec path >>= \case
   Left err -> throwM . FigFrontendException $ tshow err
   Right config -> pure config
+
+websocket :: ByteString -> (WS.Connection -> IO ()) -> Sc.ScottyM ()
+websocket pat h = Sc.middleware $ Wai.WS.websocketsOr WS.defaultConnectionOptions handler
+  where
+    handler pending = if WS.requestPath (WS.pendingRequest pending) == pat
+      then WS.acceptRequest pending >>= h
+      else WS.rejectRequest pending ""
-- 
cgit v1.2.3