{-# 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 qualified Data.Text as T
import qualified Data.Text.Encoding as TE

import qualified Network.HTTP.Req as R

import Discord.Internal.Types

-- | 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
"v6"

-- | 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 = ByteString
"DiscordBot (https://github.com/aquarial/discord-haskell, 1.8.6)"

-- Append to an URL
infixl 5 //
(//) :: Show a => R.Url scheme -> a -> R.Url scheme
// :: Url scheme -> a -> Url scheme
(//) Url scheme
url a
part = Url scheme
url Url scheme -> Text -> Url scheme
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
R./: String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
part)


-- | Represtents a HTTP request made to an API that supplies a Json response
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
  majorRoute :: a -> String
  jsonRequest :: a -> JsonRequest

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

instance R.MonadHttp RestIO where
  -- | Throw actual exceptions
  handleHttpException :: HttpException -> RestIO a
handleHttpException = 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. (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 (f :: * -> *) a. Applicative f => a -> f a
pure (HttpConfig -> RestIO HttpConfig)
-> HttpConfig -> RestIO HttpConfig
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
_ -> Maybe HttpExceptionContent
forall a. Maybe a
Nothing }