fig-frontend/src/Fig/Frontend.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.Frontend where

import Fig.Prelude

import Control.Lens (use)

import qualified Network.Wai.Middleware.Static as Wai.Static
import qualified Network.Wai.Handler.Warp as Warp

import qualified Web.Twain as Tw

import qualified Lucid as L
import qualified Lucid.Base as L

import Fig.Frontend.Utils
import Fig.Frontend.Auth
import Fig.Frontend.State

server :: Config -> IO ()
server cfg = do
  log $ "Frontend server running on port " <> tshow cfg.port
  Warp.run cfg.port =<< app cfg

window :: Text -> Text -> L.Html () -> L.Html ()
window id_ title body = 
  L.term "fig-window" [L.id_ id_, L.makeAttributes "title" title] do
    body

app :: Config -> IO Tw.Application
app cfg = do
  st <- stateRef
  pure $ foldr' @[] ($)
    (Tw.notFound . Tw.send $ Tw.text "not found")
    [ Wai.Static.staticPolicy $ Wai.Static.addBase cfg.assetPath
    , Tw.get "/"
      . Tw.send . Tw.html
      . L.renderBS
      $ L.doctypehtml_ do
          L.head_ do
            L.title_ "clonk zone api home page"
            L.link_ [L.rel_ "icon", L.href_ "data:;base64,iVBORw0KGgo="]
          L.body_ do
            "hello"
    , Tw.get "/api/check" $ authed cfg \auth -> do
        Tw.send $ Tw.json @[Text] [auth.id, auth.name]
    , Tw.put "/api/buffer" do
        buf <- withState st $ use buffer 
        Tw.send $ Tw.text buf
    ]