From 1f2e453d0c9f8412b9032cb4e655713ecdcf1fa3 Mon Sep 17 00:00:00 2001
From: LLLL Colonq <llll@colonq>
Date: Mon, 26 May 2025 04:43:38 -0400
Subject: web: Refactor major style

---
 .dir-locals.el                                     |   6 +
 .../src/Fig/Bridge/IRCDiscord.hs                   |   2 +-
 fig-bus/fig-bus.cabal                              |   4 +-
 fig-bus/main/Main.hs                               |   8 +-
 fig-bus/src/Fig/Bus/SExp.hs                        |  62 -----
 fig-bus/src/Fig/Bus/SExp/Client.hs                 |  66 ------
 fig-bus/src/Fig/Bus/SExpr.hs                       |  62 +++++
 fig-bus/src/Fig/Bus/SExpr/Client.hs                |  66 ++++++
 fig-monitor-bullfrog/src/Fig/Monitor/Bullfrog.hs   |   2 +-
 fig-monitor-discord/src/Fig/Monitor/Discord.hs     |   2 +-
 fig-monitor-irc/src/Fig/Monitor/IRC.hs             |   2 +-
 fig-utils/src/Fig/Prelude.hs                       |   2 +-
 fig-web/fig-web.cabal                              |  20 +-
 fig-web/main/Main.hs                               |   2 +-
 fig-web/src/Fig/Web/Auth.hs                        |  89 --------
 fig-web/src/Fig/Web/DB.hs                          |  53 ++---
 fig-web/src/Fig/Web/Exchange.hs                    |  67 ------
 fig-web/src/Fig/Web/LDAP.hs                        |  43 ----
 fig-web/src/Fig/Web/Module/Bells.hs                |  26 +++
 fig-web/src/Fig/Web/Module/Circle.hs               |  61 +++++
 fig-web/src/Fig/Web/Module/Exchange.hs             | 100 ++++++++
 fig-web/src/Fig/Web/Module/Gizmo.hs                |  49 ++++
 fig-web/src/Fig/Web/Module/Misc.hs                 |  38 ++++
 fig-web/src/Fig/Web/Module/Model.hs                |  26 +++
 fig-web/src/Fig/Web/Module/Redeem.hs               |  23 ++
 fig-web/src/Fig/Web/Module/Sentiment.hs            |  21 ++
 fig-web/src/Fig/Web/Module/Shader.hs               |  18 ++
 fig-web/src/Fig/Web/Module/TwitchAuth.hs           | 107 +++++++++
 fig-web/src/Fig/Web/Module/User.hs                 |  21 ++
 fig-web/src/Fig/Web/Public.hs                      | 251 ++++-----------------
 fig-web/src/Fig/Web/Secure.hs                      | 115 +++-------
 fig-web/src/Fig/Web/State.hs                       |  41 ----
 fig-web/src/Fig/Web/Types.hs                       |  70 ++++++
 fig-web/src/Fig/Web/Utils.hs                       | 131 ++++++++++-
 34 files changed, 957 insertions(+), 699 deletions(-)
 create mode 100644 .dir-locals.el
 delete mode 100644 fig-bus/src/Fig/Bus/SExp.hs
 delete mode 100644 fig-bus/src/Fig/Bus/SExp/Client.hs
 create mode 100644 fig-bus/src/Fig/Bus/SExpr.hs
 create mode 100644 fig-bus/src/Fig/Bus/SExpr/Client.hs
 delete mode 100644 fig-web/src/Fig/Web/Auth.hs
 delete mode 100644 fig-web/src/Fig/Web/Exchange.hs
 delete mode 100644 fig-web/src/Fig/Web/LDAP.hs
 create mode 100644 fig-web/src/Fig/Web/Module/Bells.hs
 create mode 100644 fig-web/src/Fig/Web/Module/Circle.hs
 create mode 100644 fig-web/src/Fig/Web/Module/Exchange.hs
 create mode 100644 fig-web/src/Fig/Web/Module/Gizmo.hs
 create mode 100644 fig-web/src/Fig/Web/Module/Misc.hs
 create mode 100644 fig-web/src/Fig/Web/Module/Model.hs
 create mode 100644 fig-web/src/Fig/Web/Module/Redeem.hs
 create mode 100644 fig-web/src/Fig/Web/Module/Sentiment.hs
 create mode 100644 fig-web/src/Fig/Web/Module/Shader.hs
 create mode 100644 fig-web/src/Fig/Web/Module/TwitchAuth.hs
 create mode 100644 fig-web/src/Fig/Web/Module/User.hs
 delete mode 100644 fig-web/src/Fig/Web/State.hs
 create mode 100644 fig-web/src/Fig/Web/Types.hs

diff --git a/.dir-locals.el b/.dir-locals.el
new file mode 100644
index 0000000..a072fc6
--- /dev/null
+++ b/.dir-locals.el
@@ -0,0 +1,6 @@
+((haskell-mode  .
+   ((eglot-workspace-configuration .
+      ((haskell
+         (plugin
+           (stan
+             (globalOn . :json-false)))))))))
diff --git a/fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord.hs b/fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord.hs
index 3da1ce0..d09691a 100644
--- a/fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord.hs
+++ b/fig-bridge-irc-discord/src/Fig/Bridge/IRCDiscord.hs
@@ -8,7 +8,7 @@ import qualified Data.List as List
 
 import Fig.Bridge.IRCDiscord.Utils
 import Fig.Utils.SExpr
-import Fig.Bus.SExp.Client
+import Fig.Bus.SExpr.Client
 
 bridge :: Config -> (Text, Text) -> IO ()
 bridge cfg busAddr = do
diff --git a/fig-bus/fig-bus.cabal b/fig-bus/fig-bus.cabal
index bfb2c7f..9655c67 100644
--- a/fig-bus/fig-bus.cabal
+++ b/fig-bus/fig-bus.cabal
@@ -32,8 +32,8 @@ library
   import: deps
   hs-source-dirs: src
   exposed-modules:
-    Fig.Bus.SExp
-    Fig.Bus.SExp.Client
+    Fig.Bus.SExpr
+    Fig.Bus.SExpr.Client
     Fig.Bus.Binary
     Fig.Bus.Binary.Utils
     Fig.Bus.Binary.Client
diff --git a/fig-bus/main/Main.hs b/fig-bus/main/Main.hs
index bf5c170..addb7dd 100644
--- a/fig-bus/main/Main.hs
+++ b/fig-bus/main/Main.hs
@@ -4,14 +4,14 @@ import Fig.Prelude
 
 import Options.Applicative
 
-import qualified Fig.Bus.SExp as SExp
+import qualified Fig.Bus.SExpr as SExpr
 import qualified Fig.Bus.Binary as Binary
 
-data Command = SExp | Binary
+data Command = SExpr | Binary
 
 parseCommand :: Parser Command
 parseCommand = subparser $ mconcat
-  [ command "sexp" $ info (pure SExp) (progDesc "Launch the s-expression bus")
+  [ command "sexp" $ info (pure SExpr) (progDesc "Launch the s-expression bus")
   , command "binary" $ info (pure Binary) (progDesc "Launch the binary bus")
   ]
 
@@ -34,5 +34,5 @@ main = do
     <> header "fig-bus - a pub/sub message bus"
     )
   case opts.cmd of
-    SExp -> SExp.main (Just opts.host, opts.port)
+    SExpr -> SExpr.main (Just opts.host, opts.port)
     Binary -> Binary.main (Just opts.host, opts.port)
diff --git a/fig-bus/src/Fig/Bus/SExp.hs b/fig-bus/src/Fig/Bus/SExp.hs
deleted file mode 100644
index ddd2896..0000000
--- a/fig-bus/src/Fig/Bus/SExp.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-module Fig.Bus.SExp (main) where
-
-import Fig.Prelude
-
-import Control.Concurrent.MVar as MVar
-
-import qualified Data.List as List
-import Data.ByteString (hPut, hGetLine)
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import qualified Data.IORef as IORef
-
-import Fig.Utils.SExpr
-import Fig.Utils.Net
-
-newtype BusState = BusState
-  { subscriptions :: Map SExpr [Handle]
-  }
-
-subscribe :: SExpr -> Handle -> BusState -> BusState
-subscribe ev h bs = bs
-  { subscriptions = Map.insertWith (<>) ev [h] bs.subscriptions
-  }
-
-unsubscribe :: SExpr -> Handle -> BusState -> BusState
-unsubscribe ev h bs = bs
-  { subscriptions = Map.update (Just . List.delete h) ev bs.subscriptions
-  }
-
-publish :: SExpr -> [SExpr] -> BusState -> IO ()
-publish ev d bs =
-  case Map.lookup ev bs.subscriptions of
-    Nothing -> pure ()
-    Just hs -> forM_ hs \h -> do
-      hPut h . encodeUtf8 $ pretty (SExprList $ ev:d) <> "\n"
-
-main :: (Maybe Text, Text) -> IO ()
-main bind = do
-  st <- MVar.newMVar $ BusState { subscriptions = Map.empty }
-  server bind do
-    subs <- IORef.newIORef ([] :: [SExpr])
-    pure \h peer ->
-      ( do
-          forever do
-            line <- throwLeft id . decodeUtf8' =<< hGetLine h
-            case parseSExpr line of
-              Just (SExprList (SExprSymbol "ping":_)) -> do
-                log $ tshow peer <> " pinged"
-                hPut h . encodeUtf8 $ "(pong)\n"
-              Just (SExprList [SExprSymbol "sub", ev]) -> do
-                log $ tshow peer <> " subscribing to: " <> pretty ev
-                IORef.modifyIORef' subs (ev:)
-                MVar.modifyMVar_ st (pure . subscribe ev h)
-              Just (SExprList (SExprSymbol "pub":ev:d)) -> do
-                log $ tshow peer <> " publishing " <> pretty (SExprList d) <> " to: " <> pretty ev
-                publish ev d =<< MVar.readMVar st
-              Just x -> log $ tshow peer <> " sent invalid command: " <> pretty x
-              Nothing -> log $ tshow peer <> " sent malformed s-expression: " <> line
-      , do
-          ss <- IORef.readIORef subs
-          MVar.modifyMVar_ st \bs -> pure $ foldr (`unsubscribe` h) bs ss
-      )
diff --git a/fig-bus/src/Fig/Bus/SExp/Client.hs b/fig-bus/src/Fig/Bus/SExp/Client.hs
deleted file mode 100644
index 780f78f..0000000
--- a/fig-bus/src/Fig/Bus/SExp/Client.hs
+++ /dev/null
@@ -1,66 +0,0 @@
-{-# Language QuasiQuotes #-}
-
-module Fig.Bus.SExp.Client (Commands(..), busClient) where
-
-import Fig.Prelude
-
-import System.Exit (exitFailure)
-
-import qualified Control.Concurrent as Conc
-import qualified Control.Concurrent.Async as Async
-
-import Data.ByteString (hPut, hGetLine)
-
-import Fig.Utils.Net
-import Fig.Utils.SExpr
-
-data Commands m = Commands
-  { ping :: m ()
-  , subscribe :: SExpr -> m ()
-  , publish :: SExpr -> [SExpr] -> m ()
-  }
-
-newtype FigBusClientException = FigBusClientException Text
-  deriving (Show, Eq, Ord)
-instance Exception FigBusClientException
-
-busClient :: forall m.
-  (MonadIO m, MonadThrow m, MonadMask m) =>
-  (Text, Text) ->
-  (Commands IO -> IO ()) ->
-  (Commands IO -> SExpr -> IO ()) ->
-  IO () ->
-  m ()
-busClient loc@(host, port) onConn onData onQuit = catchFailure . client loc $ pure \h ->
-  let
-    sendSexpr x = liftIO . hPut h . encodeUtf8 $ pretty x <> "\n"
-    cmds = Commands
-      { ping = sendSexpr [sexp|(ping)|]
-      , subscribe = \ev -> sendSexpr [sexp|(sub ,ev)|]
-      , publish = \ev d -> sendSexpr [sexp|(pub ,ev ,@d)|]
-      }
-  in
-    ( do
-        liftIO $ Async.concurrently_ (onConn cmds) do
-          forever do
-            line <- throwLeft id . decodeUtf8' =<< liftIO (hGetLine h)
-            case parseSExpr line of
-              Nothing -> throwM . FigBusClientException $ "Server sent malformed s-expression: " <> line
-              Just x -> liftIO $ onData cmds x
-    , liftIO onQuit
-    )
-  where
-    catchFailure body = catch body \(e :: IOException) -> do
-      log $ "Failed to connect to bus at " <> host <> ":" <> port <> ": " <> tshow e
-      liftIO exitFailure
-
-_testClient :: IO ()
-_testClient = busClient ("localhost", "32050")
-  (\cmds -> do
-      cmds.subscribe [sexp|foo|]
-      forever do
-        Conc.threadDelay 1000000
-        cmds.publish [sexp|bar|] [[sexp|42|]]
-  )
-  (\_cmds d -> log $ "Received: " <> pretty d)
-  (pure ())
diff --git a/fig-bus/src/Fig/Bus/SExpr.hs b/fig-bus/src/Fig/Bus/SExpr.hs
new file mode 100644
index 0000000..49cee90
--- /dev/null
+++ b/fig-bus/src/Fig/Bus/SExpr.hs
@@ -0,0 +1,62 @@
+module Fig.Bus.SExpr (main) where
+
+import Fig.Prelude
+
+import Control.Concurrent.MVar as MVar
+
+import qualified Data.List as List
+import Data.ByteString (hPut, hGetLine)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import qualified Data.IORef as IORef
+
+import Fig.Utils.SExpr
+import Fig.Utils.Net
+
+newtype BusState = BusState
+  { subscriptions :: Map SExpr [Handle]
+  }
+
+subscribe :: SExpr -> Handle -> BusState -> BusState
+subscribe ev h bs = bs
+  { subscriptions = Map.insertWith (<>) ev [h] bs.subscriptions
+  }
+
+unsubscribe :: SExpr -> Handle -> BusState -> BusState
+unsubscribe ev h bs = bs
+  { subscriptions = Map.update (Just . List.delete h) ev bs.subscriptions
+  }
+
+publish :: SExpr -> [SExpr] -> BusState -> IO ()
+publish ev d bs =
+  case Map.lookup ev bs.subscriptions of
+    Nothing -> pure ()
+    Just hs -> forM_ hs \h -> do
+      hPut h . encodeUtf8 $ pretty (SExprList $ ev:d) <> "\n"
+
+main :: (Maybe Text, Text) -> IO ()
+main bind = do
+  st <- MVar.newMVar $ BusState { subscriptions = Map.empty }
+  server bind do
+    subs <- IORef.newIORef ([] :: [SExpr])
+    pure \h peer ->
+      ( do
+          forever do
+            line <- throwLeft id . decodeUtf8' =<< hGetLine h
+            case parseSExpr line of
+              Just (SExprList (SExprSymbol "ping":_)) -> do
+                log $ tshow peer <> " pinged"
+                hPut h . encodeUtf8 $ "(pong)\n"
+              Just (SExprList [SExprSymbol "sub", ev]) -> do
+                log $ tshow peer <> " subscribing to: " <> pretty ev
+                IORef.modifyIORef' subs (ev:)
+                MVar.modifyMVar_ st (pure . subscribe ev h)
+              Just (SExprList (SExprSymbol "pub":ev:d)) -> do
+                log $ tshow peer <> " publishing " <> pretty (SExprList d) <> " to: " <> pretty ev
+                publish ev d =<< MVar.readMVar st
+              Just x -> log $ tshow peer <> " sent invalid command: " <> pretty x
+              Nothing -> log $ tshow peer <> " sent malformed s-expression: " <> line
+      , do
+          ss <- IORef.readIORef subs
+          MVar.modifyMVar_ st \bs -> pure $ foldr (`unsubscribe` h) bs ss
+      )
diff --git a/fig-bus/src/Fig/Bus/SExpr/Client.hs b/fig-bus/src/Fig/Bus/SExpr/Client.hs
new file mode 100644
index 0000000..ccd41a7
--- /dev/null
+++ b/fig-bus/src/Fig/Bus/SExpr/Client.hs
@@ -0,0 +1,66 @@
+{-# Language QuasiQuotes #-}
+
+module Fig.Bus.SExpr.Client (Commands(..), busClient) where
+
+import Fig.Prelude
+
+import System.Exit (exitFailure)
+
+import qualified Control.Concurrent as Conc
+import qualified Control.Concurrent.Async as Async
+
+import Data.ByteString (hPut, hGetLine)
+
+import Fig.Utils.Net
+import Fig.Utils.SExpr
+
+data Commands m = Commands
+  { ping :: m ()
+  , subscribe :: SExpr -> m ()
+  , publish :: SExpr -> [SExpr] -> m ()
+  }
+
+newtype FigBusClientException = FigBusClientException Text
+  deriving (Show, Eq, Ord)
+instance Exception FigBusClientException
+
+busClient :: forall m.
+  (MonadIO m, MonadThrow m, MonadMask m) =>
+  (Text, Text) ->
+  (Commands IO -> IO ()) ->
+  (Commands IO -> SExpr -> IO ()) ->
+  IO () ->
+  m ()
+busClient loc@(host, port) onConn onData onQuit = catchFailure . client loc $ pure \h ->
+  let
+    sendSexpr x = liftIO . hPut h . encodeUtf8 $ pretty x <> "\n"
+    cmds = Commands
+      { ping = sendSexpr [sexp|(ping)|]
+      , subscribe = \ev -> sendSexpr [sexp|(sub ,ev)|]
+      , publish = \ev d -> sendSexpr [sexp|(pub ,ev ,@d)|]
+      }
+  in
+    ( do
+        liftIO $ Async.concurrently_ (onConn cmds) do
+          forever do
+            line <- throwLeft id . decodeUtf8' =<< liftIO (hGetLine h)
+            case parseSExpr line of
+              Nothing -> throwM . FigBusClientException $ "Server sent malformed s-expression: " <> line
+              Just x -> liftIO $ onData cmds x
+    , liftIO onQuit
+    )
+  where
+    catchFailure body = catch body \(e :: IOException) -> do
+      log $ "Failed to connect to bus at " <> host <> ":" <> port <> ": " <> tshow e
+      liftIO exitFailure
+
+_testClient :: IO ()
+_testClient = busClient ("localhost", "32050")
+  (\cmds -> do
+      cmds.subscribe [sexp|foo|]
+      forever do
+        Conc.threadDelay 1000000
+        cmds.publish [sexp|bar|] [[sexp|42|]]
+  )
+  (\_cmds d -> log $ "Received: " <> pretty d)
+  (pure ())
diff --git a/fig-monitor-bullfrog/src/Fig/Monitor/Bullfrog.hs b/fig-monitor-bullfrog/src/Fig/Monitor/Bullfrog.hs
index b2d62db..1b0f42c 100644
--- a/fig-monitor-bullfrog/src/Fig/Monitor/Bullfrog.hs
+++ b/fig-monitor-bullfrog/src/Fig/Monitor/Bullfrog.hs
@@ -14,7 +14,7 @@ import qualified Wuss as WS
 import qualified Network.WebSockets.Connection as WS
 
 import Fig.Utils.SExpr
-import Fig.Bus.SExp.Client
+import Fig.Bus.SExpr.Client
 import Fig.Monitor.Bullfrog.Utils
 
 bullfrogClient :: Config -> (Text, Text) -> IO ()
diff --git a/fig-monitor-discord/src/Fig/Monitor/Discord.hs b/fig-monitor-discord/src/Fig/Monitor/Discord.hs
index 58372af..b451b6e 100644
--- a/fig-monitor-discord/src/Fig/Monitor/Discord.hs
+++ b/fig-monitor-discord/src/Fig/Monitor/Discord.hs
@@ -23,7 +23,7 @@ import qualified Discord.Requests as Dis
 import qualified Discord.Interactions as Dis
 
 import Fig.Utils.SExpr
-import Fig.Bus.SExp.Client
+import Fig.Bus.SExpr.Client
 import Fig.Monitor.Discord.Utils
 
 data OutgoingMessage = OutgoingMessage
diff --git a/fig-monitor-irc/src/Fig/Monitor/IRC.hs b/fig-monitor-irc/src/Fig/Monitor/IRC.hs
index 78e14a6..42754ba 100644
--- a/fig-monitor-irc/src/Fig/Monitor/IRC.hs
+++ b/fig-monitor-irc/src/Fig/Monitor/IRC.hs
@@ -19,7 +19,7 @@ import qualified Control.Concurrent.Chan as Chan
 import qualified Network.IRC.Client as IRC
 
 import Fig.Utils.SExpr
-import Fig.Bus.SExp.Client
+import Fig.Bus.SExpr.Client
 import Fig.Monitor.IRC.Utils
 
 data OutgoingMessage = OutgoingMessage
diff --git a/fig-utils/src/Fig/Prelude.hs b/fig-utils/src/Fig/Prelude.hs
index 607d26e..ef2d247 100644
--- a/fig-utils/src/Fig/Prelude.hs
+++ b/fig-utils/src/Fig/Prelude.hs
@@ -90,7 +90,7 @@ import Text.Show (Show(..))
 import Text.Read (readMaybe)
 
 import Control.Applicative (Applicative(..), (<*), (*>))
-import Control.Monad (Monad(..), join, forever, mapM, forM, foldM, void, (>>=), (=<<), (>=>), (<=<))
+import Control.Monad (Monad(..), join, forever, mapM, forM, foldM, void, when, unless, (>>=), (=<<), (>=>), (<=<))
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.State.Class (MonadState(..), get, put, modify)
 import Control.Monad.Reader.Class (MonadReader(..), ask)
diff --git a/fig-web/fig-web.cabal b/fig-web/fig-web.cabal
index b9eade6..c81f016 100644
--- a/fig-web/fig-web.cabal
+++ b/fig-web/fig-web.cabal
@@ -56,14 +56,22 @@ library
   import: deps
   hs-source-dirs: src
   exposed-modules:
-    Fig.Web.Public
-    Fig.Web.Secure
     Fig.Web.Utils
-    Fig.Web.Auth
-    Fig.Web.State
+    Fig.Web.Types
     Fig.Web.DB
-    Fig.Web.LDAP
-    Fig.Web.Exchange
+    Fig.Web.Public
+    Fig.Web.Secure
+    Fig.Web.Module.Misc
+    Fig.Web.Module.TwitchAuth
+    Fig.Web.Module.Exchange
+    Fig.Web.Module.Gizmo
+    Fig.Web.Module.Sentiment
+    Fig.Web.Module.Circle
+    Fig.Web.Module.Model
+    Fig.Web.Module.Bells
+    Fig.Web.Module.User
+    Fig.Web.Module.Shader
+    Fig.Web.Module.Redeem
 
 executable fig-web
   import: defaults
diff --git a/fig-web/main/Main.hs b/fig-web/main/Main.hs
index 1ab93f0..8db47e2 100644
--- a/fig-web/main/Main.hs
+++ b/fig-web/main/Main.hs
@@ -39,7 +39,7 @@ main :: IO ()
 main = do
   opts <- execParser $ info (parseOpts <**> helper)
     ( fullDesc
-    <> header "fig-web - public-facing web applications"
+    <> Options.Applicative.header "fig-web - public-facing web applications"
     )
   cfg <- loadConfig opts.config
   case opts.cmd of
diff --git a/fig-web/src/Fig/Web/Auth.hs b/fig-web/src/Fig/Web/Auth.hs
deleted file mode 100644
index b78e3b3..0000000
--- a/fig-web/src/Fig/Web/Auth.hs
+++ /dev/null
@@ -1,89 +0,0 @@
-module Fig.Web.Auth where
-
-import Fig.Prelude
-
-import qualified Network.HTTP.Req as R
-
-import Data.Maybe (mapMaybe)
-import qualified Data.Text as Text
-import qualified Data.Text.Lazy as Text.Lazy
-import qualified Data.Map.Strict as Map
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Types as Aeson
-
-import qualified Jose.Jwk as Jwk
-import qualified Jose.Jwt as Jwt
-
-import qualified Web.Scotty as Sc
-
-import Fig.Web.Utils
-
-data TokenContents = TokenContents
-  { aud :: !Text
-  , exp :: !Int
-  , iat :: !Int
-  , iss :: !Text
-  , sub :: !Text
-  , azp :: !(Maybe Text)
-  , nonce :: !Text
-  , preferred_username :: !Text
-  } deriving (Show, Eq, Generic)
-instance Aeson.FromJSON TokenContents
-
-fetchJwk :: MonadIO m => m (Maybe Jwk.Jwk)
-fetchJwk = do
-  resp <- R.responseBody <$> R.runReq R.defaultHttpConfig do
-    R.req R.GET (R.https "id.twitch.tv" R./: "oauth2" R./: "keys") R.NoReqBody R.jsonResponse mempty
-  let mkeys = Aeson.parseMaybe (Aeson..: "keys") resp
-  let mjwk = mkeys >>= headMay
-  log $ tshow mjwk
-  pure mjwk
-
-validateToken :: MonadIO m => ByteString -> m (Maybe TokenContents)
-validateToken encodedToken = fetchJwk >>= \case
-  Nothing -> pure Nothing
-  Just jwk -> liftIO (Jwt.decode [jwk] Nothing encodedToken) >>= \case
-    Left err -> do
-      log $ "Failed to decode token: " <> tshow err
-      pure Nothing
-    Right jwt -> do
-      let contents = case jwt of
-            Jwt.Unsecured bs -> bs
-            Jwt.Jws (_, bs) -> bs
-            Jwt.Jwe (_, bs) -> bs
-      log $ tshow contents
-      pure $ Aeson.decodeStrict contents
-
-data Auth = Auth { id :: !Text, name :: !Text } deriving Show
-checkAuth :: Config -> Sc.ActionM (Maybe Auth)
-checkAuth cfg =
-  Sc.header "Authorization"
-  >>= \case
-    Just authstrLazy -> do
-      let authstr = drop 1 $ Text.splitOn " " $ Text.Lazy.toStrict authstrLazy
-      let pairs = Map.fromList $ flip mapMaybe authstr \s ->
-            case Text.splitOn "=" s of
-              [k, v] -> Just (k, Text.takeWhile (/='"') $ Text.drop 1 v)
-              _other -> Nothing
-      case (Map.lookup "token" pairs, Map.lookup "nonce" pairs) of
-        (Just token, Just nonce) -> do
-          validateToken (encodeUtf8 token) >>= \case
-            Just tc
-              | tc.aud == cfg.clientId
-              , tc.nonce == nonce
-                -> do
-                  pure . Just $ Auth
-                    { name = tc.preferred_username
-                    , id = tc.sub
-                    }
-            _else -> do
-              pure Nothing
-        _else -> pure Nothing
-    _else -> pure Nothing
-
-authed :: Config -> (Auth -> Sc.ActionM ()) -> Sc.ActionM ()
-authed cfg f = checkAuth cfg >>= \case
-  Nothing -> do
-    Sc.status status401
-    Sc.text "unauthorized"
-  Just auth -> f auth
diff --git a/fig-web/src/Fig/Web/DB.hs b/fig-web/src/Fig/Web/DB.hs
index d8a70c2..5a51560 100644
--- a/fig-web/src/Fig/Web/DB.hs
+++ b/fig-web/src/Fig/Web/DB.hs
@@ -5,64 +5,65 @@ import Control.Error.Util (hush)
 import qualified Database.Redis as Redis
 
 import Fig.Prelude
+import Fig.Web.Types
 import Fig.Web.Utils
 
-connect :: MonadIO m => Config -> m Redis.Connection
-connect cfg = liftIO $ Redis.checkedConnect Redis.defaultConnectInfo
+connect :: MonadIO m => Config -> m DB
+connect cfg = liftIO $ DB <$> Redis.checkedConnect Redis.defaultConnectInfo
   { Redis.connectHost = unpack cfg.dbHost
   }
 
-get :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe ByteString)
-get c key = liftIO $ Redis.runRedis c do
+get :: MonadIO m => DB -> ByteString -> m (Maybe ByteString)
+get (DB c) key = liftIO $ Redis.runRedis c do
   v <- Redis.get key
   pure . join $ hush v
 
-incr :: MonadIO m => Redis.Connection -> ByteString -> m ()
-incr c key = liftIO $ Redis.runRedis c do
+incr :: MonadIO m => DB -> ByteString -> m ()
+incr (DB c) key = liftIO $ Redis.runRedis c do
   void $ Redis.incr key
 
-decr :: MonadIO m => Redis.Connection -> ByteString -> m ()
-decr c key = liftIO $ Redis.runRedis c do
+decr :: MonadIO m => DB -> ByteString -> m ()
+decr (DB c) key = liftIO $ Redis.runRedis c do
   void $ Redis.decr key
 
-hget :: MonadIO m => Redis.Connection -> ByteString -> ByteString -> m (Maybe ByteString)
-hget c key hkey = liftIO $ Redis.runRedis c do
+hget :: MonadIO m => DB -> ByteString -> ByteString -> m (Maybe ByteString)
+hget (DB c) key hkey = liftIO $ Redis.runRedis c do
   v <- Redis.hget key hkey
   pure . join $ hush v
 
-hkeys :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe [ByteString])
-hkeys c key = liftIO $ Redis.runRedis c do
+hkeys :: MonadIO m => DB -> ByteString -> m (Maybe [ByteString])
+hkeys (DB c) key = liftIO $ Redis.runRedis c do
   hush <$> Redis.hkeys key
 
-hvals :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe [ByteString])
-hvals c key = liftIO $ Redis.runRedis c do
+hvals :: MonadIO m => DB -> ByteString -> m (Maybe [ByteString])
+hvals (DB c) key = liftIO $ Redis.runRedis c do
   hush <$> Redis.hvals key
 
-sadd :: MonadIO m => Redis.Connection -> ByteString -> [ByteString] -> m ()
-sadd c key skeys = liftIO $ Redis.runRedis c do
+sadd :: MonadIO m => DB -> ByteString -> [ByteString] -> m ()
+sadd (DB c) key skeys = liftIO $ Redis.runRedis c do
   _ <- Redis.sadd key skeys
   pure ()
 
-srem :: MonadIO m => Redis.Connection -> ByteString -> [ByteString] -> m ()
-srem c key skeys = liftIO $ Redis.runRedis c do
+srem :: MonadIO m => DB -> ByteString -> [ByteString] -> m ()
+srem (DB c) key skeys = liftIO $ Redis.runRedis c do
   _ <- Redis.srem key skeys
   pure ()
 
-smembers :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe [ByteString])
-smembers c key = liftIO $ Redis.runRedis c do
+smembers :: MonadIO m => DB -> ByteString -> m (Maybe [ByteString])
+smembers (DB c) key = liftIO $ Redis.runRedis c do
   hush <$> Redis.smembers key
 
-sismember :: MonadIO m => Redis.Connection -> ByteString -> ByteString -> m Bool
-sismember c key skey = liftIO $ Redis.runRedis c do
+sismember :: MonadIO m => DB -> ByteString -> ByteString -> m Bool
+sismember (DB c) key skey = liftIO $ Redis.runRedis c do
   Redis.sismember key skey >>= hush >>> \case
     Just x -> pure x
     Nothing -> pure False
 
-lpop :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe ByteString)
-lpop c key = liftIO $ Redis.runRedis c do
+lpop :: MonadIO m => DB -> ByteString -> m (Maybe ByteString)
+lpop (DB c) key = liftIO $ Redis.runRedis c do
   join . hush <$> Redis.lpop key
 
-rpush :: MonadIO m => Redis.Connection -> ByteString -> ByteString -> m ()
-rpush c key val = liftIO $ Redis.runRedis c do
+rpush :: MonadIO m => DB -> ByteString -> ByteString -> m ()
+rpush (DB c) key val = liftIO $ Redis.runRedis c do
   _ <- Redis.rpush key [val]
   pure ()
diff --git a/fig-web/src/Fig/Web/Exchange.hs b/fig-web/src/Fig/Web/Exchange.hs
deleted file mode 100644
index 264e73c..0000000
--- a/fig-web/src/Fig/Web/Exchange.hs
+++ /dev/null
@@ -1,67 +0,0 @@
-module Fig.Web.Exchange where
-
-import Control.Error.Util (hush)
-
-import qualified Database.Redis as Redis
-
-import Data.Maybe (mapMaybe)
-import qualified Data.Aeson as Aeson
-import qualified Data.Text.Read as Text.R
-import qualified Data.ByteString.Lazy as BS.Lazy
-import qualified Data.UUID as UUID
-import qualified Data.UUID.V4 as UUID
-
-import Fig.Prelude
-
-adjustUserCurrency :: Text -> Text -> Integer -> Redis.Redis ()
-adjustUserCurrency user cur amt = do
-  let key = "currency:" <> encodeUtf8 user
-  let ecur = encodeUtf8 cur
-  mold <- hush <$> Redis.hget key ecur
-  let old = case mold of
-        Just (Just o) -> case Text.R.decimal $ decodeUtf8 o of
-          Right (num, _) -> num
-          _else -> 0
-        _else -> 0
-  void . Redis.hset key ecur . encodeUtf8 . tshow $ old + amt
-
-data Order = Order
-  { creator :: !Text
-  , wantCur :: !Text
-  , wantAmount :: !Integer
-  , haveCur :: !Text
-  , haveAmount :: !Integer
-  } deriving Generic
-instance Aeson.ToJSON Order
-instance Aeson.FromJSON Order
-
-createOrder :: MonadIO m => Redis.Connection -> Order -> m ByteString
-createOrder c o = liftIO $ Redis.runRedis c do
-  let bs = Aeson.encode o
-  uuid <- liftIO UUID.nextRandom
-  let key = BS.Lazy.toStrict $ UUID.toByteString uuid
-  void $ Redis.hset "orders" key (BS.Lazy.toStrict bs)
-  pure key
-
-getOrders :: MonadIO m => Redis.Connection -> m [Order]
-getOrders c = liftIO $ Redis.runRedis c do
-  Redis.hvals "orders" >>= \case
-    Left _ -> pure []
-    Right orders -> pure $ mapMaybe (Aeson.decode' . BS.Lazy.fromStrict) orders
-
-cancelOrder :: MonadIO m => Redis.Connection -> ByteString -> m ()
-cancelOrder c key = liftIO $ Redis.runRedis c do
-  void $ Redis.hdel "orders" [key]
-
-satisfyOrder :: MonadIO m => Redis.Connection -> ByteString -> Text -> m ()
-satisfyOrder c key buyer = liftIO $ Redis.runRedis c do
-  Redis.hget "orders" key >>= \case
-    Right (Just bs) -> case Aeson.decode' $ BS.Lazy.fromStrict bs of
-      Nothing -> pure ()
-      Just (order :: Order) -> do
-        adjustUserCurrency buyer order.wantCur (-order.wantAmount)
-        adjustUserCurrency order.creator order.wantCur order.wantAmount
-        adjustUserCurrency buyer order.haveCur order.haveAmount
-        adjustUserCurrency order.creator order.haveCur (-order.haveAmount)
-    _else -> pure ()
-        
diff --git a/fig-web/src/Fig/Web/LDAP.hs b/fig-web/src/Fig/Web/LDAP.hs
deleted file mode 100644
index 07c87d9..0000000
--- a/fig-web/src/Fig/Web/LDAP.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-module Fig.Web.LDAP where
-
-import Fig.Prelude
-
-import System.Exit (ExitCode(..))
-import qualified System.Process as Proc
-
-import qualified Data.UUID as UUID
-import qualified Data.UUID.V4 as UUID
-import qualified Data.Text as Text
-
-import Fig.Web.Utils
-
--- | Reset the password in LDAP for the specified user (creating the user if necessary)
-resetUserPassword :: MonadIO m => Config -> Text -> Text -> m (Maybe Text)
-resetUserPassword cfg user uid = do
-  let login = Text.toLower user
-  password <- UUID.toText <$> liftIO UUID.nextRandom
-  (exitCode, out0, err0) <- liftIO . flip Proc.readCreateProcessWithExitCode ""
-    . Proc.proc cfg.lldapCli $ unpack <$>
-    [ "-H", cfg.lldapHost
-    , "-D", cfg.lldapUser
-    , "-w", cfg.lldapPassword
-    , "user", "add", login, uid <> "@users.colonq.computer"
-    , "-p", password
-    , "-f", uid
-    ]
-  (_, out1, err1) <- liftIO . flip Proc.readCreateProcessWithExitCode ""
-    . Proc.proc cfg.lldapCli $ unpack <$>
-    [ "-H", cfg.lldapHost
-    , "-D", cfg.lldapUser
-    , "-w", cfg.lldapPassword
-    , "user", "group", "add", login, "fig_users"
-    ]
-  case exitCode of
-    ExitSuccess -> pure $ Just password
-    ExitFailure _ -> do
-      log . pack $ mconcat
-        [ "LDAP CLI error:\n"
-        , out0, err0
-        , out1, err1
-        ]
-      pure Nothing
diff --git a/fig-web/src/Fig/Web/Module/Bells.hs b/fig-web/src/Fig/Web/Module/Bells.hs
new file mode 100644
index 0000000..7451079
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/Bells.hs
@@ -0,0 +1,26 @@
+module Fig.Web.Module.Bells
+  ( public
+  ) where
+
+import Fig.Prelude
+
+import Fig.Utils.SExpr
+import Fig.Web.Utils
+import Fig.Web.Types
+import qualified Fig.Web.DB as DB
+
+public :: Module
+public a = do
+  onGet "/api/songs" do
+    DB.hvals a.db "songnames" >>= \case
+      Nothing -> do
+        status status404
+        respondText "no sounds found :("
+      Just songs -> respondText . pretty . SExprList @Void $ SExprString . decodeUtf8 <$> songs
+  onGet "/api/song/:hash" do
+    hash <- pathParam "hash"
+    DB.hget a.db "songnotes" hash >>= \case
+      Nothing -> do
+        status status404
+        respondText "song not found"
+      Just val -> respondText $ decodeUtf8 val
diff --git a/fig-web/src/Fig/Web/Module/Circle.hs b/fig-web/src/Fig/Web/Module/Circle.hs
new file mode 100644
index 0000000..5c21477
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/Circle.hs
@@ -0,0 +1,61 @@
+module Fig.Web.Module.Circle
+  ( public
+  , publicWebsockets
+  , publicBusEvents
+  ) where
+
+import Fig.Prelude
+
+import qualified Control.Concurrent.MVar as MVar
+import qualified Control.Concurrent.Chan as Chan
+
+import qualified Data.Text as Text
+import qualified Data.Set as Set
+
+import qualified Network.WebSockets as WS
+
+import Fig.Utils.SExpr
+import Fig.Web.Utils
+import Fig.Web.Types
+
+public :: Module
+public a = do
+  onGet "/api/circle" do
+    live <- liftIO $ MVar.readMVar a.globals.currentlyLive
+    respondText $ pretty . SExprList @Void $ SExprString <$> Set.toList live
+
+publicWebsockets :: Websockets
+publicWebsockets a =
+  [ ( "/api/circle/events", \conn -> do
+        c <- Chan.dupChan a.channels.live
+        forever do
+          ev <- liftIO $ Chan.readChan c
+          WS.sendTextData conn $ case ev of
+            LiveEventOnline online ->
+              pretty $ SExprList @Void
+              [ SExprString "online"
+              , SExprList $ SExprString <$> Set.toList online
+              ]
+            LiveEventOffline offline ->
+              pretty $ SExprList @Void
+              [ SExprString "offline"
+              , SExprList $ SExprString <$> Set.toList offline
+              ]
+    )
+  ]
+
+publicBusEvents :: BusEvents
+publicBusEvents a =
+  [ ("monitor twitch stream online", \d -> do
+        let dstr = decodeUtf8 d
+        let live = Text.splitOn " " dstr
+        let new = Set.fromList live 
+        old <- MVar.swapMVar a.globals.currentlyLive new
+        let online = Set.difference new old
+        let offline = Set.difference old new
+        unless (Set.null online && Set.null offline) do
+          log $ "Newly online: " <> Text.intercalate " " (Set.toList online) <> ", newly offline: " <> Text.intercalate " " (Set.toList offline)
+        unless (Set.null online) . Chan.writeChan a.channels.live $ LiveEventOnline online
+        unless (Set.null offline) . Chan.writeChan a.channels.live $ LiveEventOnline offline
+    )
+  ]
diff --git a/fig-web/src/Fig/Web/Module/Exchange.hs b/fig-web/src/Fig/Web/Module/Exchange.hs
new file mode 100644
index 0000000..32851fa
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/Exchange.hs
@@ -0,0 +1,100 @@
+module Fig.Web.Module.Exchange
+  ( public
+  , secure
+  ) where
+
+import Fig.Prelude
+
+import Control.Error.Util (hush)
+
+import qualified Database.Redis as Redis
+
+import Data.Maybe (mapMaybe)
+import qualified Data.Aeson as Aeson
+import qualified Data.Text.Read as Text.R
+import qualified Data.ByteString.Lazy as BS.Lazy
+import qualified Data.UUID as UUID
+import qualified Data.UUID.V4 as UUID
+
+import Fig.Web.Utils
+import Fig.Web.Types
+
+public :: Module
+public a = do
+  onGet "/api/exchange" do
+    listings <- getOrders a.db.conn
+    respondJSON listings
+
+secure :: Module
+secure a = do
+  onPost "/api/exchange" $ authed \creds -> do
+    haveCur <- formParam "haveCur"
+    haveAmount <- formParam "haveAmount"
+    wantCur <- formParam "wantCur"
+    wantAmount <- formParam "wantAmount"
+    key <- createOrder a.db.conn $ Order
+      { creator = creds.email
+      , haveCur = haveCur
+      , haveAmount = haveAmount
+      , wantCur = wantCur
+      , wantAmount = wantAmount
+      }
+    respondText $ decodeUtf8 key
+  onPost "/api/exchange/:key" $ authed \creds -> do
+    key <- pathParam "key"
+    satisfyOrder a.db.conn key creds.email
+  onDelete "/api/exchange/:key" $ authed \_creds -> do
+    key <- pathParam "key"
+    cancelOrder a.db.conn key
+
+adjustUserCurrency :: Text -> Text -> Integer -> Redis.Redis ()
+adjustUserCurrency user cur amt = do
+  let key = "currency:" <> encodeUtf8 user
+  let ecur = encodeUtf8 cur
+  mold <- hush <$> Redis.hget key ecur
+  let old = case mold of
+        Just (Just o) -> case Text.R.decimal $ decodeUtf8 o of
+          Right (num, _) -> num
+          _else -> 0
+        _else -> 0
+  void . Redis.hset key ecur . encodeUtf8 . tshow $ old + amt
+
+data Order = Order
+  { creator :: !Text
+  , wantCur :: !Text
+  , wantAmount :: !Integer
+  , haveCur :: !Text
+  , haveAmount :: !Integer
+  } deriving Generic
+instance Aeson.ToJSON Order
+instance Aeson.FromJSON Order
+
+createOrder :: MonadIO m => Redis.Connection -> Order -> m ByteString
+createOrder c o = liftIO $ Redis.runRedis c do
+  let bs = Aeson.encode o
+  uuid <- liftIO UUID.nextRandom
+  let key = BS.Lazy.toStrict $ UUID.toByteString uuid
+  void $ Redis.hset "orders" key (BS.Lazy.toStrict bs)
+  pure key
+
+getOrders :: MonadIO m => Redis.Connection -> m [Order]
+getOrders c = liftIO $ Redis.runRedis c do
+  Redis.hvals "orders" >>= \case
+    Left _ -> pure []
+    Right orders -> pure $ mapMaybe (Aeson.decode' . BS.Lazy.fromStrict) orders
+
+cancelOrder :: MonadIO m => Redis.Connection -> ByteString -> m ()
+cancelOrder c key = liftIO $ Redis.runRedis c do
+  void $ Redis.hdel "orders" [key]
+
+satisfyOrder :: MonadIO m => Redis.Connection -> ByteString -> Text -> m ()
+satisfyOrder c key buyer = liftIO $ Redis.runRedis c do
+  Redis.hget "orders" key >>= \case
+    Right (Just bs) -> case Aeson.decode' $ BS.Lazy.fromStrict bs of
+      Nothing -> pure ()
+      Just (order :: Order) -> do
+        adjustUserCurrency buyer order.wantCur (-order.wantAmount)
+        adjustUserCurrency order.creator order.wantCur order.wantAmount
+        adjustUserCurrency buyer order.haveCur order.haveAmount
+        adjustUserCurrency order.creator order.haveCur (-order.haveAmount)
+    _else -> pure ()
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
+    )
+  ]
diff --git a/fig-web/src/Fig/Web/Module/Misc.hs b/fig-web/src/Fig/Web/Module/Misc.hs
new file mode 100644
index 0000000..b193314
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/Misc.hs
@@ -0,0 +1,38 @@
+module Fig.Web.Module.Misc
+  ( public
+  ) where
+
+import Fig.Prelude
+
+import System.Random (randomRIO)
+
+import Control.Lens ((^?), Ixed (..))
+
+import Fig.Web.Utils
+import Fig.Web.Types
+import qualified Fig.Web.DB as DB
+
+public :: Module
+public a = do
+  onGet "/api/motd" do
+    DB.get a.db "motd" >>= \case
+      Nothing -> respondText ""
+      Just val -> respondText $ decodeUtf8 val
+  onGet "/api/catchphrase" do
+    let catchphrases =
+          [ "vtuber (male)"
+          , "man of letters"
+          , "cool guy, online"
+          , "internet clown man"
+          , "professional emacs fan"
+          , "web freak"
+          , "guy who really likes programming"
+          , "i use nixos btw"
+          , "(are these funny or cringe or both?)"
+          , "haha yay"
+          , "Joel"
+          ] :: [Text]
+    i <- randomRIO (0, length catchphrases - 1)
+    case catchphrases ^? ix i of
+      Nothing -> respondText "man of letters"
+      Just val -> respondText val
diff --git a/fig-web/src/Fig/Web/Module/Model.hs b/fig-web/src/Fig/Web/Module/Model.hs
new file mode 100644
index 0000000..86f0128
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/Model.hs
@@ -0,0 +1,26 @@
+module Fig.Web.Module.Model
+  ( publicWebsockets
+  ) where
+
+import Fig.Prelude
+
+import qualified Control.Concurrent.Chan as Chan
+
+import qualified Network.WebSockets as WS
+
+import Fig.Web.Types
+
+publicWebsockets :: Websockets
+publicWebsockets a =
+  [ ( "/api/model/broadcast", \conn -> do
+        forever do
+          msg <- liftIO $ WS.receiveDataMessage conn
+          Chan.writeChan a.channels.model msg
+    )
+  , ( "/api/model/events", \conn -> do
+        c <- Chan.dupChan a.channels.model
+        forever do
+          ev <- liftIO $ Chan.readChan c
+          WS.sendDataMessage conn ev
+    )
+  ]
diff --git a/fig-web/src/Fig/Web/Module/Redeem.hs b/fig-web/src/Fig/Web/Module/Redeem.hs
new file mode 100644
index 0000000..7dbafc0
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/Redeem.hs
@@ -0,0 +1,23 @@
+module Fig.Web.Module.Redeem
+  ( secure
+  ) where
+
+import Fig.Prelude
+
+import qualified Data.Maybe as Maybe
+import qualified Data.Text as Text
+
+import Fig.Web.Utils
+import Fig.Web.Types
+
+secure :: Module
+secure a = do
+  onPost "/api/redeem" $ authed \creds -> do
+    name <- formParam "name"
+    input <- formParamMaybe "input"
+    liftIO . a.cmds.publish "frontend redeem incoming"
+      . encodeUtf8 . Text.intercalate "\t" $
+      [ creds.user
+      , name
+      ] <> Maybe.maybeToList input
+    respondText "it worked"
diff --git a/fig-web/src/Fig/Web/Module/Sentiment.hs b/fig-web/src/Fig/Web/Module/Sentiment.hs
new file mode 100644
index 0000000..38a9250
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/Sentiment.hs
@@ -0,0 +1,21 @@
+module Fig.Web.Module.Sentiment
+  ( public
+  ) where
+
+import Fig.Prelude
+
+import Fig.Web.Utils
+import Fig.Web.Types
+import qualified Fig.Web.DB as DB
+
+public :: Module
+public a = do
+  onGet "/api/sentiment" do
+    s <- DB.get a.db "sentiment" >>= \case
+      Nothing -> pure "0"
+      Just x -> pure x
+    respondText $ decodeUtf8 s
+  onPost "/api/sentiment/green" do
+    DB.incr a.db "sentiment"
+  onPost "/api/sentiment/red" do
+    DB.decr a.db "sentiment"
diff --git a/fig-web/src/Fig/Web/Module/Shader.hs b/fig-web/src/Fig/Web/Module/Shader.hs
new file mode 100644
index 0000000..d4b43cc
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/Shader.hs
@@ -0,0 +1,18 @@
+module Fig.Web.Module.Shader
+  ( public
+  ) where
+
+import Fig.Prelude
+
+import Fig.Web.Utils
+import Fig.Web.Types
+import qualified Fig.Web.DB as DB
+
+public :: Module
+public a = do
+  onGet "/api/shader" do
+    DB.get a.db "shader" >>= \case
+      Nothing -> do
+        status status404
+        respondText "no shader present"
+      Just sh -> respondText $ decodeUtf8 sh
diff --git a/fig-web/src/Fig/Web/Module/TwitchAuth.hs b/fig-web/src/Fig/Web/Module/TwitchAuth.hs
new file mode 100644
index 0000000..4847da6
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/TwitchAuth.hs
@@ -0,0 +1,107 @@
+module Fig.Web.Module.TwitchAuth
+  ( public
+  ) where
+
+import Fig.Prelude
+
+import qualified Network.HTTP.Req as R
+
+import Data.Maybe (mapMaybe)
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as Text.L
+import qualified Data.Map.Strict as Map
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Types as Aeson
+
+import qualified Web.Scotty as Sc
+
+import qualified Jose.Jwk as Jwk
+import qualified Jose.Jwt as Jwt
+
+import Fig.Web.Utils
+import Fig.Web.Types
+
+public :: Module
+public a = do
+  onGet "/api/register" $ twitchAuthed a.cfg \auth -> do
+    log "Authenticated with Twitch, trying to register..."
+    let user = Text.toLower auth.name
+    resetUserPassword a.cfg user auth.id >>= \case
+      Nothing -> do
+        log "Failed to register user"
+        status status500
+        respondText "failed to register"
+      Just pass -> do
+        log "Successfully registered user, responding..."
+        respondText $ user <> " " <> pass
+  onGet "/api/check" $ twitchAuthed a.cfg \auth -> do
+    respondJSON @[Text] [auth.id, auth.name]
+
+data TokenContents = TokenContents
+  { aud :: !Text
+  , exp :: !Int
+  , iat :: !Int
+  , iss :: !Text
+  , sub :: !Text
+  , azp :: !(Maybe Text)
+  , nonce :: !Text
+  , preferred_username :: !Text
+  } deriving (Show, Eq, Generic)
+instance Aeson.FromJSON TokenContents
+
+fetchJwk :: MonadIO m => m (Maybe Jwk.Jwk)
+fetchJwk = do
+  resp <- R.responseBody <$> R.runReq R.defaultHttpConfig do
+    R.req R.GET (R.https "id.twitch.tv" R./: "oauth2" R./: "keys") R.NoReqBody R.jsonResponse mempty
+  let mkeys = Aeson.parseMaybe (Aeson..: "keys") resp
+  let mjwk = mkeys >>= headMay
+  log $ tshow mjwk
+  pure mjwk
+
+validateToken :: MonadIO m => ByteString -> m (Maybe TokenContents)
+validateToken encodedToken = fetchJwk >>= \case
+  Nothing -> pure Nothing
+  Just jwk -> liftIO (Jwt.decode [jwk] Nothing encodedToken) >>= \case
+    Left err -> do
+      log $ "Failed to decode token: " <> tshow err
+      pure Nothing
+    Right jwt -> do
+      let contents = case jwt of
+            Jwt.Unsecured bs -> bs
+            Jwt.Jws (_, bs) -> bs
+            Jwt.Jwe (_, bs) -> bs
+      log $ tshow contents
+      pure $ Aeson.decodeStrict contents
+
+data Auth = Auth { id :: !Text, name :: !Text } deriving Show
+checkAuth :: Config -> Sc.ActionM (Maybe Auth)
+checkAuth cfg =
+  Sc.header "Authorization"
+  >>= \case
+    Just authstrLazy -> do
+      let authstr = drop 1 $ Text.splitOn " " $ Text.L.toStrict authstrLazy
+      let pairs = Map.fromList $ flip mapMaybe authstr \s ->
+            case Text.splitOn "=" s of
+              [k, v] -> Just (k, Text.takeWhile (/='"') $ Text.drop 1 v)
+              _other -> Nothing
+      case (Map.lookup "token" pairs, Map.lookup "nonce" pairs) of
+        (Just token, Just nonce) -> do
+          validateToken (encodeUtf8 token) >>= \case
+            Just tc
+              | tc.aud == cfg.clientId
+              , tc.nonce == nonce
+                -> do
+                  pure . Just $ Auth { name = tc.preferred_username
+                    , id = tc.sub
+                    }
+            _else -> do
+              pure Nothing
+        _else -> pure Nothing
+    _else -> pure Nothing
+
+twitchAuthed :: Config -> (Auth -> Sc.ActionM ()) -> Sc.ActionM ()
+twitchAuthed cfg f = checkAuth cfg >>= \case
+  Nothing -> do
+    status status401
+    respondText "unauthorized"
+  Just auth -> f auth
diff --git a/fig-web/src/Fig/Web/Module/User.hs b/fig-web/src/Fig/Web/Module/User.hs
new file mode 100644
index 0000000..5b27b2d
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/User.hs
@@ -0,0 +1,21 @@
+module Fig.Web.Module.User
+  ( public
+  ) where
+
+import Fig.Prelude
+
+import qualified Data.Text as Text
+
+import Fig.Web.Utils
+import Fig.Web.Types
+import qualified Fig.Web.DB as DB
+
+public :: Module
+public a = do
+  onGet "/api/user/:name" do
+    name <- Text.toLower <$> pathParam "name"
+    DB.get a.db ("user:" <> encodeUtf8 name) >>= \case
+      Nothing -> do
+        status status404
+        respondText "user not found"
+      Just val -> respondText $ decodeUtf8 val
diff --git a/fig-web/src/Fig/Web/Public.hs b/fig-web/src/Fig/Web/Public.hs
index 40583a6..cd37d4e 100644
--- a/fig-web/src/Fig/Web/Public.hs
+++ b/fig-web/src/Fig/Web/Public.hs
@@ -1,100 +1,59 @@
-module Fig.Web.Public where
+module Fig.Web.Public
+  ( server
+  ) where
 
 import Fig.Prelude
 
-import System.Random (randomRIO)
-
-import Control.Monad (unless)
-import Control.Lens (use, (^?), Ixed (..))
-import qualified Control.Concurrent.Chan as Chan
-import qualified Control.Concurrent.MVar as MVar
-
-import qualified Data.Text as Text
-import qualified Data.Text.Lazy as Text.L
-import qualified Data.Set as Set
-
 import qualified Network.Wai as Wai
 import qualified Network.Wai.Middleware.Static as Wai.Static
 import qualified Network.Wai.Handler.Warp as Warp
-import qualified Network.WebSockets as WS
 
 import qualified Web.Scotty as Sc
 
-import Fig.Utils.SExpr
 import Fig.Bus.Binary.Client
+import Fig.Web.Types
 import Fig.Web.Utils
-import Fig.Web.Auth
-import Fig.Web.State
 import qualified Fig.Web.DB as DB
-import qualified Fig.Web.LDAP as LDAP
-import qualified Fig.Web.Exchange as Exchange
-
-data LiveEvent
-  = LiveEventOnline !(Set.Set Text)
-  | LiveEventOffline !(Set.Set Text)
-  deriving (Show, Eq, Ord)
-
-data Channels = Channels
-  { live :: !(Chan.Chan LiveEvent)
-  , gizmo :: !(Chan.Chan Text)
-  , model :: !(Chan.Chan WS.DataMessage)
-  }
-
-newChannels :: IO Channels
-newChannels = do
-  live <- Chan.newChan
-  gizmo <- Chan.newChan
-  model <- Chan.newChan
-  pure Channels {..}
+import qualified Fig.Web.Module.Misc as Misc
+import qualified Fig.Web.Module.TwitchAuth as TwitchAuth
+import qualified Fig.Web.Module.Exchange as Exchange
+import qualified Fig.Web.Module.Gizmo as Gizmo
+import qualified Fig.Web.Module.Sentiment as Sentiment
+import qualified Fig.Web.Module.Circle as Circle
+import qualified Fig.Web.Module.Model as Model
+import qualified Fig.Web.Module.Bells as Bells
+import qualified Fig.Web.Module.User as User
+import qualified Fig.Web.Module.Shader as Shader
 
-newtype Globals = Globals
-  { currentlyLive :: MVar.MVar (Set.Set Text)
-  }
-
-newGlobals :: IO Globals
-newGlobals = do
-  currentlyLive <- MVar.newMVar Set.empty
-  pure Globals {..}
+allBusEvents :: ModuleArgs -> BusEventHandlers
+allBusEvents args = busEvents . mconcat $ fmap ($ args)
+  [ Gizmo.publicBusEvents
+  , Circle.publicBusEvents
+  ]
 
 server :: Config -> (Text, Text) -> IO ()
 server cfg busAddr = do
   log $ "Web server running on port " <> tshow cfg.port
-  chans <- newChannels
-  globs <- newGlobals
+  log "Connecting to database..."
+  db <- DB.connect cfg
+  channels <- newChannels
+  globals <- newGlobals
   busClient busAddr
     (\cmds -> do
         log "Connected to bus!"
-        cmds.subscribe "monitor twitch stream online"
-        cmds.subscribe "gizmo buffer update"
-        Warp.run cfg.port =<< app cfg cmds chans globs.currentlyLive
+        let args = ModuleArgs{..}
+        subscribeBusEvents cmds $ allBusEvents args
+        Warp.run cfg.port =<< app args
     )
-    (\_cmds ev d -> do
-        case ev of
-          "monitor twitch stream online" -> do
-            let dstr = decodeUtf8 d
-            let live = Text.splitOn " " dstr
-            let new = Set.fromList live 
-            old <- MVar.swapMVar globs.currentlyLive new
-            let online = Set.difference new old
-            let offline = Set.difference old new
-            unless (Set.null online && Set.null offline) do
-              log $ "Newly online: " <> Text.intercalate " " (Set.toList online) <> ", newly offline: " <> Text.intercalate " " (Set.toList offline)
-            unless (Set.null online) . Chan.writeChan chans.live $ LiveEventOnline online
-            unless (Set.null offline) . Chan.writeChan chans.live $ LiveEventOnline offline
-          "gizmo buffer update" -> do
-            let dstr = decodeUtf8 d
-            let updates = Text.splitOn " " dstr
-            forM_ updates $ Chan.writeChan chans.gizmo
-          _other -> log $ "Invalid event: " <> tshow d
+    (\cmds ev d -> do
+        let args = ModuleArgs{..}
+        handleBusEvent (allBusEvents args) ev d
     )
     (pure ())
 
-app :: Config -> Commands IO -> Channels -> MVar.MVar (Set.Set Text) -> IO Wai.Application
-app cfg _cmds chans currentlyLive = do
-  log "Connecting to database..."
-  db <- DB.connect cfg
+app :: ModuleArgs -> IO Wai.Application
+app args = do
   log "Connected! Server active."
-  st <- stateRef
   Sc.scottyApp do
     Sc.middleware . Wai.Static.staticPolicy $ mconcat
       [ Wai.Static.isNotAbsolute
@@ -104,13 +63,11 @@ app cfg _cmds chans currentlyLive = do
         , ("main.css", "main.css")
         , ("main.js", "main.js")
         ] Wai.Static.<|> Wai.Static.hasPrefix "assets"
-      , Wai.Static.addBase cfg.assetPath
+      , Wai.Static.addBase args.cfg.assetPath
       ]
-    -- Sc.get "/register" do
-    --   Sc.redirect "/register.html"
-    Sc.get "/unauthorized" do
-      Sc.status status401
-      Sc.text $ mconcat
+    onGet "/unauthorized" do
+      status status401
+      respondText $ mconcat
         [ "your request was rejected because that endpoint requires authentication\n"
         , "you can log in by POSTing your credentials to https://auth.colonq.computer/api/firstfactor\n"
         , "for example:\n"
@@ -124,129 +81,19 @@ app cfg _cmds chans currentlyLive = do
         , "for example:\n"
         , "  curl https://secure.colonq.computer --cookie cookies.txt\n"
         ]
-    Sc.get "/api/register" $ authed cfg \auth -> do
-      log "Authenticated with Twitch, trying to register..."
-      let user = Text.toLower auth.name
-      LDAP.resetUserPassword cfg user auth.id >>= \case
-        Nothing -> do
-          log "Failed to register user"
-          Sc.status status500
-          Sc.text "failed to register"
-        Just pass -> do
-          log "Successfully registered user, responding..."
-          Sc.text . Text.L.fromStrict $ user <> " " <> pass
-    Sc.get "/api/check" $ authed cfg \auth -> do
-      Sc.json @[Text] [auth.id, auth.name]
-    Sc.put "/api/buffer" do
-      buf <- withState st $ use buffer 
-      Sc.text $ Text.L.fromStrict buf
-    Sc.get "/api/motd" do
-      DB.get db "motd" >>= \case
-        Nothing -> Sc.text ""
-        Just val -> Sc.text . Text.L.fromStrict $ decodeUtf8 val
-    Sc.get "/api/catchphrase" do
-      let catchphrases =
-            [ "vtuber (male)"
-            , "man of letters"
-            , "cool guy, online"
-            , "internet clown man"
-            , "professional emacs fan"
-            , "web freak"
-            , "guy who really likes programming"
-            , "i use nixos btw"
-            , "(are these funny or cringe or both?)"
-            , "haha yay"
-            , "Joel"
-            ] :: [Text]
-      i <- randomRIO (0, length catchphrases - 1)
-      case catchphrases ^? ix i of
-        Nothing -> Sc.text "man of letters"
-        Just val -> Sc.text $ Text.L.fromStrict val
-    Sc.get "/api/user/:name" do
-      name <- Text.toLower <$> Sc.pathParam "name"
-      DB.get db ("user:" <> encodeUtf8 name) >>= \case
-        Nothing -> do
-          Sc.status status404
-          Sc.text "user not found"
-        Just val -> Sc.text . Text.L.fromStrict $ decodeUtf8 val
-    Sc.get "/api/songs" do
-      DB.hvals db "songnames" >>= \case
-        Nothing -> do
-          Sc.status status404
-          Sc.text "no sounds found :("
-        Just songs -> Sc.text . Text.L.fromStrict . pretty . SExprList @Void $ SExprString . decodeUtf8 <$> songs
-    Sc.get "/api/song/:hash" do
-      hash <- Sc.pathParam "hash"
-      DB.hget db "songnotes" hash >>= \case
-        Nothing -> do
-          Sc.status status404
-          Sc.text "song not found"
-        Just val -> Sc.text . Text.L.fromStrict $ decodeUtf8 val
-    Sc.get "/api/sentiment" do
-      s <- DB.get db "sentiment" >>= \case
-        Nothing -> pure "0"
-        Just x -> pure x
-      Sc.text . Text.L.fromStrict . decodeUtf8 $ s
-    Sc.post "/api/sentiment/green" do
-      DB.incr db "sentiment"
-    Sc.post "/api/sentiment/red" do
-      DB.decr db "sentiment"
-    Sc.get "/api/shader" do
-      DB.get db "shader" >>= \case
-        Nothing -> do
-          Sc.status status404
-          Sc.text "no shader present"
-        Just sh -> Sc.text . Text.L.fromStrict $ decodeUtf8 sh
-    Sc.get "/api/exchange" do
-      listings <- Exchange.getOrders db
-      Sc.json listings
-    Sc.get "/api/gizmo" do
-      buf <- Sc.queryParam "buf"
-      DB.hget db "gizmos" buf >>= \case
-        Nothing -> do
-          Sc.status status404
-          Sc.text "gizmo does not exist"
-        Just html -> Sc.html . Text.L.fromStrict $ decodeUtf8 html
-    Sc.get "/api/gizmo/list" do
-      gizmos <- maybe [] (fmap decodeUtf8) <$> DB.hkeys db "gizmos"
-      Sc.text $ Text.L.fromStrict $ Text.unlines gizmos
-    Sc.get "/api/circle" do
-      live <- liftIO $ MVar.readMVar currentlyLive
-      Sc.text . Text.L.fromStrict . pretty . SExprList @Void $ SExprString <$> Set.toList live
-    websocket
-      [ ( "/api/circle/events", \conn -> do
-            c <- Chan.dupChan chans.live
-            forever do
-              ev <- liftIO $ Chan.readChan c
-              WS.sendTextData conn $ case ev of
-                LiveEventOnline online ->
-                  pretty $ SExprList @Void
-                  [ SExprString "online"
-                  , SExprList $ SExprString <$> Set.toList online
-                  ]
-                LiveEventOffline offline ->
-                  pretty $ SExprList @Void
-                  [ SExprString "offline"
-                  , SExprList $ SExprString <$> Set.toList offline
-                  ]
-        )
-      , ( "/api/gizmo/events", \conn -> do
-            c <- Chan.dupChan chans.gizmo
-            forever do
-              ev <- liftIO $ Chan.readChan c
-              WS.sendTextData conn ev
-        )
-      , ( "/api/model/broadcast", \conn -> do
-            forever do
-              msg <- liftIO $ WS.receiveDataMessage conn
-              Chan.writeChan chans.model msg
-        )
-      , ( "/api/model/events", \conn -> do
-            c <- Chan.dupChan chans.model
-            forever do
-              ev <- liftIO $ Chan.readChan c
-              WS.sendDataMessage conn ev
-        )
+    Misc.public args
+    TwitchAuth.public args
+    Exchange.public args
+    Gizmo.public args
+    Sentiment.public args
+    Circle.public args
+    Bells.public args
+    User.public args
+    Shader.public args
+    websocket $ mconcat
+      [ Gizmo.publicWebsockets args
+      , Circle.publicWebsockets args
+      , Model.publicWebsockets args
       ]
     Sc.notFound do
-      Sc.text "not found"
+      respondText "not found"
diff --git a/fig-web/src/Fig/Web/Secure.hs b/fig-web/src/Fig/Web/Secure.hs
index cf10bc1..22135f5 100644
--- a/fig-web/src/Fig/Web/Secure.hs
+++ b/fig-web/src/Fig/Web/Secure.hs
@@ -1,12 +1,9 @@
-module Fig.Web.Secure where
+module Fig.Web.Secure
+  ( server
+  ) where
 
 import Fig.Prelude
 
-import Data.Maybe (maybeToList)
-import qualified Data.Text as Text
-import qualified Data.Text.Lazy as Text.Lazy
-import qualified Data.Set as Set
-
 import qualified Network.Wai as Wai
 import qualified Network.Wai.Middleware.Static as Wai.Static
 import qualified Network.Wai.Handler.Warp as Warp
@@ -14,32 +11,39 @@ import qualified Network.Wai.Handler.Warp as Warp
 import qualified Web.Scotty as Sc
 
 import Fig.Bus.Binary.Client
+import Fig.Web.Types
 import Fig.Web.Utils
 import qualified Fig.Web.DB as DB
-import qualified Fig.Web.Exchange as Exchange
+import qualified Fig.Web.Module.Exchange as Exchange
+import qualified Fig.Web.Module.Exchange as Redeem
 
-data LiveEvent
-  = LiveEventOnline !(Set.Set Text)
-  | LiveEventOffline !(Set.Set Text)
-  deriving (Show, Eq, Ord)
+allBusEvents :: ModuleArgs -> BusEventHandlers
+allBusEvents args = busEvents . mconcat $ fmap ($ args)
+  [ 
+  ]
 
 server :: Config -> (Text, Text) -> IO ()
 server cfg busAddr = do
   log $ "Web server running on port " <> tshow cfg.port
+  log "Connecting to database..."
+  db <- DB.connect cfg
+  channels <- newChannels
+  globals <- newGlobals
   busClient busAddr
     (\cmds -> do
         log "Connected to bus!"
-        Warp.run cfg.port =<< app cfg cmds
+        let args = ModuleArgs{..}
+        subscribeBusEvents cmds $ allBusEvents args
+        Warp.run cfg.port =<< app args
     )
-    (\_cmds ev _d -> do
-        log $ "Invalid event: " <> tshow ev
+    (\cmds ev d -> do
+        let args = ModuleArgs{..}
+        handleBusEvent (allBusEvents args) ev d
     )
     (pure ())
 
-app :: Config -> Commands IO -> IO Wai.Application
-app cfg cmds = do
-  log "Connecting to database..."
-  db <- DB.connect cfg
+app :: ModuleArgs -> IO Wai.Application
+app args = do
   log "Connected! Secure server active."
   Sc.scottyApp do
     Sc.middleware . Wai.Static.staticPolicy $ mconcat
@@ -52,70 +56,15 @@ app cfg cmds = do
         ]
         Wai.Static.<|> Wai.Static.hasPrefix "assets"
         Wai.Static.<|> Wai.Static.hasPrefix "newton"
-      , Wai.Static.addBase cfg.assetPath
+      , Wai.Static.addBase args.cfg.assetPath
       ]
-    Sc.get "/" do
-      Sc.text "this is the secure endpoint"
-    Sc.get "/api/status" do
-      Sc.text "this is the secure endpoint"
-    Sc.get "/api/info" do
-      muser <- Sc.header "Remote-User"
-      memail <- Sc.header "Remote-Email"
-      case (muser, memail) of
-        (Just user, Just email) -> do
-          Sc.text $ user <> " " <> email
-        _else -> do
-          Sc.status status401
-          Sc.text "you're not logged in buddy"
-    Sc.post "/api/redeem" do
-      muser <- Sc.header "Remote-User"
-      memail <- Sc.header "Remote-Email"
-      case (muser, memail) of
-        (Just user, Just _email) -> do
-          name <- Sc.formParam "name"
-          input <- Sc.formParamMaybe "input"
-          liftIO . cmds.publish "frontend redeem incoming"
-            . encodeUtf8 . Text.intercalate "\t" $
-            [ Text.Lazy.toStrict user
-            , name
-            ] <> maybeToList input
-          Sc.text "it worked"
-        _else -> do
-          Sc.status status401
-          Sc.text "you're not logged in buddy"
-    Sc.post "/api/exchange" do
-      Sc.header "Remote-Email" >>= \case
-        Nothing -> do
-          Sc.status status401
-          Sc.text "you're not logged in buddy"
-        Just creator -> do
-          haveCur <- Text.Lazy.toStrict <$> Sc.formParam "haveCur"
-          haveAmount <- Sc.formParam "haveAmount"
-          wantCur <- Text.Lazy.toStrict <$> Sc.formParam "wantCur"
-          wantAmount <- Sc.formParam "wantAmount"
-          key <- Exchange.createOrder db $ Exchange.Order
-            { creator = Text.Lazy.toStrict creator
-            , haveCur = haveCur
-            , haveAmount = haveAmount
-            , wantCur = wantCur
-            , wantAmount = wantAmount
-            }
-          Sc.text . Text.Lazy.fromStrict $ decodeUtf8 key
-    Sc.post "/api/exchange/:key" do
-      Sc.header "Remote-Email" >>= \case
-        Nothing -> do
-          Sc.status status401
-          Sc.text "you're not logged in buddy"
-        Just buyer -> do
-          key <- Sc.pathParam "key"
-          Exchange.satisfyOrder db key $ Text.Lazy.toStrict buyer
-    Sc.delete "/api/exchange/:key" do
-      Sc.header "Remote-Email" >>= \case
-        Nothing -> do
-          Sc.status status401
-          Sc.text "you're not logged in buddy"
-        Just _buyer -> do
-          key <- Sc.pathParam "key"
-          Exchange.cancelOrder db key
+    onGet "/" do
+      respondText "this is the secure endpoint"
+    onGet "/api/status" do
+      respondText "this is the secure endpoint"
+    onGet "/api/info" $ authed \creds -> do
+      respondText $ creds.user <> " " <> creds.email
+    Exchange.secure args
+    Redeem.secure args
     Sc.notFound do
-      Sc.text "not found"
+      respondText "not found"
diff --git a/fig-web/src/Fig/Web/State.hs b/fig-web/src/Fig/Web/State.hs
deleted file mode 100644
index 11e0ece..0000000
--- a/fig-web/src/Fig/Web/State.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-{-# Language TemplateHaskell #-}
-
-module Fig.Web.State where
-
-import Control.Lens.TH (makeLensesFor)
-import Control.Lens ((<>=))
-import Control.Monad.State (runStateT)
-
-import Fig.Prelude
-
-import qualified Data.IORef as IORef
-
-newtype State = State
-  { buffer :: Text
-  }
-makeLensesFor [("buffer", "buffer")] ''State
-
-defaultState :: State
-defaultState = State
-  { buffer = ""
-  }
-
-type StateRef = IORef.IORef State
-
-stateRef :: IO StateRef
-stateRef = IORef.newIORef defaultState
-
-withState ::
-  MonadIO m' =>
-  StateRef ->
-  (forall m. (MonadIO m, MonadState State m) => m a) ->
-  m' a
-withState ref f = do
-  s <- liftIO $ IORef.readIORef ref
-  (res, s') <- liftIO $ runStateT f s
-  liftIO $ IORef.writeIORef ref s'
-  pure res
-
-sayHi :: StateRef -> IO ()
-sayHi ref = withState ref do
-  buffer <>= "hi"
diff --git a/fig-web/src/Fig/Web/Types.hs b/fig-web/src/Fig/Web/Types.hs
new file mode 100644
index 0000000..0a80f47
--- /dev/null
+++ b/fig-web/src/Fig/Web/Types.hs
@@ -0,0 +1,70 @@
+module Fig.Web.Types
+  ( LiveEvent(..)
+  , Commands(..)
+  , Channels(..)
+  , newChannels
+  , Globals(..)
+  , newGlobals
+  , DB(..)
+  , ModuleArgs(..)
+  , Module
+  , Websockets
+  , BusEvents
+  ) where
+
+import Fig.Prelude
+
+import qualified Control.Concurrent.Chan as Chan
+import qualified Control.Concurrent.MVar as MVar
+
+import qualified Data.Set as Set
+
+import qualified Network.WebSockets as WS
+
+import qualified Web.Scotty as Sc
+
+import qualified Database.Redis as Redis
+
+import Fig.Bus.Binary.Client
+import Fig.Web.Utils
+
+data LiveEvent
+  = LiveEventOnline !(Set.Set Text)
+  | LiveEventOffline !(Set.Set Text)
+  deriving (Show, Eq, Ord)
+
+data Channels = Channels
+  { live :: !(Chan.Chan LiveEvent)
+  , gizmo :: !(Chan.Chan Text)
+  , model :: !(Chan.Chan WS.DataMessage)
+  }
+
+newChannels :: IO Channels
+newChannels = do
+  live <- Chan.newChan
+  gizmo <- Chan.newChan
+  model <- Chan.newChan
+  pure Channels {..}
+
+newtype Globals = Globals
+  { currentlyLive :: MVar.MVar (Set.Set Text)
+  }
+
+newGlobals :: IO Globals
+newGlobals = do
+  currentlyLive <- MVar.newMVar Set.empty
+  pure Globals {..}
+
+newtype DB = DB { conn :: Redis.Connection }
+
+data ModuleArgs = ModuleArgs
+  { cfg :: Config
+  , cmds :: Commands IO
+  , db :: DB
+  , globals :: Globals
+  , channels :: Channels
+  }
+
+type Module = ModuleArgs -> Sc.ScottyM ()
+type Websockets = ModuleArgs -> [WebsocketHandler]
+type BusEvents = ModuleArgs -> [BusEventHandler]
diff --git a/fig-web/src/Fig/Web/Utils.hs b/fig-web/src/Fig/Web/Utils.hs
index 48f2e24..8875529 100644
--- a/fig-web/src/Fig/Web/Utils.hs
+++ b/fig-web/src/Fig/Web/Utils.hs
@@ -5,12 +5,35 @@ module Fig.Web.Utils
   ( FigWebException(..)
   , loadConfig
   , Config(..)
-  , websocket
+  , resetUserPassword
   , module Network.HTTP.Types.Status
+  , onGet, onPost, onPut, onDelete
+  , status
+  , queryParam, queryParamMaybe, formParam, formParamMaybe, pathParam
+  , header
+  , respondText, respondJSON, respondHTML
+  , Credentials(..)
+  , authed
+  , WebsocketHandler
+  , websocket
+  , BusEventHandler, BusEventHandlers
+  , busEvents
+  , handleBusEvent
+  , subscribeBusEvents
   ) where
 
 import Fig.Prelude
 
+import System.Exit (ExitCode(..))
+import qualified System.Process as Proc
+
+import qualified Data.UUID as UUID
+import qualified Data.UUID.V4 as UUID
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy as Text.L
+import qualified Data.Aeson as Aeson
+import qualified Data.Map.Strict as Map
+
 import Network.HTTP.Types.Status
 import qualified Network.Wai.Handler.WebSockets as Wai.WS
 import qualified Network.WebSockets as WS
@@ -19,6 +42,8 @@ import qualified Web.Scotty as Sc
 
 import qualified Toml
 
+import Fig.Bus.Binary.Client
+
 newtype FigWebException = FigWebException Text
   deriving (Show, Eq, Ord)
 instance Exception FigWebException
@@ -53,9 +78,111 @@ loadConfig path = Toml.decodeFileEither configCodec path >>= \case
   Left err -> throwM . FigWebException $ tshow err
   Right config -> pure config
 
-websocket :: [(ByteString, WS.Connection -> IO ())] -> Sc.ScottyM ()
+-- | Reset the password in LDAP for the specified user (creating the user if necessary)
+resetUserPassword :: MonadIO m => Config -> Text -> Text -> m (Maybe Text)
+resetUserPassword cfg user uid = do
+  let login = Text.toLower user
+  password <- UUID.toText <$> liftIO UUID.nextRandom
+  (exitCode, out0, err0) <- liftIO . flip Proc.readCreateProcessWithExitCode ""
+    . Proc.proc cfg.lldapCli $ unpack <$>
+    [ "-H", cfg.lldapHost
+    , "-D", cfg.lldapUser
+    , "-w", cfg.lldapPassword
+    , "user", "add", login, uid <> "@users.colonq.computer"
+    , "-p", password
+    , "-f", uid
+    ]
+  (_, out1, err1) <- liftIO . flip Proc.readCreateProcessWithExitCode ""
+    . Proc.proc cfg.lldapCli $ unpack <$>
+    [ "-H", cfg.lldapHost
+    , "-D", cfg.lldapUser
+    , "-w", cfg.lldapPassword
+    , "user", "group", "add", login, "fig_users"
+    ]
+  case exitCode of
+    ExitSuccess -> pure $ Just password
+    ExitFailure _ -> do
+      log . pack $ mconcat
+        [ "LDAP CLI error:\n"
+        , out0, err0
+        , out1, err1
+        ]
+      pure Nothing
+
+onGet :: Sc.RoutePattern -> Sc.ActionM () -> Sc.ScottyM ()
+onGet = Sc.get
+
+onPost :: Sc.RoutePattern -> Sc.ActionM () -> Sc.ScottyM ()
+onPost = Sc.post
+
+onPut :: Sc.RoutePattern -> Sc.ActionM () -> Sc.ScottyM ()
+onPut = Sc.post
+
+onDelete :: Sc.RoutePattern -> Sc.ActionM () -> Sc.ScottyM ()
+onDelete = Sc.post
+
+status :: Status -> Sc.ActionM ()
+status = Sc.status
+
+queryParam :: Sc.Parsable a => Text -> Sc.ActionM a
+queryParam = Sc.queryParam . Text.L.fromStrict
+queryParamMaybe :: Sc.Parsable a => Text -> Sc.ActionM (Maybe a)
+queryParamMaybe = Sc.queryParamMaybe . Text.L.fromStrict
+
+formParam :: Sc.Parsable a => Text -> Sc.ActionM a
+formParam = Sc.formParam . Text.L.fromStrict
+formParamMaybe :: Sc.Parsable a => Text -> Sc.ActionM (Maybe a)
+formParamMaybe = Sc.formParamMaybe . Text.L.fromStrict
+
+pathParam :: Sc.Parsable a => Text -> Sc.ActionM a
+pathParam = Sc.pathParam . Text.L.fromStrict
+
+header :: Text -> Sc.ActionM (Maybe Text)
+header h = Sc.header (Text.L.fromStrict h) >>= \case
+  Nothing -> pure Nothing
+  Just t -> pure . Just $ Text.L.toStrict t
+
+respondText :: Text -> Sc.ActionM ()
+respondText = Sc.text . Text.L.fromStrict
+
+respondJSON :: Aeson.ToJSON a => a -> Sc.ActionM ()
+respondJSON = Sc.json
+
+respondHTML :: Text -> Sc.ActionM ()
+respondHTML = Sc.html . Text.L.fromStrict
+
+data Credentials = Credentials
+  { user :: Text
+  , email :: Text
+  }
+authed :: (Credentials -> Sc.ActionM ()) -> Sc.ActionM ()
+authed h = do
+  muser <- header "Remote-User"
+  memail <- header "Remote-Email"
+  case (muser, memail) of
+    (Just user, Just email) -> do
+      let auth = Credentials{..}
+      h auth
+    _else -> do
+      status status401
+      respondText "you're not logged in buddy (this is probably a bug, go message clonk)"
+
+type WebsocketHandler = (ByteString, WS.Connection -> IO ())
+websocket :: [WebsocketHandler] -> Sc.ScottyM ()
 websocket hs = Sc.middleware $ Wai.WS.websocketsOr WS.defaultConnectionOptions handler
   where
     handler pending = case lookup (WS.requestPath (WS.pendingRequest pending)) hs of
       Nothing -> WS.rejectRequest pending ""
       Just h -> WS.acceptRequest pending >>= \c -> WS.withPingThread c 30 (pure ()) $ h c
+
+type BusEventHandler = (ByteString, ByteString -> IO ())
+type BusEventHandlers = Map.Map ByteString (ByteString -> IO ())
+busEvents :: [BusEventHandler] -> BusEventHandlers
+busEvents = Map.fromList
+handleBusEvent :: BusEventHandlers -> ByteString -> ByteString -> IO ()
+handleBusEvent hs ev d = case Map.lookup ev hs of
+  Just h -> h d
+  Nothing -> log $ "Invalid event: " <> tshow ev
+subscribeBusEvents :: Commands IO -> BusEventHandlers -> IO ()
+subscribeBusEvents cmds hs = forM_ (Map.keys hs) $ \ev -> do
+  cmds.subscribe ev
-- 
cgit v1.2.3