Adapt Game module to changes in protocol handling gameID with a shared GameState between public and private parts

This commit is contained in:
Tissevert 2020-01-13 08:36:28 +01:00
parent 4f5057b13f
commit 0fa50ffb28

View file

@ -21,7 +21,10 @@ import Hanafuda.KoiKoi (Game, Mode(..), Player, PlayerID, Players)
import qualified Hanafuda.KoiKoi as KoiKoi ( import qualified Hanafuda.KoiKoi as KoiKoi (
Action, Game(..), Move(..), play, new Action, Game(..), Move(..), play, new
) )
import Hanafuda.Message (PrivateState(..), PublicGame(..), PublicPlayer(..), PublicState(..)) import Hanafuda.Message (
GameState(..), PrivateState(..), PublicGame(..), PublicPlayer(..)
, PublicState(..)
)
import qualified Hanafuda.Player as Player (Player(..), Players(..), get) import qualified Hanafuda.Player as Player (Player(..), Players(..), get)
import Keys (T(..)) import Keys (T(..))
import qualified Keys (public, secret) import qualified Keys (public, secret)
@ -35,9 +38,16 @@ exportPlayers game =
let (Player.Players players) = KoiKoi.players game in let (Player.Players players) = KoiKoi.players game in
players players
privateState :: Game -> PrivateState getGameState :: Game -> GameState
privateState game = PrivateState { getGameState game = GameState {
hands = Player.hand <$> players gameID = KoiKoi.gameID game
, turns = 24 - length (KoiKoi.deck game)
}
privateState :: GameState -> Game -> PrivateState
privateState link game = PrivateState {
link
, hands = Player.hand <$> players
, deck = KoiKoi.deck game , deck = KoiKoi.deck game
} }
where where
@ -59,9 +69,10 @@ privatePlayer publicPlayers playerID hand = Player.Player {
, Player.yakus = yakus (publicPlayers ! playerID) , Player.yakus = yakus (publicPlayers ! playerID)
} }
publicState :: Game -> PublicState publicState :: GameState -> Game -> PublicState
publicState game = PublicState { publicState gameState game = PublicState {
mode = KoiKoi.mode game gameState
, mode = KoiKoi.mode game
, scores = KoiKoi.scores game , scores = KoiKoi.scores game
, month = KoiKoi.month game , month = KoiKoi.month game
, nextPlayer = KoiKoi.nextPlayer game , nextPlayer = KoiKoi.nextPlayer game
@ -72,7 +83,6 @@ publicState game = PublicState {
, river = KoiKoi.river game , river = KoiKoi.river game
, step = KoiKoi.step game , step = KoiKoi.step game
, trick = KoiKoi.trick game , trick = KoiKoi.trick game
, turns = 24 - length (KoiKoi.deck game)
, rounds = KoiKoi.rounds game , rounds = KoiKoi.rounds game
} }
@ -88,15 +98,17 @@ exportGame playerID game = do
, publicSignature = signDetached (Keys.secret sign) $ toJSON public , publicSignature = signDetached (Keys.secret sign) $ toJSON public
} }
where where
public = publicState game sharedState = getGameState game
private = privateState game public = publicState sharedState game
private = privateState sharedState game
toJSON :: ToJSON a => a -> ByteString toJSON :: ToJSON a => a -> ByteString
toJSON = toStrict . encode toJSON = toStrict . encode
gameOf :: PublicState -> PrivateState -> Game merge :: PublicState -> PrivateState -> Game
gameOf public private = KoiKoi.Game { merge public private = KoiKoi.Game {
KoiKoi.mode = mode public KoiKoi.gameID = gameID $ gameState public
, KoiKoi.mode = mode public
, KoiKoi.scores = scores public , KoiKoi.scores = scores public
, KoiKoi.month = month public , KoiKoi.month = month public
, KoiKoi.nextPlayer = nextPlayer public , KoiKoi.nextPlayer = nextPlayer public
@ -113,18 +125,22 @@ gameOf public private = KoiKoi.Game {
} }
importGame :: PublicGame -> App.T (Either String Game) importGame :: PublicGame -> App.T (Either String Game)
importGame PublicGame {nonce, private, public, publicSignature} = do importGame PublicGame {nonce, private, public, publicSignature} =
Keys.T {encrypt, sign} <- App.get Server.keys App.get Server.keys >>= \(Keys.T {encrypt, sign}) -> return $ do
if signVerifyDetached (Keys.public sign) publicSignature $ toJSON public check (signVerifyDetached (Keys.public sign) publicSignature (toJSON public))
then return $ do `orDie` "The game state has been tampered with"
n <- Saltine.decode nonce `orDie` "Could not decode nonce" n <- Saltine.decode nonce `orDie` "Could not decode nonce"
decrypted <- secretboxOpen encrypt n private decrypted <- secretboxOpen encrypt n private
`orDie` "Could not decrypt private state" `orDie` "Could not decrypt private state"
gameOf public <$> eitherDecode' (fromStrict decrypted) decoded <- eitherDecode' (fromStrict decrypted)
else return $ Left "The game state has been tampered with" check (link decoded == gameState public)
`orDie` "Private and public parts do not match"
return $ merge public decoded
where where
orDie :: Maybe a -> String -> Either String a orDie :: Maybe a -> String -> Either String a
orDie m errorMessage = maybe (Left errorMessage) Right m orDie m errorMessage = maybe (Left errorMessage) Right m
check :: Bool -> Maybe ()
check test = if test then Just () else Nothing
play :: PlayerID -> KoiKoi.Move -> PublicGame -> App.T (Either String (Game, [KoiKoi.Action])) play :: PlayerID -> KoiKoi.Move -> PublicGame -> App.T (Either String (Game, [KoiKoi.Action]))
play playerID move publicGame play playerID move publicGame