{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}

-- | Utility and base types and functions for the Discord Rest API
module Discord.Internal.Rest.Prelude where

import Prelude hiding (log)
import Control.Exception.Safe (throwIO)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.String (IsString(fromString))
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE

import qualified Network.HTTP.Req as R
import Web.Internal.HttpApiData (ToHttpApiData)

import Discord.Internal.Types

import Paths_discord_haskell (version)
import Data.Version (showVersion)

-- | The api version to use.
apiVersion :: T.Text
apiVersion :: Text
apiVersion = Text
"10"

-- | The base url (Req) for API requests
baseUrl :: R.Url 'R.Https
baseUrl :: Url 'Https
baseUrl = Text -> Url 'Https
R.https Text
"discord.com" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
R./: Text
"api" forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
R./: Text
apiVersion'
  where apiVersion' :: Text
apiVersion' = Text
"v" forall a. Semigroup a => a -> a -> a
<> Text
apiVersion

-- | Discord requires HTTP headers for authentication.
authHeader :: Auth -> R.Option 'R.Https
authHeader :: Auth -> Option 'Https
authHeader Auth
auth =
          forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
R.header ByteString
"Authorization" (Text -> ByteString
TE.encodeUtf8 (Auth -> Text
authToken Auth
auth))
       forall a. Semigroup a => a -> a -> a
<> forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
R.header ByteString
"User-Agent" ByteString
agent
  where
  -- | https://discord.com/developers/docs/reference#user-agent
  -- Second place where the library version is noted
  agent :: ByteString
agent = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"DiscordBot (https://github.com/discord-haskell/discord-haskell, " forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
version forall a. Semigroup a => a -> a -> a
<> String
")"

-- Possibly append to an URL
infixl 5 /?
(/?) :: ToHttpApiData a => R.Url scheme -> Maybe a -> R.Url scheme
/? :: forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> Maybe a -> Url scheme
(/?) Url scheme
url Maybe a
Nothing = Url scheme
url
(/?) Url scheme
url (Just a
part) = Url scheme
url forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
R./~ a
part


-- | A compiled HTTP request ready to execute
data JsonRequest where
  Delete ::                 R.Url 'R.Https ->      R.Option 'R.Https -> JsonRequest
  Get    ::                 R.Url 'R.Https ->      R.Option 'R.Https -> JsonRequest
  Put    :: R.HttpBody a => R.Url 'R.Https -> a -> R.Option 'R.Https -> JsonRequest
  Patch  :: R.HttpBody a => R.Url 'R.Https -> RestIO a -> R.Option 'R.Https -> JsonRequest
  Post   :: R.HttpBody a => R.Url 'R.Https -> RestIO a -> R.Option 'R.Https -> JsonRequest

class Request a where
  -- | used for putting a request into a rate limit bucket
  --   https://discord.com/developers/docs/topics/rate-limits#rate-limits
  majorRoute :: a -> String

  -- | build a JSON http request
  jsonRequest :: a -> JsonRequest

-- | Same Monad as IO. Overwrite Req settings
newtype RestIO a = RestIO { forall a. RestIO a -> IO a
restIOtoIO :: IO a }
  deriving (forall a b. a -> RestIO b -> RestIO a
forall a b. (a -> b) -> RestIO a -> RestIO b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RestIO b -> RestIO a
$c<$ :: forall a b. a -> RestIO b -> RestIO a
fmap :: forall a b. (a -> b) -> RestIO a -> RestIO b
$cfmap :: forall a b. (a -> b) -> RestIO a -> RestIO b
Functor, Functor RestIO
forall a. a -> RestIO a
forall a b. RestIO a -> RestIO b -> RestIO a
forall a b. RestIO a -> RestIO b -> RestIO b
forall a b. RestIO (a -> b) -> RestIO a -> RestIO b
forall a b c. (a -> b -> c) -> RestIO a -> RestIO b -> RestIO c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. RestIO a -> RestIO b -> RestIO a
$c<* :: forall a b. RestIO a -> RestIO b -> RestIO a
*> :: forall a b. RestIO a -> RestIO b -> RestIO b
$c*> :: forall a b. RestIO a -> RestIO b -> RestIO b
liftA2 :: forall a b c. (a -> b -> c) -> RestIO a -> RestIO b -> RestIO c
$cliftA2 :: forall a b c. (a -> b -> c) -> RestIO a -> RestIO b -> RestIO c
<*> :: forall a b. RestIO (a -> b) -> RestIO a -> RestIO b
$c<*> :: forall a b. RestIO (a -> b) -> RestIO a -> RestIO b
pure :: forall a. a -> RestIO a
$cpure :: forall a. a -> RestIO a
Applicative, Applicative RestIO
forall a. a -> RestIO a
forall a b. RestIO a -> RestIO b -> RestIO b
forall a b. RestIO a -> (a -> RestIO b) -> RestIO b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> RestIO a
$creturn :: forall a. a -> RestIO a
>> :: forall a b. RestIO a -> RestIO b -> RestIO b
$c>> :: forall a b. RestIO a -> RestIO b -> RestIO b
>>= :: forall a b. RestIO a -> (a -> RestIO b) -> RestIO b
$c>>= :: forall a b. RestIO a -> (a -> RestIO b) -> RestIO b
Monad, Monad RestIO
forall a. IO a -> RestIO a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> RestIO a
$cliftIO :: forall a. IO a -> RestIO a
MonadIO)

instance R.MonadHttp RestIO where
  -- | Throw actual exceptions
  handleHttpException :: forall a. HttpException -> RestIO a
handleHttpException = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO
  -- | Don't throw exceptions on http error codes like 404
  getHttpConfig :: RestIO HttpConfig
getHttpConfig = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ HttpConfig
R.defaultHttpConfig { httpConfigCheckResponse :: forall b.
Request -> Response b -> ByteString -> Maybe HttpExceptionContent
R.httpConfigCheckResponse = \Request
_ Response b
_ ByteString
_ -> forall a. Maybe a
Nothing }