Use PublicGame returned by the player and stop keeping track of the game's state internally

src/Automaton.hs

@@ -62,18 +62,17 @@ receive (Session.Answering to) message@(Message.Answer {Message.accept}) = do
       setSessionStatus newStatus
     _ -> sendError "They're not waiting for your answer"
 
-receive (Session.Playing gameID) played@(Message.Play {}) = do
+receive (Session.Playing gameID) (Message.Play {Message.move, Message.onGame}) = do
   playerID <- asks App.playerID
-  game <- Server.get gameID <$> App.server
-  (result, logs) <- Game.play playerID (Message.move played) game
+  result <- Game.play playerID move onGame
   case result of
     Left message -> sendError message
-    Right newGame -> do
+    Right (newGame, logs) -> do
       case KoiKoi.step newGame of
         KoiKoi.Over -> do
           App.debug $ "Game " ++ show gameID ++ " ended"
           App.update_ $ Server.endGame gameID
-        _ -> App.update_ $ Server.update gameID (const newGame)
+        _ -> return ()
       Messaging.notifyPlayers newGame logs
 
 receive (Session.Playing gameID) Message.Quit = do

src/Game.hs

@@ -1,29 +1,30 @@
 {-# LANGUAGE NamedFieldPuns #-}
 module Game (
-      export
+      exportGame
     , new
     , play
   ) where
 
 import qualified App (T, server, update)
-import Control.Monad.Except (runExceptT, throwError)
+import Control.Monad.Except (runExceptT)
 import Control.Monad.Reader (lift)
 import Control.Monad.Writer (runWriterT)
 import qualified Crypto.Saltine.Class as Saltine (IsEncoding(..))
-import Crypto.Saltine.Core.SecretBox (newNonce, secretbox)
-import Crypto.Saltine.Core.Sign (signDetached)
-import Data.Aeson (ToJSON, encode)
+import Crypto.Saltine.Core.SecretBox (newNonce, secretbox, secretboxOpen)
+import Crypto.Saltine.Core.Sign (signDetached, signVerifyDetached)
+import Data.Aeson (ToJSON, eitherDecode', encode)
 import Data.ByteString (ByteString)
-import Data.ByteString.Lazy (toStrict)
-import Data.Map (Map)
+import Data.ByteString.Lazy (fromStrict, toStrict)
+import Data.Map ((!), Map, mapWithKey)
 import qualified Hanafuda (Pack)
 import Hanafuda.KoiKoi (Game, GameID, Mode(..), Player, PlayerID, Players)
 import qualified Hanafuda.KoiKoi as KoiKoi (
     Action, Game(..), Move(..), play, new
   )
 import Hanafuda.Message (PrivateState(..), PublicGame(..), PublicPlayer(..), PublicState(..))
-import qualified Hanafuda.Player as Player (Player(..), Players(..), get, next)
-import Keys (T(..), secret)
+import qualified Hanafuda.Player as Player (Player(..), Players(..), get)
+import Keys (T(..))
+import qualified Keys (public, secret)
 import qualified Server (T(..), register)
 
 new :: (PlayerID, PlayerID) -> App.T GameID
@@ -35,14 +36,13 @@ exportPlayers game =
   let (Player.Players players) = KoiKoi.players game in
   players
 
-privateState :: PlayerID -> Game -> PrivateState
-privateState playerID game = PrivateState {
-      opponentHand = getHand opponentID players
+privateState :: Game -> PrivateState
+privateState game = PrivateState {
+      hands = Player.hand <$> players
     , deck = KoiKoi.deck game
   }
   where
-    players = KoiKoi.players game
-    opponentID = Player.next players playerID
+    Player.Players players = KoiKoi.players game
 
 getHand :: PlayerID -> Players -> Hanafuda.Pack
 getHand playerID = Player.hand . (Player.get playerID)
@@ -53,11 +53,19 @@ publicPlayer player = PublicPlayer {
     , yakus = Player.yakus player
   }
 
+privatePlayer :: Map PlayerID PublicPlayer -> PlayerID -> Hanafuda.Pack -> Player
+privatePlayer publicPlayers playerID hand = Player.Player {
+      Player.hand
+    , Player.meld = meld (publicPlayers ! playerID)
+    , Player.yakus = yakus (publicPlayers ! playerID)
+  }
+
 publicState :: Game -> PublicState
 publicState game = PublicState {
       mode = KoiKoi.mode game
     , scores = KoiKoi.scores game
     , month = KoiKoi.month game
+    , nextPlayer = KoiKoi.nextPlayer game
     , players = publicPlayer <$> exportPlayers game
     , playing = KoiKoi.playing game
     , winning = KoiKoi.winning game
@@ -69,8 +77,8 @@ publicState game = PublicState {
     , rounds = KoiKoi.rounds game
   }
 
-export :: PlayerID -> Game -> App.T PublicGame
-export playerID game = do
+exportGame :: PlayerID -> Game -> App.T PublicGame
+exportGame playerID game = do
   Keys.T {encrypt, sign} <- Server.keys <$> App.server
   n <- lift newNonce
   return $ PublicGame {
@@ -78,16 +86,52 @@ export playerID game = do
       , playerHand = getHand playerID (KoiKoi.players game)
       , private = secretbox encrypt n $ toJSON private
       , public
-      , publicSignature = signDetached (secret sign) $ toJSON public
+      , publicSignature = signDetached (Keys.secret sign) $ toJSON public
     }
   where
     public = publicState game
-    private = privateState playerID game
-    toJSON :: ToJSON a => a -> ByteString
-    toJSON = toStrict . encode
+    private = privateState game
 
-play :: PlayerID -> KoiKoi.Move -> Game -> App.T (Either String Game, [KoiKoi.Action])
-play playerID move game = lift . runWriterT . runExceptT $
-  if KoiKoi.playing game == playerID
-  then KoiKoi.play move game
-  else throwError "Not your turn"
+toJSON :: ToJSON a => a -> ByteString
+toJSON = toStrict . encode
+
+gameOf :: PublicState -> PrivateState -> Game
+gameOf public private = KoiKoi.Game {
+        KoiKoi.mode = mode public
+      , KoiKoi.scores = scores public
+      , KoiKoi.month = month public
+      , KoiKoi.nextPlayer = nextPlayer public
+      , KoiKoi.players = Player.Players $
+          mapWithKey (privatePlayer $ players public) (hands private)
+      , KoiKoi.playing = playing public
+      , KoiKoi.winning = winning public
+      , KoiKoi.oyake = winning public
+      , KoiKoi.deck = deck private
+      , KoiKoi.river = river public
+      , KoiKoi.step = step public
+      , KoiKoi.trick = trick public
+      , KoiKoi.rounds = rounds public
+    }
+
+importGame :: PublicGame -> App.T (Either String Game)
+importGame PublicGame {nonce, private, public, publicSignature} = do
+  Keys.T {encrypt, sign} <- Server.keys <$> App.server
+  if signVerifyDetached (Keys.public sign) publicSignature $ toJSON public
+  then return $ do
+    n <- Saltine.decode nonce `orDie` "Could not decode nonce"
+    decrypted <- secretboxOpen encrypt n private
+                  `orDie` "Could not decrypt private state"
+    gameOf public <$> eitherDecode' (fromStrict decrypted)
+  else return $ Left "The game state has been tampered with"
+  where
+    orDie :: Maybe a -> String -> Either String a
+    orDie m errorMessage = maybe (Left errorMessage) Right m
+
+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
+        Left errorMessage -> return $ Left errorMessage
+        Right game -> lift . runExceptT . runWriterT $ KoiKoi.play move game
+  | otherwise = return $ Left "Not your turn"

src/Messaging.hs

@@ -24,7 +24,7 @@ import qualified Hanafuda.KoiKoi as KoiKoi (Action, Game(..), PlayerID)
 import Hanafuda.Message (FromClient(..), T(..))
 import qualified Hanafuda.Message as Message (T)
 import Network.WebSockets (receiveData, sendTextData)
-import qualified Game (export)
+import qualified Game (exportGame)
 import qualified Server (T(..), get)
 import qualified Session (T(..))
 
@@ -73,5 +73,5 @@ update = Update {alone = [], paired = []}
 notifyPlayers :: KoiKoi.Game -> [KoiKoi.Action] -> App.T ()
 notifyPlayers game logs =
   forM_ (keys $ KoiKoi.scores game) $ \k -> do
-    state <- Game.export k game
+    state <- Game.exportGame k game
     sendTo [k] $ Game {state, logs}