From 2ef36fefc877713c18a073b0792a6a11fb8d265d Mon Sep 17 00:00:00 2001
From: LLLL Colonq <llll@colonq>
Date: Tue, 17 Feb 2026 05:21:14 -0500
Subject: Charsheet

---
 fig-web/src/Fig/Web/Module/User.hs | 47 ++++++++++++++++++++++++++++++++++++++
 fig-web/src/Fig/Web/Public.hs      |  2 +-
 fig-web/src/Fig/Web/Secure.hs      |  1 -
 3 files changed, 48 insertions(+), 2 deletions(-)

(limited to 'fig-web/src/Fig')

diff --git a/fig-web/src/Fig/Web/Module/User.hs b/fig-web/src/Fig/Web/Module/User.hs
index 6983906..7f9ac40 100644
--- a/fig-web/src/Fig/Web/Module/User.hs
+++ b/fig-web/src/Fig/Web/Module/User.hs
@@ -4,14 +4,45 @@ module Fig.Web.Module.User
 
 import Fig.Prelude
 
+import Data.Maybe (mapMaybe)
 import qualified Data.Text as Text
+import qualified Data.ByteString.Char8 as BS.C8
+import qualified Data.Map.Strict as Map
 
 import Fig.Web.Utils
 import Fig.Web.Types
 import qualified Fig.Web.DB as DB
 
+getText :: MonadIO m => DB -> ByteString -> m (Maybe Text)
+getText db key = do
+  DB.get db key >>= \case
+    Nothing -> pure Nothing
+    Just v -> pure . eitherToMaybe $ decodeUtf8' v
+
+getTextList :: MonadIO m => DB -> ByteString -> m [Text]
+getTextList db key = do
+  xs <- DB.lrange db key 0 (-1)
+  pure $ mapMaybe (eitherToMaybe . decodeUtf8') xs
+
+getTextValuedMap :: MonadIO m => DB -> ByteString -> m (Map.Map Text Text)
+getTextValuedMap db key = do
+  vs <- Map.toList <$> DB.hgetall db key
+  pure . Map.fromList $ flip mapMaybe vs \(k, v) -> do
+    tk <- eitherToMaybe $ decodeUtf8' k
+    tv <- eitherToMaybe $ decodeUtf8' v
+    Just (tk, tv)
+
+getIntegerValuedMap :: MonadIO m => DB -> ByteString -> m (Map.Map Text Integer)
+getIntegerValuedMap db key = do
+  vs <- Map.toList <$> DB.hgetall db key
+  pure . Map.fromList $ flip mapMaybe vs \(k, v) -> do
+    tk <- eitherToMaybe $ decodeUtf8' k
+    (iv, _) <- BS.C8.readInteger v
+    Just (tk, iv)
+
 public :: PublicModule
 public a = do
+  -- users
   onGet "/api/user/:name" do
     name <- Text.toLower <$> pathParam "name"
     DB.get a.db ("user:" <> encodeUtf8 name) >>= \case
@@ -19,3 +50,19 @@ public a = do
         status status404
         respondText "user not found"
       Just val -> respondText $ decodeUtf8 val
+  onGet "/api/user/stats/:uid" do
+    uid <- pathParam "uid"
+    respondJSON =<< getIntegerValuedMap a.db ("user:stats:" <> uid)
+  onGet "/api/user/talents/:uid" do
+    uid <- pathParam "uid"
+    respondJSON =<< getIntegerValuedMap a.db ("user:talents:" <> uid)
+  onGet "/api/user/properties/:uid" do
+    uid <- pathParam "uid"
+    respondJSON =<< getTextValuedMap a.db ("user:properties:" <> uid)
+  onGet "/api/user/badges/:uid" do
+    uid <- pathParam "uid"
+    respondJSON =<< getTextList a.db ("user:badges:" <> uid)
+  -- badges
+  onGet "/api/badge/:uuid" do
+    uuid <- pathParam "uuid"
+    respondJSON =<< getTextList a.db ("badge:" <> uuid)
diff --git a/fig-web/src/Fig/Web/Public.hs b/fig-web/src/Fig/Web/Public.hs
index 975a161..4a929e9 100644
--- a/fig-web/src/Fig/Web/Public.hs
+++ b/fig-web/src/Fig/Web/Public.hs
@@ -66,7 +66,7 @@ app args = do
         , ("gizmo", "gizmo.html")
         , ("advent", "advent.html")
         , ("debt", "debtclock.html")
-        , ("main.css", "main.css")
+        , ("charsheet", "charsheet.html")
         , ("main.js", "main.js")
         ] Wai.Static.<|> Wai.Static.hasPrefix "assets"
       , Wai.Static.addBase args.cfg.assetPath
diff --git a/fig-web/src/Fig/Web/Secure.hs b/fig-web/src/Fig/Web/Secure.hs
index b2706dc..628cd56 100644
--- a/fig-web/src/Fig/Web/Secure.hs
+++ b/fig-web/src/Fig/Web/Secure.hs
@@ -55,7 +55,6 @@ app args = do
         , ("soundboard", "soundboard.html")
         , ("throwshade", "throwshade.html")
         , ("advent", "advent.html")
-        , ("main.css", "main.css")
         , ("main.js", "main.js")
         ]
         Wai.Static.<|> Wai.Static.hasPrefix "assets"
-- 
cgit v1.2.3