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

-- | Provides actions for Channel API interactions
module Discord.Internal.Rest.Channel
  ( ChannelRequest(..)
  , MessageDetailedOpts(..)
  , AllowedMentions(..)
  , ReactionTiming(..)
  , MessageTiming(..)
  , ChannelInviteOpts(..)
  , ModifyChannelOpts(..)
  , ChannelPermissionsOpts(..)
  , GroupDMAddRecipientOpts(..)
  , ChannelPermissionsOptsType(..)
  ) where


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

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

instance Request (ChannelRequest a) where
  majorRoute :: ChannelRequest a -> String
majorRoute = ChannelRequest a -> String
forall a. ChannelRequest a -> String
channelMajorRoute
  jsonRequest :: ChannelRequest a -> JsonRequest
jsonRequest = ChannelRequest a -> JsonRequest
forall a. ChannelRequest a -> JsonRequest
channelJsonRequest

-- | Data constructor for requests. See <https://discord.com/developers/docs/resources/ API>
data ChannelRequest a where
  -- | Gets a channel by its id.
  GetChannel              :: ChannelId -> ChannelRequest Channel
  -- | Edits channels options.
  ModifyChannel           :: ChannelId -> ModifyChannelOpts -> ChannelRequest Channel
  -- | Deletes a channel if its id doesn't equal to the id of guild.
  DeleteChannel           :: ChannelId -> ChannelRequest Channel
  -- | Gets a messages from a channel with limit of 100 per request.
  GetChannelMessages      :: ChannelId -> (Int, MessageTiming) -> ChannelRequest [Message]
  -- | Gets a message in a channel by its id.
  GetChannelMessage       :: (ChannelId, MessageId) -> ChannelRequest Message
  -- | Sends a message to a channel.
  CreateMessage           :: ChannelId -> T.Text -> ChannelRequest Message
  -- | Sends a message with an Embed to a channel.
  CreateMessageEmbed      :: ChannelId -> T.Text -> CreateEmbed -> ChannelRequest Message
  -- | Sends a message with a file to a channel.
  CreateMessageUploadFile :: ChannelId -> T.Text -> B.ByteString -> ChannelRequest Message
  -- | Sends a message with granular controls.
  CreateMessageDetailed   :: ChannelId -> MessageDetailedOpts -> ChannelRequest Message
  -- | Add an emoji reaction to a message. ID must be present for custom emoji
  CreateReaction          :: (ChannelId, MessageId) -> T.Text -> ChannelRequest ()
  -- | Remove a Reaction this bot added
  DeleteOwnReaction       :: (ChannelId, MessageId) -> T.Text -> ChannelRequest ()
  -- | Remove a Reaction someone else added
  DeleteUserReaction      :: (ChannelId, MessageId) -> UserId -> T.Text -> ChannelRequest ()
  -- | Deletes all reactions of a single emoji on a message
  DeleteSingleReaction    :: (ChannelId, MessageId) -> T.Text -> ChannelRequest ()
  -- | List of users that reacted with this emoji
  GetReactions            :: (ChannelId, MessageId) -> T.Text -> (Int, ReactionTiming) -> ChannelRequest [User]
  -- | Delete all reactions on a message
  DeleteAllReactions      :: (ChannelId, MessageId) -> ChannelRequest ()
  -- | Edits a message content.
  EditMessage             :: (ChannelId, MessageId) -> T.Text -> Maybe CreateEmbed
                                                    -> ChannelRequest Message
  -- | Deletes a message.
  DeleteMessage           :: (ChannelId, MessageId) -> ChannelRequest ()
  -- | Deletes a group of messages.
  BulkDeleteMessage       :: (ChannelId, [MessageId]) -> ChannelRequest ()
  -- | Edits a permission overrides for a channel.
  EditChannelPermissions  :: ChannelId -> OverwriteId -> ChannelPermissionsOpts -> ChannelRequest ()
  -- | Gets all instant invites to a channel.
  GetChannelInvites       :: ChannelId -> ChannelRequest Object
  -- | Creates an instant invite to a channel.
  CreateChannelInvite     :: ChannelId -> ChannelInviteOpts -> ChannelRequest Invite
  -- | Deletes a permission override from a channel.
  DeleteChannelPermission :: ChannelId -> OverwriteId -> ChannelRequest ()
  -- | Sends a typing indicator a channel which lasts 10 seconds.
  TriggerTypingIndicator  :: ChannelId -> ChannelRequest ()
  -- | Gets all pinned messages of a channel.
  GetPinnedMessages       :: ChannelId -> ChannelRequest [Message]
  -- | Pins a message.
  AddPinnedMessage        :: (ChannelId, MessageId) -> ChannelRequest ()
  -- | Unpins a message.
  DeletePinnedMessage     :: (ChannelId, MessageId) -> ChannelRequest ()
  -- | Adds a recipient to a Group DM using their access token
  GroupDMAddRecipient     :: ChannelId -> GroupDMAddRecipientOpts -> ChannelRequest ()
  -- | Removes a recipient from a Group DM
  GroupDMRemoveRecipient  :: ChannelId -> UserId -> ChannelRequest ()


-- | Data constructor for CreateMessageDetailed requests.
data MessageDetailedOpts = MessageDetailedOpts
  { MessageDetailedOpts -> Text
messageDetailedContent                  :: T.Text
  , MessageDetailedOpts -> Bool
messageDetailedTTS                      :: Bool
  , MessageDetailedOpts -> Maybe CreateEmbed
messageDetailedEmbed                    :: Maybe CreateEmbed
  , MessageDetailedOpts -> Maybe (Text, ByteString)
messageDetailedFile                     :: Maybe (T.Text, B.ByteString)
  , MessageDetailedOpts -> Maybe AllowedMentions
messageDetailedAllowedMentions          :: Maybe AllowedMentions
  , MessageDetailedOpts -> Maybe MessageReference
messageDetailedReference                :: Maybe MessageReference
  } deriving (Int -> MessageDetailedOpts -> ShowS
[MessageDetailedOpts] -> ShowS
MessageDetailedOpts -> String
(Int -> MessageDetailedOpts -> ShowS)
-> (MessageDetailedOpts -> String)
-> ([MessageDetailedOpts] -> ShowS)
-> Show MessageDetailedOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageDetailedOpts] -> ShowS
$cshowList :: [MessageDetailedOpts] -> ShowS
show :: MessageDetailedOpts -> String
$cshow :: MessageDetailedOpts -> String
showsPrec :: Int -> MessageDetailedOpts -> ShowS
$cshowsPrec :: Int -> MessageDetailedOpts -> ShowS
Show, MessageDetailedOpts -> MessageDetailedOpts -> Bool
(MessageDetailedOpts -> MessageDetailedOpts -> Bool)
-> (MessageDetailedOpts -> MessageDetailedOpts -> Bool)
-> Eq MessageDetailedOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageDetailedOpts -> MessageDetailedOpts -> Bool
$c/= :: MessageDetailedOpts -> MessageDetailedOpts -> Bool
== :: MessageDetailedOpts -> MessageDetailedOpts -> Bool
$c== :: MessageDetailedOpts -> MessageDetailedOpts -> Bool
Eq, Eq MessageDetailedOpts
Eq MessageDetailedOpts
-> (MessageDetailedOpts -> MessageDetailedOpts -> Ordering)
-> (MessageDetailedOpts -> MessageDetailedOpts -> Bool)
-> (MessageDetailedOpts -> MessageDetailedOpts -> Bool)
-> (MessageDetailedOpts -> MessageDetailedOpts -> Bool)
-> (MessageDetailedOpts -> MessageDetailedOpts -> Bool)
-> (MessageDetailedOpts
    -> MessageDetailedOpts -> MessageDetailedOpts)
-> (MessageDetailedOpts
    -> MessageDetailedOpts -> MessageDetailedOpts)
-> Ord MessageDetailedOpts
MessageDetailedOpts -> MessageDetailedOpts -> Bool
MessageDetailedOpts -> MessageDetailedOpts -> Ordering
MessageDetailedOpts -> MessageDetailedOpts -> MessageDetailedOpts
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 :: MessageDetailedOpts -> MessageDetailedOpts -> MessageDetailedOpts
$cmin :: MessageDetailedOpts -> MessageDetailedOpts -> MessageDetailedOpts
max :: MessageDetailedOpts -> MessageDetailedOpts -> MessageDetailedOpts
$cmax :: MessageDetailedOpts -> MessageDetailedOpts -> MessageDetailedOpts
>= :: MessageDetailedOpts -> MessageDetailedOpts -> Bool
$c>= :: MessageDetailedOpts -> MessageDetailedOpts -> Bool
> :: MessageDetailedOpts -> MessageDetailedOpts -> Bool
$c> :: MessageDetailedOpts -> MessageDetailedOpts -> Bool
<= :: MessageDetailedOpts -> MessageDetailedOpts -> Bool
$c<= :: MessageDetailedOpts -> MessageDetailedOpts -> Bool
< :: MessageDetailedOpts -> MessageDetailedOpts -> Bool
$c< :: MessageDetailedOpts -> MessageDetailedOpts -> Bool
compare :: MessageDetailedOpts -> MessageDetailedOpts -> Ordering
$ccompare :: MessageDetailedOpts -> MessageDetailedOpts -> Ordering
$cp1Ord :: Eq MessageDetailedOpts
Ord)

instance Default MessageDetailedOpts where
  def :: MessageDetailedOpts
def = MessageDetailedOpts :: Text
-> Bool
-> Maybe CreateEmbed
-> Maybe (Text, ByteString)
-> Maybe AllowedMentions
-> Maybe MessageReference
-> MessageDetailedOpts
MessageDetailedOpts { messageDetailedContent :: Text
messageDetailedContent         = Text
""
                            , messageDetailedTTS :: Bool
messageDetailedTTS             = Bool
False
                            , messageDetailedEmbed :: Maybe CreateEmbed
messageDetailedEmbed           = Maybe CreateEmbed
forall a. Maybe a
Nothing
                            , messageDetailedFile :: Maybe (Text, ByteString)
messageDetailedFile            = Maybe (Text, ByteString)
forall a. Maybe a
Nothing
                            , messageDetailedAllowedMentions :: Maybe AllowedMentions
messageDetailedAllowedMentions = Maybe AllowedMentions
forall a. Maybe a
Nothing
                            , messageDetailedReference :: Maybe MessageReference
messageDetailedReference       = Maybe MessageReference
forall a. Maybe a
Nothing
                            }

-- | Data constructor for a part of MessageDetailedOpts.
data AllowedMentions = AllowedMentions
  { AllowedMentions -> Bool
mentionEveryone    :: Bool
  , AllowedMentions -> Bool
mentionUsers       :: Bool
  , AllowedMentions -> Bool
mentionRoles       :: Bool
  , AllowedMentions -> [UserId]
mentionUserIds     :: [UserId]
  , AllowedMentions -> [UserId]
mentionRoleIds     :: [RoleId]
  , AllowedMentions -> Bool
mentionRepliedUser :: Bool
  } deriving (Int -> AllowedMentions -> ShowS
[AllowedMentions] -> ShowS
AllowedMentions -> String
(Int -> AllowedMentions -> ShowS)
-> (AllowedMentions -> String)
-> ([AllowedMentions] -> ShowS)
-> Show AllowedMentions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllowedMentions] -> ShowS
$cshowList :: [AllowedMentions] -> ShowS
show :: AllowedMentions -> String
$cshow :: AllowedMentions -> String
showsPrec :: Int -> AllowedMentions -> ShowS
$cshowsPrec :: Int -> AllowedMentions -> ShowS
Show, AllowedMentions -> AllowedMentions -> Bool
(AllowedMentions -> AllowedMentions -> Bool)
-> (AllowedMentions -> AllowedMentions -> Bool)
-> Eq AllowedMentions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllowedMentions -> AllowedMentions -> Bool
$c/= :: AllowedMentions -> AllowedMentions -> Bool
== :: AllowedMentions -> AllowedMentions -> Bool
$c== :: AllowedMentions -> AllowedMentions -> Bool
Eq, Eq AllowedMentions
Eq AllowedMentions
-> (AllowedMentions -> AllowedMentions -> Ordering)
-> (AllowedMentions -> AllowedMentions -> Bool)
-> (AllowedMentions -> AllowedMentions -> Bool)
-> (AllowedMentions -> AllowedMentions -> Bool)
-> (AllowedMentions -> AllowedMentions -> Bool)
-> (AllowedMentions -> AllowedMentions -> AllowedMentions)
-> (AllowedMentions -> AllowedMentions -> AllowedMentions)
-> Ord AllowedMentions
AllowedMentions -> AllowedMentions -> Bool
AllowedMentions -> AllowedMentions -> Ordering
AllowedMentions -> AllowedMentions -> AllowedMentions
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 :: AllowedMentions -> AllowedMentions -> AllowedMentions
$cmin :: AllowedMentions -> AllowedMentions -> AllowedMentions
max :: AllowedMentions -> AllowedMentions -> AllowedMentions
$cmax :: AllowedMentions -> AllowedMentions -> AllowedMentions
>= :: AllowedMentions -> AllowedMentions -> Bool
$c>= :: AllowedMentions -> AllowedMentions -> Bool
> :: AllowedMentions -> AllowedMentions -> Bool
$c> :: AllowedMentions -> AllowedMentions -> Bool
<= :: AllowedMentions -> AllowedMentions -> Bool
$c<= :: AllowedMentions -> AllowedMentions -> Bool
< :: AllowedMentions -> AllowedMentions -> Bool
$c< :: AllowedMentions -> AllowedMentions -> Bool
compare :: AllowedMentions -> AllowedMentions -> Ordering
$ccompare :: AllowedMentions -> AllowedMentions -> Ordering
$cp1Ord :: Eq AllowedMentions
Ord)

instance Default AllowedMentions where
  def :: AllowedMentions
def = AllowedMentions :: Bool
-> Bool -> Bool -> [UserId] -> [UserId] -> Bool -> AllowedMentions
AllowedMentions { mentionEveryone :: Bool
mentionEveryone    = Bool
False
                        , mentionUsers :: Bool
mentionUsers       = Bool
True
                        , mentionRoles :: Bool
mentionRoles       = Bool
True
                        , mentionUserIds :: [UserId]
mentionUserIds     = []
                        , mentionRoleIds :: [UserId]
mentionRoleIds     = []
                        , mentionRepliedUser :: Bool
mentionRepliedUser = Bool
True
                        }

instance ToJSON AllowedMentions where
  toJSON :: AllowedMentions -> Value
toJSON AllowedMentions{Bool
[UserId]
mentionRepliedUser :: Bool
mentionRoleIds :: [UserId]
mentionUserIds :: [UserId]
mentionRoles :: Bool
mentionUsers :: Bool
mentionEveryone :: Bool
mentionRepliedUser :: AllowedMentions -> Bool
mentionRoleIds :: AllowedMentions -> [UserId]
mentionUserIds :: AllowedMentions -> [UserId]
mentionRoles :: AllowedMentions -> Bool
mentionUsers :: AllowedMentions -> Bool
mentionEveryone :: AllowedMentions -> Bool
..} = [Pair] -> Value
object [
                                 (Key
"parse" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text
name :: T.Text | (Text
name, Bool
True) <-
                                     [ (Text
"everyone", Bool
mentionEveryone),
                                       (Text
"users",    Bool
mentionUsers Bool -> Bool -> Bool
&& [UserId]
mentionUserIds [UserId] -> [UserId] -> Bool
forall a. Eq a => a -> a -> Bool
== []),
                                       (Text
"roles",    Bool
mentionRoles Bool -> Bool -> Bool
&& [UserId]
mentionRoleIds [UserId] -> [UserId] -> Bool
forall a. Eq a => a -> a -> Bool
== []) ] ]),
                                 -- https://discord.com/developers/docs/resources/channel#allowed-mentions-object
                                 --  parse.users and users list cannot both be active, prioritize id list
                                 (Key
"roles"        Key -> [UserId] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [UserId]
mentionRoleIds),
                                 (Key
"users"        Key -> [UserId] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [UserId]
mentionUserIds),
                                 (Key
"replied_user" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
mentionRepliedUser) ]

-- | Data constructor for GetReaction requests
data ReactionTiming = BeforeReaction MessageId
                    | AfterReaction MessageId
                    | LatestReaction
  deriving (Int -> ReactionTiming -> ShowS
[ReactionTiming] -> ShowS
ReactionTiming -> String
(Int -> ReactionTiming -> ShowS)
-> (ReactionTiming -> String)
-> ([ReactionTiming] -> ShowS)
-> Show ReactionTiming
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReactionTiming] -> ShowS
$cshowList :: [ReactionTiming] -> ShowS
show :: ReactionTiming -> String
$cshow :: ReactionTiming -> String
showsPrec :: Int -> ReactionTiming -> ShowS
$cshowsPrec :: Int -> ReactionTiming -> ShowS
Show, ReactionTiming -> ReactionTiming -> Bool
(ReactionTiming -> ReactionTiming -> Bool)
-> (ReactionTiming -> ReactionTiming -> Bool) -> Eq ReactionTiming
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReactionTiming -> ReactionTiming -> Bool
$c/= :: ReactionTiming -> ReactionTiming -> Bool
== :: ReactionTiming -> ReactionTiming -> Bool
$c== :: ReactionTiming -> ReactionTiming -> Bool
Eq, Eq ReactionTiming
Eq ReactionTiming
-> (ReactionTiming -> ReactionTiming -> Ordering)
-> (ReactionTiming -> ReactionTiming -> Bool)
-> (ReactionTiming -> ReactionTiming -> Bool)
-> (ReactionTiming -> ReactionTiming -> Bool)
-> (ReactionTiming -> ReactionTiming -> Bool)
-> (ReactionTiming -> ReactionTiming -> ReactionTiming)
-> (ReactionTiming -> ReactionTiming -> ReactionTiming)
-> Ord ReactionTiming
ReactionTiming -> ReactionTiming -> Bool
ReactionTiming -> ReactionTiming -> Ordering
ReactionTiming -> ReactionTiming -> ReactionTiming
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 :: ReactionTiming -> ReactionTiming -> ReactionTiming
$cmin :: ReactionTiming -> ReactionTiming -> ReactionTiming
max :: ReactionTiming -> ReactionTiming -> ReactionTiming
$cmax :: ReactionTiming -> ReactionTiming -> ReactionTiming
>= :: ReactionTiming -> ReactionTiming -> Bool
$c>= :: ReactionTiming -> ReactionTiming -> Bool
> :: ReactionTiming -> ReactionTiming -> Bool
$c> :: ReactionTiming -> ReactionTiming -> Bool
<= :: ReactionTiming -> ReactionTiming -> Bool
$c<= :: ReactionTiming -> ReactionTiming -> Bool
< :: ReactionTiming -> ReactionTiming -> Bool
$c< :: ReactionTiming -> ReactionTiming -> Bool
compare :: ReactionTiming -> ReactionTiming -> Ordering
$ccompare :: ReactionTiming -> ReactionTiming -> Ordering
$cp1Ord :: Eq ReactionTiming
Ord)

reactionTimingToQuery :: ReactionTiming -> R.Option 'R.Https
reactionTimingToQuery :: ReactionTiming -> Option 'Https
reactionTimingToQuery ReactionTiming
t = case ReactionTiming
t of
  (BeforeReaction UserId
snow) -> Text
"before" Text -> String -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: UserId -> String
forall a. Show a => a -> String
show UserId
snow
  (AfterReaction UserId
snow) -> Text
"after"  Text -> String -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: UserId -> String
forall a. Show a => a -> String
show UserId
snow
  (ReactionTiming
LatestReaction) -> Option 'Https
forall a. Monoid a => a
mempty

-- | Data constructor for GetChannelMessages requests. See <https://discord.com/developers/docs/resources/channel#get-channel-messages>
data MessageTiming = AroundMessage MessageId
                   | BeforeMessage MessageId
                   | AfterMessage MessageId
                   | LatestMessages
  deriving (Int -> MessageTiming -> ShowS
[MessageTiming] -> ShowS
MessageTiming -> String
(Int -> MessageTiming -> ShowS)
-> (MessageTiming -> String)
-> ([MessageTiming] -> ShowS)
-> Show MessageTiming
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageTiming] -> ShowS
$cshowList :: [MessageTiming] -> ShowS
show :: MessageTiming -> String
$cshow :: MessageTiming -> String
showsPrec :: Int -> MessageTiming -> ShowS
$cshowsPrec :: Int -> MessageTiming -> ShowS
Show, MessageTiming -> MessageTiming -> Bool
(MessageTiming -> MessageTiming -> Bool)
-> (MessageTiming -> MessageTiming -> Bool) -> Eq MessageTiming
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageTiming -> MessageTiming -> Bool
$c/= :: MessageTiming -> MessageTiming -> Bool
== :: MessageTiming -> MessageTiming -> Bool
$c== :: MessageTiming -> MessageTiming -> Bool
Eq, Eq MessageTiming
Eq MessageTiming
-> (MessageTiming -> MessageTiming -> Ordering)
-> (MessageTiming -> MessageTiming -> Bool)
-> (MessageTiming -> MessageTiming -> Bool)
-> (MessageTiming -> MessageTiming -> Bool)
-> (MessageTiming -> MessageTiming -> Bool)
-> (MessageTiming -> MessageTiming -> MessageTiming)
-> (MessageTiming -> MessageTiming -> MessageTiming)
-> Ord MessageTiming
MessageTiming -> MessageTiming -> Bool
MessageTiming -> MessageTiming -> Ordering
MessageTiming -> MessageTiming -> MessageTiming
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 :: MessageTiming -> MessageTiming -> MessageTiming
$cmin :: MessageTiming -> MessageTiming -> MessageTiming
max :: MessageTiming -> MessageTiming -> MessageTiming
$cmax :: MessageTiming -> MessageTiming -> MessageTiming
>= :: MessageTiming -> MessageTiming -> Bool
$c>= :: MessageTiming -> MessageTiming -> Bool
> :: MessageTiming -> MessageTiming -> Bool
$c> :: MessageTiming -> MessageTiming -> Bool
<= :: MessageTiming -> MessageTiming -> Bool
$c<= :: MessageTiming -> MessageTiming -> Bool
< :: MessageTiming -> MessageTiming -> Bool
$c< :: MessageTiming -> MessageTiming -> Bool
compare :: MessageTiming -> MessageTiming -> Ordering
$ccompare :: MessageTiming -> MessageTiming -> Ordering
$cp1Ord :: Eq MessageTiming
Ord)

messageTimingToQuery :: MessageTiming -> R.Option 'R.Https
messageTimingToQuery :: MessageTiming -> Option 'Https
messageTimingToQuery MessageTiming
t = case MessageTiming
t of
  (AroundMessage UserId
snow) -> Text
"around" Text -> String -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: UserId -> String
forall a. Show a => a -> String
show UserId
snow
  (BeforeMessage UserId
snow) -> Text
"before" Text -> String -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: UserId -> String
forall a. Show a => a -> String
show UserId
snow
  (AfterMessage UserId
snow) -> Text
"after"  Text -> String -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: UserId -> String
forall a. Show a => a -> String
show UserId
snow
  (MessageTiming
LatestMessages) -> Option 'Https
forall a. Monoid a => a
mempty

data ChannelInviteOpts = ChannelInviteOpts
  { ChannelInviteOpts -> Maybe Integer
channelInviteOptsMaxAgeSeconds          :: Maybe Integer
  , ChannelInviteOpts -> Maybe Integer
channelInviteOptsMaxUsages              :: Maybe Integer
  , ChannelInviteOpts -> Maybe Bool
channelInviteOptsIsTemporary            :: Maybe Bool
  , ChannelInviteOpts -> Maybe Bool
channelInviteOptsDontReuseSimilarInvite :: Maybe Bool
  } deriving (Int -> ChannelInviteOpts -> ShowS
[ChannelInviteOpts] -> ShowS
ChannelInviteOpts -> String
(Int -> ChannelInviteOpts -> ShowS)
-> (ChannelInviteOpts -> String)
-> ([ChannelInviteOpts] -> ShowS)
-> Show ChannelInviteOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelInviteOpts] -> ShowS
$cshowList :: [ChannelInviteOpts] -> ShowS
show :: ChannelInviteOpts -> String
$cshow :: ChannelInviteOpts -> String
showsPrec :: Int -> ChannelInviteOpts -> ShowS
$cshowsPrec :: Int -> ChannelInviteOpts -> ShowS
Show, ChannelInviteOpts -> ChannelInviteOpts -> Bool
(ChannelInviteOpts -> ChannelInviteOpts -> Bool)
-> (ChannelInviteOpts -> ChannelInviteOpts -> Bool)
-> Eq ChannelInviteOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelInviteOpts -> ChannelInviteOpts -> Bool
$c/= :: ChannelInviteOpts -> ChannelInviteOpts -> Bool
== :: ChannelInviteOpts -> ChannelInviteOpts -> Bool
$c== :: ChannelInviteOpts -> ChannelInviteOpts -> Bool
Eq, Eq ChannelInviteOpts
Eq ChannelInviteOpts
-> (ChannelInviteOpts -> ChannelInviteOpts -> Ordering)
-> (ChannelInviteOpts -> ChannelInviteOpts -> Bool)
-> (ChannelInviteOpts -> ChannelInviteOpts -> Bool)
-> (ChannelInviteOpts -> ChannelInviteOpts -> Bool)
-> (ChannelInviteOpts -> ChannelInviteOpts -> Bool)
-> (ChannelInviteOpts -> ChannelInviteOpts -> ChannelInviteOpts)
-> (ChannelInviteOpts -> ChannelInviteOpts -> ChannelInviteOpts)
-> Ord ChannelInviteOpts
ChannelInviteOpts -> ChannelInviteOpts -> Bool
ChannelInviteOpts -> ChannelInviteOpts -> Ordering
ChannelInviteOpts -> ChannelInviteOpts -> ChannelInviteOpts
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 :: ChannelInviteOpts -> ChannelInviteOpts -> ChannelInviteOpts
$cmin :: ChannelInviteOpts -> ChannelInviteOpts -> ChannelInviteOpts
max :: ChannelInviteOpts -> ChannelInviteOpts -> ChannelInviteOpts
$cmax :: ChannelInviteOpts -> ChannelInviteOpts -> ChannelInviteOpts
>= :: ChannelInviteOpts -> ChannelInviteOpts -> Bool
$c>= :: ChannelInviteOpts -> ChannelInviteOpts -> Bool
> :: ChannelInviteOpts -> ChannelInviteOpts -> Bool
$c> :: ChannelInviteOpts -> ChannelInviteOpts -> Bool
<= :: ChannelInviteOpts -> ChannelInviteOpts -> Bool
$c<= :: ChannelInviteOpts -> ChannelInviteOpts -> Bool
< :: ChannelInviteOpts -> ChannelInviteOpts -> Bool
$c< :: ChannelInviteOpts -> ChannelInviteOpts -> Bool
compare :: ChannelInviteOpts -> ChannelInviteOpts -> Ordering
$ccompare :: ChannelInviteOpts -> ChannelInviteOpts -> Ordering
$cp1Ord :: Eq ChannelInviteOpts
Ord)

instance ToJSON ChannelInviteOpts where
  toJSON :: ChannelInviteOpts -> Value
toJSON ChannelInviteOpts{Maybe Bool
Maybe Integer
channelInviteOptsDontReuseSimilarInvite :: Maybe Bool
channelInviteOptsIsTemporary :: Maybe Bool
channelInviteOptsMaxUsages :: Maybe Integer
channelInviteOptsMaxAgeSeconds :: Maybe Integer
channelInviteOptsDontReuseSimilarInvite :: ChannelInviteOpts -> Maybe Bool
channelInviteOptsIsTemporary :: ChannelInviteOpts -> Maybe Bool
channelInviteOptsMaxUsages :: ChannelInviteOpts -> Maybe Integer
channelInviteOptsMaxAgeSeconds :: ChannelInviteOpts -> Maybe Integer
..} = [Pair] -> Value
object [(Key
name, Value
val) | (Key
name, Just Value
val) <-
                         [(Key
"max_age",   Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
channelInviteOptsMaxAgeSeconds),
                          (Key
"max_uses",  Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
channelInviteOptsMaxUsages),
                          (Key
"temporary", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
channelInviteOptsIsTemporary),
                          (Key
"unique",    Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
channelInviteOptsDontReuseSimilarInvite) ] ]

data ModifyChannelOpts = ModifyChannelOpts
  { ModifyChannelOpts -> Maybe Text
modifyChannelName                 :: Maybe T.Text
  , ModifyChannelOpts -> Maybe Integer
modifyChannelPosition             :: Maybe Integer
  , ModifyChannelOpts -> Maybe Text
modifyChannelTopic                :: Maybe T.Text
  , ModifyChannelOpts -> Maybe Bool
modifyChannelNSFW                 :: Maybe Bool
  , ModifyChannelOpts -> Maybe Integer
modifyChannelBitrate              :: Maybe Integer
  , ModifyChannelOpts -> Maybe Integer
modifyChannelUserRateLimit        :: Maybe Integer
  , ModifyChannelOpts -> Maybe [Overwrite]
modifyChannelPermissionOverwrites :: Maybe [Overwrite]
  , ModifyChannelOpts -> Maybe UserId
modifyChannelParentId             :: Maybe ChannelId
  } deriving (Int -> ModifyChannelOpts -> ShowS
[ModifyChannelOpts] -> ShowS
ModifyChannelOpts -> String
(Int -> ModifyChannelOpts -> ShowS)
-> (ModifyChannelOpts -> String)
-> ([ModifyChannelOpts] -> ShowS)
-> Show ModifyChannelOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyChannelOpts] -> ShowS
$cshowList :: [ModifyChannelOpts] -> ShowS
show :: ModifyChannelOpts -> String
$cshow :: ModifyChannelOpts -> String
showsPrec :: Int -> ModifyChannelOpts -> ShowS
$cshowsPrec :: Int -> ModifyChannelOpts -> ShowS
Show, ModifyChannelOpts -> ModifyChannelOpts -> Bool
(ModifyChannelOpts -> ModifyChannelOpts -> Bool)
-> (ModifyChannelOpts -> ModifyChannelOpts -> Bool)
-> Eq ModifyChannelOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyChannelOpts -> ModifyChannelOpts -> Bool
$c/= :: ModifyChannelOpts -> ModifyChannelOpts -> Bool
== :: ModifyChannelOpts -> ModifyChannelOpts -> Bool
$c== :: ModifyChannelOpts -> ModifyChannelOpts -> Bool
Eq, Eq ModifyChannelOpts
Eq ModifyChannelOpts
-> (ModifyChannelOpts -> ModifyChannelOpts -> Ordering)
-> (ModifyChannelOpts -> ModifyChannelOpts -> Bool)
-> (ModifyChannelOpts -> ModifyChannelOpts -> Bool)
-> (ModifyChannelOpts -> ModifyChannelOpts -> Bool)
-> (ModifyChannelOpts -> ModifyChannelOpts -> Bool)
-> (ModifyChannelOpts -> ModifyChannelOpts -> ModifyChannelOpts)
-> (ModifyChannelOpts -> ModifyChannelOpts -> ModifyChannelOpts)
-> Ord ModifyChannelOpts
ModifyChannelOpts -> ModifyChannelOpts -> Bool
ModifyChannelOpts -> ModifyChannelOpts -> Ordering
ModifyChannelOpts -> ModifyChannelOpts -> ModifyChannelOpts
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 :: ModifyChannelOpts -> ModifyChannelOpts -> ModifyChannelOpts
$cmin :: ModifyChannelOpts -> ModifyChannelOpts -> ModifyChannelOpts
max :: ModifyChannelOpts -> ModifyChannelOpts -> ModifyChannelOpts
$cmax :: ModifyChannelOpts -> ModifyChannelOpts -> ModifyChannelOpts
>= :: ModifyChannelOpts -> ModifyChannelOpts -> Bool
$c>= :: ModifyChannelOpts -> ModifyChannelOpts -> Bool
> :: ModifyChannelOpts -> ModifyChannelOpts -> Bool
$c> :: ModifyChannelOpts -> ModifyChannelOpts -> Bool
<= :: ModifyChannelOpts -> ModifyChannelOpts -> Bool
$c<= :: ModifyChannelOpts -> ModifyChannelOpts -> Bool
< :: ModifyChannelOpts -> ModifyChannelOpts -> Bool
$c< :: ModifyChannelOpts -> ModifyChannelOpts -> Bool
compare :: ModifyChannelOpts -> ModifyChannelOpts -> Ordering
$ccompare :: ModifyChannelOpts -> ModifyChannelOpts -> Ordering
$cp1Ord :: Eq ModifyChannelOpts
Ord)

instance ToJSON ModifyChannelOpts where
  toJSON :: ModifyChannelOpts -> Value
toJSON ModifyChannelOpts{Maybe Bool
Maybe Integer
Maybe [Overwrite]
Maybe Text
Maybe UserId
modifyChannelParentId :: Maybe UserId
modifyChannelPermissionOverwrites :: Maybe [Overwrite]
modifyChannelUserRateLimit :: Maybe Integer
modifyChannelBitrate :: Maybe Integer
modifyChannelNSFW :: Maybe Bool
modifyChannelTopic :: Maybe Text
modifyChannelPosition :: Maybe Integer
modifyChannelName :: Maybe Text
modifyChannelParentId :: ModifyChannelOpts -> Maybe UserId
modifyChannelPermissionOverwrites :: ModifyChannelOpts -> Maybe [Overwrite]
modifyChannelUserRateLimit :: ModifyChannelOpts -> Maybe Integer
modifyChannelBitrate :: ModifyChannelOpts -> Maybe Integer
modifyChannelNSFW :: ModifyChannelOpts -> Maybe Bool
modifyChannelTopic :: ModifyChannelOpts -> Maybe Text
modifyChannelPosition :: ModifyChannelOpts -> Maybe Integer
modifyChannelName :: ModifyChannelOpts -> Maybe 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
<$> Maybe Text
modifyChannelName),
                (Key
"position",   Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
modifyChannelPosition),
                (Key
"topic",      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
modifyChannelTopic),
                (Key
"nsfw",       Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
modifyChannelNSFW),
                (Key
"bitrate",    Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
modifyChannelBitrate),
                (Key
"user_limit", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON (Integer -> Value) -> Maybe Integer -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
modifyChannelUserRateLimit),
                (Key
"permission_overwrites",  [Overwrite] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Overwrite] -> Value) -> Maybe [Overwrite] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Overwrite]
modifyChannelPermissionOverwrites),
                (Key
"parent_id",  UserId -> Value
forall a. ToJSON a => a -> Value
toJSON (UserId -> Value) -> Maybe UserId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UserId
modifyChannelParentId) ] ]

data ChannelPermissionsOpts = ChannelPermissionsOpts
  { ChannelPermissionsOpts -> Integer
channelPermissionsOptsAllow :: Integer
  , ChannelPermissionsOpts -> Integer
channelPermissionsOptsDeny :: Integer
  , ChannelPermissionsOpts -> ChannelPermissionsOptsType
channelPermissionsOptsType :: ChannelPermissionsOptsType
  } deriving (Int -> ChannelPermissionsOpts -> ShowS
[ChannelPermissionsOpts] -> ShowS
ChannelPermissionsOpts -> String
(Int -> ChannelPermissionsOpts -> ShowS)
-> (ChannelPermissionsOpts -> String)
-> ([ChannelPermissionsOpts] -> ShowS)
-> Show ChannelPermissionsOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelPermissionsOpts] -> ShowS
$cshowList :: [ChannelPermissionsOpts] -> ShowS
show :: ChannelPermissionsOpts -> String
$cshow :: ChannelPermissionsOpts -> String
showsPrec :: Int -> ChannelPermissionsOpts -> ShowS
$cshowsPrec :: Int -> ChannelPermissionsOpts -> ShowS
Show, ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
(ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool)
-> (ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool)
-> Eq ChannelPermissionsOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
$c/= :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
== :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
$c== :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
Eq, Eq ChannelPermissionsOpts
Eq ChannelPermissionsOpts
-> (ChannelPermissionsOpts -> ChannelPermissionsOpts -> Ordering)
-> (ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool)
-> (ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool)
-> (ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool)
-> (ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool)
-> (ChannelPermissionsOpts
    -> ChannelPermissionsOpts -> ChannelPermissionsOpts)
-> (ChannelPermissionsOpts
    -> ChannelPermissionsOpts -> ChannelPermissionsOpts)
-> Ord ChannelPermissionsOpts
ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
ChannelPermissionsOpts -> ChannelPermissionsOpts -> Ordering
ChannelPermissionsOpts
-> ChannelPermissionsOpts -> ChannelPermissionsOpts
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 :: ChannelPermissionsOpts
-> ChannelPermissionsOpts -> ChannelPermissionsOpts
$cmin :: ChannelPermissionsOpts
-> ChannelPermissionsOpts -> ChannelPermissionsOpts
max :: ChannelPermissionsOpts
-> ChannelPermissionsOpts -> ChannelPermissionsOpts
$cmax :: ChannelPermissionsOpts
-> ChannelPermissionsOpts -> ChannelPermissionsOpts
>= :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
$c>= :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
> :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
$c> :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
<= :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
$c<= :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
< :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
$c< :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Bool
compare :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Ordering
$ccompare :: ChannelPermissionsOpts -> ChannelPermissionsOpts -> Ordering
$cp1Ord :: Eq ChannelPermissionsOpts
Ord)

data ChannelPermissionsOptsType = ChannelPermissionsOptsUser
                                | ChannelPermissionsOptsRole
  deriving (Int -> ChannelPermissionsOptsType -> ShowS
[ChannelPermissionsOptsType] -> ShowS
ChannelPermissionsOptsType -> String
(Int -> ChannelPermissionsOptsType -> ShowS)
-> (ChannelPermissionsOptsType -> String)
-> ([ChannelPermissionsOptsType] -> ShowS)
-> Show ChannelPermissionsOptsType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelPermissionsOptsType] -> ShowS
$cshowList :: [ChannelPermissionsOptsType] -> ShowS
show :: ChannelPermissionsOptsType -> String
$cshow :: ChannelPermissionsOptsType -> String
showsPrec :: Int -> ChannelPermissionsOptsType -> ShowS
$cshowsPrec :: Int -> ChannelPermissionsOptsType -> ShowS
Show, ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
(ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool)
-> (ChannelPermissionsOptsType
    -> ChannelPermissionsOptsType -> Bool)
-> Eq ChannelPermissionsOptsType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
$c/= :: ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
== :: ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
$c== :: ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
Eq, Eq ChannelPermissionsOptsType
Eq ChannelPermissionsOptsType
-> (ChannelPermissionsOptsType
    -> ChannelPermissionsOptsType -> Ordering)
-> (ChannelPermissionsOptsType
    -> ChannelPermissionsOptsType -> Bool)
-> (ChannelPermissionsOptsType
    -> ChannelPermissionsOptsType -> Bool)
-> (ChannelPermissionsOptsType
    -> ChannelPermissionsOptsType -> Bool)
-> (ChannelPermissionsOptsType
    -> ChannelPermissionsOptsType -> Bool)
-> (ChannelPermissionsOptsType
    -> ChannelPermissionsOptsType -> ChannelPermissionsOptsType)
-> (ChannelPermissionsOptsType
    -> ChannelPermissionsOptsType -> ChannelPermissionsOptsType)
-> Ord ChannelPermissionsOptsType
ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
ChannelPermissionsOptsType
-> ChannelPermissionsOptsType -> Ordering
ChannelPermissionsOptsType
-> ChannelPermissionsOptsType -> ChannelPermissionsOptsType
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 :: ChannelPermissionsOptsType
-> ChannelPermissionsOptsType -> ChannelPermissionsOptsType
$cmin :: ChannelPermissionsOptsType
-> ChannelPermissionsOptsType -> ChannelPermissionsOptsType
max :: ChannelPermissionsOptsType
-> ChannelPermissionsOptsType -> ChannelPermissionsOptsType
$cmax :: ChannelPermissionsOptsType
-> ChannelPermissionsOptsType -> ChannelPermissionsOptsType
>= :: ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
$c>= :: ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
> :: ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
$c> :: ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
<= :: ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
$c<= :: ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
< :: ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
$c< :: ChannelPermissionsOptsType -> ChannelPermissionsOptsType -> Bool
compare :: ChannelPermissionsOptsType
-> ChannelPermissionsOptsType -> Ordering
$ccompare :: ChannelPermissionsOptsType
-> ChannelPermissionsOptsType -> Ordering
$cp1Ord :: Eq ChannelPermissionsOptsType
Ord)

instance ToJSON ChannelPermissionsOptsType where
  toJSON :: ChannelPermissionsOptsType -> Value
toJSON ChannelPermissionsOptsType
t = case ChannelPermissionsOptsType
t of ChannelPermissionsOptsType
ChannelPermissionsOptsUser -> Text -> Value
String Text
"member"
                       ChannelPermissionsOptsType
ChannelPermissionsOptsRole -> Text -> Value
String Text
"role"

instance ToJSON ChannelPermissionsOpts where
  toJSON :: ChannelPermissionsOpts -> Value
toJSON (ChannelPermissionsOpts Integer
a Integer
d ChannelPermissionsOptsType
t) = [Pair] -> Value
object [ (Key
"allow", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
a )
                                                 , (Key
"deny", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
d)
                                                 , (Key
"type", ChannelPermissionsOptsType -> Value
forall a. ToJSON a => a -> Value
toJSON ChannelPermissionsOptsType
t)]

-- | https://discord.com/developers/docs/resources/channel#group-dm-add-recipient
data GroupDMAddRecipientOpts = GroupDMAddRecipientOpts
  { GroupDMAddRecipientOpts -> UserId
groupDMAddRecipientUserToAdd :: UserId
  , GroupDMAddRecipientOpts -> Text
groupDMAddRecipientUserToAddNickName :: T.Text
  , GroupDMAddRecipientOpts -> Text
groupDMAddRecipientGDMJoinAccessToken :: T.Text
  } deriving (Int -> GroupDMAddRecipientOpts -> ShowS
[GroupDMAddRecipientOpts] -> ShowS
GroupDMAddRecipientOpts -> String
(Int -> GroupDMAddRecipientOpts -> ShowS)
-> (GroupDMAddRecipientOpts -> String)
-> ([GroupDMAddRecipientOpts] -> ShowS)
-> Show GroupDMAddRecipientOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupDMAddRecipientOpts] -> ShowS
$cshowList :: [GroupDMAddRecipientOpts] -> ShowS
show :: GroupDMAddRecipientOpts -> String
$cshow :: GroupDMAddRecipientOpts -> String
showsPrec :: Int -> GroupDMAddRecipientOpts -> ShowS
$cshowsPrec :: Int -> GroupDMAddRecipientOpts -> ShowS
Show, GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
(GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool)
-> (GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool)
-> Eq GroupDMAddRecipientOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
$c/= :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
== :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
$c== :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
Eq, Eq GroupDMAddRecipientOpts
Eq GroupDMAddRecipientOpts
-> (GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Ordering)
-> (GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool)
-> (GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool)
-> (GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool)
-> (GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool)
-> (GroupDMAddRecipientOpts
    -> GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts)
-> (GroupDMAddRecipientOpts
    -> GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts)
-> Ord GroupDMAddRecipientOpts
GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Ordering
GroupDMAddRecipientOpts
-> GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts
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 :: GroupDMAddRecipientOpts
-> GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts
$cmin :: GroupDMAddRecipientOpts
-> GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts
max :: GroupDMAddRecipientOpts
-> GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts
$cmax :: GroupDMAddRecipientOpts
-> GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts
>= :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
$c>= :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
> :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
$c> :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
<= :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
$c<= :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
< :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
$c< :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Bool
compare :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Ordering
$ccompare :: GroupDMAddRecipientOpts -> GroupDMAddRecipientOpts -> Ordering
$cp1Ord :: Eq GroupDMAddRecipientOpts
Ord)

channelMajorRoute :: ChannelRequest a -> String
channelMajorRoute :: ChannelRequest a -> String
channelMajorRoute ChannelRequest a
c = case ChannelRequest a
c of
  (GetChannel UserId
chan) ->                 String
"get_chan " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (ModifyChannel UserId
chan ModifyChannelOpts
_) ->            String
"mod_chan " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (DeleteChannel UserId
chan) ->              String
"mod_chan " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (GetChannelMessages UserId
chan (Int, MessageTiming)
_) ->            String
"msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (GetChannelMessage (UserId
chan, UserId
_)) ->      String
"get_msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (CreateMessage UserId
chan Text
_) ->                 String
"msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (CreateMessageEmbed UserId
chan Text
_ CreateEmbed
_) ->          String
"msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (CreateMessageUploadFile UserId
chan Text
_ ByteString
_) ->     String
"msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (CreateMessageDetailed UserId
chan MessageDetailedOpts
_) ->         String
"msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (CreateReaction (UserId
chan, UserId
_) Text
_) ->     String
"add_react " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (DeleteOwnReaction (UserId
chan, UserId
_) Text
_) ->      String
"react " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (DeleteUserReaction (UserId
chan, UserId
_) UserId
_ Text
_) ->   String
"react " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (DeleteSingleReaction (UserId
chan, UserId
_) Text
_) ->   String
"react " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (GetReactions (UserId
chan, UserId
_) Text
_ (Int, ReactionTiming)
_) ->         String
"react " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (DeleteAllReactions (UserId
chan, UserId
_)) ->       String
"react " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (EditMessage (UserId
chan, UserId
_) Text
_ Maybe CreateEmbed
_) ->        String
"get_msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (DeleteMessage (UserId
chan, UserId
_)) ->          String
"get_msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (BulkDeleteMessage (UserId
chan, [UserId]
_)) ->     String
"del_msgs " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (EditChannelPermissions UserId
chan UserId
_ ChannelPermissionsOpts
_) ->    String
"perms " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (GetChannelInvites UserId
chan) ->           String
"invites " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (CreateChannelInvite UserId
chan ChannelInviteOpts
_) ->       String
"invites " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (DeleteChannelPermission UserId
chan UserId
_) ->     String
"perms " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (TriggerTypingIndicator UserId
chan) ->          String
"tti " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (GetPinnedMessages UserId
chan) ->              String
"pins " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (AddPinnedMessage (UserId
chan, UserId
_)) ->           String
"pin " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (DeletePinnedMessage (UserId
chan, UserId
_)) ->        String
"pin " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (GroupDMAddRecipient UserId
chan GroupDMAddRecipientOpts
_) ->       String
"groupdm " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan
  (GroupDMRemoveRecipient UserId
chan UserId
_) ->    String
"groupdm " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UserId -> String
forall a. Show a => a -> String
show UserId
chan

cleanupEmoji :: T.Text -> T.Text
cleanupEmoji :: Text -> Text
cleanupEmoji Text
emoji =
  let noAngles :: Text
noAngles = Text -> Text -> Text -> Text
T.replace Text
"<" Text
"" (Text -> Text -> Text -> Text
T.replace Text
">" Text
"" Text
emoji)
      byName :: Maybe Text
byName = String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String
unicodeByName (Text -> String
T.unpack (Text -> Text -> Text -> Text
T.replace Text
":" Text
"" Text
emoji))
  in case (Maybe Text
byName, Text -> Text -> Maybe Text
T.stripPrefix Text
":" Text
noAngles) of
    (Just Text
e, Maybe Text
_) -> Text
e
    (Maybe Text
_, Just Text
a) -> Text
"custom:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a
    (Maybe Text
_, Maybe Text
Nothing) -> Text
noAngles

maybeEmbed :: Maybe CreateEmbed -> [PartM IO]
maybeEmbed :: Maybe CreateEmbed -> [PartM IO]
maybeEmbed = --maybe [] $ \embed -> ["embed" .= createEmbed embed]
      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 Integer
Maybe CreateEmbedImage
Text
createEmbedColor :: CreateEmbed -> Maybe Integer
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 Integer
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) ]]
      in [PartM IO]
-> (CreateEmbed -> [PartM IO]) -> Maybe CreateEmbed -> [PartM IO]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (((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 ([(Text, ByteString)] -> [PartM IO])
-> (CreateEmbed -> [(Text, ByteString)])
-> CreateEmbed
-> [PartM IO]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateEmbed -> [(Text, ByteString)]
forall a. IsString a => CreateEmbed -> [(a, ByteString)]
uploads)

channels :: R.Url 'R.Https
channels :: Url 'Https
channels = Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"channels"

channelJsonRequest :: ChannelRequest r -> JsonRequest
channelJsonRequest :: ChannelRequest r -> JsonRequest
channelJsonRequest ChannelRequest r
c = case ChannelRequest r
c of
  (GetChannel UserId
chan) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan) Option 'Https
forall a. Monoid a => a
mempty

  (ModifyChannel UserId
chan ModifyChannelOpts
patch) ->
      Url 'Https
-> RestIO (ReqBodyJson ModifyChannelOpts)
-> Option 'Https
-> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan) (ReqBodyJson ModifyChannelOpts
-> RestIO (ReqBodyJson ModifyChannelOpts)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModifyChannelOpts -> ReqBodyJson ModifyChannelOpts
forall a. a -> ReqBodyJson a
R.ReqBodyJson ModifyChannelOpts
patch)) Option 'Https
forall a. Monoid a => a
mempty

  (DeleteChannel UserId
chan) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan) Option 'Https
forall a. Monoid a => a
mempty

  (GetChannelMessages UserId
chan (Int
n,MessageTiming
timing)) ->
      let n' :: Int
n' = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then Int
1 else (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
100 then Int
100 else Int
n)
          options :: Option 'Https
options = Text
"limit" Text -> Int -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: Int
n' Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> MessageTiming -> Option 'Https
messageTimingToQuery MessageTiming
timing
      in Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages") Option 'Https
options

  (GetChannelMessage (UserId
chan, UserId
msg)) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
msg) Option 'Https
forall a. Monoid a => a
mempty

  (CreateMessage UserId
chan Text
msg) ->
      let content :: [Pair]
content = [Key
"content" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg]
          body :: RestIO (ReqBodyJson Value)
body = ReqBodyJson Value -> RestIO (ReqBodyJson Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReqBodyJson Value -> RestIO (ReqBodyJson Value))
-> ReqBodyJson Value -> RestIO (ReqBodyJson Value)
forall a b. (a -> b) -> a -> b
$ 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 [Pair]
content
      in Url 'Https
-> RestIO (ReqBodyJson Value) -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages") RestIO (ReqBodyJson Value)
body Option 'Https
forall a. Monoid a => a
mempty

  (CreateMessageEmbed UserId
chan Text
msg CreateEmbed
embed) ->
      let partJson :: PartM IO
partJson = 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
"content" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg, Key
"embed" Key -> Embed -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CreateEmbed -> Embed
createEmbed CreateEmbed
embed]
          body :: RestIO ReqBodyMultipart
body = [PartM IO] -> RestIO ReqBodyMultipart
forall (m :: * -> *). MonadIO m => [PartM IO] -> m ReqBodyMultipart
R.reqBodyMultipart (PartM IO
partJson PartM IO -> [PartM IO] -> [PartM IO]
forall a. a -> [a] -> [a]
: Maybe CreateEmbed -> [PartM IO]
maybeEmbed (CreateEmbed -> Maybe CreateEmbed
forall a. a -> Maybe a
Just CreateEmbed
embed))
      in Url 'Https
-> RestIO ReqBodyMultipart -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages") RestIO ReqBodyMultipart
body Option 'Https
forall a. Monoid a => a
mempty

  (CreateMessageUploadFile UserId
chan Text
fileName ByteString
file) ->
      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
fileName) (RequestBody -> PartM IO) -> RequestBody -> PartM IO
forall a b. (a -> b) -> a -> b
$ ByteString -> RequestBody
RequestBodyBS ByteString
file
          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
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages") RestIO ReqBodyMultipart
body Option 'Https
forall a. Monoid a => a
mempty

  (CreateMessageDetailed UserId
chan MessageDetailedOpts
msgOpts) ->
      let fileUpload :: Maybe (Text, ByteString)
fileUpload = MessageDetailedOpts -> Maybe (Text, ByteString)
messageDetailedFile MessageDetailedOpts
msgOpts
          filePart :: [PartM IO]
filePart = case Maybe (Text, ByteString)
fileUpload of
            Maybe (Text, ByteString)
Nothing -> []
            Just (Text, ByteString)
f  -> [Text -> String -> RequestBody -> PartM IO
forall (m :: * -> *).
Applicative m =>
Text -> String -> RequestBody -> PartM m
partFileRequestBody Text
"file" (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ (Text, ByteString) -> Text
forall a b. (a, b) -> a
fst (Text, ByteString)
f)
              (RequestBody -> PartM IO) -> RequestBody -> PartM IO
forall a b. (a -> b) -> a -> b
$ ByteString -> RequestBody
RequestBodyBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ (Text, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (Text, ByteString)
f]

          payloadData :: Value
payloadData = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Key
"content" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MessageDetailedOpts -> Text
messageDetailedContent MessageDetailedOpts
msgOpts
                                 , Key
"tts"     Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MessageDetailedOpts -> Bool
messageDetailedTTS MessageDetailedOpts
msgOpts ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
                                 [ Key
name Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
value | (Key
name, Just Value
value) <-
                                    [ (Key
"embed", Embed -> Value
forall a. ToJSON a => a -> Value
toJSON (Embed -> Value) -> (CreateEmbed -> Embed) -> CreateEmbed -> Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CreateEmbed -> Embed
createEmbed (CreateEmbed -> Value) -> Maybe CreateEmbed -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MessageDetailedOpts -> Maybe CreateEmbed
messageDetailedEmbed MessageDetailedOpts
msgOpts)
                                    , (Key
"allowed_mentions", AllowedMentions -> Value
forall a. ToJSON a => a -> Value
toJSON (AllowedMentions -> Value) -> Maybe AllowedMentions -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MessageDetailedOpts -> Maybe AllowedMentions
messageDetailedAllowedMentions MessageDetailedOpts
msgOpts)
                                    , (Key
"message_reference", MessageReference -> Value
forall a. ToJSON a => a -> Value
toJSON (MessageReference -> Value)
-> Maybe MessageReference -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MessageDetailedOpts -> Maybe MessageReference
messageDetailedReference MessageDetailedOpts
msgOpts)
                                    ] ]
          payloadPart :: PartM IO
payloadPart = 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
payloadData

          body :: RestIO ReqBodyMultipart
body = [PartM IO] -> RestIO ReqBodyMultipart
forall (m :: * -> *). MonadIO m => [PartM IO] -> m ReqBodyMultipart
R.reqBodyMultipart (PartM IO
payloadPart PartM IO -> [PartM IO] -> [PartM IO]
forall a. a -> [a] -> [a]
: [PartM IO]
filePart)
      in Url 'Https
-> RestIO ReqBodyMultipart -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages") RestIO ReqBodyMultipart
body Option 'Https
forall a. Monoid a => a
mempty

  (CreateReaction (UserId
chan, UserId
msgid) Text
emoji) ->
      let e :: Text
e = Text -> Text
cleanupEmoji Text
emoji
      in Url 'Https -> NoReqBody -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
msgid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"reactions" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
e Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"@me" )
             NoReqBody
R.NoReqBody Option 'Https
forall a. Monoid a => a
mempty

  (DeleteOwnReaction (UserId
chan, UserId
msgid) Text
emoji) ->
      let e :: Text
e = Text -> Text
cleanupEmoji Text
emoji
      in Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
msgid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"reactions" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
e Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"@me" ) Option 'Https
forall a. Monoid a => a
mempty

  (DeleteUserReaction (UserId
chan, UserId
msgid) UserId
uID Text
emoji) ->
      let e :: Text
e = Text -> Text
cleanupEmoji Text
emoji
      in Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
msgid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"reactions" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
e Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
uID ) Option 'Https
forall a. Monoid a => a
mempty

  (DeleteSingleReaction (UserId
chan, UserId
msgid) Text
emoji) ->
    let e :: Text
e = Text -> Text
cleanupEmoji Text
emoji
    in Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
msgid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"reactions" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
e) Option 'Https
forall a. Monoid a => a
mempty

  (GetReactions (UserId
chan, UserId
msgid) Text
emoji (Int
n, ReactionTiming
timing)) ->
      let e :: Text
e = Text -> Text
cleanupEmoji Text
emoji
          n' :: Int
n' = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then Int
1 else (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
100 then Int
100 else Int
n)
          options :: Option 'Https
options = Text
"limit" Text -> Int -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: Int
n' Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> ReactionTiming -> Option 'Https
reactionTimingToQuery ReactionTiming
timing
      in Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
msgid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"reactions" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
e) Option 'Https
options

  (DeleteAllReactions (UserId
chan, UserId
msgid)) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
msgid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"reactions" ) Option 'Https
forall a. Monoid a => a
mempty

  (EditMessage (UserId
chan, UserId
msg) Text
new Maybe CreateEmbed
embed) ->
      let partJson :: Value
partJson = Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Key
"content" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
new] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ case Maybe CreateEmbed
embed of
                                                               Just CreateEmbed
e -> [Key
"embed" Key -> Embed -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CreateEmbed -> Embed
createEmbed CreateEmbed
e]
                                                               Maybe CreateEmbed
Nothing -> []
          body :: RestIO (ReqBodyJson Value)
body = 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
partJson)
      in Url 'Https
-> RestIO (ReqBodyJson Value) -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
msg) RestIO (ReqBodyJson Value)
body Option 'Https
forall a. Monoid a => a
mempty

  (DeleteMessage (UserId
chan, UserId
msg)) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
msg) Option 'Https
forall a. Monoid a => a
mempty

  (BulkDeleteMessage (UserId
chan, [UserId]
msgs)) ->
      let body :: RestIO (ReqBodyJson Value)
body = ReqBodyJson Value -> RestIO (ReqBodyJson Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReqBodyJson Value -> RestIO (ReqBodyJson Value))
-> (Value -> ReqBodyJson Value)
-> Value
-> RestIO (ReqBodyJson Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
R.ReqBodyJson (Value -> RestIO (ReqBodyJson Value))
-> Value -> RestIO (ReqBodyJson Value)
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [Key
"messages" Key -> [UserId] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [UserId]
msgs]
      in Url 'Https
-> RestIO (ReqBodyJson Value) -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"bulk-delete") RestIO (ReqBodyJson Value)
body Option 'Https
forall a. Monoid a => a
mempty

  (EditChannelPermissions UserId
chan UserId
perm ChannelPermissionsOpts
patch) ->
      Url 'Https
-> ReqBodyJson ChannelPermissionsOpts
-> Option 'Https
-> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"permissions" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
perm) (ChannelPermissionsOpts -> ReqBodyJson ChannelPermissionsOpts
forall a. a -> ReqBodyJson a
R.ReqBodyJson ChannelPermissionsOpts
patch) Option 'Https
forall a. Monoid a => a
mempty

  (GetChannelInvites UserId
chan) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"invites") Option 'Https
forall a. Monoid a => a
mempty

  (CreateChannelInvite UserId
chan ChannelInviteOpts
patch) ->
      Url 'Https
-> RestIO (ReqBodyJson ChannelInviteOpts)
-> Option 'Https
-> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"invites") (ReqBodyJson ChannelInviteOpts
-> RestIO (ReqBodyJson ChannelInviteOpts)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChannelInviteOpts -> ReqBodyJson ChannelInviteOpts
forall a. a -> ReqBodyJson a
R.ReqBodyJson ChannelInviteOpts
patch)) Option 'Https
forall a. Monoid a => a
mempty

  (DeleteChannelPermission UserId
chan UserId
perm) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"permissions" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
perm) Option 'Https
forall a. Monoid a => a
mempty

  (TriggerTypingIndicator UserId
chan) ->
      Url 'Https -> RestIO NoReqBody -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"typing") (NoReqBody -> RestIO NoReqBody
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoReqBody
R.NoReqBody) Option 'Https
forall a. Monoid a => a
mempty

  (GetPinnedMessages UserId
chan) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"pins") Option 'Https
forall a. Monoid a => a
mempty

  (AddPinnedMessage (UserId
chan, UserId
msg)) ->
      Url 'Https -> NoReqBody -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"pins" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
msg) NoReqBody
R.NoReqBody Option 'Https
forall a. Monoid a => a
mempty

  (DeletePinnedMessage (UserId
chan, UserId
msg)) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"pins" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
msg) Option 'Https
forall a. Monoid a => a
mempty

  (GroupDMAddRecipient UserId
chan (GroupDMAddRecipientOpts UserId
uid Text
nick Text
tok)) ->
      Url 'Https -> ReqBodyJson Value -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"recipients" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
uid)
          (Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
R.ReqBodyJson ([Pair] -> Value
object [ (Key
"access_token", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
tok)
                                 , (Key
"nick", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
nick)]))
          Option 'Https
forall a. Monoid a => a
mempty

  (GroupDMRemoveRecipient UserId
chan UserId
userid) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"recipients" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// UserId
userid) Option 'Https
forall a. Monoid a => a
mempty