{-|
Module: BattlePlace.WebApi.Types
Description: Web API types.
License: MIT
-}

{-# 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(..)
	, ExternalSessionId(..)
	, 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.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.
-- At the moment it's just itch user id, but that may change.
newtype AccountId = AccountId Base64Word64 deriving (J.FromJSON, J.ToJSON, FromHttpApiData)

-- | Project id.
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
		}

-- | Auth type (for logging).
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"

-- | Type of the client. Must correspont to JSON field "type" of 'Client'.
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

-- | Project's server id.
newtype ProjectServerId = ProjectServerId Base64Word64 deriving (Eq, Hashable, J.FromJSON, J.FromJSONKey, J.ToJSON, J.ToJSONKey)

-- | 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

-- | Match tag in match request.
newtype MatchTag = MatchTag T.Text deriving (Eq, Hashable, Semigroup, Monoid, J.FromJSON, J.ToJSON)

-- | Server tag in match request.
newtype ServerTag = ServerTag T.Text deriving (Eq, Hashable, Semigroup, Monoid, J.FromJSON, J.ToJSON)

-- | Opaque player info.
newtype MatchPlayerInfo = MatchPlayerInfo J.Value deriving (J.FromJSON, J.ToJSON)

-- | Opaque server info.
newtype MatchServerInfo = MatchServerInfo J.Value deriving (J.FromJSON, J.ToJSON)

-- | Match token.
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

-- | Reason of match failure.
data MatchFailureReason
	-- | Failed to make a match in a specified time.
	= MatchFailureReason_timedOut
	-- | Match was made, but no server is available (and use of server is mandatory).
	| MatchFailureReason_noServer
	-- | Matching was explicitly cancelled by user.
	| 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

-- | Session token.
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

-- | Session id.
newtype SessionId = SessionId Base64ByteString deriving (Eq, Hashable, J.FromJSON, J.ToJSON)

-- | Server session token.
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

-- | External session token for exposure to clients and servers.
newtype ExternalSessionId = ExternalSessionId T.Text deriving (Eq, Hashable, J.FromJSON, J.ToJSON)

-- | Match session.
data MatchSession = MatchSession
	{ matchSession_externalSessionId :: !ExternalSessionId
	, 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_externalSessionId :: !ExternalSessionId
	, 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
	, 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

-- | Generic data type for id + object.
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

-- | Implementation for parseJson using base64-serialized string.
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"

-- | Implementation for toJson using base64-serialized string.
base64ToJsonStr :: S.Serialize a => a -> T.Text
base64ToJsonStr = T.decodeUtf8 . BA.convertToBase BA.Base64URLUnpadded . S.encode

-- | Implementation for parseUrlPiece using base64-serialized string.
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

-- | ByteString which serializes to JSON as base64 string.
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

-- | Word64 which serializes to JSON as base64 string.
-- Useful because 64-bit integer is not representable in javascript.
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

-- | Word64 which serializes to JSON as decimal string.
-- Useful because 64-bit integer is not representable in javascript.
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"