aboutsummaryrefslogtreecommitdiff
path: root/server/lib/Cafp/Main
diff options
context:
space:
mode:
authorJasper Van der Jeugt2020-07-30 16:16:52 +0200
committerJasper Van der Jeugt2020-07-30 16:16:52 +0200
commitf5a7875d605010540ec7c9c8f2a3ff4ed0702597 (patch)
tree2ea9642ff2c50ee86d861126d8a766fbd922e3d8 /server/lib/Cafp/Main
parent4e1068c41b84f0813b82fe61816271b92ca76f48 (diff)
Allow people to change their name
Diffstat (limited to 'server/lib/Cafp/Main')
-rw-r--r--server/lib/Cafp/Main/GenerateElmTypes.hs1
-rw-r--r--server/lib/Cafp/Main/Server.hs19
2 files changed, 18 insertions, 2 deletions
diff --git a/server/lib/Cafp/Main/GenerateElmTypes.hs b/server/lib/Cafp/Main/GenerateElmTypes.hs
index 3728850..9c72027 100644
--- a/server/lib/Cafp/Main/GenerateElmTypes.hs
+++ b/server/lib/Cafp/Main/GenerateElmTypes.hs
@@ -12,4 +12,5 @@ main :: IO ()
main = putStrLn $ makeElmModule "Messages"
[ DefineElm (Proxy :: Proxy GameView)
, DefineElm (Proxy :: Proxy ServerMessage)
+ , DefineElm (Proxy :: Proxy ClientMessage)
]
diff --git a/server/lib/Cafp/Main/Server.hs b/server/lib/Cafp/Main/Server.hs
index c71709e..e87bfb5 100644
--- a/server/lib/Cafp/Main/Server.hs
+++ b/server/lib/Cafp/Main/Server.hs
@@ -23,8 +23,12 @@ import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Handler.WebSockets as WaiWs
import qualified Network.WebSockets as WS
+import qualified System.IO as IO
import qualified Web.Scotty as Scotty
+warning :: String -> IO ()
+warning = IO.hPutStrLn IO.stderr
+
type RoomId = T.Text
type Sink = BL.ByteString -> IO ()
@@ -90,6 +94,7 @@ syncRoom room = do
(game, sinks) <- atomically $ (,)
<$> STM.readTVar (roomGame room)
<*> STM.readTVar (roomSinks room)
+ warning $ "New state: " ++ show game
for_ (HMS.toList sinks) $ \(pid, sink) ->
sink . Aeson.encode . SyncGameView $ gameViewForPlayer pid game
@@ -109,8 +114,18 @@ wsApp server pc = case routePendingConnection pc of
loop conn roomId playerId)
where
loop conn roomId playerId = forever $ do
- WS.sendTextData conn $ Aeson.encode Bye
- threadDelay $ 1 * 1000000
+ msg <- WS.receiveData conn
+ case Aeson.decode msg of
+ Just cm -> do
+ warning $ "Client: " ++ show cm
+ room <- atomically $ do
+ room <- getOrCreateRoom server roomId
+ STM.modifyTVar' (roomGame room) $
+ processClientMessage playerId cm
+ pure room
+ syncRoom room
+ Nothing -> do
+ warning $ "Could not decode client message: " ++ show msg
main :: IO ()
main = do