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