Follow move of 'logs' into PublicGame and start implementing re-sync protocol on the server side

src/Automaton.hs

@@ -5,8 +5,12 @@ module Automaton (
 
 import qualified App (Context(..), T, exec, get, player, update)
 import Control.Monad.Reader (asks)
-import qualified Game (new, play)
-import qualified Hanafuda.Message as Message (FromClient(..), T(..))
+import Data.Map ((!))
+import qualified Game (fromPublic, new, play, toPublic)
+import qualified Hanafuda.KoiKoi as KoiKoi (Game(..))
+import qualified Hanafuda.Message as Message (
+    FromClient(..), PublicGame(..), T(..)
+  )
 import qualified Messaging (
     broadcast, get, notifyPlayers, relay, send, sendTo
   )
@@ -38,22 +42,31 @@ receive (Message.Tadaima {Message.myID, Message.name}) Nothing = do
 
 receive (Message.Tadaima {}) (Just _) = sendError "You're already logged in"
 
-receive invitation@(Message.Invitation {Message.to}) (Just _) =
-  Messaging.relay invitation (Messaging.sendTo [to])
+receive invitation@(Message.Invitation {}) (Just _) = relay invitation
 
 receive answer@(Message.Answer {Message.accept, Message.to}) (Just player) =
   if accept
   then do
     publicGames <- Game.new (Player.playerID player, to)
     Messaging.relay answer (Messaging.sendTo [to])
-    Messaging.notifyPlayers publicGames []
+    Messaging.notifyPlayers (publicGames, [])
   else Messaging.relay answer (Messaging.sendTo [to])
 
-receive (Message.Play {Message.move, Message.onGame}) (Just player) = do
-  result <- Game.play (Player.playerID player) move onGame
-  case result of
-    Left message -> sendError message
-    Right (newGame, logs) -> Messaging.notifyPlayers newGame logs
+receive (Message.Play {Message.move, Message.onGame}) (Just player) =
+  Game.play (Player.playerID player) move onGame
+  >>= either sendError Messaging.notifyPlayers
+
+receive sync@(Message.Sync {}) (Just _) = relay sync
+receive yield@(Message.Yield {}) (Just _) = relay yield
+
+receive (Message.Share {Message.gameSave}) (Just player) =
+  either sendError share =<< Game.fromPublic gameSave
+  where
+    logs = Message.logs gameSave
+    share game =
+      let recipientID = KoiKoi.nextPlayer game ! (Player.playerID player) in
+      Game.toPublic recipientID game logs
+      >>= Messaging.sendTo [recipientID] . Message.Game
 
 receive message state =
   sendError $ "Invalid message " ++ show message ++ " in " ++ showState
@@ -63,6 +76,9 @@ receive message state =
         Nothing -> "disconnected state"
         Just _ -> "connected state"
 
+relay :: Message.FromClient -> App.T ()
+relay message = Messaging.relay message (Messaging.sendTo [Message.to message])
+
 sendError :: String -> App.T ()
 sendError = Messaging.send . Message.Error
 

src/Game.hs

@@ -1,8 +1,9 @@
 {-# LANGUAGE NamedFieldPuns #-}
 module Game (
-      exportGame
+      fromPublic
     , new
     , play
+    , toPublic
   ) where
 
 import qualified App (T, get)
@@ -86,12 +87,13 @@ publicState coordinates game = PublicState {
     , rounds = KoiKoi.rounds game
   }
 
-exportGame :: PlayerID -> Game -> App.T PublicGame
-exportGame playerID game = do
+toPublic :: PlayerID -> Game -> [KoiKoi.Action] -> App.T PublicGame
+toPublic playerID game logs = do
   Keys.T {encrypt, sign} <- App.get Server.keys
   n <- lift newNonce
   return $ PublicGame {
         nonce = Saltine.encode n
+      , logs
       , playerHand = getHand playerID (KoiKoi.players game)
       , private = secretbox encrypt n $ toJSON private
       , public
@@ -124,8 +126,8 @@ merge public private = KoiKoi.Game {
       , KoiKoi.rounds = rounds public
     }
 
-importGame :: PublicGame -> App.T (Either String Game)
-importGame PublicGame {nonce, private, public, publicSignature} =
+fromPublic :: PublicGame -> App.T (Either String Game)
+fromPublic PublicGame {nonce, private, public, publicSignature} =
   App.get Server.keys >>= \(Keys.T {encrypt, sign}) -> return $ do
     check (signVerifyDetached (Keys.public sign) publicSignature (toJSON public))
       `orDie` "The game state has been tampered with"
@@ -145,8 +147,8 @@ importGame PublicGame {nonce, private, public, publicSignature} =
 play :: PlayerID -> KoiKoi.Move -> PublicGame -> App.T (Either String (Game, [KoiKoi.Action]))
 play playerID move publicGame
   | playing (public publicGame) == playerID = do
-      imported <- importGame publicGame
-      case imported of
+      result <- fromPublic publicGame
+      case result of
         Left errorMessage -> return $ Left errorMessage
         Right game -> lift . runExceptT . runWriterT $ KoiKoi.play move game
   | otherwise = return $ Left "Not your turn"

src/Messaging.hs

@@ -21,7 +21,7 @@ import Data.List (intercalate)
 import Data.Map (elems, keys)
 import Data.Maybe (maybeToList)
 import qualified Data.Set as Set (fromList, member)
-import qualified Game (exportGame)
+import qualified Game (toPublic)
 import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game(..), PlayerID)
 import Hanafuda.Message (FromClient(..), T(..))
 import qualified Hanafuda.Message as Message (T)
@@ -78,8 +78,7 @@ get =
     pong Ping = send Pong >> get
     pong m = return m
 
-notifyPlayers :: KoiKoi.Game -> [KoiKoi.Action] -> App.T ()
-notifyPlayers game logs =
-  forM_ (keys $ KoiKoi.scores game) $ \k -> do
-    state <- Game.exportGame k game
-    sendTo [k] $ Game {state, logs}
+notifyPlayers :: (KoiKoi.Game, [KoiKoi.Action]) -> App.T ()
+notifyPlayers (game, logs) =
+  forM_ (keys $ KoiKoi.nextPlayer game) $ \k ->
+    sendTo [k] . Game =<< Game.toPublic k game logs