{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, LambdaCase, ViewPatterns #-}
module BattlePlace.WebApi.Types
( AccountId(..)
, ProjectId(..)
, Auth(..)
, AuthType(..)
, authTypeOf
, Client(..)
, ClientType(..)
, clientTypeOf
, ProjectServerId(..)
, ProjectServerToken(..)
, ProjectServerName(..)
, MatchTeamSize
, MatchTag(..)
, ServerTag(..)
, MatchPlayerInfo(..)
, MatchServerInfo(..)
, MatchToken(..)
, MatchFailureReason(..)
, SessionToken(..)
, SessionId(..)
, ServerSessionToken(..)
, MatchSession(..)
, MatchServerSession(..)
, MatchTeam(..)
, MatchPlayer(..)
, MatchServer(..)
, UserStats(..)
, Identified(..)
, Base64ByteString(..)
, Base64Word64(..)
, StrWord64(..)
) where
import Control.Monad
import qualified Data.Aeson as J
import qualified Data.Aeson.Types as J
import qualified Data.ByteArray as BA
import qualified Data.ByteArray.Encoding as BA
import qualified Data.ByteString as B
import Data.Either
import Data.Hashable
import qualified Data.Serialize as S
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
newtype AccountId = AccountId Base64Word64 deriving (J.FromJSON, J.ToJSON, FromHttpApiData)
newtype ProjectId = ProjectId Base64Word64 deriving (Eq, Hashable, J.FromJSON, J.ToJSON, FromHttpApiData)
data Auth
= Auth_itchJwtToken
{ auth_itchJwtToken :: !T.Text
}
| Auth_itchApiKey
{ auth_itchApiKey :: !T.Text
}
| Auth_steamEncryptedTicket
{ auth_steamEncryptedTicket :: !T.Text
}
| Auth_testKey
{ auth_testKey :: !T.Text
, auth_testId :: !StrWord64
}
deriving Generic
instance J.FromJSON Auth where
parseJSON = J.genericParseJSON jsonOptions
{ J.sumEncoding = J.UntaggedValue
}
instance J.ToJSON Auth where
toJSON = J.genericToJSON jsonOptions
{ J.sumEncoding = J.UntaggedValue
}
toEncoding = J.genericToEncoding jsonOptions
{ J.sumEncoding = J.UntaggedValue
}
data AuthType
= AuthType_itchJwtToken
| AuthType_itchApiKey
| AuthType_steamEncryptedTicket
| AuthType_testKey
deriving (Eq, Generic)
instance Hashable AuthType
instance J.FromJSON AuthType where
parseJSON = J.genericParseJSON jsonOptions
instance J.ToJSON AuthType where
toJSON = J.genericToJSON jsonOptions
toEncoding = J.genericToEncoding jsonOptions
authTypeOf :: Auth -> AuthType
authTypeOf = \case
Auth_itchJwtToken {} -> AuthType_itchJwtToken
Auth_itchApiKey {} -> AuthType_itchApiKey
Auth_steamEncryptedTicket {} -> AuthType_steamEncryptedTicket
Auth_testKey {} -> AuthType_testKey
data Client
= Client_itch
{ client_itchUserId :: {-# UNPACK #-} !StrWord64
}
| Client_steam
{ client_steamId :: {-# UNPACK #-} !StrWord64
}
| Client_test
{ client_testId :: {-# UNPACK #-} !StrWord64
}
deriving (Eq, Generic)
instance Hashable Client
instance J.FromJSON Client where
parseJSON = J.genericParseJSON $ jsonOptionsWithTag "type"
instance J.ToJSON Client where
toJSON = J.genericToJSON $ jsonOptionsWithTag "type"
toEncoding = J.genericToEncoding $ jsonOptionsWithTag "type"
data ClientType
= ClientType_itch
| ClientType_steam
| ClientType_test
deriving (Eq, Generic)
instance Hashable ClientType
instance J.FromJSON ClientType where
parseJSON = J.genericParseJSON jsonOptions
instance J.ToJSON ClientType where
toJSON = J.genericToJSON jsonOptions
toEncoding = J.genericToEncoding jsonOptions
clientTypeOf :: Client -> ClientType
clientTypeOf = \case
Client_itch {} -> ClientType_itch
Client_steam {} -> ClientType_steam
Client_test {} -> ClientType_test
newtype ProjectServerId = ProjectServerId Base64Word64 deriving (Eq, Hashable, J.FromJSON, J.FromJSONKey, J.ToJSON, J.ToJSONKey)
newtype ProjectServerToken = ProjectServerToken T.Text deriving (Eq, Hashable, J.FromJSON, J.ToJSON)
newtype ProjectServerName = ProjectServerName T.Text deriving (Eq, Hashable, J.FromJSON, J.ToJSON)
type MatchTeamSize = Int
newtype MatchTag = MatchTag T.Text deriving (Eq, Hashable, Semigroup, Monoid, J.FromJSON, J.ToJSON)
newtype ServerTag = ServerTag T.Text deriving (Eq, Hashable, Semigroup, Monoid, J.FromJSON, J.ToJSON)
newtype MatchPlayerInfo = MatchPlayerInfo J.Value deriving (J.FromJSON, J.ToJSON)
newtype MatchServerInfo = MatchServerInfo J.Value deriving (J.FromJSON, J.ToJSON)
data MatchToken = MatchToken
{
} deriving Generic
instance J.FromJSON MatchToken where
parseJSON = J.genericParseJSON jsonOptions
instance J.ToJSON MatchToken where
toJSON = J.genericToJSON jsonOptions
toEncoding = J.genericToEncoding jsonOptions
data MatchFailureReason
= MatchFailureReason_timedOut
| MatchFailureReason_noServer
| MatchFailureReason_cancelled
deriving Generic
instance J.FromJSON MatchFailureReason where
parseJSON = J.genericParseJSON jsonOptions
instance J.ToJSON MatchFailureReason where
toJSON = J.genericToJSON jsonOptions
toEncoding = J.genericToEncoding jsonOptions
data SessionToken = SessionToken
{ sessionToken_sessionId :: !SessionId
, sessionToken_teamIndex :: {-# UNPACK #-} !Int
, sessionToken_mateIndex :: {-# UNPACK #-} !Int
} deriving Generic
instance J.FromJSON SessionToken where
parseJSON = J.genericParseJSON jsonOptions
instance J.ToJSON SessionToken where
toJSON = J.genericToJSON jsonOptions
toEncoding = J.genericToEncoding jsonOptions
newtype SessionId = SessionId Base64ByteString deriving (Eq, Hashable, J.FromJSON, J.ToJSON)
newtype ServerSessionToken = ServerSessionToken
{ serverSessionToken_sessionId :: SessionId
} deriving Generic
instance J.FromJSON ServerSessionToken where
parseJSON = J.genericParseJSON jsonOptions
instance J.ToJSON ServerSessionToken where
toJSON = J.genericToJSON jsonOptions
toEncoding = J.genericToEncoding jsonOptions
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
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
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 UserStats = UserStats
{ userStats_rank :: {-# UNPACK #-} !Int
, userStats_rating :: {-# UNPACK #-} !Rating
} deriving Generic
instance J.FromJSON UserStats where
parseJSON = J.genericParseJSON jsonOptions
instance J.ToJSON UserStats where
toJSON = J.genericToJSON jsonOptions
toEncoding = J.genericToEncoding jsonOptions
data Identified i a = Identified
{ identified_id :: !i
, identified_info :: !a
} deriving Generic
instance (J.FromJSON i, J.FromJSON a) => J.FromJSON (Identified i a) where
parseJSON = J.genericParseJSON jsonOptions
instance (J.ToJSON i, J.ToJSON a) => J.ToJSON (Identified i a) where
toJSON = J.genericToJSON jsonOptions
toEncoding = J.genericToEncoding jsonOptions
base64ParseJsonStr :: S.Serialize a => T.Text -> J.Parser a
base64ParseJsonStr = \case
(BA.convertFromBase BA.Base64URLUnpadded . T.encodeUtf8 -> Right (S.decode -> Right object)) -> return object
_ -> fail "wrong base64 object"
base64ToJsonStr :: S.Serialize a => a -> T.Text
base64ToJsonStr = T.decodeUtf8 . BA.convertToBase BA.Base64URLUnpadded . S.encode
base64ParseUrlPiece :: S.Serialize a => T.Text -> Either T.Text a
base64ParseUrlPiece = either (Left . T.pack) (either (Left . T.pack) Right . S.decode) . BA.convertFromBase BA.Base64URLUnpadded . T.encodeUtf8
newtype Base64ByteString = Base64ByteString B.ByteString deriving (Eq, Ord, Semigroup, Monoid, Hashable, BA.ByteArray, BA.ByteArrayAccess)
instance J.FromJSON Base64ByteString where
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
newtype Base64Word64 = Base64Word64 Word64 deriving (Eq, Ord, Num, Storable, Hashable, S.Serialize, Read, Show)
instance J.FromJSON Base64Word64 where
parseJSON = base64ParseJsonStr <=< J.parseJSON
instance J.FromJSONKey Base64Word64 where
fromJSONKey = J.FromJSONKeyTextParser base64ParseJsonStr
instance J.ToJSON Base64Word64 where
toJSON = J.toJSON . base64ToJsonStr
toEncoding = J.toEncoding . base64ToJsonStr
instance J.ToJSONKey Base64Word64 where
toJSONKey = J.toJSONKeyText base64ToJsonStr
instance FromHttpApiData Base64Word64 where
parseUrlPiece = base64ParseUrlPiece
instance IsString Base64Word64 where
fromString = fromRight (error "wrong base64 word") . J.parseEither J.parseJSON . J.String . T.pack
newtype StrWord64 = StrWord64 Word64 deriving (Eq, Ord, Num, Storable, Hashable, S.Serialize, Read, Show)
instance J.FromJSON StrWord64 where
parseJSON = f . reads <=< J.parseJSON where
f = \case
[(n, "")] -> return $ StrWord64 n
_ -> fail "wrong number"
instance J.ToJSON StrWord64 where
toJSON (StrWord64 n) = J.toJSON $ show n
instance FromHttpApiData StrWord64 where
parseUrlPiece = f . reads <=< parseUrlPiece where
f = \case
[(n, "")] -> return $ StrWord64 n
_ -> fail "wrong number"