{-# 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(..)
  , StartThreadOpts(..)
  , StartThreadNoMessageOpts(..)
  , ListThreads(..)
  ) 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)
import Network.HTTP.Req ((/:), (/~))
import qualified Network.HTTP.Req as R

import Discord.Internal.Rest.Prelude
import Discord.Internal.Types
import Control.Monad (join)

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 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) -> MessageDetailedOpts
                                                      -> 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 -> Either RoleId UserId -> 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 -> Either RoleId UserId -> 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 ()
  -- | Start a thread from a message
  StartThreadFromMessage    :: ChannelId -> MessageId -> StartThreadOpts -> ChannelRequest Channel
  -- | Start a thread without a message
  StartThreadNoMessage      :: ChannelId -> StartThreadNoMessageOpts -> ChannelRequest Channel
  -- | Join a thread
  JoinThread                :: ChannelId -> ChannelRequest ()
  -- | Add a thread member
  AddThreadMember           :: ChannelId -> UserId -> ChannelRequest ()
  -- | Leave a thread
  LeaveThread               :: ChannelId -> ChannelRequest ()
  -- | Remove a thread member
  RemoveThreadMember        :: ChannelId -> UserId -> ChannelRequest ()
  -- | Get a thread member
  GetThreadMember           :: ChannelId -> UserId -> ChannelRequest ThreadMember
  -- | List the thread members
  ListThreadMembers         :: ChannelId -> ChannelRequest [ThreadMember]
  -- | List public archived threads in the given channel. Optionally before a 
  -- given time, and optional maximum number of threads. Returns the threads, 
  -- thread members,  and whether there are more to collect.
  -- Requires the READ_MESSAGE_HISTORY permission.
  ListPublicArchivedThreads :: ChannelId -> (Maybe UTCTime, Maybe Integer) -> ChannelRequest ListThreads
  -- | List private archived threads in the given channel. Optionally before a 
  -- given time, and optional maximum number of threads. Returns the threads, 
  -- thread members, and whether there are more to collect.
  -- Requires both the READ_MESSAGE_HISTORY and MANAGE_THREADS permissions.
  ListPrivateArchivedThreads :: ChannelId -> (Maybe UTCTime, Maybe Integer) -> ChannelRequest ListThreads
  -- | List joined private archived threads in the given channel. Optionally 
  -- before a  given time, and optional maximum number of threads. Returns the 
  -- threads, thread members, and whether there are more to collect.
  -- Requires both the READ_MESSAGE_HISTORY and MANAGE_THREADS permissions.
  ListJoinedPrivateArchivedThreads :: ChannelId -> (Maybe UTCTime, Maybe Integer) -> ChannelRequest ListThreads


-- | Options for `CreateMessageDetailed` requests.
data MessageDetailedOpts = MessageDetailedOpts
  { -- | The message contents (up to 2000 characters)
    MessageDetailedOpts -> Text
messageDetailedContent                  :: T.Text
  , -- | `True` if this is a TTS message
    MessageDetailedOpts -> Bool
messageDetailedTTS                      :: Bool
  , -- | embedded rich content (up to 6000 characters)
    MessageDetailedOpts -> Maybe [CreateEmbed]
messageDetailedEmbeds                   :: Maybe [CreateEmbed]
  , -- | the contents of the file being sent
    MessageDetailedOpts -> Maybe (Text, ByteString)
messageDetailedFile                     :: Maybe (T.Text, B.ByteString)
  , -- | allowed mentions for the message
    MessageDetailedOpts -> Maybe AllowedMentions
messageDetailedAllowedMentions          :: Maybe AllowedMentions
  , -- | If `Just`, reply to the message referenced
    MessageDetailedOpts -> Maybe MessageReference
messageDetailedReference                :: Maybe MessageReference
  , -- | Message components for the message
    MessageDetailedOpts -> Maybe [ActionRow]
messageDetailedComponents               :: Maybe [ActionRow]
  , -- | IDs of up to 3 `Sticker` in the server to send with the message
    MessageDetailedOpts -> Maybe [StickerId]
messageDetailedStickerIds               :: Maybe [StickerId]
  } 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, ReadPrec [MessageDetailedOpts]
ReadPrec MessageDetailedOpts
Int -> ReadS MessageDetailedOpts
ReadS [MessageDetailedOpts]
(Int -> ReadS MessageDetailedOpts)
-> ReadS [MessageDetailedOpts]
-> ReadPrec MessageDetailedOpts
-> ReadPrec [MessageDetailedOpts]
-> Read MessageDetailedOpts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MessageDetailedOpts]
$creadListPrec :: ReadPrec [MessageDetailedOpts]
readPrec :: ReadPrec MessageDetailedOpts
$creadPrec :: ReadPrec MessageDetailedOpts
readList :: ReadS [MessageDetailedOpts]
$creadList :: ReadS [MessageDetailedOpts]
readsPrec :: Int -> ReadS MessageDetailedOpts
$creadsPrec :: Int -> ReadS MessageDetailedOpts
Read, 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
-> Maybe [ActionRow]
-> Maybe [StickerId]
-> MessageDetailedOpts
MessageDetailedOpts { messageDetailedContent :: Text
messageDetailedContent         = Text
""
                            , messageDetailedTTS :: Bool
messageDetailedTTS             = Bool
False
                            , messageDetailedEmbeds :: Maybe [CreateEmbed]
messageDetailedEmbeds          = 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
                            , messageDetailedComponents :: Maybe [ActionRow]
messageDetailedComponents      = Maybe [ActionRow]
forall a. Maybe a
Nothing
                            , messageDetailedStickerIds :: Maybe [StickerId]
messageDetailedStickerIds      = Maybe [StickerId]
forall a. Maybe a
Nothing
                            }

-- | Data constructor for `GetReactions` 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, ReadPrec [ReactionTiming]
ReadPrec ReactionTiming
Int -> ReadS ReactionTiming
ReadS [ReactionTiming]
(Int -> ReadS ReactionTiming)
-> ReadS [ReactionTiming]
-> ReadPrec ReactionTiming
-> ReadPrec [ReactionTiming]
-> Read ReactionTiming
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReactionTiming]
$creadListPrec :: ReadPrec [ReactionTiming]
readPrec :: ReadPrec ReactionTiming
$creadPrec :: ReadPrec ReactionTiming
readList :: ReadS [ReactionTiming]
$creadList :: ReadS [ReactionTiming]
readsPrec :: Int -> ReadS ReactionTiming
$creadsPrec :: Int -> ReadS ReactionTiming
Read, 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 MessageId
snow) -> Text
"before" Text -> String -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: MessageId -> String
forall a. Show a => a -> String
show MessageId
snow
  (AfterReaction MessageId
snow) -> Text
"after"  Text -> String -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: MessageId -> String
forall a. Show a => a -> String
show MessageId
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, ReadPrec [MessageTiming]
ReadPrec MessageTiming
Int -> ReadS MessageTiming
ReadS [MessageTiming]
(Int -> ReadS MessageTiming)
-> ReadS [MessageTiming]
-> ReadPrec MessageTiming
-> ReadPrec [MessageTiming]
-> Read MessageTiming
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MessageTiming]
$creadListPrec :: ReadPrec [MessageTiming]
readPrec :: ReadPrec MessageTiming
$creadPrec :: ReadPrec MessageTiming
readList :: ReadS [MessageTiming]
$creadList :: ReadS [MessageTiming]
readsPrec :: Int -> ReadS MessageTiming
$creadsPrec :: Int -> ReadS MessageTiming
Read, 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 MessageId
snow) -> Text
"around" Text -> String -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: MessageId -> String
forall a. Show a => a -> String
show MessageId
snow
  (BeforeMessage MessageId
snow) -> Text
"before" Text -> String -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: MessageId -> String
forall a. Show a => a -> String
show MessageId
snow
  (AfterMessage MessageId
snow) -> Text
"after"  Text -> String -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=: MessageId -> String
forall a. Show a => a -> String
show MessageId
snow
  (MessageTiming
LatestMessages) -> Option 'Https
forall a. Monoid a => a
mempty

-- | Options for `CreateChannelInvite` requests
data ChannelInviteOpts = ChannelInviteOpts
  { -- | How long the invite is valid for (in seconds)
    ChannelInviteOpts -> Maybe Integer
channelInviteOptsMaxAgeSeconds          :: Maybe Integer
  , -- | How many uses the invite is valid for
    ChannelInviteOpts -> Maybe Integer
channelInviteOptsMaxUsages              :: Maybe Integer
  , -- | Whether this invite only grants temporary membership
    ChannelInviteOpts -> Maybe Bool
channelInviteOptsIsTemporary            :: Maybe Bool
  , -- | Don't reuse a similar invite. Useful for creating many unique one time
    -- use invites
    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, ReadPrec [ChannelInviteOpts]
ReadPrec ChannelInviteOpts
Int -> ReadS ChannelInviteOpts
ReadS [ChannelInviteOpts]
(Int -> ReadS ChannelInviteOpts)
-> ReadS [ChannelInviteOpts]
-> ReadPrec ChannelInviteOpts
-> ReadPrec [ChannelInviteOpts]
-> Read ChannelInviteOpts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelInviteOpts]
$creadListPrec :: ReadPrec [ChannelInviteOpts]
readPrec :: ReadPrec ChannelInviteOpts
$creadPrec :: ReadPrec ChannelInviteOpts
readList :: ReadS [ChannelInviteOpts]
$creadList :: ReadS [ChannelInviteOpts]
readsPrec :: Int -> ReadS ChannelInviteOpts
$creadsPrec :: Int -> ReadS ChannelInviteOpts
Read, 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 [(Text
name, Value
val) | (Text
name, Just Value
val) <-
                         [(Text
"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),
                          (Text
"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),
                          (Text
"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),
                          (Text
"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) ] ]

-- | Options for `ModifyChannel` requests
data ModifyChannelOpts = ModifyChannelOpts
  { -- | (All) The name of the channel (max 100 characters)
    ModifyChannelOpts -> Maybe Text
modifyChannelName                 :: Maybe T.Text
  , -- | (All) Position of the channel in the listing
    ModifyChannelOpts -> Maybe Integer
modifyChannelPosition             :: Maybe Integer
  , -- | (Text) The channel topic text (max 1024 characters)
    ModifyChannelOpts -> Maybe Text
modifyChannelTopic                :: Maybe T.Text
  , -- | (Text) Wether the channel is tagged as NSFW
    ModifyChannelOpts -> Maybe Bool
modifyChannelNSFW                 :: Maybe Bool
  , -- | (Voice) Bitrate (in bps) of a voice channel. Min 8000, max 96000
    -- (128000 for boosted servers)
    ModifyChannelOpts -> Maybe Integer
modifyChannelBitrate              :: Maybe Integer
  , -- | (Text) The rate limit of the channel, in seconds (0-21600), does not
    -- affect bots and users with @manage_channel@ or @manage_messages@
    -- permissons
    ModifyChannelOpts -> Maybe Integer
modifyChannelUserRateLimit        :: Maybe Integer
  , -- | (Voice) the user limit of the voice channel, max 99
    ModifyChannelOpts -> Maybe Integer
modifyChannelUserLimit            :: Maybe Integer
  , -- | (All) The channel permissions
    ModifyChannelOpts -> Maybe [Overwrite]
modifyChannelPermissionOverwrites :: Maybe [Overwrite]
  , -- | (All) The parent category of the channel
    ModifyChannelOpts -> Maybe ChannelId
modifyChannelParentId             :: Maybe ChannelId
  , -- | (Text) Auto-archive duration for Threads
    ModifyChannelOpts -> Maybe Integer
modifyChannelDefaultAutoArchive   :: Maybe Integer
  , -- | (Thread) Whether the thread is archived
    ModifyChannelOpts -> Maybe Bool
modifyChannelThreadArchived       :: Maybe Bool
  , -- | (Thread) duration in minutes to automatically archive the thread after
    -- recent activity, can be set to: 60, 1440, 4320 or 10080
    ModifyChannelOpts -> Maybe Integer
modifyChannelThreadAutoArchive    :: Maybe Integer
  , -- | (Thread) Whether the thread is locked. When a thread is locked, only
    -- users with @manage_threads@ can unarchive it
    ModifyChannelOpts -> Maybe Bool
modifyChannelThreadLocked         :: Maybe Bool
  , -- | (Thread) Whether non-moderators can add other non-moderators to a
    -- thread. Only available on private threads
    ModifyChannelOpts -> Maybe Bool
modifyChannelThreadInvitable     :: Maybe Bool
  } 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, ReadPrec [ModifyChannelOpts]
ReadPrec ModifyChannelOpts
Int -> ReadS ModifyChannelOpts
ReadS [ModifyChannelOpts]
(Int -> ReadS ModifyChannelOpts)
-> ReadS [ModifyChannelOpts]
-> ReadPrec ModifyChannelOpts
-> ReadPrec [ModifyChannelOpts]
-> Read ModifyChannelOpts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyChannelOpts]
$creadListPrec :: ReadPrec [ModifyChannelOpts]
readPrec :: ReadPrec ModifyChannelOpts
$creadPrec :: ReadPrec ModifyChannelOpts
readList :: ReadS [ModifyChannelOpts]
$creadList :: ReadS [ModifyChannelOpts]
readsPrec :: Int -> ReadS ModifyChannelOpts
$creadsPrec :: Int -> ReadS ModifyChannelOpts
Read, 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 Default ModifyChannelOpts where
  def :: ModifyChannelOpts
def = Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Bool
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> Maybe [Overwrite]
-> Maybe ChannelId
-> Maybe Integer
-> Maybe Bool
-> Maybe Integer
-> Maybe Bool
-> Maybe Bool
-> ModifyChannelOpts
ModifyChannelOpts Maybe Text
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe [Overwrite]
forall a. Maybe a
Nothing Maybe ChannelId
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

instance ToJSON ModifyChannelOpts where
  toJSON :: ModifyChannelOpts -> Value
toJSON ModifyChannelOpts{Maybe Bool
Maybe Integer
Maybe [Overwrite]
Maybe Text
Maybe ChannelId
modifyChannelThreadInvitable :: Maybe Bool
modifyChannelThreadLocked :: Maybe Bool
modifyChannelThreadAutoArchive :: Maybe Integer
modifyChannelThreadArchived :: Maybe Bool
modifyChannelDefaultAutoArchive :: Maybe Integer
modifyChannelParentId :: Maybe ChannelId
modifyChannelPermissionOverwrites :: Maybe [Overwrite]
modifyChannelUserLimit :: Maybe Integer
modifyChannelUserRateLimit :: Maybe Integer
modifyChannelBitrate :: Maybe Integer
modifyChannelNSFW :: Maybe Bool
modifyChannelTopic :: Maybe Text
modifyChannelPosition :: Maybe Integer
modifyChannelName :: Maybe Text
modifyChannelThreadInvitable :: ModifyChannelOpts -> Maybe Bool
modifyChannelThreadLocked :: ModifyChannelOpts -> Maybe Bool
modifyChannelThreadAutoArchive :: ModifyChannelOpts -> Maybe Integer
modifyChannelThreadArchived :: ModifyChannelOpts -> Maybe Bool
modifyChannelDefaultAutoArchive :: ModifyChannelOpts -> Maybe Integer
modifyChannelParentId :: ModifyChannelOpts -> Maybe ChannelId
modifyChannelPermissionOverwrites :: ModifyChannelOpts -> Maybe [Overwrite]
modifyChannelUserLimit :: ModifyChannelOpts -> Maybe Integer
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 [(Text
name, Value
val) | (Text
name, Just Value
val) <-
               [(Text
"name",       Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
modifyChannelName),
                (Text
"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),
                (Text
"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),
                (Text
"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),
                (Text
"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),
                (Text
"rate_limit_per_user", 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),
                (Text
"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
modifyChannelUserLimit),
                (Text
"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),
                (Text
"parent_id",  ChannelId -> Value
forall a. ToJSON a => a -> Value
toJSON (ChannelId -> Value) -> Maybe ChannelId -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ChannelId
modifyChannelParentId),
                (Text
"default_auto_archive_duration",  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
modifyChannelDefaultAutoArchive),
                (Text
"archived",  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
modifyChannelThreadArchived),
                (Text
"auto_archive_duration",  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
modifyChannelThreadAutoArchive),
                (Text
"locked",  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
modifyChannelThreadLocked),
                (Text
"invitable",  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
modifyChannelThreadInvitable) ] ]

-- | Options for The `EditChannelPermissions` request
--
-- Since the JSON encoding of this datatype will require information in the
-- route (the Either decides whether the overwrite is for a user or a role), we
-- do not provide a ToJSON instance. Instead, the JSON is manually constructed
-- in the 'channelJsonRequest' function.
data ChannelPermissionsOpts = ChannelPermissionsOpts
  { -- | The permission integer for the explicitly allowed permissions
    ChannelPermissionsOpts -> Integer
channelPermissionsOptsAllow :: Integer
  , -- | The permission integer for the explicitly denied permissions
    ChannelPermissionsOpts -> Integer
channelPermissionsOptsDeny :: Integer
  } 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, ReadPrec [ChannelPermissionsOpts]
ReadPrec ChannelPermissionsOpts
Int -> ReadS ChannelPermissionsOpts
ReadS [ChannelPermissionsOpts]
(Int -> ReadS ChannelPermissionsOpts)
-> ReadS [ChannelPermissionsOpts]
-> ReadPrec ChannelPermissionsOpts
-> ReadPrec [ChannelPermissionsOpts]
-> Read ChannelPermissionsOpts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ChannelPermissionsOpts]
$creadListPrec :: ReadPrec [ChannelPermissionsOpts]
readPrec :: ReadPrec ChannelPermissionsOpts
$creadPrec :: ReadPrec ChannelPermissionsOpts
readList :: ReadS [ChannelPermissionsOpts]
$creadList :: ReadS [ChannelPermissionsOpts]
readsPrec :: Int -> ReadS ChannelPermissionsOpts
$creadsPrec :: Int -> ReadS ChannelPermissionsOpts
Read, 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)

-- | Options for `GroupDMAddRecipient` request
--
-- See <https://discord.com/developers/docs/resources/channel#group-dm-add-recipient>
data GroupDMAddRecipientOpts = GroupDMAddRecipientOpts
  { -- | The id of the user to add to the Group DM
    GroupDMAddRecipientOpts -> UserId
groupDMAddRecipientUserToAdd :: UserId
  , -- | The nickname given to the user being added
    GroupDMAddRecipientOpts -> Text
groupDMAddRecipientUserToAddNickName :: T.Text
  , -- | Access token of the user. That user must have granted your app the
    -- @gdm.join@ scope.
    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, ReadPrec [GroupDMAddRecipientOpts]
ReadPrec GroupDMAddRecipientOpts
Int -> ReadS GroupDMAddRecipientOpts
ReadS [GroupDMAddRecipientOpts]
(Int -> ReadS GroupDMAddRecipientOpts)
-> ReadS [GroupDMAddRecipientOpts]
-> ReadPrec GroupDMAddRecipientOpts
-> ReadPrec [GroupDMAddRecipientOpts]
-> Read GroupDMAddRecipientOpts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GroupDMAddRecipientOpts]
$creadListPrec :: ReadPrec [GroupDMAddRecipientOpts]
readPrec :: ReadPrec GroupDMAddRecipientOpts
$creadPrec :: ReadPrec GroupDMAddRecipientOpts
readList :: ReadS [GroupDMAddRecipientOpts]
$creadList :: ReadS [GroupDMAddRecipientOpts]
readsPrec :: Int -> ReadS GroupDMAddRecipientOpts
$creadsPrec :: Int -> ReadS GroupDMAddRecipientOpts
Read, 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)

-- | Options for `StartThreadFromMessage` request
data StartThreadOpts = StartThreadOpts 
  { -- | Name of the thread
    StartThreadOpts -> Text
startThreadName :: T.Text
  , -- | Period of innactivity after which the thread gets archived in minutes.
    -- 
    -- Can be one of 60, 1440, 4320, 10080
    StartThreadOpts -> Maybe Integer
startThreadAutoArchive :: Maybe Integer
  , -- | Amount of seconds a user has to wait before sending another message
    -- (0-21600)
    StartThreadOpts -> Maybe Integer
startThreadRateLimit :: Maybe Integer
  } deriving (Int -> StartThreadOpts -> ShowS
[StartThreadOpts] -> ShowS
StartThreadOpts -> String
(Int -> StartThreadOpts -> ShowS)
-> (StartThreadOpts -> String)
-> ([StartThreadOpts] -> ShowS)
-> Show StartThreadOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartThreadOpts] -> ShowS
$cshowList :: [StartThreadOpts] -> ShowS
show :: StartThreadOpts -> String
$cshow :: StartThreadOpts -> String
showsPrec :: Int -> StartThreadOpts -> ShowS
$cshowsPrec :: Int -> StartThreadOpts -> ShowS
Show, ReadPrec [StartThreadOpts]
ReadPrec StartThreadOpts
Int -> ReadS StartThreadOpts
ReadS [StartThreadOpts]
(Int -> ReadS StartThreadOpts)
-> ReadS [StartThreadOpts]
-> ReadPrec StartThreadOpts
-> ReadPrec [StartThreadOpts]
-> Read StartThreadOpts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartThreadOpts]
$creadListPrec :: ReadPrec [StartThreadOpts]
readPrec :: ReadPrec StartThreadOpts
$creadPrec :: ReadPrec StartThreadOpts
readList :: ReadS [StartThreadOpts]
$creadList :: ReadS [StartThreadOpts]
readsPrec :: Int -> ReadS StartThreadOpts
$creadsPrec :: Int -> ReadS StartThreadOpts
Read, StartThreadOpts -> StartThreadOpts -> Bool
(StartThreadOpts -> StartThreadOpts -> Bool)
-> (StartThreadOpts -> StartThreadOpts -> Bool)
-> Eq StartThreadOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartThreadOpts -> StartThreadOpts -> Bool
$c/= :: StartThreadOpts -> StartThreadOpts -> Bool
== :: StartThreadOpts -> StartThreadOpts -> Bool
$c== :: StartThreadOpts -> StartThreadOpts -> Bool
Eq, Eq StartThreadOpts
Eq StartThreadOpts
-> (StartThreadOpts -> StartThreadOpts -> Ordering)
-> (StartThreadOpts -> StartThreadOpts -> Bool)
-> (StartThreadOpts -> StartThreadOpts -> Bool)
-> (StartThreadOpts -> StartThreadOpts -> Bool)
-> (StartThreadOpts -> StartThreadOpts -> Bool)
-> (StartThreadOpts -> StartThreadOpts -> StartThreadOpts)
-> (StartThreadOpts -> StartThreadOpts -> StartThreadOpts)
-> Ord StartThreadOpts
StartThreadOpts -> StartThreadOpts -> Bool
StartThreadOpts -> StartThreadOpts -> Ordering
StartThreadOpts -> StartThreadOpts -> StartThreadOpts
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 :: StartThreadOpts -> StartThreadOpts -> StartThreadOpts
$cmin :: StartThreadOpts -> StartThreadOpts -> StartThreadOpts
max :: StartThreadOpts -> StartThreadOpts -> StartThreadOpts
$cmax :: StartThreadOpts -> StartThreadOpts -> StartThreadOpts
>= :: StartThreadOpts -> StartThreadOpts -> Bool
$c>= :: StartThreadOpts -> StartThreadOpts -> Bool
> :: StartThreadOpts -> StartThreadOpts -> Bool
$c> :: StartThreadOpts -> StartThreadOpts -> Bool
<= :: StartThreadOpts -> StartThreadOpts -> Bool
$c<= :: StartThreadOpts -> StartThreadOpts -> Bool
< :: StartThreadOpts -> StartThreadOpts -> Bool
$c< :: StartThreadOpts -> StartThreadOpts -> Bool
compare :: StartThreadOpts -> StartThreadOpts -> Ordering
$ccompare :: StartThreadOpts -> StartThreadOpts -> Ordering
$cp1Ord :: Eq StartThreadOpts
Ord)

instance ToJSON StartThreadOpts where
  toJSON :: StartThreadOpts -> Value
toJSON StartThreadOpts{Maybe Integer
Text
startThreadRateLimit :: Maybe Integer
startThreadAutoArchive :: Maybe Integer
startThreadName :: Text
startThreadRateLimit :: StartThreadOpts -> Maybe Integer
startThreadAutoArchive :: StartThreadOpts -> Maybe Integer
startThreadName :: StartThreadOpts -> Text
..} = [Pair] -> Value
object [ (Text
name, Value
value) | (Text
name, Just Value
value) <- 
      [ (Text
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
startThreadName)
      , (Text
"auto_archive_duration", 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
startThreadAutoArchive)
      , (Text
"rate_limit_per_user", 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
startThreadRateLimit)
      ]
    ]

-- | Options for `StartThreadNoMessage` request
data StartThreadNoMessageOpts = StartThreadNoMessageOpts
  { -- | Base options for the thread
    StartThreadNoMessageOpts -> StartThreadOpts
startThreadNoMessageBaseOpts :: StartThreadOpts
  , -- | The type of thread to create
    --
    -- Can be @10@, @11@, or @12@. See
    -- <https://discord.com/developers/docs/resources/channel#channel-object-channel-types>
    StartThreadNoMessageOpts -> Integer
startThreadNoMessageType :: Integer
  , -- | Whether non-moderators can add other non-moderators to a thread. Only
    -- available when creating a private thread.
    StartThreadNoMessageOpts -> Maybe Bool
startThreadNoMessageInvitable :: Maybe Bool
  } deriving (Int -> StartThreadNoMessageOpts -> ShowS
[StartThreadNoMessageOpts] -> ShowS
StartThreadNoMessageOpts -> String
(Int -> StartThreadNoMessageOpts -> ShowS)
-> (StartThreadNoMessageOpts -> String)
-> ([StartThreadNoMessageOpts] -> ShowS)
-> Show StartThreadNoMessageOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartThreadNoMessageOpts] -> ShowS
$cshowList :: [StartThreadNoMessageOpts] -> ShowS
show :: StartThreadNoMessageOpts -> String
$cshow :: StartThreadNoMessageOpts -> String
showsPrec :: Int -> StartThreadNoMessageOpts -> ShowS
$cshowsPrec :: Int -> StartThreadNoMessageOpts -> ShowS
Show, ReadPrec [StartThreadNoMessageOpts]
ReadPrec StartThreadNoMessageOpts
Int -> ReadS StartThreadNoMessageOpts
ReadS [StartThreadNoMessageOpts]
(Int -> ReadS StartThreadNoMessageOpts)
-> ReadS [StartThreadNoMessageOpts]
-> ReadPrec StartThreadNoMessageOpts
-> ReadPrec [StartThreadNoMessageOpts]
-> Read StartThreadNoMessageOpts
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartThreadNoMessageOpts]
$creadListPrec :: ReadPrec [StartThreadNoMessageOpts]
readPrec :: ReadPrec StartThreadNoMessageOpts
$creadPrec :: ReadPrec StartThreadNoMessageOpts
readList :: ReadS [StartThreadNoMessageOpts]
$creadList :: ReadS [StartThreadNoMessageOpts]
readsPrec :: Int -> ReadS StartThreadNoMessageOpts
$creadsPrec :: Int -> ReadS StartThreadNoMessageOpts
Read, StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
(StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool)
-> (StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool)
-> Eq StartThreadNoMessageOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
$c/= :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
== :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
$c== :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
Eq, Eq StartThreadNoMessageOpts
Eq StartThreadNoMessageOpts
-> (StartThreadNoMessageOpts
    -> StartThreadNoMessageOpts -> Ordering)
-> (StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool)
-> (StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool)
-> (StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool)
-> (StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool)
-> (StartThreadNoMessageOpts
    -> StartThreadNoMessageOpts -> StartThreadNoMessageOpts)
-> (StartThreadNoMessageOpts
    -> StartThreadNoMessageOpts -> StartThreadNoMessageOpts)
-> Ord StartThreadNoMessageOpts
StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Ordering
StartThreadNoMessageOpts
-> StartThreadNoMessageOpts -> StartThreadNoMessageOpts
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 :: StartThreadNoMessageOpts
-> StartThreadNoMessageOpts -> StartThreadNoMessageOpts
$cmin :: StartThreadNoMessageOpts
-> StartThreadNoMessageOpts -> StartThreadNoMessageOpts
max :: StartThreadNoMessageOpts
-> StartThreadNoMessageOpts -> StartThreadNoMessageOpts
$cmax :: StartThreadNoMessageOpts
-> StartThreadNoMessageOpts -> StartThreadNoMessageOpts
>= :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
$c>= :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
> :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
$c> :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
<= :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
$c<= :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
< :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
$c< :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Bool
compare :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Ordering
$ccompare :: StartThreadNoMessageOpts -> StartThreadNoMessageOpts -> Ordering
$cp1Ord :: Eq StartThreadNoMessageOpts
Ord)

instance ToJSON StartThreadNoMessageOpts where
  toJSON :: StartThreadNoMessageOpts -> Value
toJSON StartThreadNoMessageOpts{Integer
Maybe Bool
StartThreadOpts
startThreadNoMessageInvitable :: Maybe Bool
startThreadNoMessageType :: Integer
startThreadNoMessageBaseOpts :: StartThreadOpts
startThreadNoMessageInvitable :: StartThreadNoMessageOpts -> Maybe Bool
startThreadNoMessageType :: StartThreadNoMessageOpts -> Integer
startThreadNoMessageBaseOpts :: StartThreadNoMessageOpts -> StartThreadOpts
..} = [Pair] -> Value
object [ (Text
name, Value
value) | (Text
name, Just Value
value) <- 
      [ (Text
"name", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StartThreadOpts -> Text
startThreadName StartThreadOpts
startThreadNoMessageBaseOpts))
      , (Text
"auto_archive_duration", 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
<$> (StartThreadOpts -> Maybe Integer
startThreadAutoArchive StartThreadOpts
startThreadNoMessageBaseOpts))
      , (Text
"rate_limit_per_user", 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
<$> (StartThreadOpts -> Maybe Integer
startThreadRateLimit StartThreadOpts
startThreadNoMessageBaseOpts))
      , (Text
"type", 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
<$> Integer -> Maybe Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
startThreadNoMessageType)
      , (Text
"invitable", 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
startThreadNoMessageInvitable)
      ]
    ]

-- | Result type of `ListJoinedPrivateArchivedThreads`,
-- `ListPrivateArchivedThreads` and `ListPublicArchivedThreads`
data ListThreads = ListThreads 
  { -- | The returned threads
    ListThreads -> [Channel]
listThreadsThreads :: [Channel]
  , -- | A thread member object for each returned thread the current user has
    -- joined
    ListThreads -> [ThreadMember]
listThreadsMembers :: [ThreadMember]
  ,  -- | Whether there is more data to retrieve
    ListThreads -> Bool
listThreadsHasMore :: Bool
  } deriving (Int -> ListThreads -> ShowS
[ListThreads] -> ShowS
ListThreads -> String
(Int -> ListThreads -> ShowS)
-> (ListThreads -> String)
-> ([ListThreads] -> ShowS)
-> Show ListThreads
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListThreads] -> ShowS
$cshowList :: [ListThreads] -> ShowS
show :: ListThreads -> String
$cshow :: ListThreads -> String
showsPrec :: Int -> ListThreads -> ShowS
$cshowsPrec :: Int -> ListThreads -> ShowS
Show, ReadPrec [ListThreads]
ReadPrec ListThreads
Int -> ReadS ListThreads
ReadS [ListThreads]
(Int -> ReadS ListThreads)
-> ReadS [ListThreads]
-> ReadPrec ListThreads
-> ReadPrec [ListThreads]
-> Read ListThreads
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListThreads]
$creadListPrec :: ReadPrec [ListThreads]
readPrec :: ReadPrec ListThreads
$creadPrec :: ReadPrec ListThreads
readList :: ReadS [ListThreads]
$creadList :: ReadS [ListThreads]
readsPrec :: Int -> ReadS ListThreads
$creadsPrec :: Int -> ReadS ListThreads
Read, ListThreads -> ListThreads -> Bool
(ListThreads -> ListThreads -> Bool)
-> (ListThreads -> ListThreads -> Bool) -> Eq ListThreads
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListThreads -> ListThreads -> Bool
$c/= :: ListThreads -> ListThreads -> Bool
== :: ListThreads -> ListThreads -> Bool
$c== :: ListThreads -> ListThreads -> Bool
Eq, Eq ListThreads
Eq ListThreads
-> (ListThreads -> ListThreads -> Ordering)
-> (ListThreads -> ListThreads -> Bool)
-> (ListThreads -> ListThreads -> Bool)
-> (ListThreads -> ListThreads -> Bool)
-> (ListThreads -> ListThreads -> Bool)
-> (ListThreads -> ListThreads -> ListThreads)
-> (ListThreads -> ListThreads -> ListThreads)
-> Ord ListThreads
ListThreads -> ListThreads -> Bool
ListThreads -> ListThreads -> Ordering
ListThreads -> ListThreads -> ListThreads
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 :: ListThreads -> ListThreads -> ListThreads
$cmin :: ListThreads -> ListThreads -> ListThreads
max :: ListThreads -> ListThreads -> ListThreads
$cmax :: ListThreads -> ListThreads -> ListThreads
>= :: ListThreads -> ListThreads -> Bool
$c>= :: ListThreads -> ListThreads -> Bool
> :: ListThreads -> ListThreads -> Bool
$c> :: ListThreads -> ListThreads -> Bool
<= :: ListThreads -> ListThreads -> Bool
$c<= :: ListThreads -> ListThreads -> Bool
< :: ListThreads -> ListThreads -> Bool
$c< :: ListThreads -> ListThreads -> Bool
compare :: ListThreads -> ListThreads -> Ordering
$ccompare :: ListThreads -> ListThreads -> Ordering
$cp1Ord :: Eq ListThreads
Ord)

instance ToJSON ListThreads where
  toJSON :: ListThreads -> Value
toJSON ListThreads{Bool
[ThreadMember]
[Channel]
listThreadsHasMore :: Bool
listThreadsMembers :: [ThreadMember]
listThreadsThreads :: [Channel]
listThreadsHasMore :: ListThreads -> Bool
listThreadsMembers :: ListThreads -> [ThreadMember]
listThreadsThreads :: ListThreads -> [Channel]
..} = [Pair] -> Value
object 
    [ (Text
"threads", [Channel] -> Value
forall a. ToJSON a => a -> Value
toJSON [Channel]
listThreadsThreads)
    , (Text
"members", [ThreadMember] -> Value
forall a. ToJSON a => a -> Value
toJSON [ThreadMember]
listThreadsMembers)
    , (Text
"has_more", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
listThreadsHasMore)
    ]

instance FromJSON ListThreads where
  parseJSON :: Value -> Parser ListThreads
parseJSON = String
-> (Object -> Parser ListThreads) -> Value -> Parser ListThreads
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ListThreads" ((Object -> Parser ListThreads) -> Value -> Parser ListThreads)
-> (Object -> Parser ListThreads) -> Value -> Parser ListThreads
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Channel] -> [ThreadMember] -> Bool -> ListThreads
ListThreads ([Channel] -> [ThreadMember] -> Bool -> ListThreads)
-> Parser [Channel]
-> Parser ([ThreadMember] -> Bool -> ListThreads)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser [Channel]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"threads"
                Parser ([ThreadMember] -> Bool -> ListThreads)
-> Parser [ThreadMember] -> Parser (Bool -> ListThreads)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [ThreadMember]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"members"
                Parser (Bool -> ListThreads) -> Parser Bool -> Parser ListThreads
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"has_more"

channelMajorRoute :: ChannelRequest a -> String
channelMajorRoute :: ChannelRequest a -> String
channelMajorRoute ChannelRequest a
c = case ChannelRequest a
c of
  (GetChannel ChannelId
chan) ->                       String
"get_chan " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (ModifyChannel ChannelId
chan ModifyChannelOpts
_) ->                  String
"mod_chan " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (DeleteChannel ChannelId
chan) ->                    String
"mod_chan " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (GetChannelMessages ChannelId
chan (Int, MessageTiming)
_) ->                  String
"msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (GetChannelMessage (ChannelId
chan, MessageId
_)) ->            String
"get_msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (CreateMessage ChannelId
chan Text
_) ->                       String
"msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (CreateMessageDetailed ChannelId
chan MessageDetailedOpts
_) ->               String
"msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (CreateReaction (ChannelId
chan, MessageId
_) Text
_) ->           String
"add_react " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (DeleteOwnReaction (ChannelId
chan, MessageId
_) Text
_) ->            String
"react " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (DeleteUserReaction (ChannelId
chan, MessageId
_) UserId
_ Text
_) ->         String
"react " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (DeleteSingleReaction (ChannelId
chan, MessageId
_) Text
_) ->         String
"react " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (GetReactions (ChannelId
chan, MessageId
_) Text
_ (Int, ReactionTiming)
_) ->               String
"react " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (DeleteAllReactions (ChannelId
chan, MessageId
_)) ->             String
"react " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (EditMessage (ChannelId
chan, MessageId
_) MessageDetailedOpts
_) ->                String
"get_msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (DeleteMessage (ChannelId
chan, MessageId
_)) ->                String
"get_msg " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (BulkDeleteMessage (ChannelId
chan, [MessageId]
_)) ->           String
"del_msgs " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (EditChannelPermissions ChannelId
chan Either RoleId UserId
_ ChannelPermissionsOpts
_) ->          String
"perms " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (GetChannelInvites ChannelId
chan) ->                 String
"invites " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (CreateChannelInvite ChannelId
chan ChannelInviteOpts
_) ->             String
"invites " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (DeleteChannelPermission ChannelId
chan Either RoleId UserId
_) ->           String
"perms " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (TriggerTypingIndicator ChannelId
chan) ->                String
"tti " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (GetPinnedMessages ChannelId
chan) ->                    String
"pins " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (AddPinnedMessage (ChannelId
chan, MessageId
_)) ->                 String
"pin " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (DeletePinnedMessage (ChannelId
chan, MessageId
_)) ->              String
"pin " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (GroupDMAddRecipient ChannelId
chan GroupDMAddRecipientOpts
_) ->             String
"groupdm " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (GroupDMRemoveRecipient ChannelId
chan UserId
_) ->          String
"groupdm " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (StartThreadFromMessage ChannelId
chan MessageId
_ StartThreadOpts
_) ->         String
"thread " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (StartThreadNoMessage ChannelId
chan StartThreadNoMessageOpts
_) ->           String
"thread " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (JoinThread ChannelId
chan) ->                         String
"thread " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (AddThreadMember ChannelId
chan UserId
_) ->                  String
"thread " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (LeaveThread ChannelId
chan) ->                        String
"thread " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (RemoveThreadMember ChannelId
chan UserId
_) ->               String
"thread " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (GetThreadMember ChannelId
chan UserId
_) ->                  String
"thread " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (ListThreadMembers ChannelId
chan) ->                  String
"thread " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (ListPublicArchivedThreads ChannelId
chan (Maybe UTCTime, Maybe Integer)
_) ->        String
"thread " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (ListPrivateArchivedThreads ChannelId
chan (Maybe UTCTime, Maybe Integer)
_) ->       String
"thread " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
chan
  (ListJoinedPrivateArchivedThreads ChannelId
chan (Maybe UTCTime, Maybe Integer)
_) -> String
"thread " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChannelId -> String
forall a. Show a => a -> String
show ChannelId
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

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 ChannelId
chan) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan) Option 'Https
forall a. Monoid a => a
mempty

  (ModifyChannel ChannelId
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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
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 ChannelId
chan) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan) Option 'Https
forall a. Monoid a => a
mempty

  (GetChannelMessages ChannelId
chan (Int
n,MessageTiming
timing)) ->
      let n' :: Int
n' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
100 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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"messages") Option 'Https
options

  (GetChannelMessage (ChannelId
chan, MessageId
msg)) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan 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
msg) Option 'Https
forall a. Monoid a => a
mempty

  (CreateMessage ChannelId
chan Text
msg) ->
      let content :: [Pair]
content = [Text
"content" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
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

  (CreateMessageDetailed ChannelId
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)
                    (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)
                ]
          )
            [PartM IO] -> [PartM IO] -> [PartM IO]
forall a. [a] -> [a] -> [a]
++ [[PartM IO]] -> [PartM IO]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[PartM IO]]
-> ([CreateEmbed] -> [[PartM IO]])
-> Maybe [CreateEmbed]
-> [[PartM IO]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Maybe CreateEmbed -> [PartM IO]
maybeEmbed (Maybe CreateEmbed -> [PartM IO])
-> (CreateEmbed -> Maybe CreateEmbed) -> CreateEmbed -> [PartM IO]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateEmbed -> Maybe CreateEmbed
forall a. a -> Maybe a
Just (CreateEmbed -> [PartM IO]) -> [CreateEmbed] -> [[PartM IO]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (MessageDetailedOpts -> Maybe [CreateEmbed]
messageDetailedEmbeds MessageDetailedOpts
msgOpts))

        payloadData :: Value
payloadData =  [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Text
"content" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MessageDetailedOpts -> Text
messageDetailedContent MessageDetailedOpts
msgOpts
                                , Text
"tts"     Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MessageDetailedOpts -> Bool
messageDetailedTTS MessageDetailedOpts
msgOpts ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
                                [ Text
name Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
value | (Text
name, Just Value
value) <-
                                  [ (Text
"embeds", [Embed] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Embed] -> Value)
-> ([CreateEmbed] -> [Embed]) -> [CreateEmbed] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CreateEmbed -> Embed
createEmbed (CreateEmbed -> Embed) -> [CreateEmbed] -> [Embed]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([CreateEmbed] -> Value) -> Maybe [CreateEmbed] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MessageDetailedOpts -> Maybe [CreateEmbed]
messageDetailedEmbeds MessageDetailedOpts
msgOpts)
                                  , (Text
"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)
                                  , (Text
"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)
                                  , (Text
"components", [ActionRow] -> Value
forall a. ToJSON a => a -> Value
toJSON ([ActionRow] -> Value) -> Maybe [ActionRow] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MessageDetailedOpts -> Maybe [ActionRow]
messageDetailedComponents MessageDetailedOpts
msgOpts)
                                  , (Text
"sticker_ids", [StickerId] -> Value
forall a. ToJSON a => a -> Value
toJSON ([StickerId] -> Value) -> Maybe [StickerId] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MessageDetailedOpts -> Maybe [StickerId]
messageDetailedStickerIds 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
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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
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 (ChannelId
chan, MessageId
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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan 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
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 (ChannelId
chan, MessageId
msgid) Text
emoji) ->
      let e :: Text
e = Text -> Text
cleanupEmoji Text
emoji
      in Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan 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
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 (ChannelId
chan, MessageId
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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan 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
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).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
uID ) Option 'Https
forall a. Monoid a => a
mempty

  (DeleteSingleReaction (ChannelId
chan, MessageId
msgid) Text
emoji) ->
    let e :: Text
e = Text -> Text
cleanupEmoji Text
emoji
    in Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan 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
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 (ChannelId
chan, MessageId
msgid) Text
emoji (Int
n, ReactionTiming
timing)) ->
      let e :: Text
e = Text -> Text
cleanupEmoji Text
emoji
          n' :: Int
n' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
100 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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan 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
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 (ChannelId
chan, MessageId
msgid)) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan 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
msgid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"reactions" ) Option 'Https
forall a. Monoid a => a
mempty

  -- copied from CreateMessageDetailed, should be outsourced to function probably
  (EditMessage (ChannelId
chan, MessageId
msg) 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)
                    (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)
                ]
          )
            [PartM IO] -> [PartM IO] -> [PartM IO]
forall a. [a] -> [a] -> [a]
++ [[PartM IO]] -> [PartM IO]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[PartM IO]]
-> ([CreateEmbed] -> [[PartM IO]])
-> Maybe [CreateEmbed]
-> [[PartM IO]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Maybe CreateEmbed -> [PartM IO]
maybeEmbed (Maybe CreateEmbed -> [PartM IO])
-> (CreateEmbed -> Maybe CreateEmbed) -> CreateEmbed -> [PartM IO]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateEmbed -> Maybe CreateEmbed
forall a. a -> Maybe a
Just (CreateEmbed -> [PartM IO]) -> [CreateEmbed] -> [[PartM IO]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (MessageDetailedOpts -> Maybe [CreateEmbed]
messageDetailedEmbeds MessageDetailedOpts
msgOpts))

        payloadData :: Value
payloadData =  [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Text
"content" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MessageDetailedOpts -> Text
messageDetailedContent MessageDetailedOpts
msgOpts
                                , Text
"tts"     Text -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= MessageDetailedOpts -> Bool
messageDetailedTTS MessageDetailedOpts
msgOpts ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
                                [ Text
name Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
value | (Text
name, Just Value
value) <-
                                  [ (Text
"embeds", [Embed] -> Value
forall a. ToJSON a => a -> Value
toJSON ([Embed] -> Value)
-> ([CreateEmbed] -> [Embed]) -> [CreateEmbed] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CreateEmbed -> Embed
createEmbed (CreateEmbed -> Embed) -> [CreateEmbed] -> [Embed]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([CreateEmbed] -> Value) -> Maybe [CreateEmbed] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MessageDetailedOpts -> Maybe [CreateEmbed]
messageDetailedEmbeds MessageDetailedOpts
msgOpts)
                                  , (Text
"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)
                                  , (Text
"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)
                                  , (Text
"components", [ActionRow] -> Value
forall a. ToJSON a => a -> Value
toJSON ([ActionRow] -> Value) -> Maybe [ActionRow] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MessageDetailedOpts -> Maybe [ActionRow]
messageDetailedComponents MessageDetailedOpts
msgOpts)
                                  , (Text
"sticker_ids", [StickerId] -> Value
forall a. ToJSON a => a -> Value
toJSON ([StickerId] -> Value) -> Maybe [StickerId] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MessageDetailedOpts -> Maybe [StickerId]
messageDetailedStickerIds 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
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
Patch (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan 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
msg) RestIO ReqBodyMultipart
body Option 'Https
forall a. Monoid a => a
mempty

  (DeleteMessage (ChannelId
chan, MessageId
msg)) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan 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
msg) Option 'Https
forall a. Monoid a => a
mempty

  (BulkDeleteMessage (ChannelId
chan, [MessageId]
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 [Text
"messages" Text -> [MessageId] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [MessageId]
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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
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 ChannelId
chan Either RoleId UserId
overwriteId (ChannelPermissionsOpts Integer
a Integer
d)) ->
      let body :: ReqBodyJson Value
body = 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 [(Text
"type", Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ ((RoleId -> Int) -> (UserId -> Int) -> Either RoleId UserId -> Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int -> RoleId -> Int
forall a b. a -> b -> a
const Int
0) (Int -> UserId -> Int
forall a b. a -> b -> a
const Int
1) Either RoleId UserId
overwriteId :: Int))
                                        ,(Text
"allow", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
a)
                                        ,(Text
"deny", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
d)]
      in Url 'Https -> ReqBodyJson Value -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"permissions" Url 'Https -> Snowflake -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ (RoleId -> Snowflake)
-> (UserId -> Snowflake) -> Either RoleId UserId -> Snowflake
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RoleId -> Snowflake
forall a. DiscordId a -> Snowflake
unId UserId -> Snowflake
forall a. DiscordId a -> Snowflake
unId Either RoleId UserId
overwriteId) ReqBodyJson Value
body Option 'Https
forall a. Monoid a => a
mempty

  (GetChannelInvites ChannelId
chan) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
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 ChannelId
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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
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 ChannelId
chan Either RoleId UserId
overwriteId) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"permissions" Url 'Https -> Snowflake -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ (RoleId -> Snowflake)
-> (UserId -> Snowflake) -> Either RoleId UserId -> Snowflake
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either RoleId -> Snowflake
forall a. DiscordId a -> Snowflake
unId UserId -> Snowflake
forall a. DiscordId a -> Snowflake
unId Either RoleId UserId
overwriteId) Option 'Https
forall a. Monoid a => a
mempty

  (TriggerTypingIndicator ChannelId
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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
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 ChannelId
chan) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
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 (ChannelId
chan, MessageId
msg)) ->
      Url 'Https -> NoReqBody -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"pins" Url 'Https -> MessageId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ MessageId
msg) NoReqBody
R.NoReqBody Option 'Https
forall a. Monoid a => a
mempty

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

  (GroupDMAddRecipient ChannelId
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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
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).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
uid)
          (Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
R.ReqBodyJson ([Pair] -> Value
object [ (Text
"access_token", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
tok)
                                 , (Text
"nick", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
nick)]))
          Option 'Https
forall a. Monoid a => a
mempty

  (GroupDMRemoveRecipient ChannelId
chan UserId
userid) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
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).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
userid) Option 'Https
forall a. Monoid a => a
mempty

  (StartThreadFromMessage ChannelId
chan MessageId
mid StartThreadOpts
sto) ->
      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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan 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
mid Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"threads")
           (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
$ StartThreadOpts -> Value
forall a. ToJSON a => a -> Value
toJSON StartThreadOpts
sto)
           Option 'Https
forall a. Monoid a => a
mempty

  (StartThreadNoMessage ChannelId
chan StartThreadNoMessageOpts
sto) ->
      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 -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
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
"threads")
           (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
$ StartThreadNoMessageOpts -> Value
forall a. ToJSON a => a -> Value
toJSON StartThreadNoMessageOpts
sto)
           Option 'Https
forall a. Monoid a => a
mempty

  (JoinThread ChannelId
chan) ->
      Url 'Https -> NoReqBody -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"thread-members" 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

  (AddThreadMember ChannelId
chan UserId
uid) ->
      Url 'Https -> NoReqBody -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> a -> Option 'Https -> JsonRequest
Put (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"thread-members" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
uid)
          NoReqBody
R.NoReqBody Option 'Https
forall a. Monoid a => a
mempty

  (LeaveThread ChannelId
chan) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"thread-members" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"@me")
          Option 'Https
forall a. Monoid a => a
mempty

  (RemoveThreadMember ChannelId
chan UserId
uid) ->
      Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"thread-members" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
uid)
          Option 'Https
forall a. Monoid a => a
mempty

  (GetThreadMember ChannelId
chan UserId
uid) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"thread-members" Url 'Https -> UserId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ UserId
uid)
          Option 'Https
forall a. Monoid a => a
mempty

  (ListThreadMembers ChannelId
chan) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"thread-members")
          Option 'Https
forall a. Monoid a => a
mempty

  (ListPublicArchivedThreads ChannelId
chan (Maybe UTCTime
time, Maybe Integer
lim)) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"threads" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"archived" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"public")
          (Option 'Https
-> (Integer -> Option 'Https) -> Maybe Integer -> Option 'Https
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Option 'Https
forall a. Monoid a => a
mempty (Text
"limit" Text -> Integer -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=:) Maybe Integer
lim Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Option 'Https
-> (UTCTime -> Option 'Https) -> Maybe UTCTime -> Option 'Https
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Option 'Https
forall a. Monoid a => a
mempty (Text
"before" Text -> UTCTime -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=:) Maybe UTCTime
time)

  (ListPrivateArchivedThreads ChannelId
chan (Maybe UTCTime
time, Maybe Integer
lim)) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"threads" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"archived" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"private")
          (Option 'Https
-> (Integer -> Option 'Https) -> Maybe Integer -> Option 'Https
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Option 'Https
forall a. Monoid a => a
mempty (Text
"limit" Text -> Integer -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=:) Maybe Integer
lim Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Option 'Https
-> (UTCTime -> Option 'Https) -> Maybe UTCTime -> Option 'Https
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Option 'Https
forall a. Monoid a => a
mempty (Text
"before" Text -> UTCTime -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=:) Maybe UTCTime
time)

  (ListJoinedPrivateArchivedThreads ChannelId
chan (Maybe UTCTime
time, Maybe Integer
lim)) ->
      Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
channels Url 'Https -> ChannelId -> Url 'Https
forall a (scheme :: Scheme).
ToHttpApiData a =>
Url scheme -> a -> Url scheme
/~ ChannelId
chan Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"users" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"@me" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"threads" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"archived" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"private")
          (Option 'Https
-> (Integer -> Option 'Https) -> Maybe Integer -> Option 'Https
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Option 'Https
forall a. Monoid a => a
mempty (Text
"limit" Text -> Integer -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=:) Maybe Integer
lim Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Option 'Https
-> (UTCTime -> Option 'Https) -> Maybe UTCTime -> Option 'Https
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Option 'Https
forall a. Monoid a => a
mempty (Text
"before" Text -> UTCTime -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
R.=:) Maybe UTCTime
time)