{-# LANGUAGE TemplateHaskell #-}

-- | Channel endpoints
module Calamity.HTTP.Channel (
  ChannelRequest (..),
  CreateMessageAttachment (..),
  CreateMessageOptions (..),
  EditMessageData (..),
  editMessageContent,
  editMessageEmbeds,
  editMessageFlags,
  editMessageAllowedMentions,
  editMessageComponents,
  ChannelUpdate (..),
  AllowedMentionType (..),
  AllowedMentions (..),
  ChannelMessagesFilter (..),
  ChannelMessagesLimit (..),
  GetReactionsOptions (..),
  CreateChannelInviteOptions (..),
  GroupDMAddRecipientOptions (..),
) where

import Calamity.HTTP.Internal.Request
import Calamity.HTTP.Internal.Route
import Calamity.Internal.Utils (CalamityToJSON (..), CalamityToJSON' (..), (.=), (.?=))
import Calamity.Types.Model.Channel
import Calamity.Types.Model.Guild.Emoji (RawEmoji (..))
import Calamity.Types.Model.Guild.Invite (Invite)
import Calamity.Types.Model.Guild.Overwrite (Overwrite)
import Calamity.Types.Model.Guild.Role (Role)
import Calamity.Types.Model.User
import Calamity.Types.Snowflake
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as K
import Data.ByteString.Lazy (ByteString)
import Data.Default.Class
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word
import Network.HTTP.Client.MultipartFormData
import Network.HTTP.Req
import Network.Mime
import Optics
import PyF
import TextShow

data CreateMessageAttachment = CreateMessageAttachment
  { CreateMessageAttachment -> Text
filename :: Text
  , CreateMessageAttachment -> Maybe Text
description :: Maybe Text
  , CreateMessageAttachment -> ByteString
content :: ByteString
  }
  deriving (Int -> CreateMessageAttachment -> ShowS
[CreateMessageAttachment] -> ShowS
CreateMessageAttachment -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMessageAttachment] -> ShowS
$cshowList :: [CreateMessageAttachment] -> ShowS
show :: CreateMessageAttachment -> String
$cshow :: CreateMessageAttachment -> String
showsPrec :: Int -> CreateMessageAttachment -> ShowS
$cshowsPrec :: Int -> CreateMessageAttachment -> ShowS
Show)

data CreateMessageOptions = CreateMessageOptions
  { CreateMessageOptions -> Maybe Text
content :: Maybe Text
  , CreateMessageOptions -> Maybe Text
nonce :: Maybe Text
  , CreateMessageOptions -> Maybe Bool
tts :: Maybe Bool
  , CreateMessageOptions -> Maybe [CreateMessageAttachment]
attachments :: Maybe [CreateMessageAttachment]
  , CreateMessageOptions -> Maybe [Embed]
embeds :: Maybe [Embed]
  , CreateMessageOptions -> Maybe AllowedMentions
allowedMentions :: Maybe AllowedMentions
  , CreateMessageOptions -> Maybe MessageReference
messageReference :: Maybe MessageReference
  , CreateMessageOptions -> Maybe [Component]
components :: Maybe [Component]
  }
  deriving (Int -> CreateMessageOptions -> ShowS
[CreateMessageOptions] -> ShowS
CreateMessageOptions -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMessageOptions] -> ShowS
$cshowList :: [CreateMessageOptions] -> ShowS
show :: CreateMessageOptions -> String
$cshow :: CreateMessageOptions -> String
showsPrec :: Int -> CreateMessageOptions -> ShowS
$cshowsPrec :: Int -> CreateMessageOptions -> ShowS
Show)

instance Default CreateMessageOptions where
  def :: CreateMessageOptions
def = Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [CreateMessageAttachment]
-> Maybe [Embed]
-> Maybe AllowedMentions
-> Maybe MessageReference
-> Maybe [Component]
-> CreateMessageOptions
CreateMessageOptions forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing

data CreateMessageAttachmentJson = CreateMessageAttachmentJson
  { CreateMessageAttachmentJson -> Int
id :: Int
  , CreateMessageAttachmentJson -> Text
filename :: Text
  , CreateMessageAttachmentJson -> Maybe Text
description :: Maybe Text
  }
  deriving (Int -> CreateMessageAttachmentJson -> ShowS
[CreateMessageAttachmentJson] -> ShowS
CreateMessageAttachmentJson -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMessageAttachmentJson] -> ShowS
$cshowList :: [CreateMessageAttachmentJson] -> ShowS
show :: CreateMessageAttachmentJson -> String
$cshow :: CreateMessageAttachmentJson -> String
showsPrec :: Int -> CreateMessageAttachmentJson -> ShowS
$cshowsPrec :: Int -> CreateMessageAttachmentJson -> ShowS
Show)
  deriving ([CreateMessageAttachmentJson] -> Encoding
[CreateMessageAttachmentJson] -> Value
CreateMessageAttachmentJson -> Encoding
CreateMessageAttachmentJson -> Value
forall (a :: OpticKind).
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CreateMessageAttachmentJson] -> Encoding
$ctoEncodingList :: [CreateMessageAttachmentJson] -> Encoding
toJSONList :: [CreateMessageAttachmentJson] -> Value
$ctoJSONList :: [CreateMessageAttachmentJson] -> Value
toEncoding :: CreateMessageAttachmentJson -> Encoding
$ctoEncoding :: CreateMessageAttachmentJson -> Encoding
toJSON :: CreateMessageAttachmentJson -> Value
$ctoJSON :: CreateMessageAttachmentJson -> Value
Aeson.ToJSON) via CalamityToJSON CreateMessageAttachmentJson

instance CalamityToJSON' CreateMessageAttachmentJson where
  toPairs :: forall (kv :: OpticKind).
KeyValue kv =>
CreateMessageAttachmentJson -> [Maybe kv]
toPairs CreateMessageAttachmentJson {Int
Maybe Text
Text
description :: Maybe Text
filename :: Text
id :: Int
$sel:description:CreateMessageAttachmentJson :: CreateMessageAttachmentJson -> Maybe Text
$sel:filename:CreateMessageAttachmentJson :: CreateMessageAttachmentJson -> Text
$sel:id:CreateMessageAttachmentJson :: CreateMessageAttachmentJson -> Int
..} =
    [ Key
"filename" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> v -> Maybe kv
.= Text
filename
    , Key
"description" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Text
description
    , Key
"id" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> v -> Maybe kv
.= Int
id
    ]

data CreateMessageJson = CreateMessageJson
  { CreateMessageJson -> Maybe Text
content :: Maybe Text
  , CreateMessageJson -> Maybe Text
nonce :: Maybe Text
  , CreateMessageJson -> Maybe Bool
tts :: Maybe Bool
  , CreateMessageJson -> Maybe [Embed]
embeds :: Maybe [Embed]
  , CreateMessageJson -> Maybe AllowedMentions
allowedMentions :: Maybe AllowedMentions
  , CreateMessageJson -> Maybe MessageReference
messageReference :: Maybe MessageReference
  , CreateMessageJson -> Maybe [Component]
components :: Maybe [Component]
  , CreateMessageJson -> Maybe [CreateMessageAttachmentJson]
attachments :: Maybe [CreateMessageAttachmentJson]
  }
  deriving (Int -> CreateMessageJson -> ShowS
[CreateMessageJson] -> ShowS
CreateMessageJson -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMessageJson] -> ShowS
$cshowList :: [CreateMessageJson] -> ShowS
show :: CreateMessageJson -> String
$cshow :: CreateMessageJson -> String
showsPrec :: Int -> CreateMessageJson -> ShowS
$cshowsPrec :: Int -> CreateMessageJson -> ShowS
Show)
  deriving ([CreateMessageJson] -> Encoding
[CreateMessageJson] -> Value
CreateMessageJson -> Encoding
CreateMessageJson -> Value
forall (a :: OpticKind).
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CreateMessageJson] -> Encoding
$ctoEncodingList :: [CreateMessageJson] -> Encoding
toJSONList :: [CreateMessageJson] -> Value
$ctoJSONList :: [CreateMessageJson] -> Value
toEncoding :: CreateMessageJson -> Encoding
$ctoEncoding :: CreateMessageJson -> Encoding
toJSON :: CreateMessageJson -> Value
$ctoJSON :: CreateMessageJson -> Value
Aeson.ToJSON) via CalamityToJSON CreateMessageJson

instance CalamityToJSON' CreateMessageJson where
  toPairs :: forall (kv :: OpticKind).
KeyValue kv =>
CreateMessageJson -> [Maybe kv]
toPairs CreateMessageJson {Maybe Bool
Maybe [Embed]
Maybe [Component]
Maybe [CreateMessageAttachmentJson]
Maybe Text
Maybe MessageReference
Maybe AllowedMentions
attachments :: Maybe [CreateMessageAttachmentJson]
components :: Maybe [Component]
messageReference :: Maybe MessageReference
allowedMentions :: Maybe AllowedMentions
embeds :: Maybe [Embed]
tts :: Maybe Bool
nonce :: Maybe Text
content :: Maybe Text
$sel:attachments:CreateMessageJson :: CreateMessageJson -> Maybe [CreateMessageAttachmentJson]
$sel:components:CreateMessageJson :: CreateMessageJson -> Maybe [Component]
$sel:messageReference:CreateMessageJson :: CreateMessageJson -> Maybe MessageReference
$sel:allowedMentions:CreateMessageJson :: CreateMessageJson -> Maybe AllowedMentions
$sel:embeds:CreateMessageJson :: CreateMessageJson -> Maybe [Embed]
$sel:tts:CreateMessageJson :: CreateMessageJson -> Maybe Bool
$sel:nonce:CreateMessageJson :: CreateMessageJson -> Maybe Text
$sel:content:CreateMessageJson :: CreateMessageJson -> Maybe Text
..} =
    [ Key
"content" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Text
content
    , Key
"nonce" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Text
nonce
    , Key
"tts" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Bool
tts
    , Key
"embeds" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe [Embed]
embeds
    , Key
"allowed_mentions" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe AllowedMentions
allowedMentions
    , Key
"message_reference" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe MessageReference
messageReference
    , Key
"components" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe [Component]
components
    , Key
"attachments" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe [CreateMessageAttachmentJson]
attachments
    ]

data AllowedMentionType
  = AllowedMentionRoles
  | AllowedMentionUsers
  | AllowedMentionEveryone
  deriving (Int -> AllowedMentionType -> ShowS
[AllowedMentionType] -> ShowS
AllowedMentionType -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllowedMentionType] -> ShowS
$cshowList :: [AllowedMentionType] -> ShowS
show :: AllowedMentionType -> String
$cshow :: AllowedMentionType -> String
showsPrec :: Int -> AllowedMentionType -> ShowS
$cshowsPrec :: Int -> AllowedMentionType -> ShowS
Show)

instance Aeson.ToJSON AllowedMentionType where
  toJSON :: AllowedMentionType -> Value
toJSON AllowedMentionType
AllowedMentionRoles = Text -> Value
Aeson.String Text
"roles"
  toJSON AllowedMentionType
AllowedMentionUsers = Text -> Value
Aeson.String Text
"users"
  toJSON AllowedMentionType
AllowedMentionEveryone = Text -> Value
Aeson.String Text
"everyone"

data AllowedMentions = AllowedMentions
  { AllowedMentions -> [AllowedMentionType]
parse :: [AllowedMentionType]
  , AllowedMentions -> [Snowflake Role]
roles :: [Snowflake Role]
  , AllowedMentions -> [Snowflake User]
users :: [Snowflake User]
  , AllowedMentions -> Bool
repliedUser :: Bool
  }
  deriving (Int -> AllowedMentions -> ShowS
[AllowedMentions] -> ShowS
AllowedMentions -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllowedMentions] -> ShowS
$cshowList :: [AllowedMentions] -> ShowS
show :: AllowedMentions -> String
$cshow :: AllowedMentions -> String
showsPrec :: Int -> AllowedMentions -> ShowS
$cshowsPrec :: Int -> AllowedMentions -> ShowS
Show)
  deriving ([AllowedMentions] -> Encoding
[AllowedMentions] -> Value
AllowedMentions -> Encoding
AllowedMentions -> Value
forall (a :: OpticKind).
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AllowedMentions] -> Encoding
$ctoEncodingList :: [AllowedMentions] -> Encoding
toJSONList :: [AllowedMentions] -> Value
$ctoJSONList :: [AllowedMentions] -> Value
toEncoding :: AllowedMentions -> Encoding
$ctoEncoding :: AllowedMentions -> Encoding
toJSON :: AllowedMentions -> Value
$ctoJSON :: AllowedMentions -> Value
Aeson.ToJSON) via CalamityToJSON AllowedMentions

instance CalamityToJSON' AllowedMentions where
  toPairs :: forall (kv :: OpticKind).
KeyValue kv =>
AllowedMentions -> [Maybe kv]
toPairs AllowedMentions {Bool
[Snowflake User]
[Snowflake Role]
[AllowedMentionType]
repliedUser :: Bool
users :: [Snowflake User]
roles :: [Snowflake Role]
parse :: [AllowedMentionType]
$sel:repliedUser:AllowedMentions :: AllowedMentions -> Bool
$sel:users:AllowedMentions :: AllowedMentions -> [Snowflake User]
$sel:roles:AllowedMentions :: AllowedMentions -> [Snowflake Role]
$sel:parse:AllowedMentions :: AllowedMentions -> [AllowedMentionType]
..} =
    [ Key
"parse" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> v -> Maybe kv
.= [AllowedMentionType]
parse
    , Key
"roles" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> v -> Maybe kv
.= [Snowflake Role]
roles
    , Key
"users" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> v -> Maybe kv
.= [Snowflake User]
users
    , Key
"replied_user" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> v -> Maybe kv
.= Bool
repliedUser
    ]

instance Default AllowedMentions where
  def :: AllowedMentions
def = [AllowedMentionType]
-> [Snowflake Role] -> [Snowflake User] -> Bool -> AllowedMentions
AllowedMentions forall (a :: OpticKind). Default a => a
def forall (a :: OpticKind). Default a => a
def forall (a :: OpticKind). Default a => a
def Bool
False

instance Semigroup AllowedMentions where
  AllowedMentions [AllowedMentionType]
p0 [Snowflake Role]
r0 [Snowflake User]
u0 Bool
ru0 <> :: AllowedMentions -> AllowedMentions -> AllowedMentions
<> AllowedMentions [AllowedMentionType]
p1 [Snowflake Role]
r1 [Snowflake User]
u1 Bool
ru1 =
    [AllowedMentionType]
-> [Snowflake Role] -> [Snowflake User] -> Bool -> AllowedMentions
AllowedMentions ([AllowedMentionType]
p0 forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [AllowedMentionType]
p1) ([Snowflake Role]
r0 forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [Snowflake Role]
r1) ([Snowflake User]
u0 forall (a :: OpticKind). Semigroup a => a -> a -> a
<> [Snowflake User]
u1) (Bool
ru0 Bool -> Bool -> Bool
|| Bool
ru1)

instance Monoid AllowedMentions where
  mempty :: AllowedMentions
mempty = forall (a :: OpticKind). Default a => a
def

{- | Parameters to the Edit Message endpoint.

 Use the provided methods (@editMessageX@) to create a value with the
 field set, use the Semigroup instance to union the values.

 ==== Examples

 >>> encode $ editMessageContent (Just "test") <> editMessageFlags Nothing
 "{\"nick\":\"test\",\"deaf\":null}"
-}
newtype EditMessageData = EditMessageData Aeson.Object
  deriving stock (Int -> EditMessageData -> ShowS
[EditMessageData] -> ShowS
EditMessageData -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditMessageData] -> ShowS
$cshowList :: [EditMessageData] -> ShowS
show :: EditMessageData -> String
$cshow :: EditMessageData -> String
showsPrec :: Int -> EditMessageData -> ShowS
$cshowsPrec :: Int -> EditMessageData -> ShowS
Show)
  deriving newtype ([EditMessageData] -> Encoding
[EditMessageData] -> Value
EditMessageData -> Encoding
EditMessageData -> Value
forall (a :: OpticKind).
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EditMessageData] -> Encoding
$ctoEncodingList :: [EditMessageData] -> Encoding
toJSONList :: [EditMessageData] -> Value
$ctoJSONList :: [EditMessageData] -> Value
toEncoding :: EditMessageData -> Encoding
$ctoEncoding :: EditMessageData -> Encoding
toJSON :: EditMessageData -> Value
$ctoJSON :: EditMessageData -> Value
Aeson.ToJSON, NonEmpty EditMessageData -> EditMessageData
EditMessageData -> EditMessageData -> EditMessageData
forall (b :: OpticKind).
Integral b =>
b -> EditMessageData -> EditMessageData
forall (a :: OpticKind).
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall (b :: OpticKind). Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall (b :: OpticKind).
Integral b =>
b -> EditMessageData -> EditMessageData
$cstimes :: forall (b :: OpticKind).
Integral b =>
b -> EditMessageData -> EditMessageData
sconcat :: NonEmpty EditMessageData -> EditMessageData
$csconcat :: NonEmpty EditMessageData -> EditMessageData
<> :: EditMessageData -> EditMessageData -> EditMessageData
$c<> :: EditMessageData -> EditMessageData -> EditMessageData
Semigroup, Semigroup EditMessageData
EditMessageData
[EditMessageData] -> EditMessageData
EditMessageData -> EditMessageData -> EditMessageData
forall (a :: OpticKind).
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [EditMessageData] -> EditMessageData
$cmconcat :: [EditMessageData] -> EditMessageData
mappend :: EditMessageData -> EditMessageData -> EditMessageData
$cmappend :: EditMessageData -> EditMessageData -> EditMessageData
mempty :: EditMessageData
$cmempty :: EditMessageData
Monoid)

editMessageContent :: Maybe Text -> EditMessageData
editMessageContent :: Maybe Text -> EditMessageData
editMessageContent Maybe Text
v = Object -> EditMessageData
EditMessageData forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (v :: OpticKind). [(Key, v)] -> KeyMap v
K.fromList [(Key
"content", forall (a :: OpticKind). ToJSON a => a -> Value
Aeson.toJSON Maybe Text
v)]

editMessageEmbeds :: [Embed] -> EditMessageData
editMessageEmbeds :: [Embed] -> EditMessageData
editMessageEmbeds [Embed]
v = Object -> EditMessageData
EditMessageData forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (v :: OpticKind). [(Key, v)] -> KeyMap v
K.fromList [(Key
"embeds", forall (a :: OpticKind). ToJSON a => a -> Value
Aeson.toJSON [Embed]
v)]

editMessageFlags :: Maybe Word64 -> EditMessageData
editMessageFlags :: Maybe Word64 -> EditMessageData
editMessageFlags Maybe Word64
v = Object -> EditMessageData
EditMessageData forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (v :: OpticKind). [(Key, v)] -> KeyMap v
K.fromList [(Key
"flags", forall (a :: OpticKind). ToJSON a => a -> Value
Aeson.toJSON Maybe Word64
v)]

editMessageAllowedMentions :: Maybe AllowedMentions -> EditMessageData
editMessageAllowedMentions :: Maybe AllowedMentions -> EditMessageData
editMessageAllowedMentions Maybe AllowedMentions
v = Object -> EditMessageData
EditMessageData forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (v :: OpticKind). [(Key, v)] -> KeyMap v
K.fromList [(Key
"allowed_mentions", forall (a :: OpticKind). ToJSON a => a -> Value
Aeson.toJSON Maybe AllowedMentions
v)]

editMessageComponents :: [Component] -> EditMessageData
editMessageComponents :: [Component] -> EditMessageData
editMessageComponents [Component]
v = Object -> EditMessageData
EditMessageData forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (v :: OpticKind). [(Key, v)] -> KeyMap v
K.fromList [(Key
"components", forall (a :: OpticKind). ToJSON a => a -> Value
Aeson.toJSON [Component]
v)]

data ChannelUpdate = ChannelUpdate
  { ChannelUpdate -> Maybe Text
name :: Maybe Text
  , ChannelUpdate -> Maybe Int
position :: Maybe Int
  , ChannelUpdate -> Maybe Text
topic :: Maybe Text
  , ChannelUpdate -> Maybe Bool
nsfw :: Maybe Bool
  , ChannelUpdate -> Maybe Int
rateLimitPerUser :: Maybe Int
  , ChannelUpdate -> Maybe Int
bitrate :: Maybe Int
  , ChannelUpdate -> Maybe Int
userLimit :: Maybe Int
  , ChannelUpdate -> Maybe [Overwrite]
permissionOverwrites :: Maybe [Overwrite]
  , ChannelUpdate -> Maybe (Snowflake Channel)
parentID :: Maybe (Snowflake Channel)
  }
  deriving (Int -> ChannelUpdate -> ShowS
[ChannelUpdate] -> ShowS
ChannelUpdate -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelUpdate] -> ShowS
$cshowList :: [ChannelUpdate] -> ShowS
show :: ChannelUpdate -> String
$cshow :: ChannelUpdate -> String
showsPrec :: Int -> ChannelUpdate -> ShowS
$cshowsPrec :: Int -> ChannelUpdate -> ShowS
Show)
  deriving ([ChannelUpdate] -> Encoding
[ChannelUpdate] -> Value
ChannelUpdate -> Encoding
ChannelUpdate -> Value
forall (a :: OpticKind).
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChannelUpdate] -> Encoding
$ctoEncodingList :: [ChannelUpdate] -> Encoding
toJSONList :: [ChannelUpdate] -> Value
$ctoJSONList :: [ChannelUpdate] -> Value
toEncoding :: ChannelUpdate -> Encoding
$ctoEncoding :: ChannelUpdate -> Encoding
toJSON :: ChannelUpdate -> Value
$ctoJSON :: ChannelUpdate -> Value
Aeson.ToJSON) via CalamityToJSON ChannelUpdate

instance Default ChannelUpdate where
  def :: ChannelUpdate
def = Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe [Overwrite]
-> Maybe (Snowflake Channel)
-> ChannelUpdate
ChannelUpdate forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing

instance CalamityToJSON' ChannelUpdate where
  toPairs :: forall (kv :: OpticKind).
KeyValue kv =>
ChannelUpdate -> [Maybe kv]
toPairs ChannelUpdate {Maybe Bool
Maybe Int
Maybe [Overwrite]
Maybe Text
Maybe (Snowflake Channel)
parentID :: Maybe (Snowflake Channel)
permissionOverwrites :: Maybe [Overwrite]
userLimit :: Maybe Int
bitrate :: Maybe Int
rateLimitPerUser :: Maybe Int
nsfw :: Maybe Bool
topic :: Maybe Text
position :: Maybe Int
name :: Maybe Text
$sel:parentID:ChannelUpdate :: ChannelUpdate -> Maybe (Snowflake Channel)
$sel:permissionOverwrites:ChannelUpdate :: ChannelUpdate -> Maybe [Overwrite]
$sel:userLimit:ChannelUpdate :: ChannelUpdate -> Maybe Int
$sel:bitrate:ChannelUpdate :: ChannelUpdate -> Maybe Int
$sel:rateLimitPerUser:ChannelUpdate :: ChannelUpdate -> Maybe Int
$sel:nsfw:ChannelUpdate :: ChannelUpdate -> Maybe Bool
$sel:topic:ChannelUpdate :: ChannelUpdate -> Maybe Text
$sel:position:ChannelUpdate :: ChannelUpdate -> Maybe Int
$sel:name:ChannelUpdate :: ChannelUpdate -> Maybe Text
..} =
    [ Key
"name" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Text
name
    , Key
"position" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Int
position
    , Key
"topic" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Text
topic
    , Key
"nsfw" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Bool
nsfw
    , Key
"rate_limit_per_user" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Int
rateLimitPerUser
    , Key
"bitrate" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Int
bitrate
    , Key
"user_limit" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Int
userLimit
    , Key
"permission_overwrites" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe [Overwrite]
permissionOverwrites
    , Key
"parent_id" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe (Snowflake Channel)
parentID
    ]

data ChannelMessagesFilter
  = ChannelMessagesAround
      { ChannelMessagesFilter -> Snowflake Message
around :: Snowflake Message
      }
  | ChannelMessagesBefore
      { ChannelMessagesFilter -> Snowflake Message
before :: Snowflake Message
      }
  | ChannelMessagesAfter
      { ChannelMessagesFilter -> Snowflake Message
after :: Snowflake Message
      }
  deriving (Int -> ChannelMessagesFilter -> ShowS
[ChannelMessagesFilter] -> ShowS
ChannelMessagesFilter -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelMessagesFilter] -> ShowS
$cshowList :: [ChannelMessagesFilter] -> ShowS
show :: ChannelMessagesFilter -> String
$cshow :: ChannelMessagesFilter -> String
showsPrec :: Int -> ChannelMessagesFilter -> ShowS
$cshowsPrec :: Int -> ChannelMessagesFilter -> ShowS
Show)
  deriving ([ChannelMessagesFilter] -> Encoding
[ChannelMessagesFilter] -> Value
ChannelMessagesFilter -> Encoding
ChannelMessagesFilter -> Value
forall (a :: OpticKind).
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChannelMessagesFilter] -> Encoding
$ctoEncodingList :: [ChannelMessagesFilter] -> Encoding
toJSONList :: [ChannelMessagesFilter] -> Value
$ctoJSONList :: [ChannelMessagesFilter] -> Value
toEncoding :: ChannelMessagesFilter -> Encoding
$ctoEncoding :: ChannelMessagesFilter -> Encoding
toJSON :: ChannelMessagesFilter -> Value
$ctoJSON :: ChannelMessagesFilter -> Value
Aeson.ToJSON) via CalamityToJSON ChannelMessagesFilter

instance CalamityToJSON' ChannelMessagesFilter where
  toPairs :: forall (kv :: OpticKind).
KeyValue kv =>
ChannelMessagesFilter -> [Maybe kv]
toPairs ChannelMessagesAround {Snowflake Message
around :: Snowflake Message
$sel:around:ChannelMessagesAround :: ChannelMessagesFilter -> Snowflake Message
around} = [Key
"around" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> v -> Maybe kv
.= Snowflake Message
around]
  toPairs ChannelMessagesBefore {Snowflake Message
before :: Snowflake Message
$sel:before:ChannelMessagesAround :: ChannelMessagesFilter -> Snowflake Message
before} = [Key
"before" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> v -> Maybe kv
.= Snowflake Message
before]
  toPairs ChannelMessagesAfter {Snowflake Message
after :: Snowflake Message
$sel:after:ChannelMessagesAround :: ChannelMessagesFilter -> Snowflake Message
after} = [Key
"after" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> v -> Maybe kv
.= Snowflake Message
after]

newtype ChannelMessagesLimit = ChannelMessagesLimit
  { ChannelMessagesLimit -> Integer
limit :: Integer
  }
  deriving stock (Int -> ChannelMessagesLimit -> ShowS
[ChannelMessagesLimit] -> ShowS
ChannelMessagesLimit -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelMessagesLimit] -> ShowS
$cshowList :: [ChannelMessagesLimit] -> ShowS
show :: ChannelMessagesLimit -> String
$cshow :: ChannelMessagesLimit -> String
showsPrec :: Int -> ChannelMessagesLimit -> ShowS
$cshowsPrec :: Int -> ChannelMessagesLimit -> ShowS
Show)

data GetReactionsOptions = GetReactionsOptions
  { GetReactionsOptions -> Maybe (Snowflake User)
before :: Maybe (Snowflake User)
  , GetReactionsOptions -> Maybe (Snowflake User)
after :: Maybe (Snowflake User)
  , GetReactionsOptions -> Maybe Integer
limit :: Maybe Integer
  }
  deriving (Int -> GetReactionsOptions -> ShowS
[GetReactionsOptions] -> ShowS
GetReactionsOptions -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetReactionsOptions] -> ShowS
$cshowList :: [GetReactionsOptions] -> ShowS
show :: GetReactionsOptions -> String
$cshow :: GetReactionsOptions -> String
showsPrec :: Int -> GetReactionsOptions -> ShowS
$cshowsPrec :: Int -> GetReactionsOptions -> ShowS
Show)

instance Default GetReactionsOptions where
  def :: GetReactionsOptions
def = Maybe (Snowflake User)
-> Maybe (Snowflake User) -> Maybe Integer -> GetReactionsOptions
GetReactionsOptions forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing

data CreateChannelInviteOptions = CreateChannelInviteOptions
  { CreateChannelInviteOptions -> Maybe Int
maxAge :: Maybe Int
  , CreateChannelInviteOptions -> Maybe Int
maxUses :: Maybe Int
  , CreateChannelInviteOptions -> Maybe Bool
temporary :: Maybe Bool
  , CreateChannelInviteOptions -> Maybe Bool
unique :: Maybe Bool
  }
  deriving (Int -> CreateChannelInviteOptions -> ShowS
[CreateChannelInviteOptions] -> ShowS
CreateChannelInviteOptions -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateChannelInviteOptions] -> ShowS
$cshowList :: [CreateChannelInviteOptions] -> ShowS
show :: CreateChannelInviteOptions -> String
$cshow :: CreateChannelInviteOptions -> String
showsPrec :: Int -> CreateChannelInviteOptions -> ShowS
$cshowsPrec :: Int -> CreateChannelInviteOptions -> ShowS
Show)
  deriving ([CreateChannelInviteOptions] -> Encoding
[CreateChannelInviteOptions] -> Value
CreateChannelInviteOptions -> Encoding
CreateChannelInviteOptions -> Value
forall (a :: OpticKind).
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CreateChannelInviteOptions] -> Encoding
$ctoEncodingList :: [CreateChannelInviteOptions] -> Encoding
toJSONList :: [CreateChannelInviteOptions] -> Value
$ctoJSONList :: [CreateChannelInviteOptions] -> Value
toEncoding :: CreateChannelInviteOptions -> Encoding
$ctoEncoding :: CreateChannelInviteOptions -> Encoding
toJSON :: CreateChannelInviteOptions -> Value
$ctoJSON :: CreateChannelInviteOptions -> Value
Aeson.ToJSON) via CalamityToJSON CreateChannelInviteOptions

instance Default CreateChannelInviteOptions where
  def :: CreateChannelInviteOptions
def = Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> CreateChannelInviteOptions
CreateChannelInviteOptions forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing forall (a :: OpticKind). Maybe a
Nothing

instance CalamityToJSON' CreateChannelInviteOptions where
  toPairs :: forall (kv :: OpticKind).
KeyValue kv =>
CreateChannelInviteOptions -> [Maybe kv]
toPairs CreateChannelInviteOptions {Maybe Bool
Maybe Int
unique :: Maybe Bool
temporary :: Maybe Bool
maxUses :: Maybe Int
maxAge :: Maybe Int
$sel:unique:CreateChannelInviteOptions :: CreateChannelInviteOptions -> Maybe Bool
$sel:temporary:CreateChannelInviteOptions :: CreateChannelInviteOptions -> Maybe Bool
$sel:maxUses:CreateChannelInviteOptions :: CreateChannelInviteOptions -> Maybe Int
$sel:maxAge:CreateChannelInviteOptions :: CreateChannelInviteOptions -> Maybe Int
..} =
    [ Key
"max_age" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Int
maxAge
    , Key
"max_uses" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Int
maxUses
    , Key
"temporary" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Bool
temporary
    , Key
"unique" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> Maybe v -> Maybe kv
.?= Maybe Bool
unique
    ]

data GroupDMAddRecipientOptions = GroupDMAddRecipientOptions
  { GroupDMAddRecipientOptions -> Text
accessToken :: Text
  , GroupDMAddRecipientOptions -> Text
nick :: Text
  }
  deriving (Int -> GroupDMAddRecipientOptions -> ShowS
[GroupDMAddRecipientOptions] -> ShowS
GroupDMAddRecipientOptions -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupDMAddRecipientOptions] -> ShowS
$cshowList :: [GroupDMAddRecipientOptions] -> ShowS
show :: GroupDMAddRecipientOptions -> String
$cshow :: GroupDMAddRecipientOptions -> String
showsPrec :: Int -> GroupDMAddRecipientOptions -> ShowS
$cshowsPrec :: Int -> GroupDMAddRecipientOptions -> ShowS
Show)
  deriving ([GroupDMAddRecipientOptions] -> Encoding
[GroupDMAddRecipientOptions] -> Value
GroupDMAddRecipientOptions -> Encoding
GroupDMAddRecipientOptions -> Value
forall (a :: OpticKind).
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GroupDMAddRecipientOptions] -> Encoding
$ctoEncodingList :: [GroupDMAddRecipientOptions] -> Encoding
toJSONList :: [GroupDMAddRecipientOptions] -> Value
$ctoJSONList :: [GroupDMAddRecipientOptions] -> Value
toEncoding :: GroupDMAddRecipientOptions -> Encoding
$ctoEncoding :: GroupDMAddRecipientOptions -> Encoding
toJSON :: GroupDMAddRecipientOptions -> Value
$ctoJSON :: GroupDMAddRecipientOptions -> Value
Aeson.ToJSON) via CalamityToJSON GroupDMAddRecipientOptions

instance CalamityToJSON' GroupDMAddRecipientOptions where
  toPairs :: forall (kv :: OpticKind).
KeyValue kv =>
GroupDMAddRecipientOptions -> [Maybe kv]
toPairs GroupDMAddRecipientOptions {Text
nick :: Text
accessToken :: Text
$sel:nick:GroupDMAddRecipientOptions :: GroupDMAddRecipientOptions -> Text
$sel:accessToken:GroupDMAddRecipientOptions :: GroupDMAddRecipientOptions -> Text
..} =
    [ Key
"access_token" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> v -> Maybe kv
.= Text
accessToken
    , Key
"nick" forall (v :: OpticKind) (kv :: OpticKind).
(ToJSON v, KeyValue kv) =>
Key -> v -> Maybe kv
.= Text
nick
    ]

$(makeFieldLabelsNoPrefix ''CreateMessageAttachment)
$(makeFieldLabelsNoPrefix ''CreateMessageOptions)
$(makeFieldLabelsNoPrefix ''CreateMessageAttachmentJson)
$(makeFieldLabelsNoPrefix ''AllowedMentions)
$(makeFieldLabelsNoPrefix ''ChannelUpdate)
$(makeFieldLabelsNoPrefix ''ChannelMessagesFilter)
$(makeFieldLabelsNoPrefix ''ChannelMessagesLimit)
$(makeFieldLabelsNoPrefix ''GetReactionsOptions)
$(makeFieldLabelsNoPrefix ''CreateChannelInviteOptions)
$(makeFieldLabelsNoPrefix ''GroupDMAddRecipientOptions)

data ChannelRequest a where
  CreateMessage :: (HasID Channel c) => c -> CreateMessageOptions -> ChannelRequest Message
  CrosspostMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest Message
  GetMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest Message
  EditMessage :: (HasID Channel c, HasID Message m) => c -> m -> EditMessageData -> ChannelRequest Message
  DeleteMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest ()
  BulkDeleteMessages :: (HasID Channel c, HasID Message m) => c -> [m] -> ChannelRequest ()
  GetChannel :: (HasID Channel c) => c -> ChannelRequest Channel
  ModifyChannel :: (HasID Channel c) => c -> ChannelUpdate -> ChannelRequest Channel
  DeleteChannel :: (HasID Channel c) => c -> ChannelRequest ()
  GetChannelMessages :: (HasID Channel c) => c -> Maybe ChannelMessagesFilter -> Maybe ChannelMessagesLimit -> ChannelRequest [Message]
  CreateReaction :: (HasID Channel c, HasID Message m) => c -> m -> RawEmoji -> ChannelRequest ()
  DeleteOwnReaction :: (HasID Channel c, HasID Message m) => c -> m -> RawEmoji -> ChannelRequest ()
  DeleteUserReaction :: (HasID Channel c, HasID Message m, HasID User u) => c -> m -> RawEmoji -> u -> ChannelRequest ()
  GetReactions :: (HasID Channel c, HasID Message m) => c -> m -> RawEmoji -> GetReactionsOptions -> ChannelRequest [User]
  DeleteAllReactions :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest ()
  GetChannelInvites :: (HasID Channel c) => c -> ChannelRequest [Invite]
  CreateChannelInvite :: (HasID Channel c) => c -> CreateChannelInviteOptions -> ChannelRequest Invite
  EditChannelPermissions :: (HasID Channel c) => c -> Overwrite -> ChannelRequest ()
  DeleteChannelPermission :: (HasID Channel c, HasID Overwrite o) => c -> o -> ChannelRequest ()
  TriggerTyping :: (HasID Channel c) => c -> ChannelRequest ()
  GetPinnedMessages :: (HasID Channel c) => c -> ChannelRequest [Message]
  AddPinnedMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest ()
  DeletePinnedMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest ()
  GroupDMAddRecipient :: (HasID Channel c, HasID User u) => c -> u -> GroupDMAddRecipientOptions -> ChannelRequest ()
  GroupDMRemoveRecipient :: (HasID Channel c, HasID User u) => c -> u -> ChannelRequest ()

baseRoute :: Snowflake Channel -> RouteBuilder _
baseRoute :: Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel,
           AddRequiredInner (Lookup ('IDRequirement Channel) '[]))]
baseRoute Snowflake Channel
id =
  RouteBuilder '[]
mkRouteBuilder forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"channels" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Channel
    forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Channel
id

renderEmoji :: RawEmoji -> Text
renderEmoji :: RawEmoji -> Text
renderEmoji (UnicodeEmoji Text
e) = Text
e
renderEmoji (CustomEmoji Partial Emoji
e) = Partial Emoji
e forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "name" a => a
#name forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
":" forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). TextShow a => a -> Text
showt (Partial Emoji
e forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "id" a => a
#id)

instance Request (ChannelRequest a) where
  type Result (ChannelRequest a) = a

  route :: ChannelRequest a -> Route
route (CreateMessage (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
id) CreateMessageOptions
_) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
id forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages"
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (CrosspostMessage (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
id) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message -> Snowflake Message
mid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
id forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Message
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (GetChannel (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
id)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
id
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (ModifyChannel (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
id) ChannelUpdate
_) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
id
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (DeleteChannel (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
id)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
id
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (GetChannelMessages (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
id) Maybe ChannelMessagesFilter
_ Maybe ChannelMessagesLimit
_) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
id forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages"
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (GetMessage (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message -> Snowflake Message
mid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Message
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (CreateReaction (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message -> Snowflake Message
mid) RawEmoji
emoji) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Message forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"reactions" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall (s :: Symbol). PS s
PS @"emoji" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"@me"
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (s :: Symbol)
       (reqs :: [(RequirementType, RouteRequirement)]).
KnownSymbol s =>
Text
-> RouteBuilder reqs
-> RouteBuilder ('( 'PSRequirement s, 'Satisfied) : reqs)
giveParam @"emoji" (RawEmoji -> Text
renderEmoji RawEmoji
emoji)
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (DeleteOwnReaction (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message -> Snowflake Message
mid) RawEmoji
emoji) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Message forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"reactions" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall (s :: Symbol). PS s
PS @"emoji" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"@me"
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (s :: Symbol)
       (reqs :: [(RequirementType, RouteRequirement)]).
KnownSymbol s =>
Text
-> RouteBuilder reqs
-> RouteBuilder ('( 'PSRequirement s, 'Satisfied) : reqs)
giveParam @"emoji" (RawEmoji -> Text
renderEmoji RawEmoji
emoji)
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (DeleteUserReaction (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message -> Snowflake Message
mid) RawEmoji
emoji (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @User -> Snowflake User
uid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Message forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"reactions" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall (s :: Symbol). PS s
PS @"emoji" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @User
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake User
uid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (s :: Symbol)
       (reqs :: [(RequirementType, RouteRequirement)]).
KnownSymbol s =>
Text
-> RouteBuilder reqs
-> RouteBuilder ('( 'PSRequirement s, 'Satisfied) : reqs)
giveParam @"emoji" (RawEmoji -> Text
renderEmoji RawEmoji
emoji)
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (GetReactions (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message -> Snowflake Message
mid) RawEmoji
emoji GetReactionsOptions
_) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Message forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"reactions" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall (s :: Symbol). PS s
PS @"emoji"
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (s :: Symbol)
       (reqs :: [(RequirementType, RouteRequirement)]).
KnownSymbol s =>
Text
-> RouteBuilder reqs
-> RouteBuilder ('( 'PSRequirement s, 'Satisfied) : reqs)
giveParam @"emoji" (RawEmoji -> Text
renderEmoji RawEmoji
emoji)
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (DeleteAllReactions (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message -> Snowflake Message
mid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Message forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"reactions"
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (EditMessage (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message -> Snowflake Message
mid) EditMessageData
_) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Message
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (DeleteMessage (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message -> Snowflake Message
mid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Message
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (BulkDeleteMessages (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) [m]
_) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"messages" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"bulk-delete"
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (GetChannelInvites (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"invites"
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (CreateChannelInvite (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) CreateChannelInviteOptions
_) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"invites"
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (EditChannelPermissions (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Overwrite -> Snowflake Overwrite
oid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"permissions" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Overwrite
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Overwrite
oid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (DeleteChannelPermission (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Overwrite -> Snowflake Overwrite
oid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"permissions" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Overwrite
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Overwrite
oid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (TriggerTyping (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"typing"
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (GetPinnedMessages (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"pins"
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (AddPinnedMessage (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message -> Snowflake Message
mid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"pins" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Message
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (DeletePinnedMessage (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message -> Snowflake Message
mid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"pins" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @Message
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake Message
mid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (GroupDMAddRecipient (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @User -> Snowflake User
uid) GroupDMAddRecipientOptions
_) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"recipients" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @User
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake User
uid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  route (GroupDMRemoveRecipient (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID -> Snowflake Channel
cid) (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @User -> Snowflake User
uid)) =
    Snowflake Channel
-> RouteBuilder
     '[ '( 'IDRequirement Channel, 'Satisfied),
        '( 'IDRequirement Channel, 'Required)]
baseRoute Snowflake Channel
cid forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// Text -> S
S Text
"recipients" forall (a :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
RouteFragmentable a reqs =>
RouteBuilder reqs -> a -> ConsRes a reqs
// forall {k :: OpticKind} (a :: k). ID a
ID @User
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (t :: OpticKind)
       (reqs :: [(RequirementType, RouteRequirement)]).
Typeable t =>
Snowflake t
-> RouteBuilder reqs
-> RouteBuilder ('( 'IDRequirement t, 'Satisfied) : reqs)
giveID Snowflake User
uid
      forall (a :: OpticKind) (b :: OpticKind). a -> (a -> b) -> b
& forall (reqs :: [(RequirementType, RouteRequirement)]).
EnsureFulfilled reqs =>
RouteBuilder reqs -> Route
buildRoute
  action :: ChannelRequest a -> Url 'Https -> Option 'Https -> Req LbsResponse
action (CreateMessage c
_ CreateMessageOptions
cm) = \Url 'Https
u Option 'Https
o -> do
    let filePart :: CreateMessageAttachment -> a -> PartM IO
filePart CreateMessageAttachment {Text
filename :: Text
$sel:filename:CreateMessageAttachment :: CreateMessageAttachment -> Text
filename, ByteString
content :: ByteString
$sel:content:CreateMessageAttachment :: CreateMessageAttachment -> ByteString
content} a
n =
          (forall (m :: OpticKind -> OpticKind).
Applicative m =>
Text -> ByteString -> PartM m
partLBS @IO (String -> Text
T.pack forall (a :: OpticKind) b. (a -> b) -> a -> b
$ String
"files[" forall (a :: OpticKind). Semigroup a => a -> a -> a
<> forall (a :: OpticKind). Show a => a -> String
show a
n forall (a :: OpticKind). Semigroup a => a -> a -> a
<> String
"]") ByteString
content)
            { partFilename :: Maybe String
partFilename = forall (a :: OpticKind). a -> Maybe a
Just (Text -> String
T.unpack Text
filename)
            , partContentType :: Maybe MimeType
partContentType = forall (a :: OpticKind). a -> Maybe a
Just (Text -> MimeType
defaultMimeLookup Text
filename)
            }
        attachmentPart :: CreateMessageAttachment -> Int -> CreateMessageAttachmentJson
attachmentPart CreateMessageAttachment {Text
filename :: Text
$sel:filename:CreateMessageAttachment :: CreateMessageAttachment -> Text
filename, Maybe Text
description :: Maybe Text
$sel:description:CreateMessageAttachment :: CreateMessageAttachment -> Maybe Text
description} Int
n =
          Int -> Text -> Maybe Text -> CreateMessageAttachmentJson
CreateMessageAttachmentJson Int
n Text
filename Maybe Text
description
        files :: [PartM IO]
files = forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {a :: OpticKind}.
Show a =>
CreateMessageAttachment -> a -> PartM IO
filePart (forall (a :: OpticKind). a -> Maybe a -> a
fromMaybe [] forall (a :: OpticKind) b. (a -> b) -> a -> b
$ CreateMessageOptions
cm forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "attachments" a => a
#attachments) [(Int
0 :: Int) ..]
        attachments :: Maybe [CreateMessageAttachmentJson]
attachments = (\[CreateMessageAttachment]
a -> forall (a :: OpticKind) (b :: OpticKind) (c :: OpticKind).
(a -> b -> c) -> [a] -> [b] -> [c]
zipWith CreateMessageAttachment -> Int -> CreateMessageAttachmentJson
attachmentPart [CreateMessageAttachment]
a [Int
0 ..]) forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> CreateMessageOptions
cm forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "attachments" a => a
#attachments
        jsonBody :: CreateMessageJson
jsonBody =
          CreateMessageJson
            { $sel:content:CreateMessageJson :: Maybe Text
content = CreateMessageOptions
cm forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "content" a => a
#content
            , $sel:nonce:CreateMessageJson :: Maybe Text
nonce = CreateMessageOptions
cm forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "nonce" a => a
#nonce
            , $sel:tts:CreateMessageJson :: Maybe Bool
tts = CreateMessageOptions
cm forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "tts" a => a
#tts
            , $sel:embeds:CreateMessageJson :: Maybe [Embed]
embeds = CreateMessageOptions
cm forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "embeds" a => a
#embeds
            , $sel:allowedMentions:CreateMessageJson :: Maybe AllowedMentions
allowedMentions = CreateMessageOptions
cm forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "allowedMentions" a => a
#allowedMentions
            , $sel:messageReference:CreateMessageJson :: Maybe MessageReference
messageReference = CreateMessageOptions
cm forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "messageReference" a => a
#messageReference
            , $sel:components:CreateMessageJson :: Maybe [Component]
components = CreateMessageOptions
cm forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "components" a => a
#components
            , $sel:attachments:CreateMessageJson :: Maybe [CreateMessageAttachmentJson]
attachments = Maybe [CreateMessageAttachmentJson]
attachments
            }
    ReqBodyMultipart
body <- forall (m :: OpticKind -> OpticKind).
MonadIO m =>
[PartM IO] -> m ReqBodyMultipart
reqBodyMultipart (forall (m :: OpticKind -> OpticKind).
Applicative m =>
Text -> ByteString -> PartM m
partLBS Text
"payload_json" (forall (a :: OpticKind). ToJSON a => a -> ByteString
Aeson.encode CreateMessageJson
jsonBody) forall (a :: OpticKind). a -> [a] -> [a]
: [PartM IO]
files)
    forall (a :: OpticKind).
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
postWith' ReqBodyMultipart
body Url 'Https
u Option 'Https
o
  action (CrosspostMessage c
_ m
_) = Url 'Https -> Option 'Https -> Req LbsResponse
postEmpty
  action (GetChannel c
_) = Url 'Https -> Option 'Https -> Req LbsResponse
getWith
  action (ModifyChannel c
_ ChannelUpdate
p) = forall (a :: OpticKind).
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
patchWith' (forall (a :: OpticKind). a -> ReqBodyJson a
ReqBodyJson ChannelUpdate
p)
  action (DeleteChannel c
_) = Url 'Https -> Option 'Https -> Req LbsResponse
deleteWith
  action (GetChannelMessages c
_ (Just (ChannelMessagesAround (forall (t :: OpticKind). Snowflake t -> Word64
fromSnowflake -> Word64
a))) Maybe ChannelMessagesLimit
l) =
    Option 'Https -> Url 'Https -> Option 'Https -> Req LbsResponse
getWithP (Text
"around" forall (param :: OpticKind) (a :: OpticKind).
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Word64
a forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"limit" forall (a :: OpticKind).
ToHttpApiData a =>
Text -> Maybe a -> Option 'Https
=:? (Maybe ChannelMessagesLimit
l forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall (a :: OpticKind) (b :: OpticKind).
Prism (Maybe a) (Maybe b) a b
_Just forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "limit" a => a
#limit))
  action (GetChannelMessages c
_ (Just (ChannelMessagesBefore (forall (t :: OpticKind). Snowflake t -> Word64
fromSnowflake -> Word64
a))) Maybe ChannelMessagesLimit
l) =
    Option 'Https -> Url 'Https -> Option 'Https -> Req LbsResponse
getWithP (Text
"before" forall (param :: OpticKind) (a :: OpticKind).
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Word64
a forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"limit" forall (a :: OpticKind).
ToHttpApiData a =>
Text -> Maybe a -> Option 'Https
=:? (Maybe ChannelMessagesLimit
l forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall (a :: OpticKind) (b :: OpticKind).
Prism (Maybe a) (Maybe b) a b
_Just forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "limit" a => a
#limit))
  action (GetChannelMessages c
_ (Just (ChannelMessagesAfter (forall (t :: OpticKind). Snowflake t -> Word64
fromSnowflake -> Word64
a))) Maybe ChannelMessagesLimit
l) =
    Option 'Https -> Url 'Https -> Option 'Https -> Req LbsResponse
getWithP (Text
"after" forall (param :: OpticKind) (a :: OpticKind).
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Word64
a forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"limit" forall (a :: OpticKind).
ToHttpApiData a =>
Text -> Maybe a -> Option 'Https
=:? (Maybe ChannelMessagesLimit
l forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall (a :: OpticKind) (b :: OpticKind).
Prism (Maybe a) (Maybe b) a b
_Just forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "limit" a => a
#limit))
  action (GetChannelMessages c
_ Maybe ChannelMessagesFilter
Nothing Maybe ChannelMessagesLimit
l) = Option 'Https -> Url 'Https -> Option 'Https -> Req LbsResponse
getWithP (Text
"limit" forall (a :: OpticKind).
ToHttpApiData a =>
Text -> Maybe a -> Option 'Https
=:? (Maybe ChannelMessagesLimit
l forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall (a :: OpticKind) (b :: OpticKind).
Prism (Maybe a) (Maybe b) a b
_Just forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "limit" a => a
#limit))
  action (GetMessage c
_ m
_) = Url 'Https -> Option 'Https -> Req LbsResponse
getWith
  action CreateReaction {} = Url 'Https -> Option 'Https -> Req LbsResponse
putEmpty
  action DeleteOwnReaction {} = Url 'Https -> Option 'Https -> Req LbsResponse
deleteWith
  action DeleteUserReaction {} = Url 'Https -> Option 'Https -> Req LbsResponse
deleteWith
  action (GetReactions c
_ m
_ RawEmoji
_ GetReactionsOptions {Maybe (Snowflake User)
before :: Maybe (Snowflake User)
$sel:before:GetReactionsOptions :: GetReactionsOptions -> Maybe (Snowflake User)
before, Maybe (Snowflake User)
after :: Maybe (Snowflake User)
$sel:after:GetReactionsOptions :: GetReactionsOptions -> Maybe (Snowflake User)
after, Maybe Integer
limit :: Maybe Integer
$sel:limit:GetReactionsOptions :: GetReactionsOptions -> Maybe Integer
limit}) =
    Option 'Https -> Url 'Https -> Option 'Https -> Req LbsResponse
getWithP
      ( Text
"before" forall (a :: OpticKind).
ToHttpApiData a =>
Text -> Maybe a -> Option 'Https
=:? (forall (t :: OpticKind). Snowflake t -> Word64
fromSnowflake forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Maybe (Snowflake User)
before)
          forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"after" forall (a :: OpticKind).
ToHttpApiData a =>
Text -> Maybe a -> Option 'Https
=:? (forall (t :: OpticKind). Snowflake t -> Word64
fromSnowflake forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Maybe (Snowflake User)
after)
          forall (a :: OpticKind). Semigroup a => a -> a -> a
<> Text
"limit" forall (a :: OpticKind).
ToHttpApiData a =>
Text -> Maybe a -> Option 'Https
=:? Maybe Integer
limit
      )
  action (DeleteAllReactions c
_ m
_) = Url 'Https -> Option 'Https -> Req LbsResponse
deleteWith
  action (EditMessage c
_ m
_ EditMessageData
o) = forall (a :: OpticKind).
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
patchWith' (forall (a :: OpticKind). a -> ReqBodyJson a
ReqBodyJson EditMessageData
o)
  action (DeleteMessage c
_ m
_) = Url 'Https -> Option 'Https -> Req LbsResponse
deleteWith
  action (BulkDeleteMessages c
_ (forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (forall (b :: OpticKind) (a :: OpticKind).
HasID b a =>
a -> Snowflake b
getID @Message) -> [Snowflake Message]
ids)) = forall (a :: OpticKind).
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
postWith' (forall (a :: OpticKind). a -> ReqBodyJson a
ReqBodyJson forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [(Key, Value)] -> Value
Aeson.object [Key
"messages" forall (kv :: OpticKind) (v :: OpticKind).
(KeyValue kv, ToJSON v) =>
Key -> v -> kv
Aeson..= [Snowflake Message]
ids])
  action (GetChannelInvites c
_) = Url 'Https -> Option 'Https -> Req LbsResponse
getWith
  action (CreateChannelInvite c
_ CreateChannelInviteOptions
o) = forall (a :: OpticKind).
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
postWith' (forall (a :: OpticKind). a -> ReqBodyJson a
ReqBodyJson CreateChannelInviteOptions
o)
  action (EditChannelPermissions c
_ Overwrite
o) = forall (a :: OpticKind).
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
putWith' (forall (a :: OpticKind). a -> ReqBodyJson a
ReqBodyJson Overwrite
o)
  action (DeleteChannelPermission c
_ o
_) = Url 'Https -> Option 'Https -> Req LbsResponse
deleteWith
  action (TriggerTyping c
_) = Url 'Https -> Option 'Https -> Req LbsResponse
postEmpty
  action (GetPinnedMessages c
_) = Url 'Https -> Option 'Https -> Req LbsResponse
getWith
  action (AddPinnedMessage c
_ m
_) = Url 'Https -> Option 'Https -> Req LbsResponse
putEmpty
  action (DeletePinnedMessage c
_ m
_) = Url 'Https -> Option 'Https -> Req LbsResponse
deleteWith
  action (GroupDMAddRecipient c
_ u
_ GroupDMAddRecipientOptions
o) = forall (a :: OpticKind).
HttpBody a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
putWith' (forall (a :: OpticKind). a -> ReqBodyJson a
ReqBodyJson GroupDMAddRecipientOptions
o)
  action (GroupDMRemoveRecipient c
_ u
_) = Url 'Https -> Option 'Https -> Req LbsResponse
deleteWith