2 files changed, 40 insertions, 27 deletions

diff --git a/fig-frontend/src/Fig/Frontend.hs b/fig-frontend/src/Fig/Frontend.hs
index fd2754c..a6ec8dd 100644
--- a/fig-frontend/src/Fig/Frontend.hs
+++ b/fig-frontend/src/Fig/Frontend.hs
@@ -1,10 +1,12 @@
+{-# Language QuasiQuotes #-}
+
 module Fig.Frontend where
 
 import Fig.Prelude
 
 import Control.Lens (use)
 
-import Data.Text (toLower)
+import qualified Data.Text as Text
 
 import qualified Network.Wai.Middleware.Static as Wai.Static
 import qualified Network.Wai.Handler.Warp as Warp
@@ -15,50 +17,52 @@ import qualified Lucid as L
 import qualified Lucid.Base as L
 
 import Fig.Utils.SExpr
+import Fig.Bus.Client
 import Fig.Frontend.Utils
 import Fig.Frontend.Auth
 import Fig.Frontend.State
 import qualified Fig.Frontend.DB as DB
 
-server :: Config -> IO ()
-server cfg = do
+server :: Config -> (Text, Text) -> IO ()
+server cfg busAddr = 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
+  busClient busAddr
+    (\cmds -> do
+        log "Connected to bus!"
+        Warp.run cfg.port =<< app cfg cmds
+    )
+    (\_ _ -> pure ())
+    (pure ())
 
-app :: Config -> IO Tw.Application
-app cfg = do
+app :: Config -> Commands IO -> IO Tw.Application
+app cfg cmds = do
   db <- DB.connect
   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.link_ [L.rel_ "stylesheet", L.href_ "main.css"]
-    --         L.script_ [L.type_ "module", L.src_ "main.js"] ("" :: L.Html ())
-    --       L.body_ do
-    --         L.button_ [L.id_ "foo"] 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
     , Tw.get "/api/user/:name" do
-        name <- toLower <$> Tw.param "name"
+        name <- Text.toLower <$> Tw.param "name"
         DB.get db ("user:" <> encodeUtf8 name) >>= \case
           Nothing -> Tw.send . Tw.status Tw.status404 $ Tw.text "user not found"
           Just val -> Tw.send . Tw.text $ decodeUtf8 val
+    , Tw.post "/api/redeem/:name" do
+        me <- Text.toLower <$> Tw.param "ayem"
+        name <- Text.toLower <$> Tw.param "name"
+        input <- Tw.paramMaybe "input"
+        liftIO $ cmds.publish [sexp|(frontend redeem incoming)|]
+          $ mconcat
+            [ [ SExprString me
+              , SExprString name
+              ]
+            , maybe [] ((:[]) . SExprString) input
+            ]
+        Tw.send $ Tw.text "it worked"
     , Tw.get "/api/songs" do
         DB.hvals db "songnames" >>= \case
           Nothing -> Tw.send . Tw.status Tw.status404 $ Tw.text "no sounds found :("
@@ -69,12 +73,12 @@ app cfg = do
           Nothing -> Tw.send . Tw.status Tw.status404 $ Tw.text "song not found"
           Just val -> Tw.send . Tw.text $ decodeUtf8 val
     , Tw.get "/api/poke/:name" do
-        target <- encodeUtf8 . toLower <$> Tw.param "name"
+        target <- encodeUtf8 . Text.toLower <$> Tw.param "name"
         inbox <- fromMaybe [] <$> DB.smembers db ("pokeinbox:" <> target)
         Tw.send . Tw.text . pretty . SExprList @Void $ SExprString . decodeUtf8 <$> inbox
     , Tw.post "/api/poke/:name" do
-        me <- encodeUtf8 . toLower <$> Tw.param "ayem"
-        target <- encodeUtf8 . toLower <$> Tw.param "name"
+        me <- encodeUtf8 . Text.toLower <$> Tw.param "ayem"
+        target <- encodeUtf8 . Text.toLower <$> Tw.param "name"
         DB.sismember db ("pokeinbox:" <> me) target >>= \case
           True -> do
             log . tshow $ "handshake between " <> me <> " and " <> target <> " complete!"
diff --git a/fig-frontend/src/Fig/Frontend/DB.hs b/fig-frontend/src/Fig/Frontend/DB.hs
index 5ca8772..bcf00f2 100644
--- a/fig-frontend/src/Fig/Frontend/DB.hs
+++ b/fig-frontend/src/Fig/Frontend/DB.hs
@@ -44,3 +44,12 @@ sismember 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
+  join . hush <$> Redis.lpop key
+
+rpush :: MonadIO m => Redis.Connection -> ByteString -> ByteString -> m ()
+rpush c key val = liftIO $ Redis.runRedis c do
+  _ <- Redis.rpush key [val]
+  pure ()