94 lines
3.0 KiB
Haskell
94 lines
3.0 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
module Game (
|
|
export
|
|
, new
|
|
, play
|
|
) where
|
|
|
|
import qualified App (T, server, update)
|
|
import Control.Monad.Except (runExceptT, throwError)
|
|
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 Data.ByteString (ByteString)
|
|
import Data.ByteString.Lazy (toStrict)
|
|
import Data.Map (Map)
|
|
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 Server (T(..), register)
|
|
|
|
new :: (PlayerID, PlayerID) -> App.T GameID
|
|
new (for, to) =
|
|
Server.register <$> (lift $ KoiKoi.new (for, to) WholeYear) >>= App.update
|
|
|
|
exportPlayers :: Game -> Map PlayerID Player
|
|
exportPlayers game =
|
|
let (Player.Players players) = KoiKoi.players game in
|
|
players
|
|
|
|
privateState :: PlayerID -> Game -> PrivateState
|
|
privateState playerID game = PrivateState {
|
|
opponentHand = getHand opponentID players
|
|
, deck = KoiKoi.deck game
|
|
}
|
|
where
|
|
players = KoiKoi.players game
|
|
opponentID = Player.next players playerID
|
|
|
|
getHand :: PlayerID -> Players -> Hanafuda.Pack
|
|
getHand playerID = Player.hand . (Player.get playerID)
|
|
|
|
publicPlayer :: Player -> PublicPlayer
|
|
publicPlayer player = PublicPlayer {
|
|
meld = Player.meld player
|
|
, yakus = Player.yakus player
|
|
}
|
|
|
|
publicState :: Game -> PublicState
|
|
publicState game = PublicState {
|
|
mode = KoiKoi.mode game
|
|
, scores = KoiKoi.scores game
|
|
, month = KoiKoi.month game
|
|
, players = publicPlayer <$> exportPlayers game
|
|
, playing = KoiKoi.playing game
|
|
, winning = KoiKoi.winning game
|
|
, oyake = KoiKoi.oyake game
|
|
, river = KoiKoi.river game
|
|
, step = KoiKoi.step game
|
|
, trick = KoiKoi.trick game
|
|
, turns = 24 - length (KoiKoi.deck game)
|
|
, rounds = KoiKoi.rounds game
|
|
}
|
|
|
|
export :: PlayerID -> Game -> App.T PublicGame
|
|
export playerID game = do
|
|
Keys.T {encrypt, sign} <- Server.keys <$> App.server
|
|
n <- lift newNonce
|
|
return $ PublicGame {
|
|
nonce = Saltine.encode n
|
|
, playerHand = getHand playerID (KoiKoi.players game)
|
|
, private = secretbox encrypt n $ toJSON private
|
|
, public
|
|
, publicSignature = signDetached (secret sign) $ toJSON public
|
|
}
|
|
where
|
|
public = publicState game
|
|
private = privateState playerID game
|
|
toJSON :: ToJSON a => a -> ByteString
|
|
toJSON = toStrict . encode
|
|
|
|
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"
|