diff --git a/BattlePlace/WebApi.hs b/BattlePlace/WebApi.hs --- a/BattlePlace/WebApi.hs +++ b/BattlePlace/WebApi.hs @@ -13,15 +13,14 @@ , MatchRequest(..) , MatchResponse(..) , MatchStatusResponse(..) - , MatchCancelResponse(..) - , MatchTeam(..) - , MatchPlayer(..) - , MatchServer(..) , SessionResultRequest(..) , ServerMatchRequest(..) , ServerMatchResponse(..) + , ServerMatchCancelRequest(..) + , ServerMatchCancelResponse(..) + , ServerMatchSessionsRequest(..) + , ServerMatchSessionsResponse(..) , ServerSessionResultRequest(..) - , ServerSession(..) ) where import qualified Data.Aeson as J @@ -42,7 +41,7 @@ :<|> "match" :> ( AuthProtect ClientToken :> ReqBody '[JSON] MatchRequest :> Post '[JSON] MatchResponse :<|> AuthProtect ClientToken :> Capture "matchToken" (InternalToken MatchToken) :> Get '[JSON] MatchStatusResponse - :<|> AuthProtect ClientToken :> Capture "matchToken" (InternalToken MatchToken) :> Delete '[JSON] MatchCancelResponse + :<|> AuthProtect ClientToken :> Capture "matchToken" (InternalToken MatchToken) :> Delete '[JSON] () ) :<|> "session" :> Capture "sessionToken" (InternalToken SessionToken) :> ( "result" :> AuthProtect ClientToken :> ReqBody '[JSON] SessionResultRequest :> Post '[JSON] () @@ -52,7 +51,11 @@ ) ) :<|> "server" :> - ( "match" :> ReqBody '[JSON] ServerMatchRequest :> Post '[JSON] ServerMatchResponse + ( "match" :> + ( ReqBody '[JSON] ServerMatchRequest :> Post '[JSON] ServerMatchResponse + :<|> ReqBody '[JSON] ServerMatchCancelRequest :> Delete '[JSON] ServerMatchCancelResponse + :<|> "sessions" :> ReqBody '[JSON] ServerMatchSessionsRequest :> Post '[JSON] ServerMatchSessionsResponse + ) :<|> "session" :> Capture "serverSessionToken" (InternalToken ServerSessionToken) :> ( "result" :> ReqBody '[JSON] ServerSessionResultRequest :> Post '[JSON] () ) @@ -111,19 +114,11 @@ = MatchStatusResponse_notFound | MatchStatusResponse_inProgress | MatchStatusResponse_matched - { matchStatusResponse_sessionId :: !SessionId - , matchStatusResponse_sessionToken :: !(InternalToken SessionToken) - , matchStatusResponse_teams :: !(V.Vector MatchTeam) - , matchStatusResponse_teamIndex :: {-# UNPACK #-} !Int - , matchStatusResponse_mateIndex :: {-# UNPACK #-} !Int - , matchStatusResponse_server :: !(Maybe MatchServer) + { matchStatusResponse_session :: !MatchSession } | MatchStatusResponse_failed { matchStatusResponse_reason :: !MatchFailureReason } - -- | Match status was cleaned. - -- Normallly this status should not be visible to clients, it's here just in case. - | MatchStatusResponse_cleaned deriving Generic instance J.FromJSON MatchStatusResponse where parseJSON = J.genericParseJSON jsonOptions @@ -131,40 +126,6 @@ toJSON = J.genericToJSON jsonOptions toEncoding = J.genericToEncoding jsonOptions -newtype MatchTeam = MatchTeam (V.Vector MatchPlayer) deriving (J.FromJSON, J.ToJSON) - -data MatchPlayer = MatchPlayer - { matchPlayer_info :: !MatchPlayerInfo - , matchPlayer_ourTicket :: !(Maybe Ticket) - , matchPlayer_theirTicket :: !(Maybe Ticket) - } deriving Generic -instance J.FromJSON MatchPlayer where - parseJSON = J.genericParseJSON jsonOptions -instance J.ToJSON MatchPlayer where - toJSON = J.genericToJSON jsonOptions - toEncoding = J.genericToEncoding jsonOptions - -data MatchServer = MatchServer - { matchServer_info :: !MatchServerInfo - , matchServer_ourTicket :: !Ticket - , matchServer_theirTicket :: !Ticket - } deriving Generic -instance J.FromJSON MatchServer where - parseJSON = J.genericParseJSON jsonOptions -instance J.ToJSON MatchServer where - toJSON = J.genericToJSON jsonOptions - toEncoding = J.genericToEncoding jsonOptions - -data MatchCancelResponse - = MatchCancelResponse_notFound - | MatchCancelResponse_cancelled - deriving Generic -instance J.FromJSON MatchCancelResponse where - parseJSON = J.genericParseJSON jsonOptions -instance J.ToJSON MatchCancelResponse where - toJSON = J.genericToJSON jsonOptions - toEncoding = J.genericToEncoding jsonOptions - data SessionResultRequest = SessionResultRequest_finished { sessionResultRequest_ranks :: !(V.Vector Int) @@ -177,12 +138,20 @@ toJSON = J.genericToJSON jsonOptions toEncoding = J.genericToEncoding jsonOptions +data ClientDataRequest = ClientDataRequest + { clientDataRequest_after :: !(Maybe T.Text) + } deriving Generic +instance J.FromJSON ClientDataRequest where + parseJSON = J.genericParseJSON jsonOptions +instance J.ToJSON ClientDataRequest where + toJSON = J.genericToJSON jsonOptions + toEncoding = J.genericToEncoding jsonOptions + data ServerMatchRequest = ServerMatchRequest { serverMatchRequest_projectId :: {-# UNPACK #-} !ProjectId , serverMatchRequest_projectServerToken :: !ProjectServerToken , serverMatchRequest_serverTag :: !(Maybe ServerTag) - , serverMatchRequest_maxSessionsCount :: {-# UNPACK #-} !Int - , serverMatchRequest_name :: !T.Text + , serverMatchRequest_name :: !ProjectServerName , serverMatchRequest_info :: !(Maybe MatchServerInfo) , serverMatchRequest_timeout :: !(Maybe Int) } deriving Generic @@ -192,15 +161,57 @@ toJSON = J.genericToJSON jsonOptions toEncoding = J.genericToEncoding jsonOptions -data ServerMatchResponse = ServerMatchResponse - { serverMatchResponse_sessions :: !(V.Vector ServerSession) - } deriving Generic +data ServerMatchResponse + = ServerMatchResponse_registered + | ServerMatchResponse_unused + deriving Generic instance J.FromJSON ServerMatchResponse where parseJSON = J.genericParseJSON jsonOptions instance J.ToJSON ServerMatchResponse where toJSON = J.genericToJSON jsonOptions toEncoding = J.genericToEncoding jsonOptions +data ServerMatchCancelRequest = ServerMatchCancelRequest + { serverMatchCancelRequest_projectId :: {-# UNPACK #-} !ProjectId + , serverMatchCancelRequest_projectServerToken :: !ProjectServerToken + , serverMatchCancelRequest_name :: !ProjectServerName + } deriving Generic +instance J.FromJSON ServerMatchCancelRequest where + parseJSON = J.genericParseJSON jsonOptions +instance J.ToJSON ServerMatchCancelRequest where + toJSON = J.genericToJSON jsonOptions + toEncoding = J.genericToEncoding jsonOptions + +data ServerMatchCancelResponse + = ServerMatchCancelResponse_cancelled + | ServerMatchCancelResponse_unused + deriving Generic +instance J.FromJSON ServerMatchCancelResponse where + parseJSON = J.genericParseJSON jsonOptions +instance J.ToJSON ServerMatchCancelResponse where + toJSON = J.genericToJSON jsonOptions + toEncoding = J.genericToEncoding jsonOptions + +data ServerMatchSessionsRequest = ServerMatchSessionsRequest + { serverMatchSessionsRequest_projectId :: {-# UNPACK #-} !ProjectId + , serverMatchSessionsRequest_projectServerToken :: !ProjectServerToken + , serverMatchSessionsRequest_name :: !ProjectServerName + } deriving Generic +instance J.FromJSON ServerMatchSessionsRequest where + parseJSON = J.genericParseJSON jsonOptions +instance J.ToJSON ServerMatchSessionsRequest where + toJSON = J.genericToJSON jsonOptions + toEncoding = J.genericToEncoding jsonOptions + +data ServerMatchSessionsResponse = ServerMatchSessionsResponse + { serverMatchSessionsResponse_sessions :: !(V.Vector MatchServerSession) + } deriving Generic +instance J.FromJSON ServerMatchSessionsResponse where + parseJSON = J.genericParseJSON jsonOptions +instance J.ToJSON ServerMatchSessionsResponse where + toJSON = J.genericToJSON jsonOptions + toEncoding = J.genericToEncoding jsonOptions + data ServerSessionResultRequest = ServerSessionResultRequest_finished { serverSessionResultRequest_ranks :: !(V.Vector Int) @@ -210,18 +221,5 @@ instance J.FromJSON ServerSessionResultRequest where parseJSON = J.genericParseJSON jsonOptions instance J.ToJSON ServerSessionResultRequest where - toJSON = J.genericToJSON jsonOptions - toEncoding = J.genericToEncoding jsonOptions - -data ServerSession = ServerSession - { serverSession_sessionId :: !SessionId - , serverSession_serverSessionToken :: !(InternalToken ServerSessionToken) - , serverSession_teams :: !(V.Vector MatchTeam) - , serverSession_matchTag :: !MatchTag - , serverSession_serverTag :: !ServerTag - } deriving Generic -instance J.FromJSON ServerSession where - parseJSON = J.genericParseJSON jsonOptions -instance J.ToJSON ServerSession where toJSON = J.genericToJSON jsonOptions toEncoding = J.genericToEncoding jsonOptions diff --git a/BattlePlace/WebApi/Types.hs b/BattlePlace/WebApi/Types.hs --- a/BattlePlace/WebApi/Types.hs +++ b/BattlePlace/WebApi/Types.hs @@ -17,6 +17,7 @@ , clientTypeOf , ProjectServerId(..) , ProjectServerToken(..) + , ProjectServerName(..) , MatchTeamSize , MatchTag(..) , ServerTag(..) @@ -27,6 +28,11 @@ , SessionToken(..) , SessionId(..) , ServerSessionToken(..) + , MatchSession(..) + , MatchServerSession(..) + , MatchTeam(..) + , MatchPlayer(..) + , MatchServer(..) , UserStats(..) , Identified(..) , Base64ByteString(..) @@ -46,12 +52,15 @@ import Data.String import qualified Data.Text as T import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy.Encoding as TL +import qualified Data.Vector as V import Data.Word import Foreign.Storable import GHC.Generics(Generic) import Servant.API import BattlePlace.Rating +import BattlePlace.Token.Types import BattlePlace.Util -- | Account id. @@ -152,6 +161,9 @@ -- | Project's secret server token. newtype ProjectServerToken = ProjectServerToken T.Text deriving (Eq, Hashable, J.FromJSON, J.ToJSON) +-- | Project's server name. +newtype ProjectServerName = ProjectServerName T.Text deriving (Eq, Hashable, J.FromJSON, J.ToJSON) + -- | Size of a team in match request. type MatchTeamSize = Int @@ -217,6 +229,62 @@ toJSON = J.genericToJSON jsonOptions toEncoding = J.genericToEncoding jsonOptions +-- | Match session. +data MatchSession = MatchSession + { matchSession_sessionId :: !SessionId + , matchSession_sessionToken :: !(InternalToken SessionToken) + , matchSession_teams :: !(V.Vector MatchTeam) + , matchSession_teamIndex :: {-# UNPACK #-} !Int + , matchSession_mateIndex :: {-# UNPACK #-} !Int + , matchSession_server :: !(Maybe MatchServer) + } deriving Generic +instance J.FromJSON MatchSession where + parseJSON = J.genericParseJSON jsonOptions +instance J.ToJSON MatchSession where + toJSON = J.genericToJSON jsonOptions + toEncoding = J.genericToEncoding jsonOptions + +-- | Match server session. +data MatchServerSession = MatchServerSession + { matchServerSession_sessionId :: !SessionId + , matchServerSession_serverSessionToken :: !(InternalToken ServerSessionToken) + , matchServerSession_teams :: !(V.Vector MatchTeam) + , matchServerSession_matchTag :: !MatchTag + , matchServerSession_serverTag :: !ServerTag + } deriving Generic +instance J.FromJSON MatchServerSession where + parseJSON = J.genericParseJSON jsonOptions +instance J.ToJSON MatchServerSession where + toJSON = J.genericToJSON jsonOptions + toEncoding = J.genericToEncoding jsonOptions + +-- | Match team. +newtype MatchTeam = MatchTeam (V.Vector MatchPlayer) deriving (J.FromJSON, J.ToJSON) + +-- | Match player. +data MatchPlayer = MatchPlayer + { matchPlayer_info :: !MatchPlayerInfo + , matchPlayer_ourTicket :: !(Maybe Ticket) + , matchPlayer_theirTicket :: !(Maybe Ticket) + } deriving Generic +instance J.FromJSON MatchPlayer where + parseJSON = J.genericParseJSON jsonOptions +instance J.ToJSON MatchPlayer where + toJSON = J.genericToJSON jsonOptions + toEncoding = J.genericToEncoding jsonOptions + +-- | Match server. +data MatchServer = MatchServer + { matchServer_info :: !MatchServerInfo + , matchServer_ourTicket :: !Ticket + , matchServer_theirTicket :: !Ticket + } deriving Generic +instance J.FromJSON MatchServer where + parseJSON = J.genericParseJSON jsonOptions +instance J.ToJSON MatchServer where + toJSON = J.genericToJSON jsonOptions + toEncoding = J.genericToEncoding jsonOptions + -- | User stats. data UserStats = UserStats { userStats_rank :: {-# UNPACK #-} !Int @@ -259,6 +327,7 @@ parseJSON = either fail return . BA.convertFromBase BA.Base64URLUnpadded . T.encodeUtf8 <=< J.parseJSON instance J.ToJSON Base64ByteString where toJSON = J.toJSON . T.decodeUtf8 . BA.convertToBase BA.Base64URLUnpadded + toEncoding = J.toEncoding . T.decodeUtf8 . BA.convertToBase BA.Base64URLUnpadded -- | Word64 which serializes to JSON as base64 string. -- Useful because 64-bit integer is not representable in javascript. diff --git a/battleplace.cabal b/battleplace.cabal --- a/battleplace.cabal +++ b/battleplace.cabal @@ -1,5 +1,5 @@ name: battleplace -version: 0.1.0.6 +version: 0.1.0.7 synopsis: Core definitions for BattlePlace.io service description: Core definitions for BattlePlace.io service license: MIT