From 624f7ba8b2fcda6675951dd8d41dcc99017484cf Mon Sep 17 00:00:00 2001
From: LLLL Colonq <llll@colonq>
Date: Thu, 7 Nov 2024 22:37:32 -0500
Subject: Rename fig-frontend to fig-web

(It was the backend anyway :3)
---
 fig-web/src/Fig/Web/Utils.hs | 51 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)
 create mode 100644 fig-web/src/Fig/Web/Utils.hs

(limited to 'fig-web/src/Fig/Web/Utils.hs')

diff --git a/fig-web/src/Fig/Web/Utils.hs b/fig-web/src/Fig/Web/Utils.hs
new file mode 100644
index 0000000..b6c385a
--- /dev/null
+++ b/fig-web/src/Fig/Web/Utils.hs
@@ -0,0 +1,51 @@
+{-# Language RecordWildCards #-}
+{-# Language ApplicativeDo #-}
+
+module Fig.Web.Utils
+  ( FigWebException(..)
+  , 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
+
+newtype FigWebException = FigWebException Text
+  deriving (Show, Eq, Ord)
+instance Exception FigWebException
+
+data Config = Config
+  { port :: !Int
+  , clientId :: !Text
+  , authToken :: !Text
+  , dbHost :: !Text
+  } deriving (Show, Eq, Ord)
+
+configCodec :: Toml.TomlCodec Config
+configCodec = do
+  port <- Toml.int "port" Toml..= (\a -> a.port)
+  clientId <- Toml.text "client_id" Toml..= (\a -> a.clientId)
+  authToken <- Toml.text "auth_token" Toml..= (\a -> a.authToken)
+  dbHost <- Toml.text "db_host" Toml..= (\a -> a.dbHost)
+  pure $ Config{..}
+
+loadConfig :: FilePath -> IO Config
+loadConfig path = Toml.decodeFileEither configCodec path >>= \case
+  Left err -> throwM . FigWebException $ 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