From b95a7c958dbd9076f4bde256d5bd60a545f104a6 Mon Sep 17 00:00:00 2001
From: Tissevert <tissevert+devel@marvid.fr>
Date: Sat, 25 Jan 2020 11:54:27 +0100
Subject: [PATCH] Stop imposing only one game per user, it was silly and
 finally harder to do well than to simply keep games by ID and allow several
 games in parallel for one user

---
 src/Automaton.hs | 44 +++++++++++++++++++++-----------------------
 src/Session.hs   |  4 ++--
 2 files changed, 23 insertions(+), 25 deletions(-)

diff --git a/src/Automaton.hs b/src/Automaton.hs
index b0fad58..9809e68 100644
--- a/src/Automaton.hs
+++ b/src/Automaton.hs
@@ -10,13 +10,13 @@ import Data.Aeson (encode, eitherDecode')
 import Data.ByteString.Lazy.Char8 (ByteString, append, pack, putStrLn)
 import qualified Data.ByteString.Lazy.Char8 as ByteString (concat)
 import Data.Map ((!))
-import qualified Data.Map as Map (delete, empty, member)
+import qualified Data.Map as Map (delete, empty, lookup)
 import Control.Monad.Reader (ReaderT, ask)
 import Control.Monad.Trans (lift)
 import Hanafuda.KoiKoi (Step(..))
-import Hanafuda.Message (Coordinates(..), FromClient(..), T(..), orderCoordinates)
+import Hanafuda.Message (FromClient(..), T(..), orderCoordinates)
 import qualified Hanafuda.Message as Message (
-    T(..), FromClient, PublicGame(..), PublicState(..)
+    Coordinates(..), FromClient, PublicGame(..), PublicState(..), T(..)
   )
 import Network.WebSockets (Connection, receiveData, sendTextData)
 import Prelude hiding (error, putStrLn)
@@ -58,16 +58,14 @@ answer (Message.Relay {Message.from, Message.message = Message.LogIn {Message.na
   | from == key = return $ LoggedIn {key, name}
 -}
 
-answer state@(Connected {games}) (Relay {from, message = Invitation {}}) =
-  -- policy : one game per player only
-  send (Answer {accept = not $ Map.member from games, to = from})
-  >> return state
+answer state@(Connected {}) (Relay {from, message = Invitation {}}) =
+  send (Answer {accept = True, to = from}) >> return state
 
 answer state@(Connected {playerID, games}) message@(Game {}) = do
   case Message.step $ Message.public game of
     Over ->
-      let opponentID = Message.nextPlayer (Message.public game) ! playerID in
-      return $ state {games = Map.delete opponentID games}
+      let xGameID = Message.gameID . Message.coordinates $ Message.public game in
+      return $ state {games = Map.delete xGameID games}
     _ ->
       if Message.playing (Message.public game) == playerID
       then
@@ -82,21 +80,21 @@ answer state (Error {error}) = do
   debug $ "Received error from server : " `append` pack error
   return state
 
-answer state@(Connected {games}) (Relay {from, message = Sync {latestKnown}})
-  | not $ Map.member from games =
-      send (Yield {onGameID = gameID latestKnown, to = from}) >> return state
-  | otherwise =
-    case orderCoordinates latestKnownHere latestKnown of
-      Just LT -> send $ Yield {onGameID = gameID latestKnown, to = from}
-      Just GT -> send $ Share {gameSave = game}
-      _ -> return ()
-    >> return state
-    where
-      game = games ! from
-      latestKnownHere = Message.coordinates $ Message.public game
+answer state@(Connected {games}) (Relay {from, message = Sync {latestKnown}}) =
+  case Map.lookup gameID games of
+    Nothing -> send $ Yield {onGameID = gameID, to = from}
+    Just game ->
+      let latestKnownHere = Message.coordinates $ Message.public game in
+      case orderCoordinates latestKnown latestKnownHere of
+        Just LT -> send $ Share {gameSave = game}
+        Just GT -> send $ Yield {onGameID = gameID, to = from}
+        _ -> return ()
+  >> return state
+  where
+    gameID = Message.gameID latestKnown
 
-answer state@(Connected {games}) (Relay {from, message = Yield {}}) =
-  send (Share {gameSave = games ! from}) >> return state
+answer state@(Connected {games}) (Relay {message = Yield {onGameID}}) =
+  send (Share {gameSave = games ! onGameID}) >> return state
 
 {-
  - Ignore
diff --git a/src/Session.hs b/src/Session.hs
index fce1782..4f76cbf 100644
--- a/src/Session.hs
+++ b/src/Session.hs
@@ -8,7 +8,7 @@ module Session (
 import Config (libDir)
 import Data.Map (Map)
 import qualified Data.Map as Map (empty)
-import Hanafuda.KoiKoi (PlayerID)
+import Hanafuda.KoiKoi (GameID, PlayerID)
 import qualified Hanafuda.Message as Message (PublicGame)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath ((</>))
@@ -17,7 +17,7 @@ data State =
     New
   | Connected {
         playerID :: PlayerID
-      , games :: Map PlayerID Message.PublicGame
+      , games :: Map GameID Message.PublicGame
     }
   deriving Show