From 4f71b652cf29e4c20e7e33e521371650ed5d27ad Mon Sep 17 00:00:00 2001
From: LLLL Colonq <llll@colonq>
Date: Tue, 5 Nov 2024 02:59:23 -0500
Subject: Add sentiment API

---
 fig-frontend/src/Fig/Frontend.hs    | 13 +++++++++++--
 fig-frontend/src/Fig/Frontend/DB.hs |  8 ++++++++
 2 files changed, 19 insertions(+), 2 deletions(-)

diff --git a/fig-frontend/src/Fig/Frontend.hs b/fig-frontend/src/Fig/Frontend.hs
index 0f347de..75fec53 100644
--- a/fig-frontend/src/Fig/Frontend.hs
+++ b/fig-frontend/src/Fig/Frontend.hs
@@ -32,8 +32,8 @@ import Fig.Frontend.State
 import qualified Fig.Frontend.DB as DB
 
 data LiveEvent
-  = LiveEventOnline (Set.Set Text)
-  | LiveEventOffline (Set.Set Text)
+  = LiveEventOnline !(Set.Set Text)
+  | LiveEventOffline !(Set.Set Text)
   deriving (Show, Eq, Ord)
 
 server :: Config -> (Text, Text) -> IO ()
@@ -150,6 +150,15 @@ app cfg cmds liveEvents currentlyLive = 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:green" >>= \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/circle" do
       live <- liftIO $ MVar.readMVar currentlyLive
       Sc.text . Text.L.fromStrict . pretty . SExprList @Void $ SExprString <$> Set.toList live
diff --git a/fig-frontend/src/Fig/Frontend/DB.hs b/fig-frontend/src/Fig/Frontend/DB.hs
index b0f065d..51da59e 100644
--- a/fig-frontend/src/Fig/Frontend/DB.hs
+++ b/fig-frontend/src/Fig/Frontend/DB.hs
@@ -17,6 +17,14 @@ get 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
+  void $ Redis.incr key
+
+decr :: MonadIO m => Redis.Connection -> ByteString -> m ()
+decr 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
   v <- Redis.hget key hkey
-- 
cgit v1.2.3