path: root/deps/discord-haskell/src/Discord/Internal/Rest/Channel.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# 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 Text.Emoji (emojiFromAlias)
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 = channelMajorRoute
  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)
    messageDetailedContent                  :: T.Text
  , -- | `True` if this is a TTS message
    messageDetailedTTS                      :: Bool
  , -- | embedded rich content (up to 6000 characters)
    messageDetailedEmbeds                   :: Maybe [CreateEmbed]
  , -- | the contents of the file being sent
    messageDetailedFile                     :: Maybe (T.Text, B.ByteString)
  , -- | allowed mentions for the message
    messageDetailedAllowedMentions          :: Maybe AllowedMentions
  , -- | If `Just`, reply to the message referenced
    messageDetailedReference                :: Maybe MessageReference
  , -- | Message components for the message
    messageDetailedComponents               :: Maybe [ActionRow]
  , -- | IDs of up to 3 `Sticker` in the server to send with the message
    messageDetailedStickerIds               :: Maybe [StickerId]
  } deriving (Show, Read, Eq, Ord)

instance Default MessageDetailedOpts where
  def = MessageDetailedOpts { messageDetailedContent         = ""
                            , messageDetailedTTS             = False
                            , messageDetailedEmbeds          = Nothing
                            , messageDetailedFile            = Nothing
                            , messageDetailedAllowedMentions = Nothing
                            , messageDetailedReference       = Nothing
                            , messageDetailedComponents      = Nothing
                            , messageDetailedStickerIds      = Nothing
                            }

-- | Data constructor for `GetReactions` requests
data ReactionTiming = AfterUser UserId
                    | FirstUsers
  deriving (Show, Read, Eq, Ord)

reactionTimingToQuery :: ReactionTiming -> R.Option 'R.Https
reactionTimingToQuery t = case t of
  (AfterUser snow) -> "after"  R.=: show snow
  FirstUsers -> 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 (Show, Read, Eq, Ord)

messageTimingToQuery :: MessageTiming -> R.Option 'R.Https
messageTimingToQuery t = case t of
  (AroundMessage snow) -> "around" R.=: show snow
  (BeforeMessage snow) -> "before" R.=: show snow
  (AfterMessage snow) -> "after"  R.=: show snow
  LatestMessages -> mempty

-- | Options for `CreateChannelInvite` requests
data ChannelInviteOpts = ChannelInviteOpts
  { -- | How long the invite is valid for (in seconds)
    channelInviteOptsMaxAgeSeconds          :: Maybe Integer
  , -- | How many uses the invite is valid for
    channelInviteOptsMaxUsages              :: Maybe Integer
  , -- | Whether this invite only grants temporary membership
    channelInviteOptsIsTemporary            :: Maybe Bool
  , -- | Don't reuse a similar invite. Useful for creating many unique one time
    -- use invites
    channelInviteOptsDontReuseSimilarInvite :: Maybe Bool
  } deriving (Show, Read, Eq, Ord)

instance ToJSON ChannelInviteOpts where
  toJSON ChannelInviteOpts{..} = objectFromMaybes
                         ["max_age" .=? channelInviteOptsMaxAgeSeconds,
                          "max_uses" .=? channelInviteOptsMaxUsages,
                          "temporary" .=? channelInviteOptsIsTemporary,
                          "unique" .=? channelInviteOptsDontReuseSimilarInvite ]

-- | Options for `ModifyChannel` requests
data ModifyChannelOpts = ModifyChannelOpts
  { -- | (All) The name of the channel (max 100 characters)
    modifyChannelName                 :: Maybe T.Text
  , -- | (All) Position of the channel in the listing
    modifyChannelPosition             :: Maybe Integer
  , -- | (Text) The channel topic text (max 1024 characters)
    modifyChannelTopic                :: Maybe T.Text
  , -- | (Text) Wether the channel is tagged as NSFW
    modifyChannelNSFW                 :: Maybe Bool
  , -- | (Voice) Bitrate (in bps) of a voice channel. Min 8000, max 96000
    -- (128000 for boosted servers)
    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
    modifyChannelUserRateLimit        :: Maybe Integer
  , -- | (Voice) the user limit of the voice channel, max 99
    modifyChannelUserLimit            :: Maybe Integer
  , -- | (All) The channel permissions
    modifyChannelPermissionOverwrites :: Maybe [Overwrite]
  , -- | (All) The parent category of the channel
    modifyChannelParentId             :: Maybe ChannelId
  , -- | (Text) Auto-archive duration for Threads
    modifyChannelDefaultAutoArchive   :: Maybe Integer
  , -- | (Thread) Whether the thread is archived
    modifyChannelThreadArchived       :: Maybe Bool
  , -- | (Thread) duration in minutes to automatically archive the thread after
    -- recent activity, can be set to: 60, 1440, 4320 or 10080
    modifyChannelThreadAutoArchive    :: Maybe Integer
  , -- | (Thread) Whether the thread is locked. When a thread is locked, only
    -- users with @manage_threads@ can unarchive it
    modifyChannelThreadLocked         :: Maybe Bool
  , -- | (Thread) Whether non-moderators can add other non-moderators to a
    -- thread. Only available on private threads
    modifyChannelThreadInvitable     :: Maybe Bool
  } deriving (Show, Read, Eq, Ord)

instance Default ModifyChannelOpts where
  def = ModifyChannelOpts Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing

instance ToJSON ModifyChannelOpts where
  toJSON ModifyChannelOpts{..} = objectFromMaybes
               ["name" .=? modifyChannelName,
                "position" .=? modifyChannelPosition,
                "topic" .=? modifyChannelTopic,
                "nsfw" .=? modifyChannelNSFW,
                "bitrate" .=? modifyChannelBitrate,
                "rate_limit_per_user" .=? modifyChannelUserRateLimit,
                "user_limit" .=? modifyChannelUserLimit,
                "permission_overwrites" .=? modifyChannelPermissionOverwrites,
                "parent_id" .=? modifyChannelParentId,
                "default_auto_archive_duration" .=? modifyChannelDefaultAutoArchive,
                "archived" .=? modifyChannelThreadArchived,
                "auto_archive_duration" .=? modifyChannelThreadAutoArchive,
                "locked" .=? modifyChannelThreadLocked,
                "invitable" .=? 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
    channelPermissionsOptsAllow :: Integer
  , -- | The permission integer for the explicitly denied permissions
    channelPermissionsOptsDeny :: Integer
  } deriving (Show, Read, Eq, 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
    groupDMAddRecipientUserToAdd :: UserId
  , -- | The nickname given to the user being added
    groupDMAddRecipientUserToAddNickName :: T.Text
  , -- | Access token of the user. That user must have granted your app the
    -- @gdm.join@ scope.
    groupDMAddRecipientGDMJoinAccessToken :: T.Text
  } deriving (Show, Read, Eq, Ord)

-- | Options for `StartThreadFromMessage` request
data StartThreadOpts = StartThreadOpts
  { -- | Name of the thread
    startThreadName :: T.Text
  , -- | Period of innactivity after which the thread gets archived in minutes.
    -- 
    -- Can be one of 60, 1440, 4320, 10080
    startThreadAutoArchive :: Maybe Integer
  , -- | Amount of seconds a user has to wait before sending another message
    -- (0-21600)
    startThreadRateLimit :: Maybe Integer
  } deriving (Show, Read, Eq, Ord)

instance ToJSON StartThreadOpts where
  toJSON StartThreadOpts{..} = objectFromMaybes
      [ "name" .== startThreadName
      , "auto_archive_duration" .=? startThreadAutoArchive
      , "rate_limit_per_user" .=? startThreadRateLimit
      ]

instance Default StartThreadOpts where
  def = StartThreadOpts { startThreadName        = "New Thread"
                        , startThreadAutoArchive = Nothing
                        , startThreadRateLimit   = Nothing
                        }

-- | Options for `StartThreadNoMessage` request
data StartThreadNoMessageOpts = StartThreadNoMessageOpts
  { -- | Base options for the thread
    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>
    startThreadNoMessageType :: Integer
  , -- | Whether non-moderators can add other non-moderators to a thread. Only
    -- available when creating a private thread.
    startThreadNoMessageInvitable :: Maybe Bool
  } deriving (Show, Read, Eq, Ord)

instance ToJSON StartThreadNoMessageOpts where
  toJSON StartThreadNoMessageOpts{..} = objectFromMaybes
      [ "name" .== startThreadName startThreadNoMessageBaseOpts
      , "auto_archive_duration" .=? startThreadAutoArchive startThreadNoMessageBaseOpts
      , "rate_limit_per_user" .=? startThreadRateLimit startThreadNoMessageBaseOpts
      , "type" .== startThreadNoMessageType
      , "invitable" .=? startThreadNoMessageInvitable
      ]

-- | Result type of `ListJoinedPrivateArchivedThreads`,
-- `ListPrivateArchivedThreads` and `ListPublicArchivedThreads`
data ListThreads = ListThreads
  { -- | The returned threads
    listThreadsThreads :: [Channel]
  , -- | A thread member object for each returned thread the current user has
    -- joined
    listThreadsMembers :: [ThreadMember]
  ,  -- | Whether there is more data to retrieve
    listThreadsHasMore :: Bool
  } deriving (Show, Read, Eq, Ord)

instance ToJSON ListThreads where
  toJSON ListThreads{..} = object
    [ ("threads", toJSON listThreadsThreads)
    , ("members", toJSON listThreadsMembers)
    , ("has_more", toJSON listThreadsHasMore)
    ]

instance FromJSON ListThreads where
  parseJSON = withObject "ListThreads" $ \o ->
    ListThreads <$> o .: "threads"
                <*> o .: "members"
                <*> o .: "has_more"

channelMajorRoute :: ChannelRequest a -> String
channelMajorRoute c = case c of
  (GetChannel chan) ->                       "get_chan " <> show chan
  (ModifyChannel chan _) ->                  "mod_chan " <> show chan
  (DeleteChannel chan) ->                    "mod_chan " <> show chan
  (GetChannelMessages chan _) ->                  "msg " <> show chan
  (GetChannelMessage (chan, _)) ->            "get_msg " <> show chan
  (CreateMessage chan _) ->                       "msg " <> show chan
  (CreateMessageDetailed chan _) ->               "msg " <> show chan
  (CreateReaction (chan, _) _) ->           "add_react " <> show chan
  (DeleteOwnReaction (chan, _) _) ->            "react " <> show chan
  (DeleteUserReaction (chan, _) _ _) ->         "react " <> show chan
  (DeleteSingleReaction (chan, _) _) ->         "react " <> show chan
  (GetReactions (chan, _) _ _) ->               "react " <> show chan
  (DeleteAllReactions (chan, _)) ->             "react " <> show chan
  (EditMessage (chan, _) _) ->                "get_msg " <> show chan
  (DeleteMessage (chan, _)) ->                "get_msg " <> show chan
  (BulkDeleteMessage (chan, _)) ->           "del_msgs " <> show chan
  (EditChannelPermissions chan _ _) ->          "perms " <> show chan
  (GetChannelInvites chan) ->                 "invites " <> show chan
  (CreateChannelInvite chan _) ->             "invites " <> show chan
  (DeleteChannelPermission chan _) ->           "perms " <> show chan
  (TriggerTypingIndicator chan) ->                "tti " <> show chan
  (GetPinnedMessages chan) ->                    "pins " <> show chan
  (AddPinnedMessage (chan, _)) ->                 "pin " <> show chan
  (DeletePinnedMessage (chan, _)) ->              "pin " <> show chan
  (GroupDMAddRecipient chan _) ->             "groupdm " <> show chan
  (GroupDMRemoveRecipient chan _) ->          "groupdm " <> show chan
  (StartThreadFromMessage chan _ _) ->         "thread " <> show chan
  (StartThreadNoMessage chan _) ->           "thread " <> show chan
  (JoinThread chan) ->                         "thread " <> show chan
  (AddThreadMember chan _) ->                  "thread " <> show chan
  (LeaveThread chan) ->                        "thread " <> show chan
  (RemoveThreadMember chan _) ->               "thread " <> show chan
  (GetThreadMember chan _) ->                  "thread " <> show chan
  (ListThreadMembers chan) ->                  "thread " <> show chan
  (ListPublicArchivedThreads chan _) ->        "thread " <> show chan
  (ListPrivateArchivedThreads chan _) ->       "thread " <> show chan
  (ListJoinedPrivateArchivedThreads chan _) -> "thread " <> show chan

cleanupEmoji :: T.Text -> T.Text
cleanupEmoji emoji =
  let noAngles = T.replace "<" "" (T.replace ">" "" emoji)
      noColons = T.replace ":" "" emoji
      toneModifier s = case s of
        "tone1" -> Just "\x1f3fb"
        "tone2" -> Just "\x1f3fc"
        "tone3" -> Just "\x1f3fd"
        "tone4" -> Just "\x1f3fe"
        "tone5" -> Just "\x1f3ff"
        _ -> Nothing
      byName = case emojiFromAlias noColons of
        Just e -> Just e
        Nothing ->
          let (prefix, tone) = T.breakOnEnd "_" noColons
           in case ((fst <$> T.unsnoc prefix) >>= emojiFromAlias, toneModifier tone) of
                (Just p, Just t) -> Just (p <> t)
                _ -> Nothing
   in case (byName, T.stripPrefix ":" noAngles) of
        (Just e, _) -> e
        (_, Just a) -> "custom:" <> a
        (_, Nothing) -> noAngles

channels :: R.Url 'R.Https
channels = baseUrl /: "channels"

channelJsonRequest :: ChannelRequest r -> JsonRequest
channelJsonRequest c = case c of
  (GetChannel chan) ->
      Get (channels /~ chan) mempty

  (ModifyChannel chan patch) ->
      Patch (channels /~ chan) (pure (R.ReqBodyJson patch)) mempty

  (DeleteChannel chan) ->
      Delete (channels /~ chan) mempty

  (GetChannelMessages chan (n,timing)) ->
      let n' = max 1 (min 100 n)
          options = "limit" R.=: n' <> messageTimingToQuery timing
      in Get (channels /~ chan /: "messages") options

  (GetChannelMessage (chan, msg)) ->
      Get (channels /~ chan /: "messages" /~ msg) mempty

  (CreateMessage chan msg) ->
      let content = ["content" .= msg]
          body = pure $ R.ReqBodyJson $ object content
      in Post (channels /~ chan /: "messages") body mempty

  (CreateMessageDetailed chan msgOpts) ->
    let fileUpload = messageDetailedFile msgOpts
        filePart =
          ( case fileUpload of
              Nothing -> []
              Just f ->
                [ partFileRequestBody
                    "file"
                    (T.unpack $ fst f)
                    (RequestBodyBS $ snd f)
                ]
          )
            ++ join (maybe [] (maybeEmbed . Just <$>) (messageDetailedEmbeds msgOpts))

        payloadData =  objectFromMaybes $
                        [ "content" .== messageDetailedContent msgOpts
                        , "tts"     .== messageDetailedTTS msgOpts ] ++
                        [ "embeds" .=? ((createEmbed <$>) <$> messageDetailedEmbeds msgOpts)
                        , "allowed_mentions" .=? messageDetailedAllowedMentions msgOpts
                        , "message_reference" .=? messageDetailedReference msgOpts
                        , "components" .=? messageDetailedComponents msgOpts
                        , "sticker_ids" .=? messageDetailedStickerIds msgOpts
                        ]
        payloadPart = partBS "payload_json" $ BL.toStrict $ encode payloadData

        body = R.reqBodyMultipart (payloadPart : filePart)
      in Post (channels /~ chan /: "messages") body mempty

  (CreateReaction (chan, msgid) emoji) ->
      let e = cleanupEmoji emoji
      in Put (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e /: "@me" )
             R.NoReqBody mempty

  (DeleteOwnReaction (chan, msgid) emoji) ->
      let e = cleanupEmoji emoji
      in Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e /: "@me" ) mempty

  (DeleteUserReaction (chan, msgid) uID emoji) ->
      let e = cleanupEmoji emoji
      in Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e /~ uID ) mempty

  (DeleteSingleReaction (chan, msgid) emoji) ->
    let e = cleanupEmoji emoji
    in Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e) mempty

  (GetReactions (chan, msgid) emoji (n, timing)) ->
      let e = cleanupEmoji emoji
          n' = max 1 (min 100 n)
          options = "limit" R.=: n' <> reactionTimingToQuery timing
      in Get (channels /~ chan /: "messages" /~ msgid /: "reactions" /: e) options

  (DeleteAllReactions (chan, msgid)) ->
      Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" ) mempty

  -- copied from CreateMessageDetailed, should be outsourced to function probably
  (EditMessage (chan, msg) msgOpts) ->
    let fileUpload = messageDetailedFile msgOpts
        filePart =
          ( case fileUpload of
              Nothing -> []
              Just f ->
                [ partFileRequestBody
                    "file"
                    (T.unpack $ fst f)
                    (RequestBodyBS $ snd f)
                ]
          )
            ++ join (maybe [] (maybeEmbed . Just <$>) (messageDetailedEmbeds msgOpts))

        payloadData =  objectFromMaybes $
                        [ "content" .== messageDetailedContent msgOpts
                        , "tts"     .== messageDetailedTTS msgOpts ] ++
                        [ "embeds" .=? ((createEmbed <$>) <$> messageDetailedEmbeds msgOpts)
                        , "allowed_mentions" .=? messageDetailedAllowedMentions msgOpts
                        , "message_reference" .=? messageDetailedReference msgOpts
                        , "components" .=? messageDetailedComponents msgOpts
                        , "sticker_ids" .=? messageDetailedStickerIds msgOpts
                        ]
        payloadPart = partBS "payload_json" $ BL.toStrict $ encode payloadData

        body = R.reqBodyMultipart (payloadPart : filePart)
      in Patch (channels /~ chan /: "messages" /~ msg) body mempty

  (DeleteMessage (chan, msg)) ->
      Delete (channels /~ chan /: "messages" /~ msg) mempty

  (BulkDeleteMessage (chan, msgs)) ->
      let body = pure . R.ReqBodyJson $ object ["messages" .= msgs]
      in Post (channels /~ chan /: "messages" /: "bulk-delete") body mempty

  (EditChannelPermissions chan overwriteId (ChannelPermissionsOpts a d)) ->
      let body = R.ReqBodyJson $ object [("type", toJSON (either (const 0) (const 1) overwriteId :: Int))
                                        ,("allow", toJSON a)
                                        ,("deny", toJSON d)]
      in Put (channels /~ chan /: "permissions" /~ either unId unId overwriteId) body mempty

  (GetChannelInvites chan) ->
      Get (channels /~ chan /: "invites") mempty

  (CreateChannelInvite chan patch) ->
      Post (channels /~ chan /: "invites") (pure (R.ReqBodyJson patch)) mempty

  (DeleteChannelPermission chan overwriteId) ->
      Delete (channels /~ chan /: "permissions" /~ either unId unId overwriteId) mempty

  (TriggerTypingIndicator chan) ->
      Post (channels /~ chan /: "typing") (pure R.NoReqBody) mempty

  (GetPinnedMessages chan) ->
      Get (channels /~ chan /: "pins") mempty

  (AddPinnedMessage (chan, msg)) ->
      Put (channels /~ chan /: "pins" /~ msg) R.NoReqBody mempty

  (DeletePinnedMessage (chan, msg)) ->
      Delete (channels /~ chan /: "pins" /~ msg) mempty

  (GroupDMAddRecipient chan (GroupDMAddRecipientOpts uid nick tok)) ->
      Put (channels /~ chan /~ chan /: "recipients" /~ uid)
          (R.ReqBodyJson (object [ ("access_token", toJSON tok)
                                 , ("nick", toJSON nick)]))
          mempty

  (GroupDMRemoveRecipient chan userid) ->
      Delete (channels /~ chan /~ chan /: "recipients" /~ userid) mempty

  (StartThreadFromMessage chan mid sto) ->
      Post (channels /~ chan /: "messages" /~ mid /: "threads")
           (pure $ R.ReqBodyJson $ toJSON sto)
           mempty

  (StartThreadNoMessage chan sto) ->
      Post (channels /~ chan /: "threads")
           (pure $ R.ReqBodyJson $ toJSON sto)
           mempty

  (JoinThread chan) ->
      Put (channels /~ chan /: "thread-members" /: "@me")
          R.NoReqBody mempty

  (AddThreadMember chan uid) ->
      Put (channels /~ chan /: "thread-members" /~ uid)
          R.NoReqBody mempty

  (LeaveThread chan) ->
      Delete (channels /~ chan /: "thread-members" /: "@me")
          mempty

  (RemoveThreadMember chan uid) ->
      Delete (channels /~ chan /: "thread-members" /~ uid)
          mempty

  (GetThreadMember chan uid) ->
      Get (channels /~ chan /: "thread-members" /~ uid)
          mempty

  (ListThreadMembers chan) ->
      Get (channels /~ chan /: "thread-members")
          mempty

  (ListPublicArchivedThreads chan (time, lim)) ->
      Get (channels /~ chan /: "threads" /: "archived" /: "public")
          (maybe mempty ("limit" R.=:) lim <> maybe mempty ("before" R.=:) time)

  (ListPrivateArchivedThreads chan (time, lim)) ->
      Get (channels /~ chan /: "threads" /: "archived" /: "private")
          (maybe mempty ("limit" R.=:) lim <> maybe mempty ("before" R.=:) time)

  (ListJoinedPrivateArchivedThreads chan (time, lim)) ->
      Get (channels /~ chan /: "users" /: "@me" /: "threads" /: "archived" /: "private")
          (maybe mempty ("limit" R.=:) lim <> maybe mempty ("before" R.=:) time)