{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Provides actions for Webhook API interactions
module Discord.Internal.Rest.Webhook
  ( CreateWebhookOpts(..)
  , ExecuteWebhookWithTokenOpts(..)
  , ModifyWebhookOpts(..)
  , WebhookContent(..)
  , WebhookRequest(..)
  ) where

import           Data.Aeson
import qualified Data.Text as T
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import           Network.HTTP.Req ((/:))
import qualified Network.HTTP.Req as R
import Network.HTTP.Client (RequestBody (RequestBodyBS))
import Network.HTTP.Client.MultipartFormData (partBS, partFileRequestBody)

import Discord.Internal.Rest.Prelude
import Discord.Internal.Types

-- aeson introduced type name for json key (text)
-- https://github.com/haskell/aeson/issues/881
# if MIN_VERSION_aeson(2, 0, 0)
import qualified Data.Aeson.Key as Key
toKey :: T.Text -> Key.Key
toKey :: Text -> Key
toKey = Text -> Key
Key.fromText
# else
toKey :: T.Text -> T.Text
toKey = id
# endif

instance Request (WebhookRequest a) where
  majorRoute :: WebhookRequest a -> String
majorRoute = WebhookRequest a -> String
forall a. WebhookRequest a -> String
webhookMajorRoute
  jsonRequest :: WebhookRequest a -> JsonRequest
jsonRequest = WebhookRequest a -> JsonRequest
forall a. WebhookRequest a -> JsonRequest
webhookJsonRequest

-- | Data constructor for requests. See <https://discord.com/developers/docs/resources/ API>
data WebhookRequest a where
  CreateWebhook :: ChannelId -> CreateWebhookOpts -> WebhookRequest Webhook
  GetChannelWebhooks :: ChannelId -> WebhookRequest [Webhook]
  GetGuildWebhooks :: GuildId -> WebhookRequest [Webhook]
  GetWebhook :: WebhookId -> WebhookRequest Webhook
  GetWebhookWithToken :: WebhookId -> T.Text -> WebhookRequest Webhook
  ModifyWebhook :: WebhookId -> ModifyWebhookOpts
                                      -> WebhookRequest Webhook
  ModifyWebhookWithToken :: WebhookId -> T.Text -> ModifyWebhookOpts
                                      -> WebhookRequest Webhook
  DeleteWebhook :: WebhookId -> WebhookRequest ()
  DeleteWebhookWithToken :: WebhookId -> T.Text -> WebhookRequest ()
  ExecuteWebhookWithToken :: WebhookId -> T.Text -> ExecuteWebhookWithTokenOpts
                                       -> WebhookRequest ()

data ModifyWebhookOpts = ModifyWebhookOpts
  { ModifyWebhookOpts -> Maybe Text
modifyWebhookOptsName          :: Maybe T.Text
  , ModifyWebhookOpts -> Maybe Text
modifyWebhookOptsAvatar        :: Maybe T.Text
  , ModifyWebhookOpts -> Maybe ChannelId
modifyWebhookOptsChannelId     :: Maybe ChannelId
  } deriving (Int -> ModifyWebhookOpts -> ShowS
[ModifyWebhookOpts] -> ShowS
ModifyWebhookOpts -> String
(Int -> ModifyWebhookOpts -> ShowS)
-> (ModifyWebhookOpts -> String)
-> ([ModifyWebhookOpts] -> ShowS)
-> Show ModifyWebhookOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyWebhookOpts] -> ShowS
$cshowList :: [ModifyWebhookOpts] -> ShowS
show :: ModifyWebhookOpts -> String
$cshow :: ModifyWebhookOpts -> String
showsPrec :: Int -> ModifyWebhookOpts -> ShowS
$cshowsPrec :: Int -> ModifyWebhookOpts -> ShowS
Show, ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
(ModifyWebhookOpts -> ModifyWebhookOpts -> Bool)
-> (ModifyWebhookOpts -> ModifyWebhookOpts -> Bool)
-> Eq ModifyWebhookOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
$c/= :: ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
== :: ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
$c== :: ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
Eq, Eq ModifyWebhookOpts
Eq ModifyWebhookOpts
-> (ModifyWebhookOpts -> ModifyWebhookOpts -> Ordering)
-> (ModifyWebhookOpts -> ModifyWebhookOpts -> Bool)
-> (ModifyWebhookOpts -> ModifyWebhookOpts -> Bool)
-> (ModifyWebhookOpts -> ModifyWebhookOpts -> Bool)
-> (ModifyWebhookOpts -> ModifyWebhookOpts -> Bool)
-> (ModifyWebhookOpts -> ModifyWebhookOpts -> ModifyWebhookOpts)
-> (ModifyWebhookOpts -> ModifyWebhookOpts -> ModifyWebhookOpts)
-> Ord ModifyWebhookOpts
ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
ModifyWebhookOpts -> ModifyWebhookOpts -> Ordering
ModifyWebhookOpts -> ModifyWebhookOpts -> ModifyWebhookOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModifyWebhookOpts -> ModifyWebhookOpts -> ModifyWebhookOpts
$cmin :: ModifyWebhookOpts -> ModifyWebhookOpts -> ModifyWebhookOpts
max :: ModifyWebhookOpts -> ModifyWebhookOpts -> ModifyWebhookOpts
$cmax :: ModifyWebhookOpts -> ModifyWebhookOpts -> ModifyWebhookOpts
>= :: ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
$c>= :: ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
> :: ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
$c> :: ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
<= :: ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
$c<= :: ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
< :: ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
$c< :: ModifyWebhookOpts -> ModifyWebhookOpts -> Bool
compare :: ModifyWebhookOpts -> ModifyWebhookOpts -> Ordering
$ccompare :: ModifyWebhookOpts -> ModifyWebhookOpts -> Ordering
$cp1Ord :: Eq ModifyWebhookOpts
Ord)

instance ToJSON ModifyWebhookOpts where
  toJSON :: ModifyWebhookOpts -> Value
toJSON ModifyWebhookOpts{Maybe Text
Maybe ChannelId
modifyWebhookOptsChannelId :: Maybe ChannelId
modifyWebhookOptsAvatar :: Maybe Text
modifyWebhookOptsName :: Maybe Text
modifyWebhookOptsChannelId :: ModifyWebhookOpts -> Maybe ChannelId
modifyWebhookOptsAvatar :: ModifyWebhookOpts -> Maybe Text
modifyWebhookOptsName :: ModifyWebhookOpts -> Maybe Text
..} = [Pair] -> Value
object [(Text -> Key
toKey Text
name, Value
val) | (Text
name, Just Value
val) <-
                         [(Text
"channel_id",   ChannelId -> Value
forall a. ToJSON a => a -> Value
toJSON (ChannelId -> Value) -> Maybe ChannelId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChannelId
modifyWebhookOptsChannelId),
                          (Text
"name",   Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
modifyWebhookOptsName),
                          (Text
"avatar",  Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
modifyWebhookOptsAvatar) ] ]

data CreateWebhookOpts = CreateWebhookOpts
  { CreateWebhookOpts -> Text
createWebhookOptsName          :: T.Text
  , CreateWebhookOpts -> Maybe Text
createWebhookOptsAvatar        :: Maybe T.Text
  } deriving (Int -> CreateWebhookOpts -> ShowS
[CreateWebhookOpts] -> ShowS
CreateWebhookOpts -> String
(Int -> CreateWebhookOpts -> ShowS)
-> (CreateWebhookOpts -> String)
-> ([CreateWebhookOpts] -> ShowS)
-> Show CreateWebhookOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWebhookOpts] -> ShowS
$cshowList :: [CreateWebhookOpts] -> ShowS
show :: CreateWebhookOpts -> String
$cshow :: CreateWebhookOpts -> String
showsPrec :: Int -> CreateWebhookOpts -> ShowS
$cshowsPrec :: Int -> CreateWebhookOpts -> ShowS
Show, CreateWebhookOpts -> CreateWebhookOpts -> Bool
(CreateWebhookOpts -> CreateWebhookOpts -> Bool)
-> (CreateWebhookOpts -> CreateWebhookOpts -> Bool)
-> Eq CreateWebhookOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWebhookOpts -> CreateWebhookOpts -> Bool
$c/= :: CreateWebhookOpts -> CreateWebhookOpts -> Bool
== :: CreateWebhookOpts -> CreateWebhookOpts -> Bool
$c== :: CreateWebhookOpts -> CreateWebhookOpts -> Bool
Eq, Eq CreateWebhookOpts
Eq CreateWebhookOpts
-> (CreateWebhookOpts -> CreateWebhookOpts -> Ordering)
-> (CreateWebhookOpts -> CreateWebhookOpts -> Bool)
-> (CreateWebhookOpts -> CreateWebhookOpts -> Bool)
-> (CreateWebhookOpts -> CreateWebhookOpts -> Bool)
-> (CreateWebhookOpts -> CreateWebhookOpts -> Bool)
-> (CreateWebhookOpts -> CreateWebhookOpts -> CreateWebhookOpts)
-> (CreateWebhookOpts -> CreateWebhookOpts -> CreateWebhookOpts)
-> Ord CreateWebhookOpts
CreateWebhookOpts -> CreateWebhookOpts -> Bool
CreateWebhookOpts -> CreateWebhookOpts -> Ordering
CreateWebhookOpts -> CreateWebhookOpts -> CreateWebhookOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CreateWebhookOpts -> CreateWebhookOpts -> CreateWebhookOpts
$cmin :: CreateWebhookOpts -> CreateWebhookOpts -> CreateWebhookOpts
max :: CreateWebhookOpts -> CreateWebhookOpts -> CreateWebhookOpts
$cmax :: CreateWebhookOpts -> CreateWebhookOpts -> CreateWebhookOpts
>= :: CreateWebhookOpts -> CreateWebhookOpts -> Bool
$c>= :: CreateWebhookOpts -> CreateWebhookOpts -> Bool
> :: CreateWebhookOpts -> CreateWebhookOpts -> Bool
$c> :: CreateWebhookOpts -> CreateWebhookOpts -> Bool
<= :: CreateWebhookOpts -> CreateWebhookOpts -> Bool
$c<= :: CreateWebhookOpts -> CreateWebhookOpts -> Bool
< :: CreateWebhookOpts -> CreateWebhookOpts -> Bool
$c< :: CreateWebhookOpts -> CreateWebhookOpts -> Bool
compare :: CreateWebhookOpts -> CreateWebhookOpts -> Ordering
$ccompare :: CreateWebhookOpts -> CreateWebhookOpts -> Ordering
$cp1Ord :: Eq CreateWebhookOpts
Ord)

instance ToJSON CreateWebhookOpts where
  toJSON :: CreateWebhookOpts -> Value
toJSON CreateWebhookOpts{Maybe Text
Text
createWebhookOptsAvatar :: Maybe Text
createWebhookOptsName :: Text
createWebhookOptsAvatar :: CreateWebhookOpts -> Maybe Text
createWebhookOptsName :: CreateWebhookOpts -> Text
..} = [Pair] -> Value
object [(Key
name, Value
val) | (Key
name, Just Value
val) <-
                         [(Key
"name",   Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
createWebhookOptsName),
                          (Key
"avatar",  Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
createWebhookOptsAvatar) ] ]

data ExecuteWebhookWithTokenOpts = ExecuteWebhookWithTokenOpts
  { ExecuteWebhookWithTokenOpts -> Maybe Text
executeWebhookWithTokenOptsUsername      :: Maybe T.Text
  , ExecuteWebhookWithTokenOpts -> WebhookContent
executeWebhookWithTokenOptsContent       :: WebhookContent
  } deriving (Int -> ExecuteWebhookWithTokenOpts -> ShowS
[ExecuteWebhookWithTokenOpts] -> ShowS
ExecuteWebhookWithTokenOpts -> String
(Int -> ExecuteWebhookWithTokenOpts -> ShowS)
-> (ExecuteWebhookWithTokenOpts -> String)
-> ([ExecuteWebhookWithTokenOpts] -> ShowS)
-> Show ExecuteWebhookWithTokenOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecuteWebhookWithTokenOpts] -> ShowS
$cshowList :: [ExecuteWebhookWithTokenOpts] -> ShowS
show :: ExecuteWebhookWithTokenOpts -> String
$cshow :: ExecuteWebhookWithTokenOpts -> String
showsPrec :: Int -> ExecuteWebhookWithTokenOpts -> ShowS
$cshowsPrec :: Int -> ExecuteWebhookWithTokenOpts -> ShowS
Show, ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
(ExecuteWebhookWithTokenOpts
 -> ExecuteWebhookWithTokenOpts -> Bool)
-> (ExecuteWebhookWithTokenOpts
    -> ExecuteWebhookWithTokenOpts -> Bool)
-> Eq ExecuteWebhookWithTokenOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
$c/= :: ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
== :: ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
$c== :: ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
Eq, Eq ExecuteWebhookWithTokenOpts
Eq ExecuteWebhookWithTokenOpts
-> (ExecuteWebhookWithTokenOpts
    -> ExecuteWebhookWithTokenOpts -> Ordering)
-> (ExecuteWebhookWithTokenOpts
    -> ExecuteWebhookWithTokenOpts -> Bool)
-> (ExecuteWebhookWithTokenOpts
    -> ExecuteWebhookWithTokenOpts -> Bool)
-> (ExecuteWebhookWithTokenOpts
    -> ExecuteWebhookWithTokenOpts -> Bool)
-> (ExecuteWebhookWithTokenOpts
    -> ExecuteWebhookWithTokenOpts -> Bool)
-> (ExecuteWebhookWithTokenOpts
    -> ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts)
-> (ExecuteWebhookWithTokenOpts
    -> ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts)
-> Ord ExecuteWebhookWithTokenOpts
ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
ExecuteWebhookWithTokenOpts
-> ExecuteWebhookWithTokenOpts -> Ordering
ExecuteWebhookWithTokenOpts
-> ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExecuteWebhookWithTokenOpts
-> ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts
$cmin :: ExecuteWebhookWithTokenOpts
-> ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts
max :: ExecuteWebhookWithTokenOpts
-> ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts
$cmax :: ExecuteWebhookWithTokenOpts
-> ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts
>= :: ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
$c>= :: ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
> :: ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
$c> :: ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
<= :: ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
$c<= :: ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
< :: ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
$c< :: ExecuteWebhookWithTokenOpts -> ExecuteWebhookWithTokenOpts -> Bool
compare :: ExecuteWebhookWithTokenOpts
-> ExecuteWebhookWithTokenOpts -> Ordering
$ccompare :: ExecuteWebhookWithTokenOpts
-> ExecuteWebhookWithTokenOpts -> Ordering
$cp1Ord :: Eq ExecuteWebhookWithTokenOpts
Ord)

data WebhookContent = WebhookContentText T.Text
                    | WebhookContentFile T.Text B.ByteString
                    | WebhookContentEmbeds [CreateEmbed]
  deriving (Int -> WebhookContent -> ShowS
[WebhookContent] -> ShowS
WebhookContent -> String
(Int -> WebhookContent -> ShowS)
-> (WebhookContent -> String)
-> ([WebhookContent] -> ShowS)
-> Show WebhookContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebhookContent] -> ShowS
$cshowList :: [WebhookContent] -> ShowS
show :: WebhookContent -> String
$cshow :: WebhookContent -> String
showsPrec :: Int -> WebhookContent -> ShowS
$cshowsPrec :: Int -> WebhookContent -> ShowS
Show, WebhookContent -> WebhookContent -> Bool
(WebhookContent -> WebhookContent -> Bool)
-> (WebhookContent -> WebhookContent -> Bool) -> Eq WebhookContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebhookContent -> WebhookContent -> Bool
$c/= :: WebhookContent -> WebhookContent -> Bool
== :: WebhookContent -> WebhookContent -> Bool
$c== :: WebhookContent -> WebhookContent -> Bool
Eq, Eq WebhookContent
Eq WebhookContent
-> (WebhookContent -> WebhookContent -> Ordering)
-> (WebhookContent -> WebhookContent -> Bool)
-> (WebhookContent -> WebhookContent -> Bool)
-> (WebhookContent -> WebhookContent -> Bool)
-> (WebhookContent -> WebhookContent -> Bool)
-> (WebhookContent -> WebhookContent -> WebhookContent)
-> (WebhookContent -> WebhookContent -> WebhookContent)
-> Ord WebhookContent
WebhookContent -> WebhookContent -> Bool
WebhookContent -> WebhookContent -> Ordering
WebhookContent -> WebhookContent -> WebhookContent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WebhookContent -> WebhookContent -> WebhookContent
$cmin :: WebhookContent -> WebhookContent -> WebhookContent
max :: WebhookContent -> WebhookContent -> WebhookContent
$cmax :: WebhookContent -> WebhookContent -> WebhookContent
>= :: WebhookContent -> WebhookContent -> Bool
$c>= :: WebhookContent -> WebhookContent -> Bool
> :: WebhookContent -> WebhookContent -> Bool
$c> :: WebhookContent -> WebhookContent -> Bool
<= :: WebhookContent -> WebhookContent -> Bool
$c<= :: WebhookContent -> WebhookContent -> Bool
< :: WebhookContent -> WebhookContent -> Bool
$c< :: WebhookContent -> WebhookContent -> Bool
compare :: WebhookContent -> WebhookContent -> Ordering
$ccompare :: WebhookContent -> WebhookContent -> Ordering
$cp1Ord :: Eq WebhookContent
Ord)

webhookContentJson :: WebhookContent -> [(T.Text, Maybe Value)]
webhookContentJson :: WebhookContent -> [(Text, Maybe Value)]
webhookContentJson WebhookContent
c = case WebhookContent
c of
                      WebhookContentText Text
t -> [(Text
"content", Value -> Maybe Value
forall a. a -> Maybe a
Just (Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t))]
                      WebhookContentFile Text
_ ByteString
_  -> []
                      WebhookContentEmbeds [CreateEmbed]
e -> [(Text
"embeds", Value -> Maybe Value
forall a. a -> Maybe a
Just ([Embed] -> Value
forall a. ToJSON a => a -> Value
toJSON (CreateEmbed -> Embed
createEmbed (CreateEmbed -> Embed) -> [CreateEmbed] -> [Embed]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CreateEmbed]
e)))]

instance ToJSON ExecuteWebhookWithTokenOpts where
  toJSON :: ExecuteWebhookWithTokenOpts -> Value
toJSON ExecuteWebhookWithTokenOpts{Maybe Text
WebhookContent
executeWebhookWithTokenOptsContent :: WebhookContent
executeWebhookWithTokenOptsUsername :: Maybe Text
executeWebhookWithTokenOptsContent :: ExecuteWebhookWithTokenOpts -> WebhookContent
executeWebhookWithTokenOptsUsername :: ExecuteWebhookWithTokenOpts -> Maybe Text
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [(Text -> Key
toKey Text
name, Value
val) | (Text
name, Just Value
val) <-
                         [(Text
"username",   Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
executeWebhookWithTokenOptsUsername)]
                           [(Text, Maybe Value)]
-> [(Text, Maybe Value)] -> [(Text, Maybe Value)]
forall a. Semigroup a => a -> a -> a
<> WebhookContent -> [(Text, Maybe Value)]
webhookContentJson WebhookContent
executeWebhookWithTokenOptsContent
                         ]

webhookMajorRoute :: WebhookRequest a -> String
webhookMajorRoute :: WebhookRequest a -> String
webhookMajorRoute WebhookRequest a
ch = case WebhookRequest a
ch of
  (CreateWebhook ChannelId
c CreateWebhookOpts
_) ->            String
"aaaaaahook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
c
  (GetChannelWebhooks ChannelId
c) ->         String
"aaaaaahook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
c
  (GetGuildWebhooks ChannelId
g) ->           String
"aaaaaahook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
g
  (GetWebhook ChannelId
w) ->                 String
"aaaaaahook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
w
  (GetWebhookWithToken ChannelId
w Text
_) ->      String
"getwebhook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
w
  (ModifyWebhook ChannelId
w ModifyWebhookOpts
_) ->            String
"modifyhook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
w
  (ModifyWebhookWithToken ChannelId
w Text
_ ModifyWebhookOpts
_) -> String
"modifyhook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
w
  (DeleteWebhook ChannelId
w) ->              String
"deletehook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
w
  (DeleteWebhookWithToken ChannelId
w Text
_) ->   String
"deletehook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
w
  (ExecuteWebhookWithToken ChannelId
w Text
_ ExecuteWebhookWithTokenOpts
_) -> String
"executehk " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
w

webhookJsonRequest :: WebhookRequest r -> JsonRequest
webhookJsonRequest :: WebhookRequest r -> JsonRequest
webhookJsonRequest WebhookRequest r
ch = case WebhookRequest r
ch of
  (CreateWebhook ChannelId
channel CreateWebhookOpts
patch) ->
    let body :: RestIO (ReqBodyJson CreateWebhookOpts)
body = ReqBodyJson CreateWebhookOpts
-> RestIO (ReqBodyJson CreateWebhookOpts)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CreateWebhookOpts -> ReqBodyJson CreateWebhookOpts
forall a. a -> ReqBodyJson a
R.ReqBodyJson CreateWebhookOpts
patch)
    in Url 'Https
-> RestIO (ReqBodyJson CreateWebhookOpts)
-> Option 'Https
-> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"channels" Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// ChannelId
channel Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"webhooks") RestIO (ReqBodyJson CreateWebhookOpts)
body  Option 'Https
forall a. Monoid a => a
mempty

  (GetChannelWebhooks ChannelId
c) ->
    Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"channels" Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// ChannelId
c Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"webhooks")  Option 'Https
forall a. Monoid a => a
mempty

  (GetGuildWebhooks ChannelId
g) ->
    Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds" Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// ChannelId
g Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"webhooks")  Option 'Https
forall a. Monoid a => a
mempty

  (GetWebhook ChannelId
w) ->
    Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"webhooks" Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// ChannelId
w)  Option 'Https
forall a. Monoid a => a
mempty

  (GetWebhookWithToken ChannelId
w Text
t) ->
    Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"webhooks" Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// ChannelId
w Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
t)  Option 'Https
forall a. Monoid a => a
mempty

  (ModifyWebhook ChannelId
w ModifyWebhookOpts
patch) ->
    Url 'Https
-> RestIO (ReqBodyJson ModifyWebhookOpts)
-> Option 'Https
-> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"webhooks" Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// ChannelId
w) (ReqBodyJson ModifyWebhookOpts
-> RestIO (ReqBodyJson ModifyWebhookOpts)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModifyWebhookOpts -> ReqBodyJson ModifyWebhookOpts
forall a. a -> ReqBodyJson a
R.ReqBodyJson ModifyWebhookOpts
patch))  Option 'Https
forall a. Monoid a => a
mempty

  (ModifyWebhookWithToken ChannelId
w Text
t ModifyWebhookOpts
p) ->
    Url 'Https
-> RestIO (ReqBodyJson ModifyWebhookOpts)
-> Option 'Https
-> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"webhooks" Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// ChannelId
w Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
t) (ReqBodyJson ModifyWebhookOpts
-> RestIO (ReqBodyJson ModifyWebhookOpts)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModifyWebhookOpts -> ReqBodyJson ModifyWebhookOpts
forall a. a -> ReqBodyJson a
R.ReqBodyJson ModifyWebhookOpts
p))  Option 'Https
forall a. Monoid a => a
mempty

  (DeleteWebhook ChannelId
w) ->
    Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"webhooks" Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// ChannelId
w)  Option 'Https
forall a. Monoid a => a
mempty

  (DeleteWebhookWithToken ChannelId
w Text
t) ->
    Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"webhooks" Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// ChannelId
w Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
t)  Option 'Https
forall a. Monoid a => a
mempty

  (ExecuteWebhookWithToken ChannelId
w Text
tok ExecuteWebhookWithTokenOpts
o) ->
    case ExecuteWebhookWithTokenOpts -> WebhookContent
executeWebhookWithTokenOptsContent ExecuteWebhookWithTokenOpts
o of
      WebhookContentFile Text
name ByteString
text  ->
        let part :: PartM IO
part = Text -> String -> RequestBody -> PartM IO
forall (m :: * -> *).
Applicative m =>
Text -> String -> RequestBody -> PartM m
partFileRequestBody Text
"file" (Text -> String
T.unpack Text
name) (ByteString -> RequestBody
RequestBodyBS ByteString
text)
            body :: RestIO ReqBodyMultipart
body = [PartM IO] -> RestIO ReqBodyMultipart
forall (m :: * -> *). MonadIO m => [PartM IO] -> m ReqBodyMultipart
R.reqBodyMultipart [PartM IO
part]
        in Url 'Https
-> RestIO ReqBodyMultipart -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"webhooks" Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// ChannelId
w Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
tok) RestIO ReqBodyMultipart
body Option 'Https
forall a. Monoid a => a
mempty
      WebhookContentText Text
_ ->
        let body :: RestIO (ReqBodyJson ExecuteWebhookWithTokenOpts)
body = ReqBodyJson ExecuteWebhookWithTokenOpts
-> RestIO (ReqBodyJson ExecuteWebhookWithTokenOpts)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecuteWebhookWithTokenOpts
-> ReqBodyJson ExecuteWebhookWithTokenOpts
forall a. a -> ReqBodyJson a
R.ReqBodyJson ExecuteWebhookWithTokenOpts
o)
        in Url 'Https
-> RestIO (ReqBodyJson ExecuteWebhookWithTokenOpts)
-> Option 'Https
-> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"webhooks" Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// ChannelId
w Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
tok) RestIO (ReqBodyJson ExecuteWebhookWithTokenOpts)
body Option 'Https
forall a. Monoid a => a
mempty
      WebhookContentEmbeds [CreateEmbed]
embeds ->
        let mkPart :: (Text, ByteString) -> PartM m
mkPart (Text
name,ByteString
content) = Text -> String -> RequestBody -> PartM m
forall (m :: * -> *).
Applicative m =>
Text -> String -> RequestBody -> PartM m
partFileRequestBody Text
name (Text -> String
T.unpack Text
name) (ByteString -> RequestBody
RequestBodyBS ByteString
content)
            uploads :: CreateEmbed -> [(a, ByteString)]
uploads CreateEmbed{[EmbedField]
Maybe ColorInteger
Maybe CreateEmbedImage
Text
createEmbedColor :: CreateEmbed -> Maybe ColorInteger
createEmbedFooterIcon :: CreateEmbed -> Maybe CreateEmbedImage
createEmbedFooterText :: CreateEmbed -> Text
createEmbedImage :: CreateEmbed -> Maybe CreateEmbedImage
createEmbedFields :: CreateEmbed -> [EmbedField]
createEmbedDescription :: CreateEmbed -> Text
createEmbedThumbnail :: CreateEmbed -> Maybe CreateEmbedImage
createEmbedUrl :: CreateEmbed -> Text
createEmbedTitle :: CreateEmbed -> Text
createEmbedAuthorIcon :: CreateEmbed -> Maybe CreateEmbedImage
createEmbedAuthorUrl :: CreateEmbed -> Text
createEmbedAuthorName :: CreateEmbed -> Text
createEmbedColor :: Maybe ColorInteger
createEmbedFooterIcon :: Maybe CreateEmbedImage
createEmbedFooterText :: Text
createEmbedImage :: Maybe CreateEmbedImage
createEmbedFields :: [EmbedField]
createEmbedDescription :: Text
createEmbedThumbnail :: Maybe CreateEmbedImage
createEmbedUrl :: Text
createEmbedTitle :: Text
createEmbedAuthorIcon :: Maybe CreateEmbedImage
createEmbedAuthorUrl :: Text
createEmbedAuthorName :: Text
..} = [(a
n,ByteString
c) | (a
n, Just (CreateEmbedImageUpload ByteString
c)) <-
                                          [ (a
"author.png", Maybe CreateEmbedImage
createEmbedAuthorIcon)
                                          , (a
"thumbnail.png", Maybe CreateEmbedImage
createEmbedThumbnail)
                                          , (a
"image.png", Maybe CreateEmbedImage
createEmbedImage)
                                          , (a
"footer.png", Maybe CreateEmbedImage
createEmbedFooterIcon) ]]
            parts :: [PartM IO]
parts =  ((Text, ByteString) -> PartM IO)
-> [(Text, ByteString)] -> [PartM IO]
forall a b. (a -> b) -> [a] -> [b]
map (Text, ByteString) -> PartM IO
forall (m :: * -> *).
Applicative m =>
(Text, ByteString) -> PartM m
mkPart ((CreateEmbed -> [(Text, ByteString)])
-> [CreateEmbed] -> [(Text, ByteString)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap CreateEmbed -> [(Text, ByteString)]
forall a. IsString a => CreateEmbed -> [(a, ByteString)]
uploads [CreateEmbed]
embeds)
            partsJson :: [PartM IO]
partsJson = [Text -> ByteString -> PartM IO
forall (m :: * -> *).
Applicative m =>
Text -> ByteString -> PartM m
partBS Text
"payload_json" (ByteString -> PartM IO) -> ByteString -> PartM IO
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"embed" Key -> Embed -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CreateEmbed -> Embed
createEmbed CreateEmbed
e] | CreateEmbed
e <- [CreateEmbed]
embeds]
            body :: RestIO ReqBodyMultipart
body = [PartM IO] -> RestIO ReqBodyMultipart
forall (m :: * -> *). MonadIO m => [PartM IO] -> m ReqBodyMultipart
R.reqBodyMultipart ([PartM IO]
partsJson [PartM IO] -> [PartM IO] -> [PartM IO]
forall a. [a] -> [a] -> [a]
++ [PartM IO]
parts)
        in Url 'Https
-> RestIO ReqBodyMultipart -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"webhooks" Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// ChannelId
w Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
tok) RestIO ReqBodyMultipart
body Option 'Https
forall a. Monoid a => a
mempty