-- | Generic Request type
module Calamity.HTTP.Internal.Request
    ( Request(..)
    , postWith'
    , postWithP'
    , putWith'
    , patchWith'
    , putEmpty
    , putEmptyP
    , postEmpty
    , postEmptyP
    , getWithP ) where

import           Calamity.Client.Types
import           Calamity.HTTP.Internal.Ratelimit
import           Calamity.HTTP.Internal.Route
import           Calamity.HTTP.Internal.Types
import           Calamity.Internal.Utils
import           Calamity.Metrics.Eff
import           Calamity.Types.Token

import           Control.Lens
import           Control.Monad

import           Data.Aeson                       hiding ( Options )
import           Data.ByteString                  ( ByteString )
import qualified Data.ByteString.Lazy             as LB
import qualified Data.Text.Encoding               as TS
import qualified Data.Text.Lazy                   as TL
import           Data.Text.Strict.Lens

import           DiPolysemy                       hiding ( debug, error, info )

import           Network.Wreq
import           Network.Wreq.Types               ( Patchable, Postable, Putable )

import           Polysemy                         ( Sem )
import qualified Polysemy                         as P
import qualified Polysemy.Error                   as P
import qualified Polysemy.Reader                  as P

import           TextShow

fromResult :: P.Member (P.Error RestError) r => Data.Aeson.Result a -> Sem r a
fromResult :: Result a -> Sem r a
fromResult (Success a :: a
a) = a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
fromResult (Error e :: String
e) = RestError -> Sem r a
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
P.throw (Text -> RestError
DecodeError (Text -> RestError) -> (String -> Text) -> String -> RestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack (String -> RestError) -> String -> RestError
forall a b. (a -> b) -> a -> b
$ String
e)

fromJSONDecode :: P.Member (P.Error RestError) r => Either String a -> Sem r a
fromJSONDecode :: Either String a -> Sem r a
fromJSONDecode (Right a :: a
a) = a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
fromJSONDecode (Left e :: String
e) = RestError -> Sem r a
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
P.throw (Text -> RestError
DecodeError (Text -> RestError) -> (String -> Text) -> String -> RestError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack (String -> RestError) -> String -> RestError
forall a b. (a -> b) -> a -> b
$ String
e)

extractRight :: P.Member (P.Error e) r => Either e a -> Sem r a
extractRight :: Either e a -> Sem r a
extractRight (Left e :: e
e) = e -> Sem r a
forall e (r :: [Effect]) a.
MemberWithError (Error e) r =>
e -> Sem r a
P.throw e
e
extractRight (Right a :: a
a) = a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

class ReadResponse a where
  readResp :: LB.ByteString -> Either String a

instance ReadResponse () where
  readResp :: ByteString -> Either String ()
readResp = Either String () -> ByteString -> Either String ()
forall a b. a -> b -> a
const (() -> Either String ()
forall a b. b -> Either a b
Right ())

instance {-# OVERLAPS #-}FromJSON a => ReadResponse a where
  readResp :: ByteString -> Either String a
readResp = ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode

class Request a where
  type Result a

  route :: a -> Route

  action :: a -> Options -> String -> IO (Response LB.ByteString)

  invoke :: (BotC r, FromJSON (Calamity.HTTP.Internal.Request.Result a)) => a -> Sem r (Either RestError (Calamity.HTTP.Internal.Request.Result a))
  invoke a :: a
a = do
      RateLimitState
rlState' <- (Client -> RateLimitState) -> Sem r RateLimitState
forall i j (r :: [Effect]).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks Client -> RateLimitState
rlState
      Token
token' <- (Client -> Token) -> Sem r Token
forall i j (r :: [Effect]).
Member (Reader i) r =>
(i -> j) -> Sem r j
P.asks Client -> Token
token

      let route' :: Route
route' = a -> Route
forall a. Request a => a -> Route
route a
a

      Gauge
inFlightRequests <- Text -> [(Text, Text)] -> Sem r Gauge
forall (r :: [Effect]).
MemberWithError MetricEff r =>
Text -> [(Text, Text)] -> Sem r Gauge
registerGauge "inflight_requests" [("route", Route
route' Route -> Getting Text Route Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "path" (Getting Text Route Text)
Getting Text Route Text
#path)]
      Counter
totalRequests <- Text -> [(Text, Text)] -> Sem r Counter
forall (r :: [Effect]).
MemberWithError MetricEff r =>
Text -> [(Text, Text)] -> Sem r Counter
registerCounter "total_requests" [("route", Route
route' Route -> Getting Text Route Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "path" (Getting Text Route Text)
Getting Text Route Text
#path)]
      Sem r Double -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Double -> Sem r ()) -> Sem r Double -> Sem r ()
forall a b. (a -> b) -> a -> b
$ (Double -> Double) -> Gauge -> Sem r Double
forall (r :: [Effect]).
MemberWithError MetricEff r =>
(Double -> Double) -> Gauge -> Sem r Double
modifyGauge Double -> Double
forall a. Enum a => a -> a
succ Gauge
inFlightRequests
      Sem r Int -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Int -> Sem r ()) -> Sem r Int -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Int -> Counter -> Sem r Int
forall (r :: [Effect]).
MemberWithError MetricEff r =>
Int -> Counter -> Sem r Int
addCounter 1 Counter
totalRequests

      Maybe (Snowflake Guild)
-> (Snowflake Guild -> Sem r ()) -> Sem r ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Route
route' Route
-> Getting
     (Maybe (Snowflake Guild)) Route (Maybe (Snowflake Guild))
-> Maybe (Snowflake Guild)
forall s a. s -> Getting a s a -> a
^. IsLabel
  "guildID"
  (Getting (Maybe (Snowflake Guild)) Route (Maybe (Snowflake Guild)))
Getting (Maybe (Snowflake Guild)) Route (Maybe (Snowflake Guild))
#guildID) ((Snowflake Guild -> Sem r ()) -> Sem r ())
-> (Snowflake Guild -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \guildID :: Snowflake Guild
guildID -> do
        Counter
totalRequestsGuild <- Text -> [(Text, Text)] -> Sem r Counter
forall (r :: [Effect]).
MemberWithError MetricEff r =>
Text -> [(Text, Text)] -> Sem r Counter
registerCounter "total_requests" [("guild", Snowflake Guild -> Text
forall a. TextShow a => a -> Text
showt Snowflake Guild
guildID)]
        Sem r Int -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Int -> Sem r ()) -> Sem r Int -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Int -> Counter -> Sem r Int
forall (r :: [Effect]).
MemberWithError MetricEff r =>
Int -> Counter -> Sem r Int
addCounter 1 Counter
totalRequestsGuild

      Either RestError ByteString
resp <- Key
-> Text
-> Sem r (Either RestError ByteString)
-> Sem r (Either RestError ByteString)
forall value level msg (r :: [Effect]) a.
(ToValue value, Member (Di level Path msg) r) =>
Key -> value -> Sem r a -> Sem r a
attr "route" (Route
route' Route -> Getting Text Route Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "path" (Getting Text Route Text)
Getting Text Route Text
#path) (Sem r (Either RestError ByteString)
 -> Sem r (Either RestError ByteString))
-> Sem r (Either RestError ByteString)
-> Sem r (Either RestError ByteString)
forall a b. (a -> b) -> a -> b
$ RateLimitState
-> Route
-> IO (Response ByteString)
-> Sem r (Either RestError ByteString)
forall (r :: [Effect]).
BotC r =>
RateLimitState
-> Route
-> IO (Response ByteString)
-> Sem r (Either RestError ByteString)
doRequest RateLimitState
rlState' Route
route'
        (a -> Options -> String -> IO (Response ByteString)
forall a.
Request a =>
a -> Options -> String -> IO (Response ByteString)
action a
a (Token -> Options
requestOptions Token
token') (Route
route' Route -> Getting String Route String -> String
forall s a. s -> Getting a s a -> a
^. IsLabel
  "path" ((Text -> Const String Text) -> Route -> Const String Route)
(Text -> Const String Text) -> Route -> Const String Route
#path ((Text -> Const String Text) -> Route -> Const String Route)
-> ((String -> Const String String) -> Text -> Const String Text)
-> Getting String Route String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String) -> Text -> Const String Text
Iso' Text String
unpacked))

      Sem r Double -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Double -> Sem r ()) -> Sem r Double -> Sem r ()
forall a b. (a -> b) -> a -> b
$ (Double -> Double) -> Gauge -> Sem r Double
forall (r :: [Effect]).
MemberWithError MetricEff r =>
(Double -> Double) -> Gauge -> Sem r Double
modifyGauge Double -> Double
forall a. Enum a => a -> a
pred Gauge
inFlightRequests

      Sem (Error RestError : r) (Result a)
-> Sem r (Either RestError (Result a))
forall e (r :: [Effect]) a.
Sem (Error e : r) a -> Sem r (Either e a)
P.runError (Sem (Error RestError : r) (Result a)
 -> Sem r (Either RestError (Result a)))
-> Sem (Error RestError : r) (Result a)
-> Sem r (Either RestError (Result a))
forall a b. (a -> b) -> a -> b
$ (Result (Result a) -> Sem (Error RestError : r) (Result a)
forall (r :: [Effect]) a.
Member (Error RestError) r =>
Result a -> Sem r a
fromResult (Result (Result a) -> Sem (Error RestError : r) (Result a))
-> (Value -> Result (Result a))
-> Value
-> Sem (Error RestError : r) (Result a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Result (Result a)
forall a. FromJSON a => Value -> Result a
fromJSON) (Value -> Sem (Error RestError : r) (Result a))
-> Sem (Error RestError : r) Value
-> Sem (Error RestError : r) (Result a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Either String Value -> Sem (Error RestError : r) Value
forall (r :: [Effect]) a.
Member (Error RestError) r =>
Either String a -> Sem r a
fromJSONDecode (Either String Value -> Sem (Error RestError : r) Value)
-> (ByteString -> Either String Value)
-> ByteString
-> Sem (Error RestError : r) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Value
forall a. ReadResponse a => ByteString -> Either String a
readResp) (ByteString -> Sem (Error RestError : r) Value)
-> Sem (Error RestError : r) ByteString
-> Sem (Error RestError : r) Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either RestError ByteString -> Sem (Error RestError : r) ByteString
forall e (r :: [Effect]) a.
Member (Error e) r =>
Either e a -> Sem r a
extractRight Either RestError ByteString
resp

defaultRequestOptions :: Options
defaultRequestOptions :: Options
defaultRequestOptions = Options
defaults
  Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header "User-Agent" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ["Calamity (https://github.com/nitros12/calamity)"]
  Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header "X-RateLimit-Precision" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ["millisecond"]
  Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (Maybe ResponseChecker -> Identity (Maybe ResponseChecker))
-> Options -> Identity Options
Lens' Options (Maybe ResponseChecker)
checkResponse ((Maybe ResponseChecker -> Identity (Maybe ResponseChecker))
 -> Options -> Identity Options)
-> ResponseChecker -> Options -> Options
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ (\_ _ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

requestOptions :: Token -> Options
requestOptions :: Token -> Options
requestOptions t :: Token
t = Options
defaultRequestOptions
  Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& HeaderName -> Lens' Options [ByteString]
header "Authorization" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text -> ByteString
TS.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Token -> Text
formatToken Token
t]

postWith' :: Postable a => a -> Options -> String -> IO (Response LB.ByteString)
postWith' :: a -> Options -> String -> IO (Response ByteString)
postWith' p :: a
p o :: Options
o s :: String
s = Options -> String -> a -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
postWith Options
o String
s a
p

postWithP' :: Postable a => a -> (Options -> Options) -> Options -> String -> IO (Response LB.ByteString)
postWithP' :: a
-> (Options -> Options)
-> Options
-> String
-> IO (Response ByteString)
postWithP' p :: a
p oF :: Options -> Options
oF o :: Options
o s :: String
s = Options -> String -> a -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
postWith (Options -> Options
oF Options
o) String
s a
p

postEmpty :: Options -> String -> IO (Response LB.ByteString)
postEmpty :: Options -> String -> IO (Response ByteString)
postEmpty o :: Options
o s :: String
s = Options -> String -> ByteString -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
postWith Options
o String
s ("" :: ByteString)

putWith' :: Putable a => a -> Options -> String -> IO (Response LB.ByteString)
putWith' :: a -> Options -> String -> IO (Response ByteString)
putWith' p :: a
p o :: Options
o s :: String
s = Options -> String -> a -> IO (Response ByteString)
forall a.
Putable a =>
Options -> String -> a -> IO (Response ByteString)
putWith Options
o String
s a
p

patchWith' :: Patchable a => a -> Options -> String -> IO (Response LB.ByteString)
patchWith' :: a -> Options -> String -> IO (Response ByteString)
patchWith' p :: a
p o :: Options
o s :: String
s = Options -> String -> a -> IO (Response ByteString)
forall a.
Patchable a =>
Options -> String -> a -> IO (Response ByteString)
patchWith Options
o String
s a
p

putEmpty :: Options -> String -> IO (Response LB.ByteString)
putEmpty :: Options -> String -> IO (Response ByteString)
putEmpty o :: Options
o s :: String
s = Options -> String -> ByteString -> IO (Response ByteString)
forall a.
Putable a =>
Options -> String -> a -> IO (Response ByteString)
putWith Options
o String
s ("" :: ByteString)

putEmptyP :: (Options -> Options) -> Options -> String -> IO (Response LB.ByteString)
putEmptyP :: (Options -> Options)
-> Options -> String -> IO (Response ByteString)
putEmptyP = (Options -> String -> IO (Response ByteString)
putEmpty (Options -> String -> IO (Response ByteString))
-> (Options -> Options)
-> Options
-> String
-> IO (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

postEmptyP :: (Options -> Options) -> Options -> String -> IO (Response LB.ByteString)
postEmptyP :: (Options -> Options)
-> Options -> String -> IO (Response ByteString)
postEmptyP = (Options -> String -> IO (Response ByteString)
postEmpty (Options -> String -> IO (Response ByteString))
-> (Options -> Options)
-> Options
-> String
-> IO (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

getWithP :: (Options -> Options) -> Options -> String -> IO (Response LB.ByteString)
getWithP :: (Options -> Options)
-> Options -> String -> IO (Response ByteString)
getWithP oF :: Options -> Options
oF o :: Options
o = Options -> String -> IO (Response ByteString)
getWith (Options -> Options
oF Options
o)