Follow «Coordinates» change in protocol

This commit is contained in:
Tissevert 2020-01-18 09:35:19 +01:00
parent 4436ea10f7
commit ca30340aaa

View file

@ -22,7 +22,7 @@ import qualified Hanafuda.KoiKoi as KoiKoi (
Action, Game(..), Move(..), play, new Action, Game(..), Move(..), play, new
) )
import Hanafuda.Message ( import Hanafuda.Message (
GameState(..), PrivateState(..), PublicGame(..), PublicPlayer(..) Coordinates(..), PrivateState(..), PublicGame(..), PublicPlayer(..)
, PublicState(..) , PublicState(..)
) )
import qualified Hanafuda.Player as Player (Player(..), Players(..), get) import qualified Hanafuda.Player as Player (Player(..), Players(..), get)
@ -38,13 +38,14 @@ exportPlayers game =
let (Player.Players players) = KoiKoi.players game in let (Player.Players players) = KoiKoi.players game in
players players
getGameState :: Game -> GameState getCoordinates :: Game -> Coordinates
getGameState game = GameState { getCoordinates game = Coordinates {
gameID = KoiKoi.gameID game gameID = KoiKoi.gameID game
, turns = 24 - length (KoiKoi.deck game) , month = KoiKoi.month game
, turn = 24 - length (KoiKoi.deck game)
} }
privateState :: GameState -> Game -> PrivateState privateState :: Coordinates -> Game -> PrivateState
privateState link game = PrivateState { privateState link game = PrivateState {
link link
, hands = Player.hand <$> players , hands = Player.hand <$> players
@ -69,12 +70,11 @@ privatePlayer publicPlayers playerID hand = Player.Player {
, Player.yakus = yakus (publicPlayers ! playerID) , Player.yakus = yakus (publicPlayers ! playerID)
} }
publicState :: GameState -> Game -> PublicState publicState :: Coordinates -> Game -> PublicState
publicState gameState game = PublicState { publicState coordinates game = PublicState {
gameState coordinates
, mode = KoiKoi.mode game , mode = KoiKoi.mode game
, scores = KoiKoi.scores game , scores = KoiKoi.scores game
, month = KoiKoi.month game
, nextPlayer = KoiKoi.nextPlayer game , nextPlayer = KoiKoi.nextPlayer game
, players = publicPlayer <$> exportPlayers game , players = publicPlayer <$> exportPlayers game
, playing = KoiKoi.playing game , playing = KoiKoi.playing game
@ -98,19 +98,19 @@ exportGame playerID game = do
, publicSignature = signDetached (Keys.secret sign) $ toJSON public , publicSignature = signDetached (Keys.secret sign) $ toJSON public
} }
where where
sharedState = getGameState game shared = getCoordinates game
public = publicState sharedState game public = publicState shared game
private = privateState sharedState game private = privateState shared game
toJSON :: ToJSON a => a -> ByteString toJSON :: ToJSON a => a -> ByteString
toJSON = toStrict . encode toJSON = toStrict . encode
merge :: PublicState -> PrivateState -> Game merge :: PublicState -> PrivateState -> Game
merge public private = KoiKoi.Game { merge public private = KoiKoi.Game {
KoiKoi.gameID = gameID $ gameState public KoiKoi.gameID = gameID $ coordinates public
, KoiKoi.mode = mode public , KoiKoi.mode = mode public
, KoiKoi.scores = scores public , KoiKoi.scores = scores public
, KoiKoi.month = month public , KoiKoi.month = month $ coordinates public
, KoiKoi.nextPlayer = nextPlayer public , KoiKoi.nextPlayer = nextPlayer public
, KoiKoi.players = Player.Players $ , KoiKoi.players = Player.Players $
mapWithKey (privatePlayer $ players public) (hands private) mapWithKey (privatePlayer $ players public) (hands private)
@ -133,7 +133,7 @@ importGame PublicGame {nonce, private, public, publicSignature} =
decrypted <- secretboxOpen encrypt n private decrypted <- secretboxOpen encrypt n private
`orDie` "Could not decrypt private state" `orDie` "Could not decrypt private state"
decoded <- eitherDecode' (fromStrict decrypted) decoded <- eitherDecode' (fromStrict decrypted)
check (link decoded == gameState public) check (link decoded == coordinates public)
`orDie` "Private and public parts do not match" `orDie` "Private and public parts do not match"
return $ merge public decoded return $ merge public decoded
where where