Initial work on binary switch

2 files changed, 31 insertions, 62 deletions

diff --git a/fig-web/src/Fig/Web/Public.hs b/fig-web/src/Fig/Web/Public.hs
index 5650b78..40583a6 100644
--- a/fig-web/src/Fig/Web/Public.hs
+++ b/fig-web/src/Fig/Web/Public.hs
@@ -1,5 +1,3 @@
-{-# Language QuasiQuotes #-}
-
 module Fig.Web.Public where
 
 import Fig.Prelude
@@ -11,10 +9,8 @@ import Control.Lens (use, (^?), Ixed (..))
 import qualified Control.Concurrent.Chan as Chan
 import qualified Control.Concurrent.MVar as MVar
 
-import Data.Maybe (mapMaybe)
 import qualified Data.Text as Text
 import qualified Data.Text.Lazy as Text.L
-import qualified Data.ByteString.Base64 as BS.Base64
 import qualified Data.Set as Set
 
 import qualified Network.Wai as Wai
@@ -25,7 +21,7 @@ import qualified Network.WebSockets as WS
 import qualified Web.Scotty as Sc
 
 import Fig.Utils.SExpr
-import Fig.Bus.Client
+import Fig.Bus.Binary.Client
 import Fig.Web.Utils
 import Fig.Web.Auth
 import Fig.Web.State
@@ -51,8 +47,8 @@ newChannels = do
   model <- Chan.newChan
   pure Channels {..}
 
-data Globals = Globals
-  { currentlyLive :: !(MVar.MVar (Set.Set Text))
+newtype Globals = Globals
+  { currentlyLive :: MVar.MVar (Set.Set Text)
   }
 
 newGlobals :: IO Globals
@@ -68,33 +64,31 @@ server cfg busAddr = do
   busClient busAddr
     (\cmds -> do
         log "Connected to bus!"
-        cmds.subscribe [sexp|(monitor twitch stream online)|]
-        cmds.subscribe [sexp|(gizmo buffer update)|]
+        cmds.subscribe "monitor twitch stream online"
+        cmds.subscribe "gizmo buffer update"
         Warp.run cfg.port =<< app cfg cmds chans globs.currentlyLive
     )
-    (\_cmds d -> do
-        case d of
-          SExprList (ev:rest)
-            | ev == [sexp|(monitor twitch stream online)|] -> do
-                let live = mapMaybe (\case SExprString s -> Just s; _other -> Nothing) rest
-                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
-            | ev == [sexp|(gizmo buffer update)|] -> do
-                let updates = mapMaybe (\case SExprString s -> Just s; _other -> Nothing) rest
-                forM_ updates $ Chan.writeChan chans.gizmo
+    (\_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
     )
     (pure ())
 
-sexprStr :: Text -> SExpr
-sexprStr = SExprString . BS.Base64.encodeBase64 . encodeUtf8
-
 app :: Config -> Commands IO -> Channels -> MVar.MVar (Set.Set Text) -> IO Wai.Application
 app cfg _cmds chans currentlyLive = do
   log "Connecting to database..."
@@ -188,23 +182,6 @@ app cfg _cmds chans currentlyLive = do
           Sc.status status404
           Sc.text "song not found"
         Just val -> Sc.text . Text.L.fromStrict $ decodeUtf8 val
-    Sc.get "/api/poke/:name" do
-      target <- encodeUtf8 . Text.toLower <$> Sc.pathParam "name"
-      inbox <- fromMaybe [] <$> DB.smembers db ("pokeinbox:" <> target)
-      Sc.text . Text.L.fromStrict . pretty . SExprList @Void $ sexprStr . decodeUtf8 <$> inbox
-    Sc.post "/api/poke/:name" do
-      me <- encodeUtf8 . Text.toLower <$> Sc.formParam "ayem"
-      target <- encodeUtf8 . Text.toLower <$> Sc.pathParam "name"
-      DB.sismember db ("pokeinbox:" <> me) target >>= \case
-        True -> do
-          log . tshow $ "handshake between " <> me <> " and " <> target <> " complete!"
-          DB.srem db ("pokeinbox:" <> target) [me]
-          DB.srem db ("pokeinbox:" <> me) [target]
-          Sc.text "complete"
-        False -> do
-          log . tshow $ "partial handshake from " <> me <> " to " <> target
-          DB.sadd db ("pokeinbox:" <> target) [me]
-          Sc.text "partial"
     Sc.get "/api/sentiment" do
       s <- DB.get db "sentiment" >>= \case
         Nothing -> pure "0"
diff --git a/fig-web/src/Fig/Web/Secure.hs b/fig-web/src/Fig/Web/Secure.hs
index 9aa9cea..d903a61 100644
--- a/fig-web/src/Fig/Web/Secure.hs
+++ b/fig-web/src/Fig/Web/Secure.hs
@@ -1,12 +1,10 @@
-{-# Language QuasiQuotes #-}
-
 module Fig.Web.Secure 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.ByteString.Base64 as BS.Base64
 import qualified Data.Set as Set
 
 import qualified Network.Wai as Wai
@@ -15,8 +13,7 @@ import qualified Network.Wai.Handler.Warp as Warp
 
 import qualified Web.Scotty as Sc
 
-import Fig.Utils.SExpr
-import Fig.Bus.Client
+import Fig.Bus.Binary.Client
 import Fig.Web.Utils
 import qualified Fig.Web.DB as DB
 import qualified Fig.Web.Exchange as Exchange
@@ -34,14 +31,11 @@ server cfg busAddr = do
         log "Connected to bus!"
         Warp.run cfg.port =<< app cfg cmds
     )
-    (\_cmds d -> do
-        log $ "Invalid event: " <> tshow d
+    (\_cmds ev _d -> do
+        log $ "Invalid event: " <> tshow ev
     )
     (pure ())
 
-sexprStr :: Text -> SExpr
-sexprStr = SExprString . BS.Base64.encodeBase64 . encodeUtf8
-
 app :: Config -> Commands IO -> IO Wai.Application
 app cfg cmds = do
   log "Connecting to database..."
@@ -80,13 +74,11 @@ app cfg cmds = do
         (Just user, Just _email) -> do
           name <- Sc.formParam "name"
           input <- Sc.formParamMaybe "input"
-          liftIO $ cmds.publish [sexp|(frontend redeem incoming)|]
-            $ mconcat
-              [ [ sexprStr $ Text.Lazy.toStrict user
-                , sexprStr name
-                ]
-              , maybe [] ((:[]) . sexprStr) input
-              ]
+          liftIO . cmds.publish "frontend redeem incoming"
+            . encodeUtf8 . Text.unwords $
+            [ Text.Lazy.toStrict user
+            , name
+            ] <> maybeToList input
           Sc.text "it worked"
         _else -> do
           Sc.status status401