summaryrefslogtreecommitdiff
path: root/fig-web/src/Fig/Web/Module/Gizmo.hs
diff options
context:
space:
mode:
Diffstat (limited to 'fig-web/src/Fig/Web/Module/Gizmo.hs')
-rw-r--r--fig-web/src/Fig/Web/Module/Gizmo.hs49
1 files changed, 49 insertions, 0 deletions
diff --git a/fig-web/src/Fig/Web/Module/Gizmo.hs b/fig-web/src/Fig/Web/Module/Gizmo.hs
new file mode 100644
index 0000000..8112670
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/Gizmo.hs
@@ -0,0 +1,49 @@
+module Fig.Web.Module.Gizmo
+ ( public
+ , publicWebsockets
+ , publicBusEvents
+ ) where
+
+import Fig.Prelude
+
+import qualified Control.Concurrent.Chan as Chan
+
+import qualified Data.Text as Text
+
+import qualified Network.WebSockets as WS
+
+import Fig.Web.Utils
+import Fig.Web.Types
+import qualified Fig.Web.DB as DB
+
+public :: Module
+public a = do
+ onGet "/api/gizmo" do
+ buf <- queryParam "buf"
+ DB.hget a.db "gizmos" buf >>= \case
+ Nothing -> do
+ status status404
+ respondText "gizmo does not exist"
+ Just html -> respondHTML $ decodeUtf8 html
+ onGet "/api/gizmo/list" do
+ gizmos <- maybe [] (fmap decodeUtf8) <$> DB.hkeys a.db "gizmos"
+ respondText $ Text.unlines gizmos
+
+publicWebsockets :: Websockets
+publicWebsockets a =
+ [ ( "/api/gizmo/events", \conn -> do
+ c <- Chan.dupChan a.channels.gizmo
+ forever do
+ ev <- liftIO $ Chan.readChan c
+ WS.sendTextData conn ev
+ )
+ ]
+
+publicBusEvents :: BusEvents
+publicBusEvents a =
+ [ ("gizmo buffer update", \d -> do
+ let dstr = decodeUtf8 d
+ let updates = Text.splitOn " " dstr
+ forM_ updates $ Chan.writeChan a.channels.gizmo
+ )
+ ]