Adapt Game module to changes in protocol handling gameID with a shared GameState between public and private parts
This commit is contained in:
parent
4f5057b13f
commit
0fa50ffb28
1 changed files with 35 additions and 19 deletions
54
src/Game.hs
54
src/Game.hs
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue