From 3b7d11c6182b8aa3d3d4f9e36c213e4eba6c8d8f Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt
Date: Thu, 30 Jul 2020 19:42:26 +0200
Subject: Add cards from CardsAgainstCryptography

---
 server/lib/Cafp/Main/Server.hs | 27 ++++++++++++++++++++-------
 1 file changed, 20 insertions(+), 7 deletions(-)

(limited to 'server/lib/Cafp/Main')

diff --git a/server/lib/Cafp/Main/Server.hs b/server/lib/Cafp/Main/Server.hs
index e87bfb5..eae887e 100644
--- a/server/lib/Cafp/Main/Server.hs
+++ b/server/lib/Cafp/Main/Server.hs
@@ -18,6 +18,7 @@ import qualified Data.HashMap.Strict            as HMS
 import           Data.Text                      (Text)
 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 qualified Network.Wai                    as Wai
 import qualified Network.Wai.Handler.Warp       as Warp
@@ -39,14 +40,22 @@ data Room = Room
     }
 
 data Server = Server
-    { serverRooms :: TVar (HMS.HashMap RoomId Room)
+    { serverCards :: Cards
+    , serverRooms :: TVar (HMS.HashMap RoomId Room)
     }
 
-newServer :: STM Server
-newServer = Server <$> STM.newTVar HMS.empty
+readCards :: IO Cards
+readCards = Cards
+    <$> fmap T.lines (T.readFile "assets/black.txt")
+    <*> fmap T.lines (T.readFile "assets/white.txt")
 
-newRoom :: STM Room
-newRoom = Room <$> STM.newTVar newGame <*> STM.newTVar HMS.empty
+newServer :: IO Server
+newServer = Server <$> readCards <*> atomically (STM.newTVar HMS.empty)
+
+newRoom :: Server -> STM Room
+newRoom server = Room
+    <$> STM.newTVar (newGame $ serverCards server)
+    <*> STM.newTVar HMS.empty
 
 scottyApp :: IO Wai.Application
 scottyApp = Scotty.scottyApp $ do
@@ -61,6 +70,10 @@ scottyApp = Scotty.scottyApp $ do
         Scotty.setHeader "Content-Type" "application/JavaScript"
         Scotty.file "assets/client.js"
 
+    Scotty.get "/assets/style.css" $ do
+        Scotty.setHeader "Content-Type" "text/css"
+        Scotty.file "assets/style.css"
+
 routePendingConnection :: WS.PendingConnection -> Maybe RoomId
 routePendingConnection pending =
     let path = T.decodeUtf8 . WS.requestPath $ WS.pendingRequest pending in
@@ -74,7 +87,7 @@ getOrCreateRoom server roomId = do
     case HMS.lookup roomId rooms of
         Just room -> pure room
         Nothing   -> do
-            room <- newRoom
+            room <- newRoom server
             STM.writeTVar (serverRooms server) $ HMS.insert roomId room rooms
             pure room
 
@@ -131,7 +144,7 @@ main :: IO ()
 main = do
     let port = 3000
         settings = Warp.setPort port Warp.defaultSettings
-    server <- atomically newServer
+    server <- newServer
     sapp <- scottyApp
     Warp.runSettings settings $
         WaiWs.websocketsOr WS.defaultConnectionOptions (wsApp server) sapp
-- 
cgit v1.2.3