{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# 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

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 constructors for webhook requests.
data WebhookRequest a where
  -- | Creates a new webhook and returns a webhook object on success. Requires the @MANAGE_WEBHOOKS@ permission.
  -- An error will be returned if a webhook name (name) is not valid. A webhook name is valid if:
  --
  -- * It does not contain the substring @clyde@ (case-insensitive)
  -- * It follows the nickname guidelines in the Usernames and Nicknames documentation,
  --   with an exception that webhook names can be up to 80 characters
  CreateWebhook :: ChannelId
                -> CreateWebhookOpts
                -> WebhookRequest Webhook
  -- | Returns a channel's `Webhook`s as a list. Requires the @MANAGE_WEBHOOKS@ permission.
  GetChannelWebhooks :: ChannelId
                     -> WebhookRequest [Webhook]
  -- | Returns a guild's `Webhook`s as a list. Requires the @MANAGE_WEBHOOKS@ permission.
  GetGuildWebhooks :: GuildId
                   -> WebhookRequest [Webhook]
  -- | Returns the `Webhook` for the given id. If a token is given, authentication is not required.
  GetWebhook :: WebhookId
             -> Maybe WebhookToken
             -> WebhookRequest Webhook
  -- | Modify a webhook. Requires the @MANAGE_WEBHOOKS@ permission. Returns the updated `Webhook` on success.
  -- If a token is given, authentication is not required.
  ModifyWebhook :: WebhookId
                -> Maybe WebhookToken
                -> ModifyWebhookOpts
                -> WebhookRequest Webhook
  -- | Delete a webhook permanently. Requires the @MANAGE_WEBHOOKS@ permission.
  -- If a token is given, authentication is not required.
  DeleteWebhook :: WebhookId
                -> Maybe WebhookToken
                -> WebhookRequest ()
  -- | Executes a Webhook.
  -- 
  -- Refer to [Uploading Files](https://discord.com/developers/docs/reference#uploading-files)
  -- for details on attachments and @multipart/form-data@ requests.
  ExecuteWebhook :: WebhookId
                 -> WebhookToken
                 -> ExecuteWebhookWithTokenOpts
                 -> WebhookRequest ()
  -- We don't support slack and github compatible webhooks because you should
  --  just use execute webhook.

  -- | Returns a previously-sent webhook message from the same token.
  GetWebhookMessage :: WebhookId
                    -> WebhookToken
                    -> MessageId
                    -> WebhookRequest Message
  -- | Edits a previously-sent webhook message from the same token.
  EditWebhookMessage :: WebhookId
                     -> WebhookToken
                     -> MessageId
                     -> T.Text -- currently we don't support the full range of edits - feel free to PR and fix this
                     -> WebhookRequest Message
  -- | Deletes a previously-sent webhook message from the same token.
  DeleteWebhookMessage :: WebhookId
                       -> WebhookToken
                       -> MessageId
                       -> WebhookRequest ()

-- | Options for `ModifyWebhook` and `ModifyWebhookWithToken`
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, ReadPrec [ModifyWebhookOpts]
ReadPrec ModifyWebhookOpts
Int -> ReadS ModifyWebhookOpts
ReadS [ModifyWebhookOpts]
(Int -> ReadS ModifyWebhookOpts)
-> ReadS [ModifyWebhookOpts]
-> ReadPrec ModifyWebhookOpts
-> ReadPrec [ModifyWebhookOpts]
-> Read ModifyWebhookOpts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyWebhookOpts]
$creadListPrec :: ReadPrec [ModifyWebhookOpts]
readPrec :: ReadPrec ModifyWebhookOpts
$creadPrec :: ReadPrec ModifyWebhookOpts
readList :: ReadS [ModifyWebhookOpts]
$creadList :: ReadS [ModifyWebhookOpts]
readsPrec :: Int -> ReadS ModifyWebhookOpts
$creadsPrec :: Int -> ReadS ModifyWebhookOpts
Read, 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
..} = [Maybe Pair] -> Value
objectFromMaybes
                         [AesonKey
"channel_id" AesonKey -> Maybe ChannelId -> Maybe Pair
forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe ChannelId
modifyWebhookOptsChannelId,
                          AesonKey
"name" AesonKey -> Maybe Text -> Maybe Pair
forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Text
modifyWebhookOptsName,
                          AesonKey
"avatar" AesonKey -> Maybe Text -> Maybe Pair
forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Text
modifyWebhookOptsAvatar ]

-- | Options for `CreateWebhook`
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, ReadPrec [CreateWebhookOpts]
ReadPrec CreateWebhookOpts
Int -> ReadS CreateWebhookOpts
ReadS [CreateWebhookOpts]
(Int -> ReadS CreateWebhookOpts)
-> ReadS [CreateWebhookOpts]
-> ReadPrec CreateWebhookOpts
-> ReadPrec [CreateWebhookOpts]
-> Read CreateWebhookOpts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWebhookOpts]
$creadListPrec :: ReadPrec [CreateWebhookOpts]
readPrec :: ReadPrec CreateWebhookOpts
$creadPrec :: ReadPrec CreateWebhookOpts
readList :: ReadS [CreateWebhookOpts]
$creadList :: ReadS [CreateWebhookOpts]
readsPrec :: Int -> ReadS CreateWebhookOpts
$creadsPrec :: Int -> ReadS CreateWebhookOpts
Read, 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
..} = [Maybe Pair] -> Value
objectFromMaybes
                         [AesonKey
"name" AesonKey -> Text -> Maybe Pair
forall a. ToJSON a => AesonKey -> a -> Maybe Pair
.== Text
createWebhookOptsName,
                          AesonKey
"avatar" AesonKey -> Maybe Text -> Maybe Pair
forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Text
createWebhookOptsAvatar ]

-- | Options for `ExecuteWebhookWithToken`
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, ReadPrec [ExecuteWebhookWithTokenOpts]
ReadPrec ExecuteWebhookWithTokenOpts
Int -> ReadS ExecuteWebhookWithTokenOpts
ReadS [ExecuteWebhookWithTokenOpts]
(Int -> ReadS ExecuteWebhookWithTokenOpts)
-> ReadS [ExecuteWebhookWithTokenOpts]
-> ReadPrec ExecuteWebhookWithTokenOpts
-> ReadPrec [ExecuteWebhookWithTokenOpts]
-> Read ExecuteWebhookWithTokenOpts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecuteWebhookWithTokenOpts]
$creadListPrec :: ReadPrec [ExecuteWebhookWithTokenOpts]
readPrec :: ReadPrec ExecuteWebhookWithTokenOpts
$creadPrec :: ReadPrec ExecuteWebhookWithTokenOpts
readList :: ReadS [ExecuteWebhookWithTokenOpts]
$creadList :: ReadS [ExecuteWebhookWithTokenOpts]
readsPrec :: Int -> ReadS ExecuteWebhookWithTokenOpts
$creadsPrec :: Int -> ReadS ExecuteWebhookWithTokenOpts
Read, 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)

-- | A webhook's content
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, ReadPrec [WebhookContent]
ReadPrec WebhookContent
Int -> ReadS WebhookContent
ReadS [WebhookContent]
(Int -> ReadS WebhookContent)
-> ReadS [WebhookContent]
-> ReadPrec WebhookContent
-> ReadPrec [WebhookContent]
-> Read WebhookContent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebhookContent]
$creadListPrec :: ReadPrec [WebhookContent]
readPrec :: ReadPrec WebhookContent
$creadPrec :: ReadPrec WebhookContent
readList :: ReadS [WebhookContent]
$creadList :: ReadS [WebhookContent]
readsPrec :: Int -> ReadS WebhookContent
$creadsPrec :: Int -> ReadS WebhookContent
Read, 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 -> [(AesonKey, Value)]
webhookContentJson :: WebhookContent -> [Pair]
webhookContentJson WebhookContent
c = case WebhookContent
c of
                      WebhookContentText Text
t -> [(AesonKey
"content", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t)]
                      WebhookContentFile Text
_ ByteString
_  -> []
                      WebhookContentEmbeds [CreateEmbed]
e -> [(AesonKey
"embeds", [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
..} = [Maybe Pair] -> Value
objectFromMaybes ([Maybe Pair] -> Value) -> [Maybe Pair] -> Value
forall a b. (a -> b) -> a -> b
$
                          [AesonKey
"username" AesonKey -> Maybe Text -> Maybe Pair
forall a. ToJSON a => AesonKey -> Maybe a -> Maybe Pair
.=? Maybe Text
executeWebhookWithTokenOptsUsername]
                           [Maybe Pair] -> [Maybe Pair] -> [Maybe Pair]
forall a. Semigroup a => a -> a -> a
<> (Pair -> Maybe Pair) -> [Pair] -> [Maybe Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pair -> Maybe Pair
forall a. a -> Maybe a
Just (WebhookContent -> [Pair]
webhookContentJson WebhookContent
executeWebhookWithTokenOptsContent)

-- | Major routes for webhook requests
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 GuildId
g) ->   String
"aaaaaahook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> GuildId -> String
forall a. Show a => a -> String
show GuildId
g
  (GetWebhook WebhookId
w Maybe WebhookToken
_) ->       String
"getwebhook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> WebhookId -> String
forall a. Show a => a -> String
show WebhookId
w
  (ModifyWebhook WebhookId
w Maybe WebhookToken
_ ModifyWebhookOpts
_) ->  String
"modifyhook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> WebhookId -> String
forall a. Show a => a -> String
show WebhookId
w
  (DeleteWebhook WebhookId
w Maybe WebhookToken
_) ->    String
"deletehook " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> WebhookId -> String
forall a. Show a => a -> String
show WebhookId
w
  (ExecuteWebhook WebhookId
w WebhookToken
_ ExecuteWebhookWithTokenOpts
_) ->  String
"executehk " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> WebhookId -> String
forall a. Show a => a -> String
show WebhookId
w
  (GetWebhookMessage WebhookId
w WebhookToken
_ MessageId
_) -> String
"gethkmsg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> WebhookId -> String
forall a. Show a => a -> String
show WebhookId
w
  (EditWebhookMessage WebhookId
w WebhookToken
_ MessageId
_ Text
_) -> String
"edithkmsg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> WebhookId -> String
forall a. Show a => a -> String
show WebhookId
w
  (DeleteWebhookMessage WebhookId
w WebhookToken
_ MessageId
_) -> String
"delhkmsg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> WebhookId -> String
forall a. Show a => a -> String
show WebhookId
w

-- | Create a 'JsonRequest' from a `WebhookRequest`
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).
ToHttpApiData 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).
ToHttpApiData 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 GuildId
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 -> GuildId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ GuildId
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 WebhookId
w Maybe WebhookToken
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 -> WebhookId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookId
w Url 'Https -> Maybe WebhookToken -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> Maybe a -> Url scheme
/? Maybe WebhookToken
t)  Option 'Https
forall a. Monoid a => a
mempty

  (ModifyWebhook WebhookId
w Maybe WebhookToken
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 -> WebhookId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookId
w Url 'Https -> Maybe WebhookToken -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> Maybe a -> Url scheme
/? Maybe WebhookToken
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 WebhookId
w Maybe WebhookToken
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 -> WebhookId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookId
w Url 'Https -> Maybe WebhookToken -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> Maybe a -> Url scheme
/? Maybe WebhookToken
t)  Option 'Https
forall a. Monoid a => a
mempty

  (ExecuteWebhook WebhookId
w WebhookToken
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 -> WebhookId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookId
w Url 'Https -> WebhookToken -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookToken
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 -> WebhookId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookId
w Url 'Https -> WebhookToken -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookToken
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 UTCTime
Maybe DiscordColor
Maybe CreateEmbedImage
Text
createEmbedTimestamp :: CreateEmbed -> Maybe UTCTime
createEmbedColor :: CreateEmbed -> Maybe DiscordColor
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
createEmbedTimestamp :: Maybe UTCTime
createEmbedColor :: Maybe DiscordColor
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 [AesonKey
"embed" AesonKey -> Embed -> Pair
forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> 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 -> WebhookId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookId
w Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: WebhookToken -> Text
forall a. DiscordToken a -> Text
unToken WebhookToken
tok) RestIO ReqBodyMultipart
body Option 'Https
forall a. Monoid a => a
mempty

  (GetWebhookMessage WebhookId
w WebhookToken
t MessageId
m) ->
    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 -> WebhookId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookId
w Url 'Https -> WebhookToken -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookToken
t Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> MessageId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ MessageId
m)  Option 'Https
forall a. Monoid a => a
mempty

  (EditWebhookMessage WebhookId
w WebhookToken
t MessageId
m Text
p) ->
    Url 'Https
-> RestIO (ReqBodyJson Value) -> 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 -> WebhookId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookId
w Url 'Https -> WebhookToken -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookToken
t Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> MessageId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ MessageId
m) (ReqBodyJson Value -> RestIO (ReqBodyJson Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
R.ReqBodyJson (Value -> ReqBodyJson Value) -> Value -> ReqBodyJson Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [AesonKey
"content" AesonKey -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => AesonKey -> v -> kv
.= Text
p]))  Option 'Https
forall a. Monoid a => a
mempty

  (DeleteWebhookMessage WebhookId
w WebhookToken
t MessageId
m) ->
    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 -> WebhookId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookId
w Url 'Https -> WebhookToken -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ WebhookToken
t Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> MessageId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ MessageId
m)  Option 'Https
forall a. Monoid a => a
mempty