-----------------------------------------------------------------------------
-- |
-- License     :  BSD-3-Clause
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
module GitHub.Data.RateLimit where

import GitHub.Internal.Prelude
import Prelude ()

import Data.Time.Clock.System.Compat (SystemTime (..))

import qualified Data.ByteString.Char8 as BS8
import qualified Network.HTTP.Client as HTTP

data Limits = Limits
    { Limits -> Int
limitsMax       :: !Int
    , Limits -> Int
limitsRemaining :: !Int
    , Limits -> SystemTime
limitsReset     :: !SystemTime
    }
  deriving (Int -> Limits -> ShowS
[Limits] -> ShowS
Limits -> String
(Int -> Limits -> ShowS)
-> (Limits -> String) -> ([Limits] -> ShowS) -> Show Limits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limits] -> ShowS
$cshowList :: [Limits] -> ShowS
show :: Limits -> String
$cshow :: Limits -> String
showsPrec :: Int -> Limits -> ShowS
$cshowsPrec :: Int -> Limits -> ShowS
Show, {- Data, -} Typeable, Limits -> Limits -> Bool
(Limits -> Limits -> Bool)
-> (Limits -> Limits -> Bool) -> Eq Limits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Limits -> Limits -> Bool
$c/= :: Limits -> Limits -> Bool
== :: Limits -> Limits -> Bool
$c== :: Limits -> Limits -> Bool
Eq, Eq Limits
Eq Limits
-> (Limits -> Limits -> Ordering)
-> (Limits -> Limits -> Bool)
-> (Limits -> Limits -> Bool)
-> (Limits -> Limits -> Bool)
-> (Limits -> Limits -> Bool)
-> (Limits -> Limits -> Limits)
-> (Limits -> Limits -> Limits)
-> Ord Limits
Limits -> Limits -> Bool
Limits -> Limits -> Ordering
Limits -> Limits -> Limits
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Limits -> Limits -> Limits
$cmin :: Limits -> Limits -> Limits
max :: Limits -> Limits -> Limits
$cmax :: Limits -> Limits -> Limits
>= :: Limits -> Limits -> Bool
$c>= :: Limits -> Limits -> Bool
> :: Limits -> Limits -> Bool
$c> :: Limits -> Limits -> Bool
<= :: Limits -> Limits -> Bool
$c<= :: Limits -> Limits -> Bool
< :: Limits -> Limits -> Bool
$c< :: Limits -> Limits -> Bool
compare :: Limits -> Limits -> Ordering
$ccompare :: Limits -> Limits -> Ordering
$cp1Ord :: Eq Limits
Ord, (forall x. Limits -> Rep Limits x)
-> (forall x. Rep Limits x -> Limits) -> Generic Limits
forall x. Rep Limits x -> Limits
forall x. Limits -> Rep Limits x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Limits x -> Limits
$cfrom :: forall x. Limits -> Rep Limits x
Generic)

instance NFData Limits where rnf :: Limits -> ()
rnf = Limits -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary Limits

instance FromJSON Limits where
    parseJSON :: Value -> Parser Limits
parseJSON = String -> (Object -> Parser Limits) -> Value -> Parser Limits
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Limits" ((Object -> Parser Limits) -> Value -> Parser Limits)
-> (Object -> Parser Limits) -> Value -> Parser Limits
forall a b. (a -> b) -> a -> b
$ \Object
obj -> Int -> Int -> SystemTime -> Limits
Limits
        (Int -> Int -> SystemTime -> Limits)
-> Parser Int -> Parser (Int -> SystemTime -> Limits)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"limit"
        Parser (Int -> SystemTime -> Limits)
-> Parser Int -> Parser (SystemTime -> Limits)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"remaining"
        Parser (SystemTime -> Limits) -> Parser SystemTime -> Parser Limits
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int64 -> SystemTime) -> Parser Int64 -> Parser SystemTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int64
t -> Int64 -> Word32 -> SystemTime
MkSystemTime Int64
t Word32
0) (Object
obj Object -> Key -> Parser Int64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reset")

data RateLimit = RateLimit
    { RateLimit -> Limits
rateLimitCore    :: Limits
    , RateLimit -> Limits
rateLimitSearch  :: Limits
    , RateLimit -> Limits
rateLimitGraphQL :: Limits
    }
  deriving (Int -> RateLimit -> ShowS
[RateLimit] -> ShowS
RateLimit -> String
(Int -> RateLimit -> ShowS)
-> (RateLimit -> String)
-> ([RateLimit] -> ShowS)
-> Show RateLimit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RateLimit] -> ShowS
$cshowList :: [RateLimit] -> ShowS
show :: RateLimit -> String
$cshow :: RateLimit -> String
showsPrec :: Int -> RateLimit -> ShowS
$cshowsPrec :: Int -> RateLimit -> ShowS
Show, {- Data, -} Typeable, RateLimit -> RateLimit -> Bool
(RateLimit -> RateLimit -> Bool)
-> (RateLimit -> RateLimit -> Bool) -> Eq RateLimit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RateLimit -> RateLimit -> Bool
$c/= :: RateLimit -> RateLimit -> Bool
== :: RateLimit -> RateLimit -> Bool
$c== :: RateLimit -> RateLimit -> Bool
Eq, Eq RateLimit
Eq RateLimit
-> (RateLimit -> RateLimit -> Ordering)
-> (RateLimit -> RateLimit -> Bool)
-> (RateLimit -> RateLimit -> Bool)
-> (RateLimit -> RateLimit -> Bool)
-> (RateLimit -> RateLimit -> Bool)
-> (RateLimit -> RateLimit -> RateLimit)
-> (RateLimit -> RateLimit -> RateLimit)
-> Ord RateLimit
RateLimit -> RateLimit -> Bool
RateLimit -> RateLimit -> Ordering
RateLimit -> RateLimit -> RateLimit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RateLimit -> RateLimit -> RateLimit
$cmin :: RateLimit -> RateLimit -> RateLimit
max :: RateLimit -> RateLimit -> RateLimit
$cmax :: RateLimit -> RateLimit -> RateLimit
>= :: RateLimit -> RateLimit -> Bool
$c>= :: RateLimit -> RateLimit -> Bool
> :: RateLimit -> RateLimit -> Bool
$c> :: RateLimit -> RateLimit -> Bool
<= :: RateLimit -> RateLimit -> Bool
$c<= :: RateLimit -> RateLimit -> Bool
< :: RateLimit -> RateLimit -> Bool
$c< :: RateLimit -> RateLimit -> Bool
compare :: RateLimit -> RateLimit -> Ordering
$ccompare :: RateLimit -> RateLimit -> Ordering
$cp1Ord :: Eq RateLimit
Ord, (forall x. RateLimit -> Rep RateLimit x)
-> (forall x. Rep RateLimit x -> RateLimit) -> Generic RateLimit
forall x. Rep RateLimit x -> RateLimit
forall x. RateLimit -> Rep RateLimit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RateLimit x -> RateLimit
$cfrom :: forall x. RateLimit -> Rep RateLimit x
Generic)

instance NFData RateLimit where rnf :: RateLimit -> ()
rnf = RateLimit -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary RateLimit

instance FromJSON RateLimit where
    parseJSON :: Value -> Parser RateLimit
parseJSON = String -> (Object -> Parser RateLimit) -> Value -> Parser RateLimit
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RateLimit" ((Object -> Parser RateLimit) -> Value -> Parser RateLimit)
-> (Object -> Parser RateLimit) -> Value -> Parser RateLimit
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        Object
resources <- Object
obj Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"resources"
        Limits -> Limits -> Limits -> RateLimit
RateLimit
            (Limits -> Limits -> Limits -> RateLimit)
-> Parser Limits -> Parser (Limits -> Limits -> RateLimit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
resources Object -> Key -> Parser Limits
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"core"
            Parser (Limits -> Limits -> RateLimit)
-> Parser Limits -> Parser (Limits -> RateLimit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
resources Object -> Key -> Parser Limits
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"search"
            Parser (Limits -> RateLimit) -> Parser Limits -> Parser RateLimit
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
resources Object -> Key -> Parser Limits
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"graphql"

-------------------------------------------------------------------------------
-- Extras
-------------------------------------------------------------------------------

-- | @since 0.24
limitsFromHttpResponse :: HTTP.Response a -> Maybe Limits
limitsFromHttpResponse :: Response a -> Maybe Limits
limitsFromHttpResponse Response a
res = do
    let hdrs :: ResponseHeaders
hdrs = Response a -> ResponseHeaders
forall body. Response body -> ResponseHeaders
HTTP.responseHeaders Response a
res
    Int
m <- HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-RateLimit-Limit"     ResponseHeaders
hdrs Maybe ByteString -> (ByteString -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Int
forall a. Num a => ByteString -> Maybe a
readIntegral
    Int
r <- HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-RateLimit-Remaining" ResponseHeaders
hdrs Maybe ByteString -> (ByteString -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Int
forall a. Num a => ByteString -> Maybe a
readIntegral
    Int64
t <- HeaderName -> ResponseHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"X-RateLimit-Reset"     ResponseHeaders
hdrs Maybe ByteString -> (ByteString -> Maybe Int64) -> Maybe Int64
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Int64
forall a. Num a => ByteString -> Maybe a
readIntegral
    Limits -> Maybe Limits
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> SystemTime -> Limits
Limits Int
m Int
r (Int64 -> Word32 -> SystemTime
MkSystemTime Int64
t Word32
0))
  where
    readIntegral :: Num a => BS8.ByteString -> Maybe a
    readIntegral :: ByteString -> Maybe a
readIntegral ByteString
bs = case ByteString -> Maybe (Int, ByteString)
BS8.readInt ByteString
bs of
        Just (Int
n, ByteString
bs') | ByteString -> Bool
BS8.null ByteString
bs' -> a -> Maybe a
forall a. a -> Maybe a
Just (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
        Maybe (Int, ByteString)
_                            -> Maybe a
forall a. Maybe a
Nothing