fig-web/src/Fig/Web/Module/Gizmo.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
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.Utils.DB as DB

public :: PublicModule
public a = do
  onGet "/api/gizmo" do
    buf <- queryParam "buf"
    DB.run a.db (DB.hget "gizmos" buf) >>= \case
      Nothing -> do
        status status404
        respondText "gizmo does not exist"
      Just html -> respondHTMLText $ decodeUtf8 html
  onGet "/api/gizmo/list" do
    gizmos <- maybe [] (fmap decodeUtf8) <$> DB.run a.db (DB.hkeys "gizmos")
    respondText $ Text.unlines gizmos

publicWebsockets :: PublicWebsockets
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 :: PublicBusEvents
publicBusEvents a =
  [ ("gizmo buffer update", \d -> do
        let dstr = decodeUtf8 d
        let updates = Text.splitOn " " dstr
        forM_ updates $ Chan.writeChan a.channels.gizmo
    )
  ]