module Calamity.HTTP.Internal.Request
( Request(..)
, postWith'
, putWith'
, patchWith'
, putEmpty
, postEmpty
, getWithP ) where
import Calamity.Client.Types
import Calamity.HTTP.Internal.Ratelimit
import Calamity.HTTP.Internal.Route
import Calamity.HTTP.Internal.Types
import Calamity.Types.Token
import Control.Lens
import Data.Aeson hiding ( Options )
import Data.ByteString ( ByteString )
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as TS
import qualified Data.Text.Encoding as TS
import qualified Data.Text.Lazy as TL
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
fromResult :: P.Member (P.Error RestError) r => Result a -> Sem r a
fromResult (Success a) = pure a
fromResult (Error e) = P.throw (DecodeError . TL.pack $ e)
fromJSONDecode :: P.Member (P.Error RestError) r => Either String a -> Sem r a
fromJSONDecode (Right a) = pure a
fromJSONDecode (Left e) = P.throw (DecodeError . TL.pack $ e)
extractRight :: P.Member (P.Error e) r => Either e a -> Sem r a
extractRight (Left e) = P.throw e
extractRight (Right a) = pure a
class ReadResponse a where
readResp :: LB.ByteString -> Either String a
instance ReadResponse () where
readResp = const (Right ())
instance {-# OVERLAPS #-}FromJSON a => ReadResponse a where
readResp = eitherDecode
class Request a r | a -> r where
toRoute :: a -> Route
url :: a -> String
url = TS.unpack . path . toRoute
toAction :: a -> Options -> String -> IO (Response LB.ByteString)
invokeRequest :: forall reffs. (BotC reffs, FromJSON r) => a -> Sem reffs (Either RestError r)
invokeRequest a = do
rlState' <- P.asks rlState
token' <- P.asks token
resp <- attr "route" (toRoute a ^. #path) $ doRequest rlState' (toRoute a)
(toAction a (requestOptions token') (Calamity.HTTP.Internal.Request.url a))
P.runError $ (fromResult . fromJSON) =<< (fromJSONDecode . readResp) =<< extractRight resp
defaultRequestOptions :: Options
defaultRequestOptions = defaults
& header "User-Agent" .~ ["Calamity (https://github.com/nitros12/calamity)"]
& header "X-RateLimit-Precision" .~ ["millisecond"]
& checkResponse ?~ (\_ _ -> pure ())
requestOptions :: Token -> Options
requestOptions t = defaultRequestOptions
& header "Authorization" .~ [TS.encodeUtf8 . TL.toStrict $ formatToken t]
postWith' :: Postable a => a -> Options -> String -> IO (Response LB.ByteString)
postWith' p o s = postWith o s p
postEmpty :: Options -> String -> IO (Response LB.ByteString)
postEmpty o s = postWith o s ("" :: ByteString)
putWith' :: Putable a => a -> Options -> String -> IO (Response LB.ByteString)
putWith' p o s = putWith o s p
patchWith' :: Patchable a => a -> Options -> String -> IO (Response LB.ByteString)
patchWith' p o s = patchWith o s p
putEmpty :: Options -> String -> IO (Response LB.ByteString)
putEmpty o s = putWith o s ("" :: ByteString)
getWithP :: (Options -> Options) -> Options -> String -> IO (Response LB.ByteString)
getWithP oF o = getWith (oF o)