{-# LANGUAGE TemplateHaskell #-}

-- | Types for the http lib
module Calamity.HTTP.Internal.Types
    ( RestError(..)
    , RateLimitState(..)
    , DiscordResponseType(..)
    , Bucket(..)
    , BucketState(..)
    , GatewayResponse
    , BotGatewayResponse ) where

import Calamity.HTTP.Internal.Route
import           Control.Concurrent.Event      ( Event )
import           Control.Concurrent.STM.TVar   ( TVar )
import Data.Time
import           Data.Aeson
import qualified Data.ByteString.Lazy          as LB
import qualified Data.ByteString          as B
import           Data.Text as T
import qualified StmContainers.Map             as SC
import qualified Data.Aeson as Aeson
import Optics.TH

data RestError
  -- | An error response from discord
  = HTTPError
      { RestError -> Int
status   :: Int
      , RestError -> Maybe Value
response :: Maybe Value
      }
  -- | Something failed while making the request (after retrying a few times)
  | InternalClientError T.Text
  deriving ( Int -> RestError -> ShowS
[RestError] -> ShowS
RestError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestError] -> ShowS
$cshowList :: [RestError] -> ShowS
show :: RestError -> String
$cshow :: RestError -> String
showsPrec :: Int -> RestError -> ShowS
$cshowsPrec :: Int -> RestError -> ShowS
Show)

data BucketState = BucketState
  { BucketState -> Maybe UTCTime
resetTime :: Maybe UTCTime
    -- ^ The time when the bucket resets, used to heuristically wait out ratelimits
  , BucketState -> Int
resetKey  :: Int
    -- ^ The X-Ratelimit-Reset value discord gave us
  , BucketState -> Int
remaining :: Int
    -- ^ The number of uses left in the bucket, used to heuristically wait out ratelimits
  , BucketState -> Int
limit :: Int
    -- ^ The total number of uses for this bucket
  , BucketState -> Int
ongoing :: Int
    -- ^ How many ongoing requests
  }
  deriving ( Int -> BucketState -> ShowS
[BucketState] -> ShowS
BucketState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BucketState] -> ShowS
$cshowList :: [BucketState] -> ShowS
show :: BucketState -> String
$cshow :: BucketState -> String
showsPrec :: Int -> BucketState -> ShowS
$cshowsPrec :: Int -> BucketState -> ShowS
Show )

newtype Bucket = Bucket
  { Bucket -> TVar BucketState
state :: TVar BucketState
  }

data RateLimitState = RateLimitState
  { RateLimitState -> Map RouteKey ByteString
bucketKeys :: SC.Map RouteKey B.ByteString
  , RateLimitState -> Map ByteString Bucket
buckets    :: SC.Map B.ByteString Bucket
  , RateLimitState -> Event
globalLock :: Event
  }

data DiscordResponseType
  = Good
    -- ^ A good response
    LB.ByteString
    (Maybe (BucketState, B.ByteString))
    -- ^ The ratelimit headers if we got them
  | Ratelimited
    -- ^ We hit a 429, no response and ratelimited
    UTCTime
    -- ^ Retry after
    Bool
    -- ^ Global ratelimit
    (Maybe (BucketState, B.ByteString))
  | ServerError Int -- ^ Discord's error, we should retry (HTTP 5XX)
  | ClientError Int LB.ByteString -- ^ Our error, we should fail
  | InternalResponseError T.Text -- ^ Something went wrong with the http client

newtype GatewayResponse = GatewayResponse
  { GatewayResponse -> Text
url :: T.Text
  }
  deriving stock ( Int -> GatewayResponse -> ShowS
[GatewayResponse] -> ShowS
GatewayResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GatewayResponse] -> ShowS
$cshowList :: [GatewayResponse] -> ShowS
show :: GatewayResponse -> String
$cshow :: GatewayResponse -> String
showsPrec :: Int -> GatewayResponse -> ShowS
$cshowsPrec :: Int -> GatewayResponse -> ShowS
Show )

instance Aeson.FromJSON GatewayResponse where
  parseJSON :: Value -> Parser GatewayResponse
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"GatewayResponse" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> GatewayResponse
GatewayResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"

data BotGatewayResponse = BotGatewayResponse
  { BotGatewayResponse -> Text
url    :: T.Text
  , BotGatewayResponse -> Int
shards :: Int
  }
  deriving ( Int -> BotGatewayResponse -> ShowS
[BotGatewayResponse] -> ShowS
BotGatewayResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BotGatewayResponse] -> ShowS
$cshowList :: [BotGatewayResponse] -> ShowS
show :: BotGatewayResponse -> String
$cshow :: BotGatewayResponse -> String
showsPrec :: Int -> BotGatewayResponse -> ShowS
$cshowsPrec :: Int -> BotGatewayResponse -> ShowS
Show )

instance Aeson.FromJSON BotGatewayResponse where
  parseJSON :: Value -> Parser BotGatewayResponse
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"BotGatewayResponse" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> Int -> BotGatewayResponse
BotGatewayResponse
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"shards"

$(makeFieldLabelsNoPrefix ''Bucket)
$(makeFieldLabelsNoPrefix ''BucketState)
$(makeFieldLabelsNoPrefix ''RateLimitState)
$(makeFieldLabelsNoPrefix ''GatewayResponse)
$(makeFieldLabelsNoPrefix ''BotGatewayResponse)