From 41622353bc3309921109f44bc0163e0987c20052 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt
Date: Fri, 14 Aug 2020 17:32:00 +0200
Subject: List room num members

---
 server/lib/Uplcg/Main/Server.hs | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

(limited to 'server/lib/Uplcg/Main/Server.hs')

diff --git a/server/lib/Uplcg/Main/Server.hs b/server/lib/Uplcg/Main/Server.hs
index bd2b3ec..bd89540 100644
--- a/server/lib/Uplcg/Main/Server.hs
+++ b/server/lib/Uplcg/Main/Server.hs
@@ -24,6 +24,7 @@ import qualified Data.Text                      as T
 import qualified Data.Text.Encoding             as T
 import qualified Data.Text.IO                   as T
 import qualified Data.Text.Lazy                 as TL
+import           Data.Traversable               (for)
 import qualified Data.Vector                    as V
 import qualified Network.Wai                    as Wai
 import qualified Network.Wai.Handler.Warp       as Warp
@@ -78,8 +79,17 @@ newRoom rid cards gen = Room rid
 
 parseRoomId :: T.Text -> Either String T.Text
 parseRoomId txt
-    | T.all isAlphaNum txt && T.length txt >= 6 = Right txt
+    | T.all isAlphaNum txt && l >= 6 && l <= 32 = Right txt
     | otherwise                                 = Left "Bad room name"
+  where
+    l = T.length txt
+
+roomViews :: Server -> IO [Views.RoomView]
+roomViews server = do
+    rooms <- liftIO . MVar.readMVar $ serverRooms server
+    liftIO . for (HMS.toList rooms) $ \(rid, room) ->
+        fmap (Views.RoomView rid . HMS.size) . atomically . STM.readTVar $
+        roomSinks room
 
 scottyApp :: Server -> IO Wai.Application
 scottyApp server = Scotty.scottyApp $ do
@@ -88,9 +98,8 @@ scottyApp server = Scotty.scottyApp $ do
             BaseUrl.render (serverBaseUrl server) <> "/rooms"
 
     Scotty.get "/rooms" $ do
-        rooms <- liftIO . MVar.readMVar $ serverRooms server
-        Scotty.html . renderHtml . Views.rooms (serverBaseUrl server) $
-            HMS.keys rooms
+        views <- liftIO $ roomViews server
+        Scotty.html . renderHtml $ Views.rooms (serverBaseUrl server) views
 
     Scotty.get "/rooms/:id/" $ do
         rid <- Scotty.param "id"
-- 
cgit v1.2.3