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/Game.hs        | 17 +++++++++++++----
 server/lib/Cafp/Main/Server.hs | 27 ++++++++++++++++++++-------
 server/lib/Cafp/Messages.hs    |  1 +
 3 files changed, 34 insertions(+), 11 deletions(-)

(limited to 'server/lib/Cafp')

diff --git a/server/lib/Cafp/Game.hs b/server/lib/Cafp/Game.hs
index af958ae..a083e57 100644
--- a/server/lib/Cafp/Game.hs
+++ b/server/lib/Cafp/Game.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE TemplateHaskell   #-}
 module Cafp.Game
     ( PlayerId
+    , Cards (..)
     , Game (..)
 
     , newGame
@@ -15,7 +16,7 @@ module Cafp.Game
     ) where
 
 import           Cafp.Messages
-import           Control.Lens        (at, ix, over, (%~), (&), (.~), (^.))
+import           Control.Lens        (at, ix, over, (%~), (&), (.~), (^.), (^?))
 import           Control.Lens.TH     (makeLenses)
 import qualified Data.HashMap.Strict as HMS
 import           Data.Maybe          (fromMaybe)
@@ -24,15 +25,22 @@ import qualified Data.Text           as T
 
 type PlayerId = Int
 
+data Cards = Cards
+    { _cardsBlack :: [T.Text]
+    , _cardsWhite :: [T.Text]
+    } deriving (Show)
+
 data Game = Game
-    { _gamePlayers      :: !(HMS.HashMap Int Text)
+    { _gameCards        :: !Cards
+    , _gamePlayers      :: !(HMS.HashMap Int Text)
     , _gameNextPlayerId :: !Int
     } deriving (Show)
 
+makeLenses ''Cards
 makeLenses ''Game
 
-newGame :: Game
-newGame = Game HMS.empty 1
+newGame :: Cards -> Game
+newGame cards = Game cards HMS.empty 1
 
 joinGame :: Game -> (PlayerId, Game)
 joinGame game =
@@ -58,4 +66,5 @@ gameViewForPlayer self game =
     GameView
         { gameViewOpponents = opponents
         , gameViewMyName    = name
+        , gameViewBlackCard = game ^? gameCards . cardsBlack . ix 0
         }
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
diff --git a/server/lib/Cafp/Messages.hs b/server/lib/Cafp/Messages.hs
index 29f5575..3e345f2 100644
--- a/server/lib/Cafp/Messages.hs
+++ b/server/lib/Cafp/Messages.hs
@@ -11,6 +11,7 @@ import           Elm.Derive
 data GameView = GameView
     { gameViewOpponents :: [Text]
     , gameViewMyName    :: Text
+    , gameViewBlackCard :: Maybe Text
     } deriving (Show)
 
 data ServerMessage
-- 
cgit v1.2.3