fig-web: Add leaderboardsHEADmaster

1 files changed, 36 insertions, 0 deletions

diff --git a/fig-web/src/Fig/Web/Module/Leaderboard.hs b/fig-web/src/Fig/Web/Module/Leaderboard.hs
new file mode 100644
index 0000000..1b093a1
--- /dev/null
+++ b/fig-web/src/Fig/Web/Module/Leaderboard.hs
@@ -0,0 +1,36 @@
+module Fig.Web.Module.Leaderboard
+  ( public
+  ) where
+
+import Fig.Prelude
+
+import qualified Lucid as L
+
+import Fig.Web.Utils
+import Fig.Web.Types
+import Fig.Utils.DB (DB)
+import qualified Fig.Utils.DB as DB
+
+leaderboardKey :: ByteString -> ByteString
+leaderboardKey = ("leaderboard:"<>)
+
+fetchLeaderboard :: MonadIO m => DB -> ByteString -> m [(Text, Text, Double)]
+fetchLeaderboard db lid = DB.run db do
+  top <- DB.zrevrange (leaderboardKey lid) 0 (-1)
+  forM top $ \(uid, score) -> do
+    name <- fromMaybe uid <$> DB.hget ("user:properties:" <> uid) "name"
+    pure (decodeUtf8 uid, decodeUtf8 name, score)
+
+public :: PublicModule
+public a = do
+  onGet "/leaderboard/:lid" do
+    lid <- pathParam "lid"
+    top10 <- fetchLeaderboard a.db lid
+    respondHTML do
+      head_ . title_ . L.toHtml $ "LCOLONQ Leaderboard: " <> decodeUtf8 lid
+      body_ do
+        ol_ $ forM_ top10 $ \(_, key, score) -> do
+          li_ . L.toHtml $ key <> ": " <> tshow score
+  onGet "/api/leaderboard/:lid" do
+    lid <- pathParam "lid"
+    respondJSON =<< fetchLeaderboard a.db lid