{-# 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" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
R./: Text
"api" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
R./: Text
apiVersion'
  where apiVersion' :: Text
apiVersion' = Text
"v" Text -> Text -> Text
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 =
          ByteString -> ByteString -> Option 'Https
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
R.header ByteString
"Authorization" (Text -> ByteString
TE.encodeUtf8 (Auth -> Text
authToken Auth
auth))
       Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString -> Option 'Https
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 = String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"DiscordBot (https://github.com/discord-haskell/discord-haskell, " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
version String -> String -> String
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 Url scheme -> a -> Url scheme
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 -> b) -> RestIO a -> RestIO b)
-> (forall a b. a -> RestIO b -> RestIO a) -> Functor RestIO
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
$cfmap :: forall a b. (a -> b) -> RestIO a -> RestIO b
fmap :: forall a b. (a -> b) -> RestIO a -> RestIO b
$c<$ :: forall a b. a -> RestIO b -> RestIO a
<$ :: forall a b. a -> RestIO b -> RestIO a
Functor, Functor RestIO
Functor RestIO =>
(forall a. a -> RestIO a)
-> (forall a b. RestIO (a -> b) -> RestIO a -> RestIO b)
-> (forall a b c.
    (a -> b -> c) -> RestIO a -> RestIO b -> RestIO c)
-> (forall a b. RestIO a -> RestIO b -> RestIO b)
-> (forall a b. RestIO a -> RestIO b -> RestIO a)
-> Applicative 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
$cpure :: forall a. a -> RestIO a
pure :: forall a. a -> RestIO a
$c<*> :: forall a b. RestIO (a -> b) -> RestIO a -> RestIO b
<*> :: forall a b. RestIO (a -> b) -> RestIO a -> RestIO b
$cliftA2 :: forall a b c. (a -> b -> c) -> RestIO a -> RestIO b -> RestIO c
liftA2 :: forall a b c. (a -> b -> c) -> RestIO a -> RestIO b -> RestIO c
$c*> :: forall a b. RestIO a -> RestIO b -> RestIO b
*> :: forall a b. RestIO a -> RestIO b -> RestIO b
$c<* :: forall a b. RestIO a -> RestIO b -> RestIO a
<* :: forall a b. RestIO a -> RestIO b -> RestIO a
Applicative, Applicative RestIO
Applicative RestIO =>
(forall a b. RestIO a -> (a -> RestIO b) -> RestIO b)
-> (forall a b. RestIO a -> RestIO b -> RestIO b)
-> (forall a. a -> RestIO a)
-> Monad 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
$c>>= :: forall a b. RestIO a -> (a -> RestIO b) -> RestIO b
>>= :: forall a b. RestIO a -> (a -> RestIO b) -> RestIO b
$c>> :: forall a b. RestIO a -> RestIO b -> RestIO b
>> :: forall a b. RestIO a -> RestIO b -> RestIO b
$creturn :: forall a. a -> RestIO a
return :: forall a. a -> RestIO a
Monad, Monad RestIO
Monad RestIO => (forall a. IO a -> RestIO a) -> MonadIO RestIO
forall a. IO a -> RestIO a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> RestIO a
liftIO :: forall a. IO a -> RestIO a
MonadIO)

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