WIP : Start redesigning the protocol / informations kept on the server. Breaks pretty much everything

src/Automaton.hs

@@ -8,37 +8,36 @@ import Control.Monad.Reader (asks)
 import qualified Game (new, play)
 import qualified Hanafuda.Message as Message (FromClient(..), T(..))
 import qualified Messaging (
-    broadcast, get, notifyPlayers, relay, send, sendTo, update
+    broadcast, get, notifyPlayers, relay, send, sendTo
   )
 import qualified RW (RW(..))
 import qualified Server (logIn, logOut, update, room)
 import qualified Session (Status(..), T(..), Update)
 
-receive :: Session.Status -> Message.FromClient -> App.T ()
+receive :: Message.FromClient -> Bool -> App.T ()
 
-receive (Session.LoggedIn False) logIn@(Message.LogIn login) =
+receive logIn@(Message.LogIn login) False =
   asks App.playerID >>= App.try . (Server.logIn login)
   >>= maybe
    (Messaging.relay logIn Messaging.broadcast >> setSessionStatus (Session.LoggedIn True))
    sendError
 
-receive (Session.LoggedIn True) logOut@Message.LogOut = do
+receive logOut@Message.LogOut True = do
   Messaging.relay logOut Messaging.broadcast
   asks App.playerID >>= App.update_ . Server.logOut
-  setSessionStatus (Session.LoggedIn False)
+  setSessionStatus (Session.Status False)
 
-receive (Session.LoggedIn True) invitation@(Message.Invitation {Message.to}) = do
+receive invitation@(Message.Invitation {Message.to}) True = do
   session <- App.get to
   case Session.status session of
     Session.LoggedIn True -> do
       from <- asks App.playerID
       App.update_ (Server.update to (RW.set $ Session.Answering from :: Session.Update))
-      Messaging.broadcast $ Messaging.update {Message.paired = [from, to]}
       (Messaging.relay invitation $ Messaging.sendTo [to])
       setSessionStatus (Session.Waiting to)
     _ -> sendError "They just left"
 
-receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do
+receive (Session.LoggedIn True) message@(Message.Answer {Message.accept}) = do
   session <- App.get to
   playerID <- asks App.playerID
   case Session.status session of
@@ -51,7 +50,6 @@ receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do
             Messaging.notifyPlayers game []
             return Session.Playing
           else do
-            Messaging.broadcast $ Messaging.update {Message.alone = [for, to]}
             return $ Session.LoggedIn True
       App.update_ $ Server.update to (RW.set newStatus :: Session.Update)
       setSessionStatus newStatus
@@ -80,8 +78,7 @@ setSessionStatus newStatus = do
 loop :: App.T ()
 loop = do
   message <- Messaging.get
-  status <- Session.status <$> App.current
+  receive message (Status.loggedIn . Session.status <$> App.current)
-  status `receive` message
   loop
 
 start :: App.T ()

src/Messaging.hs

@@ -10,7 +10,6 @@ module Messaging (
     , relay
     , send
     , sendTo
-    , update
   ) where
 
 import qualified App (Context(..), T, connection, debug, server)
@@ -67,9 +66,6 @@ get =
     pong Ping = send Pong >> get
     pong m = return m
 
-update :: T
-update = Update {alone = [], paired = []}
-
 notifyPlayers :: KoiKoi.Game -> [KoiKoi.Action] -> App.T ()
 notifyPlayers game logs =
   forM_ (keys $ KoiKoi.scores game) $ \k -> do

src/Session.hs

@@ -7,16 +7,12 @@ module Session (
     , open
   ) where
 
-import Hanafuda.KoiKoi (PlayerID)
 import Network.WebSockets (Connection)
 import qualified RW (RW(..))
 
-data Status =
+newtype Status = Status {
-    LoggedIn Bool
+    loggedIn :: Bool
-  | Answering PlayerID
+  } deriving (Show)
-  | Waiting PlayerID
-  | Playing
-  deriving (Show)
 
 data T = T {
       connection :: Connection
@@ -31,5 +27,5 @@ instance RW.RW Status T where
 open :: Connection -> T
 open connection = T {
       connection
-    , status = LoggedIn False
+    , status = Status False
   }