{-# 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 extractPrivateState :: PlayerID -> Game -> PrivateState extractPrivateState 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 } extractPublicState :: Game -> PublicState extractPublicState 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) , privateState = secretbox encrypt n $ toJSON privateState , publicState , publicSignature = signDetached (secret sign) $ toJSON publicState } where publicState = extractPublicState game privateState = extractPrivateState 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"