discord-haskell 1.14.0 → 1.15.0
raw patch · 19 files changed
+978/−810 lines, 19 filesdep +networkdep +unordered-containersdep ~aesondep ~http-api-datadep ~http-clientnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: network, unordered-containers
Dependency ranges changed: aeson, http-api-data, http-client, req
API changes (from Hackage documentation)
- Discord.Internal.Rest.Guild: data CreateGuildIntegrationOpts
- Discord.Internal.Types.ApplicationCommands: [applicationCommandDefaultPermission] :: ApplicationCommand -> Bool
- Discord.Internal.Types.ApplicationCommands: [createDefaultPermission] :: CreateApplicationCommand -> Bool
- Discord.Internal.Types.ApplicationCommands: [editDefaultPermission] :: EditApplicationCommand -> Maybe Bool
- Discord.Internal.Types.Prelude: data ApplicationCommandIdType
- Discord.Internal.Types.Prelude: data ApplicationIdType
- Discord.Internal.Types.Prelude: data AttachmentIdType
- Discord.Internal.Types.Prelude: data ChannelIdType
- Discord.Internal.Types.Prelude: data EmojiIdType
- Discord.Internal.Types.Prelude: data GuildIdType
- Discord.Internal.Types.Prelude: data IntegrationIdType
- Discord.Internal.Types.Prelude: data InteractionIdType
- Discord.Internal.Types.Prelude: data MessageIdType
- Discord.Internal.Types.Prelude: data ParentIdType
- Discord.Internal.Types.Prelude: data RoleIdType
- Discord.Internal.Types.Prelude: data ScheduledEventEntityIdType
- Discord.Internal.Types.Prelude: data ScheduledEventIdType
- Discord.Internal.Types.Prelude: data StageIdType
- Discord.Internal.Types.Prelude: data StickerIdType
- Discord.Internal.Types.Prelude: data UserIdType
- Discord.Internal.Types.Prelude: data WebhookIdType
- Discord.Internal.Types.Prelude: toMaybeJSON :: ToJSON a => a -> Maybe Value
- Discord.Types: data ApplicationCommandIdType
- Discord.Types: data ApplicationIdType
- Discord.Types: data AttachmentIdType
- Discord.Types: data ChannelIdType
- Discord.Types: data EmojiIdType
- Discord.Types: data GuildIdType
- Discord.Types: data IntegrationIdType
- Discord.Types: data InteractionIdType
- Discord.Types: data MessageIdType
- Discord.Types: data ParentIdType
- Discord.Types: data RoleIdType
- Discord.Types: data ScheduledEventEntityIdType
- Discord.Types: data ScheduledEventIdType
- Discord.Types: data StageIdType
- Discord.Types: data StickerIdType
- Discord.Types: data UserIdType
- Discord.Types: data WebhookIdType
- Discord.Types: toMaybeJSON :: ToJSON a => a -> Maybe Value
+ Discord.Internal.Gateway: [gatewayHandleHostname] :: GatewayHandle -> IORef HostName
+ Discord.Internal.Gateway.EventLoop: [gatewayHandleHostname] :: GatewayHandle -> IORef HostName
+ Discord.Internal.Rest.Guild: newtype CreateGuildIntegrationOpts
+ Discord.Internal.Types.ApplicationCommands: [applicationCommandDMPermission] :: ApplicationCommand -> Maybe Bool
+ Discord.Internal.Types.ApplicationCommands: [applicationCommandDefaultMemberPermissions] :: ApplicationCommand -> Maybe Text
+ Discord.Internal.Types.ApplicationCommands: [applicationCommandLocalizedDescription] :: ApplicationCommand -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [applicationCommandLocalizedName] :: ApplicationCommand -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [choiceLocalizedName] :: Choice a -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [createDMPermission] :: CreateApplicationCommand -> Maybe Bool
+ Discord.Internal.Types.ApplicationCommands: [createLocalizedDescription] :: CreateApplicationCommand -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [createLocalizedName] :: CreateApplicationCommand -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [editDMPermission] :: EditApplicationCommand -> Maybe Bool
+ Discord.Internal.Types.ApplicationCommands: [editDefaultMemberPermissions] :: EditApplicationCommand -> Maybe Text
+ Discord.Internal.Types.ApplicationCommands: [editLocalizedDescription] :: EditApplicationCommand -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [editLocalizedName] :: EditApplicationCommand -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [optionSubcommandGroupLocalizedDescription] :: OptionSubcommandOrGroup -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [optionSubcommandGroupLocalizedName] :: OptionSubcommandOrGroup -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [optionSubcommandLocalizedDescription] :: OptionSubcommand -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [optionSubcommandLocalizedName] :: OptionSubcommand -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [optionValueLocalizedDescription] :: OptionValue -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [optionValueLocalizedName] :: OptionValue -> Maybe LocalizedText
+ Discord.Internal.Types.ApplicationCommands: [optionValueStringMaxLen] :: OptionValue -> Maybe Integer
+ Discord.Internal.Types.ApplicationCommands: [optionValueStringMinLen] :: OptionValue -> Maybe Integer
+ Discord.Internal.Types.ApplicationCommands: type AutocompleteOrChoice a = Either Bool [Choice a]
+ Discord.Internal.Types.ApplicationCommands: type Locale = Text
+ Discord.Internal.Types.ApplicationCommands: type LocalizedText = Map Locale Text
+ Discord.Internal.Types.Events: extractHostname :: String -> HostName
+ Discord.Internal.Types.Interactions: [interactionPermissions] :: Interaction -> Maybe Text
+ Discord.Internal.Types.Prelude: (.==) :: ToJSON a => AesonKey -> a -> Maybe Pair
+ Discord.Internal.Types.Prelude: (.=?) :: ToJSON a => AesonKey -> Maybe a -> Maybe Pair
+ Discord.Internal.Types.Prelude: objectFromMaybes :: [Maybe Pair] -> Value
+ Discord.Internal.Types.Prelude: type AesonKey = Key
+ Discord.Types: (.==) :: ToJSON a => AesonKey -> a -> Maybe Pair
+ Discord.Types: (.=?) :: ToJSON a => AesonKey -> Maybe a -> Maybe Pair
+ Discord.Types: extractHostname :: String -> HostName
+ Discord.Types: objectFromMaybes :: [Maybe Pair] -> Value
+ Discord.Types: type AesonKey = Key
- Discord.Internal.Gateway: GatewayHandle :: Chan (Either GatewayException EventInternalParse) -> Chan GatewaySendable -> IORef (Maybe UpdateStatusOpts) -> IORef Integer -> IORef Text -> GatewayHandle
+ Discord.Internal.Gateway: GatewayHandle :: Chan (Either GatewayException EventInternalParse) -> Chan GatewaySendable -> IORef (Maybe UpdateStatusOpts) -> IORef Integer -> IORef Text -> IORef HostName -> GatewayHandle
- Discord.Internal.Gateway.EventLoop: GatewayHandle :: Chan (Either GatewayException EventInternalParse) -> Chan GatewaySendable -> IORef (Maybe UpdateStatusOpts) -> IORef Integer -> IORef Text -> GatewayHandle
+ Discord.Internal.Gateway.EventLoop: GatewayHandle :: Chan (Either GatewayException EventInternalParse) -> Chan GatewaySendable -> IORef (Maybe UpdateStatusOpts) -> IORef Integer -> IORef Text -> IORef HostName -> GatewayHandle
- Discord.Internal.Types: type Object = HashMap Text Value
+ Discord.Internal.Types: type Object = KeyMap Value
- Discord.Internal.Types.ApplicationCommands: ApplicationCommandChatInput :: ApplicationCommandId -> ApplicationId -> Maybe GuildId -> Text -> Text -> Maybe Options -> Bool -> Snowflake -> ApplicationCommand
+ Discord.Internal.Types.ApplicationCommands: ApplicationCommandChatInput :: ApplicationCommandId -> ApplicationId -> Maybe GuildId -> Text -> Maybe LocalizedText -> Text -> Maybe LocalizedText -> Maybe Options -> Maybe Text -> Maybe Bool -> Snowflake -> ApplicationCommand
- Discord.Internal.Types.ApplicationCommands: ApplicationCommandMessage :: ApplicationCommandId -> ApplicationId -> Maybe GuildId -> Text -> Bool -> Snowflake -> ApplicationCommand
+ Discord.Internal.Types.ApplicationCommands: ApplicationCommandMessage :: ApplicationCommandId -> ApplicationId -> Maybe GuildId -> Text -> Maybe LocalizedText -> Maybe Text -> Maybe Bool -> Snowflake -> ApplicationCommand
- Discord.Internal.Types.ApplicationCommands: ApplicationCommandUser :: ApplicationCommandId -> ApplicationId -> Maybe GuildId -> Text -> Bool -> Snowflake -> ApplicationCommand
+ Discord.Internal.Types.ApplicationCommands: ApplicationCommandUser :: ApplicationCommandId -> ApplicationId -> Maybe GuildId -> Text -> Maybe LocalizedText -> Maybe Text -> Maybe Bool -> Snowflake -> ApplicationCommand
- Discord.Internal.Types.ApplicationCommands: Choice :: Text -> a -> Choice a
+ Discord.Internal.Types.ApplicationCommands: Choice :: Text -> Maybe LocalizedText -> a -> Choice a
- Discord.Internal.Types.ApplicationCommands: CreateApplicationCommandChatInput :: Text -> Text -> Maybe Options -> Maybe Text -> Bool -> CreateApplicationCommand
+ Discord.Internal.Types.ApplicationCommands: CreateApplicationCommandChatInput :: Text -> Maybe LocalizedText -> Text -> Maybe LocalizedText -> Maybe Options -> Maybe Text -> Maybe Bool -> CreateApplicationCommand
- Discord.Internal.Types.ApplicationCommands: CreateApplicationCommandMessage :: Text -> Maybe Text -> Bool -> CreateApplicationCommand
+ Discord.Internal.Types.ApplicationCommands: CreateApplicationCommandMessage :: Text -> Maybe LocalizedText -> Maybe Text -> Maybe Bool -> CreateApplicationCommand
- Discord.Internal.Types.ApplicationCommands: CreateApplicationCommandUser :: Text -> Maybe Text -> Bool -> CreateApplicationCommand
+ Discord.Internal.Types.ApplicationCommands: CreateApplicationCommandUser :: Text -> Maybe LocalizedText -> Maybe Text -> Maybe Bool -> CreateApplicationCommand
- Discord.Internal.Types.ApplicationCommands: EditApplicationCommandChatInput :: Maybe Text -> Maybe Text -> Maybe Options -> Maybe Bool -> EditApplicationCommand
+ Discord.Internal.Types.ApplicationCommands: EditApplicationCommandChatInput :: Maybe Text -> Maybe LocalizedText -> Maybe Text -> Maybe LocalizedText -> Maybe Options -> Maybe Text -> Maybe Bool -> EditApplicationCommand
- Discord.Internal.Types.ApplicationCommands: EditApplicationCommandMessage :: Maybe Text -> Maybe Bool -> EditApplicationCommand
+ Discord.Internal.Types.ApplicationCommands: EditApplicationCommandMessage :: Maybe Text -> Maybe LocalizedText -> Maybe Text -> Maybe Bool -> EditApplicationCommand
- Discord.Internal.Types.ApplicationCommands: EditApplicationCommandUser :: Maybe Text -> Maybe Bool -> EditApplicationCommand
+ Discord.Internal.Types.ApplicationCommands: EditApplicationCommandUser :: Maybe Text -> Maybe LocalizedText -> Maybe Text -> Maybe Bool -> EditApplicationCommand
- Discord.Internal.Types.ApplicationCommands: OptionSubcommand :: Text -> Text -> [OptionValue] -> OptionSubcommand
+ Discord.Internal.Types.ApplicationCommands: OptionSubcommand :: Text -> Maybe LocalizedText -> Text -> Maybe LocalizedText -> [OptionValue] -> OptionSubcommand
- Discord.Internal.Types.ApplicationCommands: OptionSubcommandGroup :: Text -> Text -> [OptionSubcommand] -> OptionSubcommandOrGroup
+ Discord.Internal.Types.ApplicationCommands: OptionSubcommandGroup :: Text -> Maybe LocalizedText -> Text -> Maybe LocalizedText -> [OptionSubcommand] -> OptionSubcommandOrGroup
- Discord.Internal.Types.ApplicationCommands: OptionValueBoolean :: Text -> Text -> Bool -> OptionValue
+ Discord.Internal.Types.ApplicationCommands: OptionValueBoolean :: Text -> Maybe LocalizedText -> Text -> Maybe LocalizedText -> Bool -> OptionValue
- Discord.Internal.Types.ApplicationCommands: OptionValueChannel :: Text -> Text -> Bool -> Maybe [ApplicationCommandChannelType] -> OptionValue
+ Discord.Internal.Types.ApplicationCommands: OptionValueChannel :: Text -> Maybe LocalizedText -> Text -> Maybe LocalizedText -> Bool -> Maybe [ApplicationCommandChannelType] -> OptionValue
- Discord.Internal.Types.ApplicationCommands: OptionValueInteger :: Text -> Text -> Bool -> AutocompleteOrChoice Integer -> Maybe Integer -> Maybe Integer -> OptionValue
+ Discord.Internal.Types.ApplicationCommands: OptionValueInteger :: Text -> Maybe LocalizedText -> Text -> Maybe LocalizedText -> Bool -> AutocompleteOrChoice Integer -> Maybe Integer -> Maybe Integer -> OptionValue
- Discord.Internal.Types.ApplicationCommands: OptionValueMentionable :: Text -> Text -> Bool -> OptionValue
+ Discord.Internal.Types.ApplicationCommands: OptionValueMentionable :: Text -> Maybe LocalizedText -> Text -> Maybe LocalizedText -> Bool -> OptionValue
- Discord.Internal.Types.ApplicationCommands: OptionValueNumber :: Text -> Text -> Bool -> AutocompleteOrChoice Number -> Maybe Number -> Maybe Number -> OptionValue
+ Discord.Internal.Types.ApplicationCommands: OptionValueNumber :: Text -> Maybe LocalizedText -> Text -> Maybe LocalizedText -> Bool -> AutocompleteOrChoice Number -> Maybe Number -> Maybe Number -> OptionValue
- Discord.Internal.Types.ApplicationCommands: OptionValueRole :: Text -> Text -> Bool -> OptionValue
+ Discord.Internal.Types.ApplicationCommands: OptionValueRole :: Text -> Maybe LocalizedText -> Text -> Maybe LocalizedText -> Bool -> OptionValue
- Discord.Internal.Types.ApplicationCommands: OptionValueString :: Text -> Text -> Bool -> AutocompleteOrChoice Text -> OptionValue
+ Discord.Internal.Types.ApplicationCommands: OptionValueString :: Text -> Maybe LocalizedText -> Text -> Maybe LocalizedText -> Bool -> AutocompleteOrChoice Text -> Maybe Integer -> Maybe Integer -> OptionValue
- Discord.Internal.Types.ApplicationCommands: OptionValueUser :: Text -> Text -> Bool -> OptionValue
+ Discord.Internal.Types.ApplicationCommands: OptionValueUser :: Text -> Maybe LocalizedText -> Text -> Maybe LocalizedText -> Bool -> OptionValue
- Discord.Internal.Types.Events: InternalReady :: Int -> User -> [Channel] -> [GuildUnavailable] -> Text -> Maybe Shard -> PartialApplication -> EventInternalParse
+ Discord.Internal.Types.Events: InternalReady :: Int -> User -> [GuildUnavailable] -> Text -> HostName -> Maybe Shard -> PartialApplication -> EventInternalParse
- Discord.Internal.Types.Events: Ready :: Int -> User -> [Channel] -> [GuildUnavailable] -> Text -> Maybe Shard -> PartialApplication -> Event
+ Discord.Internal.Types.Events: Ready :: Int -> User -> [GuildUnavailable] -> Text -> HostName -> Maybe Shard -> PartialApplication -> Event
- Discord.Internal.Types.Interactions: InteractionApplicationCommand :: InteractionId -> ApplicationId -> ApplicationCommandData -> Maybe GuildId -> Maybe ChannelId -> MemberOrUser -> InteractionToken -> Int -> Text -> Maybe Text -> Interaction
+ Discord.Internal.Types.Interactions: InteractionApplicationCommand :: InteractionId -> ApplicationId -> ApplicationCommandData -> Maybe GuildId -> Maybe ChannelId -> MemberOrUser -> InteractionToken -> Int -> Maybe Text -> Text -> Maybe Text -> Interaction
- Discord.Internal.Types.Interactions: InteractionApplicationCommandAutocomplete :: InteractionId -> ApplicationId -> ApplicationCommandData -> Maybe GuildId -> Maybe ChannelId -> MemberOrUser -> InteractionToken -> Int -> Text -> Maybe Text -> Interaction
+ Discord.Internal.Types.Interactions: InteractionApplicationCommandAutocomplete :: InteractionId -> ApplicationId -> ApplicationCommandData -> Maybe GuildId -> Maybe ChannelId -> MemberOrUser -> InteractionToken -> Int -> Maybe Text -> Text -> Maybe Text -> Interaction
- Discord.Internal.Types.Interactions: InteractionComponent :: InteractionId -> ApplicationId -> ComponentData -> Maybe GuildId -> Maybe ChannelId -> MemberOrUser -> InteractionToken -> Int -> Message -> Text -> Maybe Text -> Interaction
+ Discord.Internal.Types.Interactions: InteractionComponent :: InteractionId -> ApplicationId -> ComponentData -> Maybe GuildId -> Maybe ChannelId -> MemberOrUser -> InteractionToken -> Int -> Message -> Maybe Text -> Text -> Maybe Text -> Interaction
- Discord.Internal.Types.Interactions: InteractionModalSubmit :: InteractionId -> ApplicationId -> ModalData -> Maybe GuildId -> Maybe ChannelId -> MemberOrUser -> InteractionToken -> Int -> Text -> Maybe Text -> Interaction
+ Discord.Internal.Types.Interactions: InteractionModalSubmit :: InteractionId -> ApplicationId -> ModalData -> Maybe GuildId -> Maybe ChannelId -> MemberOrUser -> InteractionToken -> Int -> Maybe Text -> Text -> Maybe Text -> Interaction
- Discord.Internal.Types.Interactions: InteractionPing :: InteractionId -> ApplicationId -> InteractionToken -> Int -> Interaction
+ Discord.Internal.Types.Interactions: InteractionPing :: InteractionId -> ApplicationId -> InteractionToken -> Int -> Maybe Text -> Interaction
- Discord.Types: Ready :: Int -> User -> [Channel] -> [GuildUnavailable] -> Text -> Maybe Shard -> PartialApplication -> Event
+ Discord.Types: Ready :: Int -> User -> [GuildUnavailable] -> Text -> HostName -> Maybe Shard -> PartialApplication -> Event
- Discord.Types: type Object = HashMap Text Value
+ Discord.Types: type Object = KeyMap Value
Files
- changelog.md +114/−98
- discord-haskell.cabal +7/−5
- src/Discord/Internal/Gateway.hs +2/−1
- src/Discord/Internal/Gateway/Cache.hs +2/−3
- src/Discord/Internal/Gateway/EventLoop.hs +21/−5
- src/Discord/Internal/Rest/Channel.hs +55/−58
- src/Discord/Internal/Rest/Emoji.hs +4/−7
- src/Discord/Internal/Rest/Guild.hs +57/−58
- src/Discord/Internal/Rest/Prelude.hs +1/−1
- src/Discord/Internal/Rest/Webhook.hs +23/−35
- src/Discord/Internal/Types/ApplicationCommands.hs +218/−106
- src/Discord/Internal/Types/Channel.hs +183/−183
- src/Discord/Internal/Types/Components.hs +39/−54
- src/Discord/Internal/Types/Emoji.hs +7/−10
- src/Discord/Internal/Types/Events.hs +15/−3
- src/Discord/Internal/Types/Interactions.hs +34/−25
- src/Discord/Internal/Types/Prelude.hs +79/−10
- src/Discord/Internal/Types/ScheduledEvents.hs +87/−118
- src/Discord/Internal/Types/User.hs +30/−30
changelog.md view
@@ -1,283 +1,299 @@ # Changelog -View on github for newest version: https://github.com/discord-haskell/discord-haskell/blob/master/changelog.md+View on GitHub for the newest ChangeLog: https://github.com/discord-haskell/discord-haskell/blob/master/changelog.md -Discord API changes, so use the most recent version at all times+The Discord API constantly changes. This library issues updates when we implement new features added to the API or remove outdated functionalities. In order to interact with the Discord API safely and predictably, please update the library whenever there is a new version released. -## master+## Unreleased changes +-++## 1.15.0++- [Annwan](https://github.com/discord-haskell/discord-haskell/pull/137) Implemented optional localization for application commands. `[..]LocalizedName` and `[..]LocalizedDescription` fields have been added to many ADTs ([Discord documentation](https://discord.com/developers/docs/interactions/application-commands#localization))++- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/136) Removed `applicationCommandDefaultPermission` from `ApplicationCommand`, replaced it with `applicationCommandDefaultMemberPermissions` and `applicationCommandDMPermission` ([Discord changelog](https://discord.com/developers/docs/change-log#updated-command-permissions))++- [yutotakano](https://github.com/discord-haskell/discord-haskell/pull/135) Implemented session-specific Resume URLs for the Gateway internally, which will prevent disconnects in the future ([Discord changelog](https://discord.com/developers/docs/change-log#sessionspecific-gateway-resume-urls)). Also removed the deprecated list of private channels received in Ready event.++- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/133) Implemented maximum and minimum string lengths for application command options ([Discord changelog](https://discord.com/developers/docs/change-log#min-and-max-length-for-command-options)). Also implemented calculated context permissions for interaction payloads ([Discord changelog](https://discord.com/developers/docs/change-log#calculated-permissions-in-interaction-payloads))++- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/132) Simplified internals of JSON creation using `objectFromMaybes` and `.=?`. Support `aeson-2.0`++- [yutotakano](https://github.com/discord-haskell/discord-haskell/pull/134) Loosened some acceptable version bounds for `http-client`, `req` and `http-api-data`, that were added with 1.14.0+ ## 1.14.0 -[yutotakano](https://github.com/discord-haskell/discord-haskell/pull/124) Replace JuicyPixels image parsing with a mimetype check. Make image handling consistent: use `parseStickerImage` fro sticker images. Use `parseAvatarImage` for avatars.+- [degustaf](https://github.com/discord-haskell/discord-haskell/pull/131) Add `Exception` instance for `RestCallErrorCode` -[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/123/files) Make webhook API smaller, each constructor takes in a `Maybe WebhookToken`. Passing `Nothing` will continue to work as normal.+- [yutotakano](https://github.com/discord-haskell/discord-haskell/pull/124) Replace JuicyPixels image parsing with a mimetype check. Make image handling consistent: use `parseStickerImage` fro sticker images. Use `parseAvatarImage` for avatars. -[Annwan](https://github.com/discord-haskell/discord-haskell/pull/123) Huge documentation flourish. Removed deprecated AppCommandPermissions func & fix presences typo+- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/123/files) Make webhook API smaller, each constructor takes in a `Maybe WebhookToken`. Passing `Nothing` will continue to work as normal. -[yutotakano](https://github.com/discord-haskell/discord-haskell/pull/121) Replace `OverwriteId` with `Either RoleId UserId` in `ChannelPermission` requests, and remove the `type` field from `ChannelPermissionsOpts`+- [Annwan](https://github.com/discord-haskell/discord-haskell/pull/123) Huge documentation flourish. Removed deprecated AppCommandPermissions func & fix presences typo +- [yutotakano](https://github.com/discord-haskell/discord-haskell/pull/121) Replace `OverwriteId` with `Either RoleId UserId` in `ChannelPermission` requests, and remove the `type` field from `ChannelPermissionsOpts`+ ## 1.13.0 -[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/117) Shorten ApplicationCommand names! To update search [the pull-request](https://github.com/discord-haskell/discord-haskell/pull/117/files) for what the names are replaced with+- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/117) Shorten ApplicationCommand names! To update search [the pull-request](https://github.com/discord-haskell/discord-haskell/pull/117/files) for what the names are replaced with -[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/116) Typesafe Snowflakes (guildid, channelid, userid, etcid)+- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/116) Typesafe Snowflakes (guildid, channelid, userid, etcid) -Improve `restCall` type error messages https://github.com/discord-haskell/discord-haskell/issues/102+- Improve `restCall` type error messages https://github.com/discord-haskell/discord-haskell/issues/102 ## 1.12.5 -[Annwan](https://github.com/discord-haskell/discord-haskell/pull/109) Add `ScheduledEvent` rest API+- [Annwan](https://github.com/discord-haskell/discord-haskell/pull/109) Add `ScheduledEvent` rest API -[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/110) Add stickers API+- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/110) Add stickers API -[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/111) Add ModifyGuildMember 'timeout' option+- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/111) Add ModifyGuildMember 'timeout' option ## 1.12.4 -Library won't crash if something fails to parse. Errors are printed to the log+- Library won't crash if something fails to parse. Errors are printed to the log ## 1.12.3 -Add another CreateMessage flag option, stop crashing on unknown flags.+- Add another CreateMessage flag option, stop crashing on unknown flags. ## 1.12.2 -[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/107) `EditMessage` takes full `MessageDetailedOpts` (instead of Embed)+- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/107) `EditMessage` takes full `MessageDetailedOpts` (instead of Embed) -Removed `CreateMessageUploadFile` (use `CreateMessageDetailed { MessageDetailedOpts { messageDetailedFile } }`)+- Removed `CreateMessageUploadFile` (use `CreateMessageDetailed { MessageDetailedOpts { messageDetailedFile } }`) ## 1.12.1 -[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/103) Add threads, switch api to V10, Update Guild data fields+- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/103) Add threads, switch api to V10, Update Guild data fields -[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/104) Add model interaction and components+- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/104) Add model interaction and components ## 1.12.0 -[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/96) breaking changes and fixes to application commands, interactions, and components, and updates elsewhere+- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/96) breaking changes and fixes to application commands, interactions, and components, and updates elsewhere ## 1.11.0 -[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/88) did a LOT of work wrangling the discord API for interactions and commands!---[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/94) fixed a parse error with webhooktoken+- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/88) did a LOT of work wrangling the discord API for interactions and commands! +- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/94) fixed a parse error with webhooktoken -rename fields `messageText` -> `messageContent`, `messageChannel` -> `messageChannelId`+- Rename fields `messageText` -> `messageContent`, `messageChannel` -> `messageChannelId` ## 1.10.0 -[drewolson](https://github.com/discord-haskell/discord-haskell/pull/80) allows parsing an optional guild region+- [drewolson](https://github.com/discord-haskell/discord-haskell/pull/80) allows parsing an optional guild region -[L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/82) add 'animated' flag for Emoji+- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/82) add 'animated' flag for Emoji -Removed `CreateGuild` rest call! You can only do it if your bot is in fewer than 10 guilds, and it's [a pain to support](https://discord.com/developers/docs/resources/guild#create-guild). Just do it manually.+- Removed `CreateGuild` rest call! You can only do it if your bot is in fewer than 10 guilds, and it's [a pain to support](https://discord.com/developers/docs/resources/guild#create-guild). Just do it manually. -Added `Read` instance to complement `Show` for lots of types. Removed ToJSON for `Channel`. +- Added `Read` instance to complement `Show` for lots of types. Removed ToJSON for `Channel`. ## 1.9.1 -Add [color attribute for CreateEmbed](https://github.com/discord-haskell/discord-haskell/issues/78)+- Add [color attribute for CreateEmbed](https://github.com/discord-haskell/discord-haskell/issues/78) -Rewrite [EventLoop.hs](https://github.com/discord-haskell/discord-haskell/issues/70) to be easier to modify+- Rewrite [EventLoop.hs](https://github.com/discord-haskell/discord-haskell/issues/70) to be easier to modify -Rename a bunch of internal handles so they have more consistent names+- Rename a bunch of internal handles so they have more consistent names ## 1.8.9 -Handle both aeson 1.0 and 2.0 [(breaking changes broke builds)](https://github.com/discord-haskell/discord-haskell/issues/77)+- Handle both aeson 1.0 and 2.0 [(breaking changes broke builds)](https://github.com/discord-haskell/discord-haskell/issues/77) -Simplify [some examples](https://github.com/discord-haskell/discord-haskell/issues/71)+- Simplify [some examples](https://github.com/discord-haskell/discord-haskell/issues/71) ## 1.8.8 -Remove git artifacts from [examples/ping-pong.hs](https://github.com/discord-haskell/discord-haskell/issues/69)+- Remove git artifacts from [examples/ping-pong.hs](https://github.com/discord-haskell/discord-haskell/issues/69) ## 1.8.7 -Add [Stage channel](https://github.com/discord-haskell/discord-haskell/issues/68) and a catch-all Unknown channel so we stop crashing on new releases (?)+- Add [Stage channel](https://github.com/discord-haskell/discord-haskell/issues/68) and a catch-all Unknown channel so we stop crashing on new releases (?) ## 1.8.6 -Add [missing fields](https://github.com/discord-haskell/discord-haskell/issues/67) to ChannelGuildCategory+- Add [missing fields](https://github.com/discord-haskell/discord-haskell/issues/67) to ChannelGuildCategory ## 1.8.5 - Fix examples/ping-pong.hs compilation error https://github.com/discord-haskell/discord-haskell/issues/65+- Fix examples/ping-pong.hs compilation error https://github.com/discord-haskell/discord-haskell/issues/65 ## 1.8.4 -[yutotakano](https://github.com/discord-haskell/discord-haskell/pull/64) Added discord replies type, and message constructor+- [yutotakano](https://github.com/discord-haskell/discord-haskell/pull/64) Added discord replies type, and message constructor ## 1.8.3 -Bot no longer disconnects randomly (hopefully) https://github.com/discord-haskell/discord-haskell/issues/62+- Bot no longer disconnects randomly (hopefully) https://github.com/discord-haskell/discord-haskell/issues/62 ## 1.8.2 -Added 'Competing' activity https://github.com/discord-haskell/discord-haskell/issues/61+- Added 'Competing' activity https://github.com/discord-haskell/discord-haskell/issues/61 -Resend the last Activity settings on Resume fixing https://github.com/discord-haskell/discord-haskell/issues/60+- Resend the last Activity settings on Resume fixing https://github.com/discord-haskell/discord-haskell/issues/60 ## 1.8.1 -Added `MessageReaction` to Message https://github.com/discord-haskell/discord-haskell/issues/56+- Added `MessageReaction` to Message https://github.com/discord-haskell/discord-haskell/issues/56 ## 1.8.0 -Fixed [null parent_id on channel](https://github.com/discord-haskell/discord-haskell/issues/55)+- Fixed [null parent_id on channel](https://github.com/discord-haskell/discord-haskell/issues/55) ## 1.7.0 -[elikoga](https://github.com/discord-haskell/discord-haskell/pull/51) Changed to use `ReaderT` interface+- [elikoga](https://github.com/discord-haskell/discord-haskell/pull/51) Changed to use `ReaderT` interface -[elikoga](https://github.com/discord-haskell/discord-haskell/pull/50) Fixed compiler warnings+- [elikoga](https://github.com/discord-haskell/discord-haskell/pull/50) Fixed compiler warnings -Changed api url to new `discord.com`+- Changed api url to new `discord.com` ## 1.6.1 -Changed discordapp.com to discord.com in accordance with official discord policy +- Changed discordapp.com to discord.com in accordance with official discord policy -[rexim](https://github.com/discord-haskell/discord-haskell/pull/41) Add `Emoji.user` field. Who uploaded the emoji+- [rexim](https://github.com/discord-haskell/discord-haskell/pull/41) Add `Emoji.user` field. Who uploaded the emoji ## 1.6.0 -Add News Channel and StorePage Channel. Fix crash `Unknown channel type:5`+- Add News Channel and StorePage Channel. Fix crash `Unknown channel type:5` -Add NSFW and UserRateLimit to `Channel` type+- Add NSFW and UserRateLimit to `Channel` type ## 1.5.1 -Fix `EditMessage` rest request, send JSON+- Fix `EditMessage` rest request, send JSON ## 1.5.0 -[rexim](https://github.com/discord-haskell/discord-haskell/pull/35) Add `Read` instance for `Snowflake`+- [rexim](https://github.com/discord-haskell/discord-haskell/pull/35) Add `Read` instance for `Snowflake` ## 1.4.0 -Rename `SubEmbed` to `EmbedPart`+- Rename `SubEmbed` to `EmbedPart` -New and improved Embed API: Add `CreateEmbed` record and `createEmbed :: CreateEmbed -> Embed`+- New and improved Embed API: Add `CreateEmbed` record and `createEmbed :: CreateEmbed -> Embed` -`CreateEmbedImageUpload` implementation inspired by [Flutterlice](https://github.com/discord-haskell/discord-haskell/pull/32)+- `CreateEmbedImageUpload` implementation inspired by [Flutterlice](https://github.com/discord-haskell/discord-haskell/pull/32) ## 1.3.0 -[PixeLinc](https://github.com/discord-haskell/discord-haskell/pull/33) Add `DeleteSingleReaction` rest-request, Add GuildId to `ReactinInfo`, Add `MESSAGE_REACTION_REMOVE_EMOJI` gateway event+- [PixeLinc](https://github.com/discord-haskell/discord-haskell/pull/33) Add `DeleteSingleReaction` rest-request, Add GuildId to `ReactinInfo`, Add `MESSAGE_REACTION_REMOVE_EMOJI` gateway event -`GetReactions` actually returns the User objects request+- `GetReactions` actually returns the User objects request -Rename `Ban` to `GuildBan`+- Rename `Ban` to `GuildBan` -Re-export UTCTime from `time` package+- Re-export UTCTime from `time` package ## 1.2.0 -[MDeltaX](https://github.com/discord-haskell/discord-haskell/pull/27) Fixed typo: depreciated --> deprecated+- [MDeltaX](https://github.com/discord-haskell/discord-haskell/pull/27) Fixed typo: depreciated --> deprecated -[MDeltaX](https://github.com/discord-haskell/discord-haskell/pull/29) More consistency: RoleID --> RoleId+- [MDeltaX](https://github.com/discord-haskell/discord-haskell/pull/29) More consistency: RoleID --> RoleId -[MDeltaX](https://github.com/discord-haskell/discord-haskell/pull/29) Fix ModifyGuildRole: Post --> Patch && optional args+- [MDeltaX](https://github.com/discord-haskell/discord-haskell/pull/29) Fix ModifyGuildRole: Post --> Patch && optional args -[Hippu](https://github.com/discord-haskell/discord-haskell/pull/31) Won't crash on integer-nonces in ChannelMessage-events (usually strings)+- [Hippu](https://github.com/discord-haskell/discord-haskell/pull/31) Won't crash on integer-nonces in ChannelMessage-events (usually strings) ## 1.1.3 -Minor improvements to rate-limiting like using newer `X-RateLimit-Reset-After` header+- Minor improvements to rate-limiting like using newer `X-RateLimit-Reset-After` header ## 1.1.2 -[michalrus](https://github.com/discord-haskell/discord-haskell/issues/25) Fix `DeleteGuildRole` parse exception+- [michalrus](https://github.com/discord-haskell/discord-haskell/issues/25) Fix `DeleteGuildRole` parse exception ## 1.1.1 -Fix ModifyGuildRolePositions results in 400 Bad Request issue+- Fix ModifyGuildRolePositions results in 400 Bad Request issue ## 1.1.0 -Upgrade req to 2.x major version.+- Upgrade req to 2.x major version. ## 1.0.0 -Going through some major updates to the library. Expect types to change and things to break.+- Going through some major updates to the library. Expect types to change and things to break. -Compare the [old ping-pong](https://github.com/discord-haskell/discord-haskell/blob/20f7f8556823a754c76d01484118a5abf336530b/examples/ping-pong.hs)+- Compare the [old ping-pong](https://github.com/discord-haskell/discord-haskell/blob/20f7f8556823a754c76d01484118a5abf336530b/examples/ping-pong.hs) to the [new ping-pong](https://github.com/discord-haskell/discord-haskell/blob/7eaa6ca068f945603de7f43f6f270c2dbecd3c85/examples/ping-pong.hs) -Added a few rest ADT types+- Added a few rest ADT types ## 0.8.4 -[marcotoniut](https://github.com/discord-haskell/discord-haskell/pull/18) Improved changed Embed ADT to have optional fields, and improved two field names+- [marcotoniut](https://github.com/discord-haskell/discord-haskell/pull/18) Improved changed Embed ADT to have optional fields, and improved two field names -Add `ModifyGuildMember`, `AddGuildMember`, `AddGuildMemberRole`, `AddGuildMemberRole`, `RemoveGuildmembeRole`, `GetGuildBan`, `GetGuildVanityURL` rest data types+- Add `ModifyGuildMember`, `AddGuildMember`, `AddGuildMemberRole`, `AddGuildMemberRole`, `RemoveGuildmembeRole`, `GetGuildBan`, `GetGuildVanityURL` rest data types ## 0.8.3 -Simplify Message Author from `Either WebhookId User` to `User`+- Simplify Message Author from `Either WebhookId User` to `User` -Add `loginRestGatewayWithLog`+- Add `loginRestGatewayWithLog` ### 0.8.2 -Hardcode CreateReaction delay so bots can add reactions 4 times faster+- Hardcode CreateReaction delay so bots can add reactions 4 times faster -[MP2E](https://github.com/discord-haskell/discord-haskell/pull/14) Fixed parse error on GuildBanAdd + GuildBanRevoke: user\_object instead the whole object+- [MP2E](https://github.com/discord-haskell/discord-haskell/pull/14) Fixed parse error on GuildBanAdd + GuildBanRevoke: user\_object instead the whole object ### 0.8.1 -[MP2E](https://github.com/discord-haskell/discord-haskell/pull/11) Fixed parse error on GuildRoleDelete: role_id instead of role+- [MP2E](https://github.com/discord-haskell/discord-haskell/pull/11) Fixed parse error on GuildRoleDelete: role_id instead of role ### 0.8.0 -`MessageUpdate` does not contain a full Message object, just `ChannelId` `MessageId`+- `MessageUpdate` does not contain a full Message object, just `ChannelId` `MessageId` -Message Author changed from `User` to `Either WebhookId User`+- Message Author changed from `User` to `Either WebhookId User` -Add Webhook ADT+- Add Webhook ADT -Add requests: GetInvite, DeleteInvite+- Add requests: GetInvite, DeleteInvite -UpdateStatusVoiceOpts takes Bool for Mute+- UpdateStatusVoiceOpts takes Bool for Mute -`Unavailable` becomes `GuildUnavailable`+- `Unavailable` becomes `GuildUnavailable` ### 0.7.1 -[t1m0thyj](https://github.com/discord-haskell/discord-haskell/pull/6/files) Typo in RequestGuildMemberOpts fields fixed.+- [t1m0thyj](https://github.com/discord-haskell/discord-haskell/pull/6/files) Typo in RequestGuildMemberOpts fields fixed. -[t1m0thyj](https://github.com/discord-haskell/discord-haskell/pull/6/files) Added Activity, ActivityType ADT+- [t1m0thyj](https://github.com/discord-haskell/discord-haskell/pull/6/files) Added Activity, ActivityType ADT -UpdateStatusTypes became UpdateStatusType (singular ADT)+- UpdateStatusTypes became UpdateStatusType (singular ADT) -[t1m0thyj](https://github.com/discord-haskell/discord-haskell/pull/7) Retry connection on 1001 websocket close+- [t1m0thyj](https://github.com/discord-haskell/discord-haskell/pull/7) Retry connection on 1001 websocket close ### 0.7.0 -Snowflake -> named id+- Snowflake -> named id -Add requests: ModifyChanPositions, CreateGuildChannel+- Add requests: ModifyChanPositions, CreateGuildChannel -Changed constructors of Channel to have prefix "Channel", isGuildChannel --> channelIsInGuild+- Changed constructors of Channel to have prefix "Channel", isGuildChannel --> channelIsInGuild -Change Emoji Id ADTs+- Change Emoji Id ADTs ### 0.6.0 -Add requests: CreateGuildEmoji, GroupDMRemoveRecipient, ModifyCurrentUser, EditChannelPermissions, CreateChannelInvite, GroupDMAddRecipient, ModifyGuild+- Add requests: CreateGuildEmoji, GroupDMRemoveRecipient, ModifyCurrentUser, EditChannelPermissions, CreateChannelInvite, GroupDMAddRecipient, ModifyGuild -restCall, readCache pass errors as an ADT, including underling http exceptions+- restCall, readCache pass errors as an ADT, including underling http exceptions -Only add "Bot " prefix to secret token if it's not there+- Only add "Bot " prefix to secret token if it's not there ### 0.5.1 -sendCommand with GatewaySendable types+- sendCommand with GatewaySendable types ### 0.5.0 -restCall with Request types+- restCall with Request types -nextEvent with Event types+- nextEvent with Event types
discord-haskell.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.0 name: discord-haskell -- library version is also noted at src/Discord/Rest/Prelude.hs-version: 1.14.0+version: 1.15.0 description: Functions and data types to write discord bots. Official discord docs <https://discord.com/developers/docs/reference>. .@@ -89,23 +89,25 @@ , Discord.Internal.Types.ScheduledEvents build-depends: base ==4.*,- aeson >=1.5 && <1.6,+ aeson >= 1.5 && < 1.6 || >= 2.0 && < 2.2, async >=2.2 && <2.3, bytestring >=0.10 && <0.11, base64-bytestring >=1.1 && <1.2, containers >=0.6 && <0.7, data-default >=0.7 && <0.8, emoji ==0.1.*,- http-client >=0.6 && <0.7,+ http-client >=0.6 && <0.8, iso8601-time >=0.1 && <0.2, MonadRandom >=0.5 && <0.6,- req >=3.9 && <3.10,+ req >=3.9 && <3.13, safe-exceptions >=0.1 && <0.2, text >=1.2 && <1.3, time >=1.9 && <1.10, websockets >=0.12 && <0.13,+ network >=3.0.0.0 && <3.2.0.0, wuss >=1.1 && <1.2, mtl >=2.2 && <2.3, unliftio >=0.2 && <0.3, scientific >=0.3 && <0.4,- http-api-data >=0.4 && <0.5+ http-api-data >=0.4 && <0.6,+ unordered-containers >=0.2.10.0 && <0.3
src/Discord/Internal/Gateway.hs view
@@ -40,7 +40,8 @@ status <- newIORef Nothing seqid <- newIORef 0 seshid <- newIORef ""- let gatewayHandle = GatewayHandle events sends status seqid seshid+ host <- newIORef $ "gateway.discord.gg"+ let gatewayHandle = GatewayHandle events sends status seqid seshid host tid <- forkIO $ connectionLoop auth intent gatewayHandle log pure (gatewayHandle, tid)
src/Discord/Internal/Gateway/Cache.hs view
@@ -30,9 +30,8 @@ cacheLoop cacheHandle log = do ready <- readChan eventChan case ready of- Right (InternalReady _ user dmChannels _unavailableGuilds _ _ pApp) -> do- let dmChans = M.fromList (zip (map channelId dmChannels) dmChannels)- putMVar cache (Right (Cache user dmChans M.empty M.empty pApp))+ Right (InternalReady _ user _ _ _ _ pApp) -> do+ putMVar cache (Right (Cache user M.empty M.empty M.empty pApp)) loop Right r -> writeChan log ("cache - stopping cache - expected Ready event, but got " <> T.pack (show r))
src/Discord/Internal/Gateway/EventLoop.hs view
@@ -20,6 +20,7 @@ import qualified Data.ByteString.Lazy as BL import Wuss (runSecureClient)+import Network.Socket (HostName) import Network.WebSockets (ConnectionException(..), Connection, receiveData, sendTextData, sendClose) @@ -38,7 +39,13 @@ -- | Recent sent event sequence (used to reconnect) gatewayHandleLastSequenceId :: IORef Integer, -- | Which discord server session (used to reconnect)- gatewayHandleSessionId :: IORef T.Text+ gatewayHandleSessionId :: IORef T.Text,+ -- | Which discord gateway to connect to. This should contain a default value+ -- ("gateway.discord.gg") on first connect, but on subsequent Resumes this+ -- may contain a different value. This should never contain trailing slashes,+ -- or any "wss://" prefixes, since HostNames of this kind are not supported+ -- by the websockets library.+ gatewayHandleHostname :: IORef HostName } -- | Ways the gateway connection can fail with no possibility of recovery.@@ -83,12 +90,13 @@ -- | Main connection loop. Catch exceptions and reconnect. outerloop :: LoopState -> IO () outerloop state = do+ gatewayHost <- readIORef (gatewayHandleHostname gatewayHandle) mfirst <- firstmessage state -- construct first message case mfirst of Nothing -> pure () -- close Just message -> do- nextstate <- try (startOneConnection message) -- connection+ nextstate <- try (startOneConnection gatewayHost message) -- connection case nextstate :: Either SomeException LoopState of Left _ -> do t <- getRandomR (3,20) threadDelay (t * (10^(6 :: Int)))@@ -110,8 +118,15 @@ else pure $ Just $ Resume auth seshId seqId LoopClosed -> pure Nothing - startOneConnection :: GatewaySendableInternal -> IO LoopState- startOneConnection message = runSecureClient "gateway.discord.gg" 443 ("/?v=" <> T.unpack apiVersion <>"&encoding=json") $ \conn -> do+ startOneConnection+ :: HostName+ -- ^ The gateway address to connect to. Should be "gateway.discord.gg" on first try, but+ -- all Resumes should go to the resume_gateway_url specified in the Ready event+ -- https://discord.com/developers/docs/change-log#sessionspecific-gateway-resume-urls+ -> GatewaySendableInternal+ -- ^ The first message to send. Either an Identify or Resume.+ -> IO LoopState+ startOneConnection gatewayAddr message = runSecureClient gatewayAddr 443 ("/?v=" <> T.unpack apiVersion <>"&encoding=json") $ \conn -> do msg <- getPayload conn log case msg of Right (Hello interval) -> do@@ -159,8 +174,9 @@ writeIORef (gatewayHandleLastSequenceId thehandle) sq writeChan eventChan (Right event) -- send the event to user case event of- (InternalReady _ _ _ _ seshID _ _) ->+ (InternalReady _ _ _ seshID resumeHost _ _) -> do writeIORef (gatewayHandleSessionId thehandle) seshID+ writeIORef (gatewayHandleHostname thehandle) $ resumeHost _ -> writeIORef (startsendingUsers sendablesData) True loop Right (Hello _interval) -> do writeChan log ("eventloop - unexpected hello")
src/Discord/Internal/Rest/Channel.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} @@ -169,7 +168,7 @@ reactionTimingToQuery t = case t of (BeforeReaction snow) -> "before" R.=: show snow (AfterReaction snow) -> "after" R.=: show snow- (LatestReaction) -> mempty+ LatestReaction -> mempty -- | Data constructor for `GetChannelMessages` requests. -- @@ -185,7 +184,7 @@ (AroundMessage snow) -> "around" R.=: show snow (BeforeMessage snow) -> "before" R.=: show snow (AfterMessage snow) -> "after" R.=: show snow- (LatestMessages) -> mempty+ LatestMessages -> mempty -- | Options for `CreateChannelInvite` requests data ChannelInviteOpts = ChannelInviteOpts@@ -201,11 +200,11 @@ } deriving (Show, Read, Eq, Ord) instance ToJSON ChannelInviteOpts where- toJSON ChannelInviteOpts{..} = object [(name, val) | (name, Just val) <-- [("max_age", toJSON <$> channelInviteOptsMaxAgeSeconds),- ("max_uses", toJSON <$> channelInviteOptsMaxUsages),- ("temporary", toJSON <$> channelInviteOptsIsTemporary),- ("unique", toJSON <$> channelInviteOptsDontReuseSimilarInvite) ] ]+ toJSON ChannelInviteOpts{..} = objectFromMaybes+ ["max_age" .=? channelInviteOptsMaxAgeSeconds,+ "max_uses" .=? channelInviteOptsMaxUsages,+ "temporary" .=? channelInviteOptsIsTemporary,+ "unique" .=? channelInviteOptsDontReuseSimilarInvite ] -- | Options for `ModifyChannel` requests data ModifyChannelOpts = ModifyChannelOpts@@ -249,21 +248,21 @@ def = ModifyChannelOpts Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing instance ToJSON ModifyChannelOpts where- toJSON ModifyChannelOpts{..} = object [(name, val) | (name, Just val) <-- [("name", toJSON <$> modifyChannelName),- ("position", toJSON <$> modifyChannelPosition),- ("topic", toJSON <$> modifyChannelTopic),- ("nsfw", toJSON <$> modifyChannelNSFW),- ("bitrate", toJSON <$> modifyChannelBitrate),- ("rate_limit_per_user", toJSON <$> modifyChannelUserRateLimit),- ("user_limit", toJSON <$> modifyChannelUserLimit),- ("permission_overwrites", toJSON <$> modifyChannelPermissionOverwrites),- ("parent_id", toJSON <$> modifyChannelParentId),- ("default_auto_archive_duration", toJSON <$> modifyChannelDefaultAutoArchive),- ("archived", toJSON <$> modifyChannelThreadArchived),- ("auto_archive_duration", toJSON <$> modifyChannelThreadAutoArchive),- ("locked", toJSON <$> modifyChannelThreadLocked),- ("invitable", toJSON <$> modifyChannelThreadInvitable) ] ]+ 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 --@@ -292,7 +291,7 @@ } deriving (Show, Read, Eq, Ord) -- | Options for `StartThreadFromMessage` request-data StartThreadOpts = StartThreadOpts +data StartThreadOpts = StartThreadOpts { -- | Name of the thread startThreadName :: T.Text , -- | Period of innactivity after which the thread gets archived in minutes.@@ -305,12 +304,11 @@ } deriving (Show, Read, Eq, Ord) instance ToJSON StartThreadOpts where- toJSON StartThreadOpts{..} = object [ (name, value) | (name, Just value) <- - [ ("name", toJSON <$> pure startThreadName)- , ("auto_archive_duration", toJSON <$> startThreadAutoArchive)- , ("rate_limit_per_user", toJSON <$> startThreadRateLimit)+ toJSON StartThreadOpts{..} = objectFromMaybes+ [ "name" .== startThreadName+ , "auto_archive_duration" .=? startThreadAutoArchive+ , "rate_limit_per_user" .=? startThreadRateLimit ]- ] -- | Options for `StartThreadNoMessage` request data StartThreadNoMessageOpts = StartThreadNoMessageOpts@@ -327,18 +325,17 @@ } deriving (Show, Read, Eq, Ord) instance ToJSON StartThreadNoMessageOpts where- toJSON StartThreadNoMessageOpts{..} = object [ (name, value) | (name, Just value) <- - [ ("name", toJSON <$> pure (startThreadName startThreadNoMessageBaseOpts))- , ("auto_archive_duration", toJSON <$> (startThreadAutoArchive startThreadNoMessageBaseOpts))- , ("rate_limit_per_user", toJSON <$> (startThreadRateLimit startThreadNoMessageBaseOpts))- , ("type", toJSON <$> pure startThreadNoMessageType)- , ("invitable", toJSON <$> startThreadNoMessageInvitable)+ 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 +data ListThreads = ListThreads { -- | The returned threads listThreadsThreads :: [Channel] , -- | A thread member object for each returned thread the current user has@@ -349,7 +346,7 @@ } deriving (Show, Read, Eq, Ord) instance ToJSON ListThreads where- toJSON ListThreads{..} = object + toJSON ListThreads{..} = object [ ("threads", toJSON listThreadsThreads) , ("members", toJSON listThreadsMembers) , ("has_more", toJSON listThreadsHasMore)@@ -451,15 +448,15 @@ ) ++ join (maybe [] (maybeEmbed . Just <$>) (messageDetailedEmbeds msgOpts)) - payloadData = object $ [ "content" .= messageDetailedContent msgOpts- , "tts" .= messageDetailedTTS msgOpts ] ++- [ name .= value | (name, Just value) <-- [ ("embeds", toJSON . (createEmbed <$>) <$> messageDetailedEmbeds msgOpts)- , ("allowed_mentions", toJSON <$> messageDetailedAllowedMentions msgOpts)- , ("message_reference", toJSON <$> messageDetailedReference msgOpts)- , ("components", toJSON <$> messageDetailedComponents msgOpts)- , ("sticker_ids", toJSON <$> messageDetailedStickerIds 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)@@ -492,7 +489,7 @@ Delete (channels /~ chan /: "messages" /~ msgid /: "reactions" ) mempty -- copied from CreateMessageDetailed, should be outsourced to function probably- (EditMessage (chan, msg) msgOpts) -> + (EditMessage (chan, msg) msgOpts) -> let fileUpload = messageDetailedFile msgOpts filePart = ( case fileUpload of@@ -506,15 +503,15 @@ ) ++ join (maybe [] (maybeEmbed . Just <$>) (messageDetailedEmbeds msgOpts)) - payloadData = object $ [ "content" .= messageDetailedContent msgOpts- , "tts" .= messageDetailedTTS msgOpts ] ++- [ name .= value | (name, Just value) <-- [ ("embeds", toJSON . (createEmbed <$>) <$> messageDetailedEmbeds msgOpts)- , ("allowed_mentions", toJSON <$> messageDetailedAllowedMentions msgOpts)- , ("message_reference", toJSON <$> messageDetailedReference msgOpts)- , ("components", toJSON <$> messageDetailedComponents msgOpts)- , ("sticker_ids", toJSON <$> messageDetailedStickerIds 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)@@ -528,7 +525,7 @@ 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))+ 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
src/Discord/Internal/Rest/Emoji.hs view
@@ -148,13 +148,10 @@ instance ToJSON EditGuildStickerOpts where toJSON EditGuildStickerOpts {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("name", toJSON <$> editGuildStickerName),- ("description", toJSON <$> editGuildStickerDescription),- ("tags", toJSON . T.intercalate "," <$> editGuildStickerTags)- ]+ objectFromMaybes+ [ "name" .=? editGuildStickerName,+ "description" .=? editGuildStickerDescription,+ "tags" .=? fmap (T.intercalate ",") editGuildStickerTags ] instance Request (StickerRequest a) where
src/Discord/Internal/Rest/Guild.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} @@ -149,19 +148,19 @@ } deriving (Show, Read, Eq, Ord) instance ToJSON ModifyGuildIntegrationOpts where- toJSON ModifyGuildIntegrationOpts{..} = object [(name, val) | (name, Just val) <-- [ ("expire_grace_period", toJSON <$> pure modifyGuildIntegrationOptsExpireGraceSeconds )- , ("expire_behavior", toJSON <$> pure modifyGuildIntegrationOptsExpireBehavior )- , ("enable_emoticons", toJSON <$> pure modifyGuildIntegrationOptsEmoticonsEnabled ) ]]+ toJSON ModifyGuildIntegrationOpts{..} = objectFromMaybes+ [ "expire_grace_period" .== modifyGuildIntegrationOptsExpireGraceSeconds+ , "expire_behavior" .== modifyGuildIntegrationOptsExpireBehavior+ , "enable_emoticons" .== modifyGuildIntegrationOptsEmoticonsEnabled ] -- | Options for `CreateGuildIntegration`-data CreateGuildIntegrationOpts = CreateGuildIntegrationOpts+newtype CreateGuildIntegrationOpts = CreateGuildIntegrationOpts { createGuildIntegrationOptsType :: T.Text } deriving (Show, Read, Eq, Ord) instance ToJSON CreateGuildIntegrationOpts where- toJSON CreateGuildIntegrationOpts{..} = object [(name, val) | (name, Just val) <-- [("type", toJSON <$> pure createGuildIntegrationOptsType ) ]]+ toJSON CreateGuildIntegrationOpts{..} = objectFromMaybes+ ["type" .== createGuildIntegrationOptsType] -- | Options for `CreateGuildBan` data CreateGuildBanOpts = CreateGuildBanOpts@@ -170,10 +169,10 @@ } deriving (Show, Read, Eq, Ord) instance ToJSON CreateGuildBanOpts where- toJSON CreateGuildBanOpts{..} = object [(name, val) | (name, Just val) <-- [("delete_message_days",- toJSON <$> createGuildBanOptsDeleteLastNMessages ),- ("reason", toJSON <$> createGuildBanOptsReason )]]+ toJSON CreateGuildBanOpts{..} = objectFromMaybes+ [ "delete_message_days"+ .=? createGuildBanOptsDeleteLastNMessages+ , "reason" .=? createGuildBanOptsReason] -- | Options for `ModifyGuildRole` data ModifyGuildRoleOpts = ModifyGuildRoleOpts@@ -185,12 +184,12 @@ } deriving (Show, Read, Eq, Ord) instance ToJSON ModifyGuildRoleOpts where- toJSON ModifyGuildRoleOpts{..} = object [(name, val) | (name, Just val) <-- [("name", toJSON <$> modifyGuildRoleOptsName ),- ("permissions", toJSON <$> modifyGuildRoleOptsPermissions ),- ("color", toJSON <$> modifyGuildRoleOptsColor ),- ("hoist", toJSON <$> modifyGuildRoleOptsSeparateSidebar ),- ("mentionable", toJSON <$> modifyGuildRoleOptsMentionable )]]+ toJSON ModifyGuildRoleOpts{..} = objectFromMaybes+ ["name" .=? modifyGuildRoleOptsName,+ "permissions" .=? modifyGuildRoleOptsPermissions,+ "color" .=? modifyGuildRoleOptsColor,+ "hoist" .=? modifyGuildRoleOptsSeparateSidebar,+ "mentionable" .=? modifyGuildRoleOptsMentionable] -- | Options for `AddGuildMember` data AddGuildMemberOpts = AddGuildMemberOpts@@ -202,12 +201,12 @@ } deriving (Show, Read, Eq, Ord) instance ToJSON AddGuildMemberOpts where- toJSON AddGuildMemberOpts{..} = object [(name, val) | (name, Just val) <-- [("access_token", toJSON <$> Just addGuildMemberOptsAccessToken ),- ("nick", toJSON <$> addGuildMemberOptsNickname ),- ("roles", toJSON <$> addGuildMemberOptsRoles ),- ("mute", toJSON <$> addGuildMemberOptsIsMuted ),- ("deaf", toJSON <$> addGuildMemberOptsIsDeafened )]]+ toJSON AddGuildMemberOpts{..} = objectFromMaybes+ ["access_token" .== addGuildMemberOptsAccessToken,+ "nick" .=? addGuildMemberOptsNickname,+ "roles" .=? addGuildMemberOptsRoles,+ "mute" .=? addGuildMemberOptsIsMuted,+ "deaf" .=? addGuildMemberOptsIsDeafened] -- | Options for `ModifyGuildMember` data ModifyGuildMemberOpts = ModifyGuildMemberOpts@@ -220,16 +219,16 @@ } deriving (Show, Read, Eq, Ord) instance Default ModifyGuildMemberOpts where- def = ModifyGuildMemberOpts Nothing Nothing Nothing Nothing Nothing Nothing + def = ModifyGuildMemberOpts Nothing Nothing Nothing Nothing Nothing Nothing instance ToJSON ModifyGuildMemberOpts where- toJSON ModifyGuildMemberOpts{..} = object [(name, val) | (name, Just val) <-- [("nick", toJSON <$> modifyGuildMemberOptsNickname ),- ("roles", toJSON <$> modifyGuildMemberOptsRoles ),- ("mute", toJSON <$> modifyGuildMemberOptsIsMuted ),- ("deaf", toJSON <$> modifyGuildMemberOptsIsDeafened ),- ("channel_id", toJSON <$> modifyGuildMemberOptsMoveToChannel),- ("communication_disabled_until", toJSON <$> modifyGuildMemberOptsTimeoutUntil)]]+ toJSON ModifyGuildMemberOpts{..} = objectFromMaybes+ ["nick" .=? modifyGuildMemberOptsNickname,+ "roles" .=? modifyGuildMemberOptsRoles,+ "mute" .=? modifyGuildMemberOptsIsMuted,+ "deaf" .=? modifyGuildMemberOptsIsDeafened,+ "channel_id" .=? modifyGuildMemberOptsMoveToChannel,+ "communication_disabled_until" .=? modifyGuildMemberOptsTimeoutUntil] -- | Options for `CreateGuildChannel` data CreateGuildChannelOpts@@ -250,28 +249,28 @@ -- | Converts a channel name, a list of permissions and other channel options into a JSON Value createChannelOptsToJSON :: T.Text -> [Overwrite] -> CreateGuildChannelOpts -> Value-createChannelOptsToJSON name perms opts = object [(key, val) | (key, Just val) <- optsJSON]+createChannelOptsToJSON name perms opts = objectFromMaybes optsJSON where optsJSON = case opts of CreateGuildChannelOptsText{..} ->- [("name", Just (String name))- ,("type", Just (Number 0))- ,("permission_overwrites", toJSON <$> Just perms)- ,("topic", toJSON <$> createGuildChannelOptsTopic)- ,("rate_limit_per_user", toJSON <$> createGuildChannelOptsUserMessageRateDelay)- ,("nsfw", toJSON <$> createGuildChannelOptsIsNSFW)- ,("parent_id", toJSON <$> createGuildChannelOptsCategoryId)]+ ["name" .== String name+ ,"type" .== Number 0+ ,"permission_overwrites" .== perms+ ,"topic" .=? createGuildChannelOptsTopic+ ,"rate_limit_per_user" .=? createGuildChannelOptsUserMessageRateDelay+ ,"nsfw" .=? createGuildChannelOptsIsNSFW+ ,"parent_id" .=? createGuildChannelOptsCategoryId] CreateGuildChannelOptsVoice{..} ->- [("name", Just (String name))- ,("type", Just (Number 2))- ,("permission_overwrites", toJSON <$> Just perms)- ,("bitrate", toJSON <$> createGuildChannelOptsBitrate)- ,("user_limit", toJSON <$> createGuildChannelOptsMaxUsers)- ,("parent_id", toJSON <$> createGuildChannelOptsCategoryId)]+ ["name" .== String name+ ,"type" .== Number 2+ ,"permission_overwrites" .== perms+ ,"bitrate" .=? createGuildChannelOptsBitrate+ ,"user_limit" .=? createGuildChannelOptsMaxUsers+ ,"parent_id" .=? createGuildChannelOptsCategoryId] CreateGuildChannelOptsCategory ->- [("name", Just (String name))- ,("type", Just (Number 4))- ,("permission_overwrites", toJSON <$> Just perms)]+ ["name" .== String name+ ,"type" .== Number 4+ ,"permission_overwrites" .== perms] -- | Options for `ModifyGuild`@@ -289,11 +288,11 @@ } deriving (Show, Read, Eq, Ord) instance ToJSON ModifyGuildOpts where- toJSON ModifyGuildOpts{..} = object [(name, val) | (name, Just val) <-- [("name", toJSON <$> modifyGuildOptsName ),- ("afk_channel_id", toJSON <$> modifyGuildOptsAFKChannelId ),- ("icon", toJSON <$> modifyGuildOptsIcon ),- ("owner_id", toJSON <$> modifyGuildOptsOwnerId )] ]+ toJSON ModifyGuildOpts{..} = objectFromMaybes+ ["name" .=? modifyGuildOptsName,+ "afk_channel_id" .=? modifyGuildOptsAFKChannelId,+ "icon" .=? modifyGuildOptsIcon,+ "owner_id" .=? modifyGuildOptsOwnerId] data GuildMembersTiming = GuildMembersTiming { guildMembersTimingLimit :: Maybe Int@@ -334,7 +333,7 @@ (CreateGuildRole g _) -> "guild_roles " <> show g (ModifyGuildRolePositions g _) -> "guild_roles " <> show g (ModifyGuildRole g _ _) -> "guild_role " <> show g- (DeleteGuildRole g _ ) -> "guild_role " <> show g+ (DeleteGuildRole g _) -> "guild_role " <> show g (GetGuildPruneCount g _) -> "guild_prune " <> show g (BeginGuildPrune g _) -> "guild_prune " <> show g (GetGuildVoiceRegions g) -> "guild_voice " <> show g@@ -344,8 +343,8 @@ (ModifyGuildIntegration g _ _) -> "guild_intgr " <> show g (DeleteGuildIntegration g _) -> "guild_intgr " <> show g (SyncGuildIntegration g _) -> "guild_sync " <> show g- (GetGuildWidget g) -> "guild_widget " <> show g- (ModifyGuildWidget g _) -> "guild_widget " <> show g+ (GetGuildWidget g) -> "guild_widget " <> show g+ (ModifyGuildWidget g _) -> "guild_widget " <> show g (GetGuildVanityURL g) -> "guild " <> show g @@ -443,7 +442,7 @@ Get (guilds /~ guild /: "integrations") mempty (CreateGuildIntegration guild iid opts) ->- let patch = object [("type" .= createGuildIntegrationOptsType opts) ,("id" .= iid)]+ let patch = object ["type" .= createGuildIntegrationOptsType opts, "id" .= iid] in Post (guilds /~ guild /: "integrations") (pure (R.ReqBodyJson patch)) mempty (ModifyGuildIntegration guild iid patch) ->
src/Discord/Internal/Rest/Prelude.hs view
@@ -34,7 +34,7 @@ where -- | https://discord.com/developers/docs/reference#user-agent -- Second place where the library version is noted- agent = "DiscordBot (https://github.com/discord-haskell/discord-haskell, 1.14.0)"+ agent = "DiscordBot (https://github.com/discord-haskell/discord-haskell, 1.15.0)" -- Possibly append to an URL infixl 5 /?
src/Discord/Internal/Rest/Webhook.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE RecordWildCards #-}@@ -25,17 +24,6 @@ import Discord.Internal.Rest.Prelude import Discord.Internal.Types --- aeson introduced type name for json key (text)--- https://github.com/haskell/aeson/issues/881-# if MIN_VERSION_aeson(2, 0, 0)-import qualified Data.Aeson.Key as Key-toKey :: T.Text -> Key.Key-toKey = Key.fromText-# else-toKey :: T.Text -> T.Text-toKey = id-# endif- instance Request (WebhookRequest a) where majorRoute = webhookMajorRoute jsonRequest = webhookJsonRequest@@ -84,20 +72,20 @@ -- just use execute webhook. -- | Returns a previously-sent webhook message from the same token.- GetWebhookMessage :: WebhookId - -> WebhookToken - -> MessageId + GetWebhookMessage :: WebhookId+ -> WebhookToken+ -> MessageId -> WebhookRequest Message -- | Edits a previously-sent webhook message from the same token.- EditWebhookMessage :: WebhookId - -> WebhookToken - -> MessageId + EditWebhookMessage :: WebhookId+ -> WebhookToken+ -> MessageId -> T.Text -- currently we don't support the full range of edits - feel free to PR and fix this -> WebhookRequest Message -- | Deletes a previously-sent webhook message from the same token.- DeleteWebhookMessage :: WebhookId - -> WebhookToken - -> MessageId + DeleteWebhookMessage :: WebhookId+ -> WebhookToken+ -> MessageId -> WebhookRequest () -- | Options for `ModifyWebhook` and `ModifyWebhookWithToken`@@ -108,10 +96,10 @@ } deriving (Show, Read, Eq, Ord) instance ToJSON ModifyWebhookOpts where- toJSON ModifyWebhookOpts{..} = object [(toKey name, val) | (name, Just val) <-- [("channel_id", toJSON <$> modifyWebhookOptsChannelId),- ("name", toJSON <$> modifyWebhookOptsName),- ("avatar", toJSON <$> modifyWebhookOptsAvatar) ] ]+ toJSON ModifyWebhookOpts{..} = objectFromMaybes+ ["channel_id" .=? modifyWebhookOptsChannelId,+ "name" .=? modifyWebhookOptsName,+ "avatar" .=? modifyWebhookOptsAvatar ] -- | Options for `CreateWebhook` data CreateWebhookOpts = CreateWebhookOpts@@ -120,9 +108,9 @@ } deriving (Show, Read, Eq, Ord) instance ToJSON CreateWebhookOpts where- toJSON CreateWebhookOpts{..} = object [(name, val) | (name, Just val) <-- [("name", toJSON <$> Just createWebhookOptsName),- ("avatar", toJSON <$> createWebhookOptsAvatar) ] ]+ toJSON CreateWebhookOpts{..} = objectFromMaybes+ ["name" .== createWebhookOptsName,+ "avatar" .=? createWebhookOptsAvatar ] -- | Options for `ExecuteWebhookWithToken` data ExecuteWebhookWithTokenOpts = ExecuteWebhookWithTokenOpts@@ -136,17 +124,17 @@ | WebhookContentEmbeds [CreateEmbed] deriving (Show, Read, Eq, Ord) -webhookContentJson :: WebhookContent -> [(T.Text, Maybe Value)]+webhookContentJson :: WebhookContent -> [(AesonKey, Value)] webhookContentJson c = case c of- WebhookContentText t -> [("content", Just (toJSON t))]+ WebhookContentText t -> [("content", toJSON t)] WebhookContentFile _ _ -> []- WebhookContentEmbeds e -> [("embeds", Just (toJSON (createEmbed <$> e)))]+ WebhookContentEmbeds e -> [("embeds", toJSON (createEmbed <$> e))] instance ToJSON ExecuteWebhookWithTokenOpts where- toJSON ExecuteWebhookWithTokenOpts{..} = object $ [(toKey name, val) | (name, Just val) <-- [("username", toJSON <$> executeWebhookWithTokenOptsUsername)]- <> webhookContentJson executeWebhookWithTokenOptsContent- ]+ toJSON ExecuteWebhookWithTokenOpts{..} = objectFromMaybes $+ ["username" .=? executeWebhookWithTokenOptsUsername]+ <> fmap Just (webhookContentJson executeWebhookWithTokenOptsContent)+ -- | Major routes for webhook requests webhookMajorRoute :: WebhookRequest a -> String webhookMajorRoute ch = case ch of
src/Discord/Internal/Types/ApplicationCommands.hs view
@@ -25,6 +25,9 @@ GuildApplicationCommandPermissions (..), ApplicationCommandPermissions (..), Number,+ AutocompleteOrChoice,+ LocalizedText,+ Locale ) where @@ -34,7 +37,8 @@ import Data.Foldable (Foldable (toList)) import Data.Scientific (Scientific) import qualified Data.Text as T-import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, GuildId, InternalDiscordEnum (..), Snowflake, discordTypeParseJSON, toMaybeJSON)+import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, GuildId, InternalDiscordEnum (..), Snowflake, discordTypeParseJSON, objectFromMaybes, (.==), (.=?))+import Data.Map.Strict (Map) type Number = Scientific @@ -49,8 +53,12 @@ applicationCommandGuildId :: Maybe GuildId, -- | The name of the application command. applicationCommandName :: T.Text,- -- | Whether the command is enabled by default when the app is added to a guild.- applicationCommandDefaultPermission :: Bool,+ -- | The localized names of the application command.+ applicationCommandLocalizedName :: Maybe LocalizedText,+ -- | What permissions are required to use this command by default.+ applicationCommandDefaultMemberPermissions :: Maybe T.Text,+ -- | Whether the command is available in DMs.+ applicationCommandDMPermission :: Maybe Bool, -- | Autoincrementing version identifier updated during substantial record changes. applicationCommandVersion :: Snowflake }@@ -63,8 +71,12 @@ applicationCommandGuildId :: Maybe GuildId, -- | The name of the application command. applicationCommandName :: T.Text,- -- | Whether the command is enabled by default when the app is added to a guild.- applicationCommandDefaultPermission :: Bool,+ -- | The localized names of the application command.+ applicationCommandLocalizedName :: Maybe LocalizedText,+ -- | What permissions are required to use this command by default.+ applicationCommandDefaultMemberPermissions :: Maybe T.Text,+ -- | Whether the command is available in DMs.+ applicationCommandDMPermission :: Maybe Bool, -- | Autoincrementing version identifier updated during substantial record changes. applicationCommandVersion :: Snowflake }@@ -77,12 +89,18 @@ applicationCommandGuildId :: Maybe GuildId, -- | The name of the application command. applicationCommandName :: T.Text,+ -- | The localized names of the application command.+ applicationCommandLocalizedName :: Maybe LocalizedText, -- | The description of the application command. applicationCommandDescription :: T.Text,+ -- | The localized descriptions of the application command.+ applicationCommandLocalizedDescription :: Maybe LocalizedText, -- | The parameters for the command. applicationCommandOptions :: Maybe Options,- -- | Whether the command is enabled by default when the app is added to a guild.- applicationCommandDefaultPermission :: Bool,+ -- | What permissions are required to use this command by default.+ applicationCommandDefaultMemberPermissions :: Maybe T.Text,+ -- | Whether the command is available in DMs.+ applicationCommandDMPermission :: Maybe Bool, -- | Autoincrementing version identifier updated during substantial record changes. applicationCommandVersion :: Snowflake }@@ -97,16 +115,19 @@ aid <- v .: "application_id" gid <- v .:? "guild_id" name <- v .: "name"- defPerm <- v .:? "default_permission" .!= True+ lname <- v .:? "name_localizations"+ defPerm <- v .:? "default_member_permissions"+ dmPerm <- v .:? "dm_permission" version <- v .: "version" t <- v .:? "type" :: Parser (Maybe Int) case t of- (Just 2) -> return $ ApplicationCommandUser acid aid gid name defPerm version- (Just 3) -> return $ ApplicationCommandMessage acid aid gid name defPerm version+ (Just 2) -> return $ ApplicationCommandUser acid aid gid name lname defPerm dmPerm version+ (Just 3) -> return $ ApplicationCommandMessage acid aid gid name lname defPerm dmPerm version _ -> do desc <- v .: "description" options <- v .:? "options"- return $ ApplicationCommandChatInput acid aid gid name desc options defPerm version+ ldesc <- v .: "description_localizations"+ return $ ApplicationCommandChatInput acid aid gid name lname desc ldesc options defPerm dmPerm version ) -- | Either subcommands and groups, or values.@@ -144,8 +165,12 @@ = OptionSubcommandGroup { -- | The name of the subcommand group optionSubcommandGroupName :: T.Text,+ -- | The localized name of the subcommand group+ optionSubcommandGroupLocalizedName :: Maybe LocalizedText, -- | The description of the subcommand group optionSubcommandGroupDescription :: T.Text,+ -- | The localized description of the subcommand group+ optionSubcommandGroupLocalizedDescription :: Maybe LocalizedText, -- | The subcommands in this subcommand group optionSubcommandGroupOptions :: [OptionSubcommand] }@@ -162,7 +187,9 @@ 2 -> OptionSubcommandGroup <$> v .: "name"+ <*> v .:? "name_localizations" <*> v .: "description"+ <*> v .:? "description_localizations" <*> v .: "options" 1 -> OptionSubcommandOrGroupSubcommand <$> parseJSON (Object v) _ -> fail "unexpected subcommand group type"@@ -173,7 +200,9 @@ object [ ("type", Number 2), ("name", toJSON optionSubcommandGroupName),+ ("name_localizations", toJSON optionSubcommandGroupLocalizedName), ("description", toJSON optionSubcommandGroupDescription),+ ("description_localizations", toJSON optionSubcommandGroupLocalizedDescription), ("options", toJSON optionSubcommandGroupOptions) ] toJSON (OptionSubcommandOrGroupSubcommand a) = toJSON a@@ -182,8 +211,12 @@ data OptionSubcommand = OptionSubcommand { -- | The name of the subcommand optionSubcommandName :: T.Text,+ -- | The localized name of the subcommand+ optionSubcommandLocalizedName :: Maybe LocalizedText, -- | The description of the subcommand optionSubcommandDescription :: T.Text,+ -- | The localized description of the subcommand+ optionSubcommandLocalizedDescription :: Maybe LocalizedText, -- | What options are there in this subcommand optionSubcommandOptions :: [OptionValue] }@@ -199,7 +232,9 @@ 1 -> OptionSubcommand <$> v .: "name"+ <*> v .:? "name_localizations" <*> v .: "description"+ <*> v .:? "description_localizations" <*> v .:? "options" .!= [] _ -> fail "unexpected subcommand type" )@@ -209,7 +244,9 @@ object [ ("type", Number 1), ("name", toJSON optionSubcommandName),+ ("name_localizations", toJSON optionSubcommandLocalizedName), ("description", toJSON optionSubcommandDescription),+ ("description_localizations", toJSON optionSubcommandLocalizedDescription), ("options", toJSON optionSubcommandOptions) ] @@ -218,18 +255,30 @@ = OptionValueString { -- | The name of the value optionValueName :: T.Text,+ -- | The localized name of the value+ optionValueLocalizedName :: Maybe LocalizedText, -- | The description of the value optionValueDescription :: T.Text,+ -- | The localized description of the value+ optionValueLocalizedDescription :: Maybe LocalizedText, -- | Whether this option is required optionValueRequired :: Bool, -- | Whether to autocomplete or have a list of named choices. For neither option, use `Left False`- optionValueStringChoices :: AutocompleteOrChoice T.Text+ optionValueStringChoices :: AutocompleteOrChoice T.Text,+ -- | The minimum length of the string (minimum 0)+ optionValueStringMinLen :: Maybe Integer,+ -- | The maximum length of the string (minimum 1)+ optionValueStringMaxLen :: Maybe Integer } | OptionValueInteger { -- | The name of the value optionValueName :: T.Text,+ -- | The localized name of the value+ optionValueLocalizedName :: Maybe LocalizedText, -- | The description of the value optionValueDescription :: T.Text,+ -- | The localized description of the value+ optionValueLocalizedDescription :: Maybe LocalizedText, -- | Whether this option is required optionValueRequired :: Bool, -- | Whether to autocomplete or have a list of named choices. For neither option, use `Left False`@@ -242,24 +291,36 @@ | OptionValueBoolean { -- | The name of the value optionValueName :: T.Text,+ -- | The localized name of the value+ optionValueLocalizedName :: Maybe LocalizedText, -- | The description of the value optionValueDescription :: T.Text,+ -- | The localized description of the value+ optionValueLocalizedDescription :: Maybe LocalizedText, -- | Whether this option is required optionValueRequired :: Bool } | OptionValueUser { -- | The name of the value optionValueName :: T.Text,+ -- | The localized name of the value+ optionValueLocalizedName :: Maybe LocalizedText, -- | The description of the value optionValueDescription :: T.Text,+ -- | The localized description of the value+ optionValueLocalizedDescription :: Maybe LocalizedText, -- | Whether this option is required optionValueRequired :: Bool } | OptionValueChannel { -- | The name of the value optionValueName :: T.Text,+ -- | The localized name of the value+ optionValueLocalizedName :: Maybe LocalizedText, -- | The description of the value optionValueDescription :: T.Text,+ -- | The localized description of the value+ optionValueLocalizedDescription :: Maybe LocalizedText, -- | Whether this option is required optionValueRequired :: Bool, -- | What type of channel can be put in here@@ -268,24 +329,36 @@ | OptionValueRole { -- | The name of the value optionValueName :: T.Text,+ -- | The localized name of the value+ optionValueLocalizedName :: Maybe LocalizedText, -- | The description of the value optionValueDescription :: T.Text,+ -- | The localized description of the value+ optionValueLocalizedDescription :: Maybe LocalizedText, -- | Whether this option is required optionValueRequired :: Bool } | OptionValueMentionable { -- | The name of the value optionValueName :: T.Text,+ -- | The localized name of the value+ optionValueLocalizedName :: Maybe LocalizedText, -- | The description of the value optionValueDescription :: T.Text,+ -- | The localized description of the value+ optionValueLocalizedDescription :: Maybe LocalizedText, -- | Whether this option is required optionValueRequired :: Bool } | OptionValueNumber { -- | The name of the value optionValueName :: T.Text,+ -- | The localized name of the value+ optionValueLocalizedName :: Maybe LocalizedText, -- | The description of the value optionValueDescription :: T.Text,+ -- | The localized description of the value+ optionValueLocalizedDescription :: Maybe LocalizedText, -- | Whether this option is required optionValueRequired :: Bool, -- | Whether to autocomplete or have a list of named choices. For neither option, use `Left False`@@ -303,30 +376,34 @@ "OptionValue" ( \v -> do name <- v .: "name"+ lname <- v .:? "name_localizations" desc <- v .: "description"+ ldesc <- v .:? "description_localizations" required <- v .:? "required" .!= False t <- v .: "type" :: Parser Int case t of 3 ->- OptionValueString name desc required+ OptionValueString name lname desc ldesc required <$> parseJSON (Object v)+ <*> v .:? "min_length"+ <*> v .:? "max_length" 4 ->- OptionValueInteger name desc required+ OptionValueInteger name lname desc ldesc required <$> parseJSON (Object v) <*> v .:? "min_value" <*> v .:? "max_value" 10 ->- OptionValueNumber name desc required+ OptionValueNumber name lname desc ldesc required <$> parseJSON (Object v) <*> v .:? "min_value" <*> v .:? "max_value" 7 ->- OptionValueChannel name desc required+ OptionValueChannel name lname desc ldesc required <$> v .:? "channel_types"- 5 -> return $ OptionValueBoolean name desc required- 6 -> return $ OptionValueUser name desc required- 8 -> return $ OptionValueRole name desc required- 9 -> return $ OptionValueMentionable name desc required+ 5 -> return $ OptionValueBoolean name lname desc ldesc required+ 6 -> return $ OptionValueUser name lname desc ldesc required+ 8 -> return $ OptionValueRole name lname desc ldesc required+ 9 -> return $ OptionValueMentionable name lname desc ldesc required _ -> fail "unknown application command option value type" ) @@ -336,7 +413,11 @@ [ ("type", Number 3), ("name", toJSON optionValueName), ("description", toJSON optionValueDescription),+ ("name_localizations", toJSON optionValueLocalizedName),+ ("description_localizations", toJSON optionValueLocalizedDescription), ("required", toJSON optionValueRequired),+ ("min_length", toJSON optionValueStringMinLen),+ ("max_length", toJSON optionValueStringMaxLen), choiceOrAutocompleteToJSON optionValueStringChoices ] toJSON OptionValueInteger {..} =@@ -344,7 +425,11 @@ [ ("type", Number 4), ("name", toJSON optionValueName), ("description", toJSON optionValueDescription),+ ("name_localizations", toJSON optionValueLocalizedName),+ ("description_localizations", toJSON optionValueLocalizedDescription), ("required", toJSON optionValueRequired),+ ("min_value", toJSON optionValueIntegerMinVal),+ ("max_value", toJSON optionValueIntegerMaxVal), choiceOrAutocompleteToJSON optionValueIntegerChoices ] toJSON OptionValueNumber {..} =@@ -352,7 +437,11 @@ [ ("type", Number 10), ("name", toJSON optionValueName), ("description", toJSON optionValueDescription),+ ("name_localizations", toJSON optionValueLocalizedName),+ ("description_localizations", toJSON optionValueLocalizedDescription), ("required", toJSON optionValueRequired),+ ("min_value", toJSON optionValueNumberMinVal),+ ("max_value", toJSON optionValueNumberMaxVal), choiceOrAutocompleteToJSON optionValueNumberChoices ] toJSON OptionValueChannel {..} =@@ -360,6 +449,8 @@ [ ("type", Number 7), ("name", toJSON optionValueName), ("description", toJSON optionValueDescription),+ ("name_localizations", toJSON optionValueLocalizedName),+ ("description_localizations", toJSON optionValueLocalizedDescription), ("required", toJSON optionValueRequired), ("channel_types", toJSON optionValueChannelTypes) ]@@ -368,6 +459,8 @@ [ ("type", Number (t acov)), ("name", toJSON $ optionValueName acov), ("description", toJSON $ optionValueDescription acov),+ ("name_localizations", toJSON $ optionValueLocalizedName acov),+ ("description_localizations", toJSON $ optionValueLocalizedDescription acov), ("required", toJSON $ optionValueRequired acov) ] where@@ -397,78 +490,78 @@ = CreateApplicationCommandChatInput { -- | The application command name (1-32 chars). createName :: T.Text,+ -- | The localized application name+ createLocalizedName :: Maybe LocalizedText, -- | The application command description (1-100 chars). createDescription :: T.Text,+ -- | The localized application command description.+ createLocalizedDescription :: Maybe LocalizedText, -- | What options the application (max length 25). createOptions :: Maybe Options, -- | The default permissions required for members set when using the command -- in a guild. -- Set of permissions represented as a bit set. createDefaultMemberPermissions :: Maybe T.Text,- -- | Whether the command is enabled by default when the application is added- -- to a guild.- createDefaultPermission :: Bool+ -- | Whether the command is available in DMs.+ createDMPermission :: Maybe Bool } | CreateApplicationCommandUser { -- | The application command name (1-32 chars). createName :: T.Text,+ -- | The localized application name+ createLocalizedName :: Maybe LocalizedText, -- | The default permissions required for members set when using the command -- in a guild. -- Set of permissions represented as a bit set. createDefaultMemberPermissions :: Maybe T.Text,- -- | Whether the command is enabled by default when the application is added- -- to a guild.- createDefaultPermission :: Bool+ -- | Whether the command is available in DMs.+ createDMPermission :: Maybe Bool } | CreateApplicationCommandMessage { -- | The application command name (1-32 chars). createName :: T.Text,+ -- | The localized application name+ createLocalizedName :: Maybe LocalizedText, -- | The default permissions required for members set when using the command -- in a guild. -- Set of permissions represented as a bit set. createDefaultMemberPermissions :: Maybe T.Text,- -- | Whether the command is enabled by default when the application is added- -- to a guild.- createDefaultPermission :: Bool+ -- | Whether the command is available in DMs.+ createDMPermission :: Maybe Bool } deriving (Show, Eq, Read) instance ToJSON CreateApplicationCommand where toJSON CreateApplicationCommandChatInput {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("name", toMaybeJSON createName),- ("description", toMaybeJSON createDescription),- ("options", toJSON <$> createOptions),- ("default_member_permissions", toMaybeJSON createDefaultMemberPermissions),- ("default_permission", toMaybeJSON createDefaultPermission),- ("type", Just $ Number 1)- ]+ objectFromMaybes+ [ "name" .== createName,+ "name_localizations" .=? createLocalizedName,+ "description" .== createDescription,+ "description_localizations" .=? createLocalizedDescription,+ "options" .=? createOptions,+ "default_member_permissions" .== createDefaultMemberPermissions,+ "dm_permission" .== createDMPermission,+ "type" .== Number 1 ] toJSON CreateApplicationCommandUser {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("name", toMaybeJSON createName),- ("default_member_permissions", toMaybeJSON createDefaultMemberPermissions),- ("default_permission", toMaybeJSON createDefaultPermission),- ("type", Just $ Number 2)- ]+ objectFromMaybes+ [ "name" .== createName,+ "name_localizations" .=? createLocalizedName,+ "default_member_permissions" .== createDefaultMemberPermissions,+ "dm_permission" .== createDMPermission,+ "type" .== Number 2 ] toJSON CreateApplicationCommandMessage {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("name", toMaybeJSON createName),- ("default_member_permissions", toMaybeJSON createDefaultMemberPermissions),- ("default_permission", toMaybeJSON createDefaultPermission),- ("type", Just $ Number 3)- ]+ objectFromMaybes+ [ "name" .== createName,+ "name_localizations" .=? createLocalizedName,+ "default_member_permissions" .== createDefaultMemberPermissions,+ "dm_permission" .== createDMPermission,+ "type" .== Number 3 ] nameIsValid :: Bool -> T.Text -> Bool-nameIsValid isChatInput name = l >= 1 && l <= 32 && (isChatInput <= T.all (`elem` validChars) name)+nameIsValid isChatInput name = l >= 1 && l <= 32 && isChatInput <= T.all (`elem` validChars) name where l = T.length name validChars = '-' : ['a' .. 'z']@@ -479,21 +572,21 @@ -- than or equal to 100 characters. createChatInput :: T.Text -> T.Text -> Maybe CreateApplicationCommand createChatInput name desc- | nameIsValid True name && not (T.null desc) && T.length desc <= 100 = Just $ CreateApplicationCommandChatInput name desc Nothing Nothing True+ | nameIsValid True name && not (T.null desc) && T.length desc <= 100 = Just $ CreateApplicationCommandChatInput name Nothing desc Nothing Nothing Nothing Nothing | otherwise = Nothing -- | Create the basics for a user command. Use record overwriting to enter the -- other values. The name needs to be between 1 and 32 characters. createUser :: T.Text -> Maybe CreateApplicationCommand createUser name- | nameIsValid False name = Just $ CreateApplicationCommandUser name Nothing True+ | nameIsValid False name = Just $ CreateApplicationCommandUser name Nothing Nothing Nothing | otherwise = Nothing -- | Create the basics for a message command. Use record overwriting to enter -- the other values. The name needs to be between 1 and 32 characters. createMessage :: T.Text -> Maybe CreateApplicationCommand createMessage name- | nameIsValid False name = Just $ CreateApplicationCommandMessage name Nothing True+ | nameIsValid False name = Just $ CreateApplicationCommandMessage name Nothing Nothing Nothing | otherwise = Nothing -- | Data type to be used when editing application commands. The specification@@ -504,63 +597,80 @@ data EditApplicationCommand = EditApplicationCommandChatInput { editName :: Maybe T.Text,+ editLocalizedName :: Maybe LocalizedText, editDescription :: Maybe T.Text,+ editLocalizedDescription :: Maybe LocalizedText, editOptions :: Maybe Options,- editDefaultPermission :: Maybe Bool+ editDefaultMemberPermissions :: Maybe T.Text,+ editDMPermission :: Maybe Bool } | EditApplicationCommandUser { editName :: Maybe T.Text,- editDefaultPermission :: Maybe Bool+ editLocalizedName :: Maybe LocalizedText,+ editDefaultMemberPermissions :: Maybe T.Text,+ editDMPermission :: Maybe Bool } | EditApplicationCommandMessage { editName :: Maybe T.Text,- editDefaultPermission :: Maybe Bool+ editLocalizedName :: Maybe LocalizedText,+ editDefaultMemberPermissions :: Maybe T.Text,+ editDMPermission :: Maybe Bool } defaultEditApplicationCommand :: Int -> EditApplicationCommand-defaultEditApplicationCommand 2 = EditApplicationCommandUser Nothing Nothing-defaultEditApplicationCommand 3 = EditApplicationCommandMessage Nothing Nothing-defaultEditApplicationCommand _ = EditApplicationCommandChatInput Nothing Nothing Nothing Nothing+defaultEditApplicationCommand 2 = EditApplicationCommandUser Nothing Nothing Nothing Nothing+defaultEditApplicationCommand 3 = EditApplicationCommandMessage Nothing Nothing Nothing Nothing+defaultEditApplicationCommand _ = EditApplicationCommandChatInput Nothing Nothing Nothing Nothing Nothing Nothing Nothing instance ToJSON EditApplicationCommand where toJSON EditApplicationCommandChatInput {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("name", toJSON <$> editName),- ("description", toJSON <$> editDescription),- ("options", toJSON <$> editOptions),- ("default_permission", toJSON <$> editDefaultPermission),- ("type", Just $ Number 1)- ]+ objectFromMaybes+ [ "name" .=? editName,+ "name_localization" .=? editLocalizedName,+ "description" .=? editDescription,+ "description_localization" .=? editLocalizedDescription,+ "options" .=? editOptions,+ "default_member_permissions" .=? editDefaultMemberPermissions,+ "dm_permission" .=? editDMPermission,+ "type" .== Number 1 ] toJSON EditApplicationCommandUser {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("name", toJSON <$> editName),- ("default_permission", toJSON <$> editDefaultPermission),- ("type", Just $ Number 2)- ]+ objectFromMaybes+ [ "name" .=? editName,+ "name_localization" .=? editLocalizedName,+ "default_member_permissions" .=? editDefaultMemberPermissions,+ "dm_permission" .=? editDMPermission,+ "type" .== Number 2 ] toJSON EditApplicationCommandMessage {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("name", toJSON <$> editName),- ("default_permission", toJSON <$> editDefaultPermission),- ("type", Just $ Number 3)- ]+ objectFromMaybes+ [ "name" .=? editName,+ "name_localization" .=? editLocalizedName,+ "default_member_permissions" .=? editDefaultMemberPermissions,+ "dm_permission" .=? editDMPermission,+ "type" .== Number 3 ] -data Choice a = Choice {choiceName :: T.Text, choiceValue :: a}+data Choice a = Choice+ { -- | The name of the choice+ choiceName :: T.Text,+ -- | The localized name of the choice+ choiceLocalizedName :: Maybe LocalizedText,+ -- | The value of the choice+ choiceValue :: a+ } deriving (Show, Read, Eq, Ord) instance Functor Choice where- fmap f (Choice s a) = Choice s (f a)+ fmap f (Choice s l a) = Choice s l (f a) instance (ToJSON a) => ToJSON (Choice a) where- toJSON Choice {..} = object [("name", toJSON choiceName), ("value", toJSON choiceValue)]+ toJSON Choice {..} =+ object+ [ ("name", toJSON choiceName),+ ("value", toJSON choiceValue),+ ("name_localizations", toJSON choiceLocalizedName)+ ] instance (FromJSON a) => FromJSON (Choice a) where parseJSON =@@ -569,6 +679,7 @@ ( \v -> Choice <$> v .: "name"+ <*> v .:? "name_localizations" <*> v .: "value" ) @@ -664,14 +775,11 @@ instance ToJSON GuildApplicationCommandPermissions where toJSON GuildApplicationCommandPermissions {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("id", toMaybeJSON guildApplicationCommandPermissionsId),- ("application_id", toMaybeJSON guildApplicationCommandPermissionsApplicationId),- ("guild_id", toMaybeJSON guildApplicationCommandPermissionsGuildId),- ("permissions", toMaybeJSON guildApplicationCommandPermissionsPermissions)- ]+ objectFromMaybes+ [ "id" .== guildApplicationCommandPermissionsId,+ "application_id" .== guildApplicationCommandPermissionsApplicationId,+ "guild_id" .== guildApplicationCommandPermissionsGuildId,+ "permissions" .== guildApplicationCommandPermissionsPermissions ] -- | Application command permissions allow you to enable or disable commands for@@ -699,11 +807,15 @@ instance ToJSON ApplicationCommandPermissions where toJSON ApplicationCommandPermissions {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("id", toMaybeJSON applicationCommandPermissionsId),- ("type", toMaybeJSON applicationCommandPermissionsType),- ("permission", toMaybeJSON applicationCommandPermissionsPermission)- ]+ objectFromMaybes+ [ "id" .== applicationCommandPermissionsId,+ "type" .== applicationCommandPermissionsType,+ "permission" .== applicationCommandPermissionsPermission ]++-- | A discord locale. See+-- <https://discord.com/developers/docs/reference#locales> for available locales+type Locale = T.Text++-- | Translations for a text+type LocalizedText = Map Locale T.Text
src/Discord/Internal/Types/Channel.hs view
@@ -232,113 +232,113 @@ <*> pure (T.pack (show o)) instance ToJSON Channel where- toJSON ChannelText{..} = object [(name,value) | (name, Just value) <-- [ ("type", Just (Number 0))- , ("id", toJSON <$> pure channelId)- , ("guild_id", toJSON <$> pure channelGuild)- , ("name", toJSON <$> pure channelName)- , ("position", toJSON <$> pure channelPosition)- , ("rate_limit_per_user", toJSON <$> pure channelUserRateLimit)- , ("nsfw", toJSON <$> pure channelNSFW)- , ("permission_overwrites", toJSON <$> pure channelPermissions)- , ("topic", toJSON <$> pure channelTopic)- , ("last_message_id", toJSON <$> channelLastMessage)- , ("parent_id", toJSON <$> pure channelParentId)- ] ]- toJSON ChannelNews{..} = object [(name,value) | (name, Just value) <-- [ ("type", Just (Number 5))- , ("id", toJSON <$> pure channelId)- , ("guild_id", toJSON <$> pure channelGuild)- , ("name", toJSON <$> pure channelName)- , ("position", toJSON <$> pure channelPosition)- , ("permission_overwrites", toJSON <$> pure channelPermissions)- , ("nsfw", toJSON <$> pure channelNSFW)- , ("topic", toJSON <$> pure channelTopic)- , ("last_message_id", toJSON <$> channelLastMessage)- , ("parent_id", toJSON <$> channelParentId)- ] ]- toJSON ChannelStorePage{..} = object [(name,value) | (name, Just value) <-- [ ("type", Just (Number 6))- , ("id", toJSON <$> pure channelId)- , ("guild_id", toJSON <$> pure channelGuild)- , ("name", toJSON <$> pure channelName)- , ("nsfw", toJSON <$> pure channelNSFW)- , ("position", toJSON <$> pure channelPosition)- , ("permission_overwrites", toJSON <$> pure channelPermissions)- ] ]- toJSON ChannelDirectMessage{..} = object [(name,value) | (name, Just value) <-- [ ("type", Just (Number 1))- , ("id", toJSON <$> pure channelId)- , ("recipients", toJSON <$> pure channelRecipients)- , ("last_message_id", toJSON <$> channelLastMessage)- ] ]- toJSON ChannelVoice{..} = object [(name,value) | (name, Just value) <-- [ ("type", Just (Number 2))- , ("id", toJSON <$> pure channelId)- , ("guild_id", toJSON <$> pure channelGuild)- , ("name", toJSON <$> pure channelName)- , ("position", toJSON <$> pure channelPosition)- , ("nsfw", toJSON <$> pure channelNSFW)- , ("permission_overwrites", toJSON <$> pure channelPermissions)- , ("bitrate", toJSON <$> pure channelBitRate)- , ("user_limit", toJSON <$> pure channelUserLimit)- ] ]- toJSON ChannelGroupDM{..} = object [(name,value) | (name, Just value) <-- [ ("type", Just (Number 3))- , ("id", toJSON <$> pure channelId)- , ("recipients", toJSON <$> pure channelRecipients)- , ("last_message_id", toJSON <$> channelLastMessage)- ] ]- toJSON ChannelGuildCategory{..} = object [(name,value) | (name, Just value) <-- [ ("type", Just (Number 4))- , ("id", toJSON <$> pure channelId)- , ("name", toJSON <$> pure channelName)- , ("guild_id", toJSON <$> pure channelGuild)- ] ]- toJSON ChannelStage{..} = object [(name,value) | (name, Just value) <-- [ ("type", Just (Number 13))- , ("id", toJSON <$> pure channelId)- , ("guild_id", toJSON <$> pure channelGuild)- , ("channel_id", toJSON <$> pure channelStageId)- , ("topic", toJSON <$> pure channelStageTopic)- ] ]- toJSON ChannelNewsThread{..} = object [(name,value) | (name, Just value) <-- [ ("type", Just (Number 10))- , ("id", toJSON <$> pure channelId)- , ("guild_id", toJSON <$> pure channelGuild)- , ("name", toJSON <$> channelThreadName)- , ("rate_limit_per_user", toJSON <$> channelUserRateLimitThread)- , ("last_message_id", toJSON <$> channelLastMessage)- , ("parent_id", toJSON <$> pure channelParentId)- , ("thread_metadata", toJSON <$> channelThreadMetadata)- , ("member", toJSON <$> channelThreadMember)- ] ]- toJSON ChannelPublicThread{..} = object [(name,value) | (name, Just value) <-- [ ("type", Just (Number 11))- , ("id", toJSON <$> pure channelId)- , ("guild_id", toJSON <$> pure channelGuild)- , ("name", toJSON <$> channelThreadName)- , ("rate_limit_per_user", toJSON <$> channelUserRateLimitThread)- , ("last_message_id", toJSON <$> channelLastMessage)- , ("parent_id", toJSON <$> pure channelParentId)- , ("thread_metadata", toJSON <$> channelThreadMetadata)- , ("member", toJSON <$> channelThreadMember)- ] ]- toJSON ChannelPrivateThread{..} = object [(name,value) | (name, Just value) <-- [ ("type", Just (Number 12))- , ("id", toJSON <$> pure channelId)- , ("guild_id", toJSON <$> pure channelGuild)- , ("name", toJSON <$> channelThreadName)- , ("rate_limit_per_user", toJSON <$> channelUserRateLimitThread)- , ("last_message_id", toJSON <$> channelLastMessage)- , ("parent_id", toJSON <$> pure channelParentId)- , ("thread_metadata", toJSON <$> channelThreadMetadata)- , ("member", toJSON <$> channelThreadMember)- ] ]- toJSON ChannelUnknownType{..} = object [(name,value) | (name, Just value) <-- [ ("id", toJSON <$> pure channelId)- , ("json", toJSON <$> pure channelJSON)- ] ]+ toJSON ChannelText{..} = objectFromMaybes+ [ "type" .== Number 0+ , "id" .== channelId+ , "guild_id" .== channelGuild+ , "name" .== channelName+ , "position" .== channelPosition+ , "rate_limit_per_user" .== channelUserRateLimit+ , "nsfw" .== channelNSFW+ , "permission_overwrites" .== channelPermissions+ , "topic" .== channelTopic+ , "last_message_id" .=? channelLastMessage+ , "parent_id" .== channelParentId+ ]+ toJSON ChannelNews{..} = objectFromMaybes+ [ "type" .== Number 5+ , "id" .== channelId+ , "guild_id" .== channelGuild+ , "name" .== channelName+ , "position" .== channelPosition+ , "permission_overwrites" .== channelPermissions+ , "nsfw" .== channelNSFW+ , "topic" .== channelTopic+ , "last_message_id" .=? channelLastMessage+ , "parent_id" .=? channelParentId+ ]+ toJSON ChannelStorePage{..} = objectFromMaybes+ [ "type" .== Number 6+ , "id" .== channelId+ , "guild_id" .== channelGuild+ , "name" .== channelName+ , "nsfw" .== channelNSFW+ , "position" .== channelPosition+ , "permission_overwrites" .== channelPermissions+ ]+ toJSON ChannelDirectMessage{..} = objectFromMaybes+ [ "type" .== Number 1+ , "id" .== channelId+ , "recipients" .== channelRecipients+ , "last_message_id" .=? channelLastMessage+ ]+ toJSON ChannelVoice{..} = objectFromMaybes+ [ "type" .== Number 2+ , "id" .== channelId+ , "guild_id" .== channelGuild+ , "name" .== channelName+ , "position" .== channelPosition+ , "nsfw" .== channelNSFW+ , "permission_overwrites" .== channelPermissions+ , "bitrate" .== channelBitRate+ , "user_limit" .== channelUserLimit+ ]+ toJSON ChannelGroupDM{..} = objectFromMaybes+ [ "type" .== Number 3+ , "id" .== channelId+ , "recipients" .== channelRecipients+ , "last_message_id" .=? channelLastMessage+ ]+ toJSON ChannelGuildCategory{..} = objectFromMaybes+ [ "type" .== Number 4+ , "id" .== channelId+ , "name" .== channelName+ , "guild_id" .== channelGuild+ ]+ toJSON ChannelStage{..} = objectFromMaybes+ [ "type" .== Number 13+ , "id" .== channelId+ , "guild_id" .== channelGuild+ , "channel_id" .== channelStageId+ , "topic" .== channelStageTopic+ ]+ toJSON ChannelNewsThread{..} = objectFromMaybes+ [ "type" .== Number 10+ , "id" .== channelId+ , "guild_id" .== channelGuild+ , "name" .=? channelThreadName+ , "rate_limit_per_user" .=? channelUserRateLimitThread+ , "last_message_id" .=? channelLastMessage+ , "parent_id" .== channelParentId+ , "thread_metadata" .=? channelThreadMetadata+ , "member" .=? channelThreadMember+ ]+ toJSON ChannelPublicThread{..} = objectFromMaybes+ [ "type" .== Number 11+ , "id" .== channelId+ , "guild_id" .== channelGuild+ , "name" .=? channelThreadName+ , "rate_limit_per_user" .=? channelUserRateLimitThread+ , "last_message_id" .=? channelLastMessage+ , "parent_id" .== channelParentId+ , "thread_metadata" .=? channelThreadMetadata+ , "member" .=? channelThreadMember+ ]+ toJSON ChannelPrivateThread{..} = objectFromMaybes+ [ "type" .== Number 12+ , "id" .== channelId+ , "guild_id" .== channelGuild+ , "name" .=? channelThreadName+ , "rate_limit_per_user" .=? channelUserRateLimitThread+ , "last_message_id" .=? channelLastMessage+ , "parent_id" .== channelParentId+ , "thread_metadata" .=? channelThreadMetadata+ , "member" .=? channelThreadMember+ ]+ toJSON ChannelUnknownType{..} = objectFromMaybes+ [ "id" .== channelId+ , "json" .== channelJSON+ ] -- | If the channel is part of a guild (has a guild id field) channelIsInGuild :: Channel -> Bool@@ -374,7 +374,7 @@ instance ToJSON Overwrite where toJSON Overwrite{..} = object [ ("id", toJSON $ either unId unId overwriteId)- , ("type", toJSON $ (either (const 0) (const 1) overwriteId :: Int))+ , ("type", toJSON (either (const 0) (const 1) overwriteId :: Int)) , ("allow", toJSON overwriteAllow) , ("deny", toJSON overwriteDeny) ]@@ -399,14 +399,14 @@ <*> o .:? "create_timestamp" instance ToJSON ThreadMetadata where- toJSON ThreadMetadata{..} = object [(name,value) | (name, Just value) <-- [ ("archived", toJSON <$> pure threadMetadataArchived)- , ("auto_archive_duration", toJSON <$> pure threadMetadataAutoArchive)- , ("archive_timestamp", toJSON <$> pure threadMetadataArchiveTime)- , ("locked", toJSON <$> pure threadMetadataLocked)- , ("invitable", toJSON <$> threadMetadataInvitable)- , ("create_timestamp", toJSON <$> pure threadMetadataCreateTime)- ] ]+ toJSON ThreadMetadata{..} = objectFromMaybes+ [ "archived" .== threadMetadataArchived+ , "auto_archive_duration" .== threadMetadataAutoArchive+ , "archive_timestamp" .== threadMetadataArchiveTime+ , "locked" .== threadMetadataLocked+ , "invitable" .=? threadMetadataInvitable+ , "create_timestamp" .== threadMetadataCreateTime+ ] -- | A user in a thread data ThreadMember = ThreadMember@@ -424,12 +424,12 @@ <*> o .: "flags" instance ToJSON ThreadMember where- toJSON ThreadMember{..} = object [(name,value) | (name, Just value) <-- [ ("id", toJSON <$> threadMemberThreadId)- , ("user_id", toJSON <$> threadMemberUserId)- , ("join_timestamp", toJSON <$> pure threadMemberJoinTime)- , ("flags", toJSON <$> pure threadMemberFlags)- ] ]+ toJSON ThreadMember{..} = objectFromMaybes+ [ "id" .=? threadMemberThreadId+ , "user_id" .=? threadMemberUserId+ , "join_timestamp" .== threadMemberJoinTime+ , "flags" .== threadMemberFlags+ ] data ThreadListSyncFields = ThreadListSyncFields@@ -539,37 +539,37 @@ instance ToJSON Message where- toJSON Message {..} = object [(name, value) | (name, Just value) <-- [ ("id", toJSON <$> pure messageId)- , ("channel_id", toJSON <$> pure messageChannelId)- , ("guild_id", toJSON <$> messageGuildId)- , ("author", toJSON <$> pure messageAuthor)- , ("member", toJSON <$> messageMember)- , ("content", toJSON <$> pure messageContent)- , ("timestamp", toJSON <$> pure messageTimestamp)- , ("edited_timestamp", toJSON <$> messageEdited)- , ("tts", toJSON <$> pure messageTts)- , ("mention_everyone", toJSON <$> pure messageEveryone)- , ("mentions", toJSON <$> pure messageMentions)- , ("mention_roles", toJSON <$> pure messageMentionRoles)- , ("attachments", toJSON <$> pure messageAttachments)- , ("embeds", toJSON <$> pure messageEmbeds)- , ("reactions", toJSON <$> pure messageReactions)- , ("nonce", toJSON <$> messageNonce)- , ("pinned", toJSON <$> pure messagePinned)- , ("webhook_id", toJSON <$> messageWebhookId)- , ("type", toJSON <$> pure messageType)- , ("activity", toJSON <$> messageActivity)+ toJSON Message {..} = objectFromMaybes+ [ "id" .== messageId+ , "channel_id" .== messageChannelId+ , "guild_id" .=? messageGuildId+ , "author" .== messageAuthor+ , "member" .=? messageMember+ , "content" .== messageContent+ , "timestamp" .== messageTimestamp+ , "edited_timestamp" .=? messageEdited+ , "tts" .== messageTts+ , "mention_everyone" .== messageEveryone+ , "mentions" .== messageMentions+ , "mention_roles" .== messageMentionRoles+ , "attachments" .== messageAttachments+ , "embeds" .== messageEmbeds+ , "reactions" .== messageReactions+ , "nonce" .=? messageNonce+ , "pinned" .== messagePinned+ , "webhook_id" .=? messageWebhookId+ , "type" .== messageType+ , "activity" .=? messageActivity -- , ("application", toJSON <$> messageApplication)- , ("application_id", toJSON <$> messageApplicationId)- , ("message_reference", toJSON <$> messageReference)- , ("flags", toJSON <$> messageFlags)- , ("referenced_message", toJSON <$> messageReferencedMessage)- , ("interaction", toJSON <$> messageInteraction)- , ("thread", toJSON <$> messageThread)- , ("components", toJSON <$> messageComponents)- , ("sticker_items", toJSON <$> messageStickerItems)- ] ]+ , "application_id" .=? messageApplicationId+ , "message_reference" .=? messageReference+ , "flags" .=? messageFlags+ , "referenced_message" .=? messageReferencedMessage+ , "interaction" .=? messageInteraction+ , "thread" .=? messageThread+ , "components" .=? messageComponents+ , "sticker_items" .=? messageStickerItems+ ] -- | Data constructor for a part of MessageDetailedOpts. data AllowedMentions = AllowedMentions@@ -604,7 +604,7 @@ -- | A reaction to a message data MessageReaction = MessageReaction- { messageReactionCount :: Int + { messageReactionCount :: Int , messageReactionMeIncluded :: Bool , messageReactionEmoji :: Emoji } deriving (Show, Read, Eq, Ord)@@ -616,11 +616,11 @@ <*> o .: "emoji" instance ToJSON MessageReaction where- toJSON MessageReaction{..} = object [(name, value) | (name, Just value) <-- [ ("count", toJSON <$> pure messageReactionCount)- , ("me", toJSON <$> pure messageReactionMeIncluded)- , ("emoji", toJSON <$> pure messageReactionEmoji)- ]]+ toJSON MessageReaction{..} = objectFromMaybes+ [ "count" .== messageReactionCount+ , "me" .== messageReactionMeIncluded+ , "emoji" .== messageReactionEmoji+ ] -- | Represents an attached to a message file. data Attachment = Attachment@@ -644,15 +644,15 @@ <*> o .:? "width" instance ToJSON Attachment where- toJSON Attachment {..} = object [(name, value) | (name, Just value) <-- [ ("id", toJSON <$> pure attachmentId)- , ("filename", toJSON <$> pure attachmentFilename)- , ("size", toJSON <$> pure attachmentSize)- , ("url", toJSON <$> pure attachmentUrl)- , ("proxy_url", toJSON <$> pure attachmentProxy)- , ("height", toJSON <$> attachmentHeight)- , ("width", toJSON <$> attachmentWidth)- ] ]+ toJSON Attachment {..} = objectFromMaybes+ [ "id" .== attachmentId+ , "filename" .== attachmentFilename+ , "size" .== attachmentSize+ , "url" .== attachmentUrl+ , "proxy_url" .== attachmentProxy+ , "height" .=? attachmentHeight+ , "width" .=? attachmentWidth+ ] newtype Nonce = Nonce T.Text deriving (Show, Read, Eq, Ord)@@ -682,12 +682,12 @@ <*> o .:? "fail_if_not_exists" .!= True instance ToJSON MessageReference where- toJSON MessageReference{..} = object [(name,value) | (name, Just value) <-- [ ("message_id", toJSON <$> pure referenceMessageId)- , ("channel_id", toJSON <$> pure referenceChannelId)- , ("guild_id", toJSON <$> pure referenceGuildId)- , ("fail_if_not_exists", toJSON <$> pure failIfNotExists)- ] ]+ toJSON MessageReference{..} = objectFromMaybes+ [ "message_id" .== referenceMessageId+ , "channel_id" .== referenceChannelId+ , "guild_id" .== referenceGuildId+ , "fail_if_not_exists" .== failIfNotExists+ ] instance Default MessageReference where def = MessageReference { referenceMessageId = Nothing@@ -767,10 +767,10 @@ <*> o .:? "party_id" instance ToJSON MessageActivity where- toJSON MessageActivity{..} = object [(name,value) | (name, Just value) <-- [ ("type", toJSON <$> pure messageActivityType)- , ("party_id", toJSON <$> messageActivityPartyId)- ] ]+ toJSON MessageActivity{..} = objectFromMaybes+ [ "type" .== messageActivityType+ , "party_id" .=? messageActivityPartyId+ ] data MessageActivityType = MessageActivityTypeJoin -- ^ Join a Rich Presence event@@ -842,12 +842,12 @@ } deriving (Show, Read, Eq, Ord) instance ToJSON MessageInteraction where- toJSON MessageInteraction{..} = object [(name,value) | (name, Just value) <-- [ ("id", toJSON <$> pure messageInteractionId)- , ("type", toJSON <$> pure messageInteractionType)- , ("name", toJSON <$> pure messageInteractionName)- , ("user", toJSON <$> pure messageInteractionUser)- ] ]+ toJSON MessageInteraction{..} = objectFromMaybes+ [ "id" .== messageInteractionId+ , "type" .== messageInteractionType+ , "name" .== messageInteractionName+ , "user" .== messageInteractionUser+ ] instance FromJSON MessageInteraction where
src/Discord/Internal/Types/Components.hs view
@@ -27,7 +27,7 @@ import Data.Scientific (Scientific) import qualified Data.Text as T import Discord.Internal.Types.Emoji (Emoji)-import Discord.Internal.Types.Prelude (toMaybeJSON)+import Discord.Internal.Types.Prelude (objectFromMaybes, (.==), (.=?)) -- | Container for other message Components data ActionRow = ActionRowButtons [Button] | ActionRowSelectMenu SelectMenu@@ -127,28 +127,22 @@ instance ToJSON Button where toJSON ButtonUrl {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("type", Just $ Number 2),- ("style", Just $ Number 5),- ("label", toJSON <$> buttonLabel),- ("disabled", toMaybeJSON buttonDisabled),- ("url", toMaybeJSON buttonUrl),- ("emoji", toJSON <$> buttonEmoji)- ]+ objectFromMaybes+ [ "type" .== Number 2,+ "style" .== Number 5,+ "label" .=? buttonLabel,+ "disabled" .== buttonDisabled,+ "url" .== buttonUrl,+ "emoji" .=? buttonEmoji ] toJSON Button {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("type", Just $ Number 2),- ("style", Just $ toJSON buttonStyle),- ("label", toJSON <$> buttonLabel),- ("disabled", toMaybeJSON buttonDisabled),- ("custom_id", toMaybeJSON buttonCustomId),- ("emoji", toJSON <$> buttonEmoji)- ]+ objectFromMaybes+ [ "type" .== Number 2,+ "style" .== buttonStyle,+ "label" .=? buttonLabel,+ "disabled" .== buttonDisabled,+ "custom_id" .== buttonCustomId,+ "emoji" .=? buttonEmoji ] -- | Buttton colors.@@ -226,17 +220,14 @@ instance ToJSON SelectMenu where toJSON SelectMenu {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("type", Just $ Number 3),- ("custom_id", toMaybeJSON selectMenuCustomId),- ("disabled", toMaybeJSON selectMenuDisabled),- ("options", toMaybeJSON selectMenuOptions),- ("placeholder", toJSON <$> selectMenuPlaceholder),- ("min_values", toJSON <$> selectMenuMinValues),- ("max_values", toJSON <$> selectMenuMaxValues)- ]+ objectFromMaybes+ [ "type" .== Number 3,+ "custom_id" .== selectMenuCustomId,+ "disabled" .== selectMenuDisabled,+ "options" .== selectMenuOptions,+ "placeholder" .=? selectMenuPlaceholder,+ "min_values" .=? selectMenuMinValues,+ "max_values" .=? selectMenuMaxValues ] -- | A single option in a select menu.@@ -268,15 +259,12 @@ instance ToJSON SelectOption where toJSON SelectOption {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("label", toMaybeJSON selectOptionLabel),- ("value", toMaybeJSON selectOptionValue),- ("description", toJSON <$> selectOptionDescription),- ("emoji", toJSON <$> selectOptionEmoji),- ("default", toJSON <$> selectOptionDefault)- ]+ objectFromMaybes+ [ "label" .== selectOptionLabel,+ "value" .== selectOptionValue,+ "description" .=? selectOptionDescription,+ "emoji" .=? selectOptionEmoji,+ "default" .=? selectOptionDefault ] data TextInput = TextInput@@ -301,19 +289,16 @@ instance ToJSON TextInput where toJSON TextInput {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("type", Just $ Number 4),- ("custom_id", toMaybeJSON textInputCustomId),- ("style", toMaybeJSON (1 + fromEnum textInputIsParagraph)),- ("label", toMaybeJSON textInputLabel),- ("min_length", toJSON <$> textInputMinLength),- ("max_length", toJSON <$> textInputMaxLength),- ("required", toMaybeJSON textInputRequired),- ("value", toMaybeJSON textInputValue),- ("placeholder", toMaybeJSON textInputPlaceholder)- ]+ objectFromMaybes+ [ "type" .== Number 4,+ "custom_id" .== textInputCustomId,+ "style" .== (1 + fromEnum textInputIsParagraph),+ "label" .== textInputLabel,+ "min_length" .=? textInputMinLength,+ "max_length" .=? textInputMaxLength,+ "required" .== textInputRequired,+ "value" .== textInputValue,+ "placeholder" .== textInputPlaceholder ] instance FromJSON TextInput where
src/Discord/Internal/Types/Emoji.hs view
@@ -43,17 +43,14 @@ instance ToJSON Emoji where toJSON Emoji {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("id", toJSON <$> emojiId),- ("name", toMaybeJSON emojiName),- ("roles", toJSON <$> emojiRoles),- ("user", toJSON <$> emojiUser),- ("managed", toJSON <$> emojiManaged),- ("animated", toJSON <$> emojiAnimated)+ objectFromMaybes+ [ "id" .=? emojiId,+ "name" .== emojiName,+ "roles" .=? emojiRoles,+ "user" .=? emojiUser,+ "managed" .=? emojiManaged,+ "animated" .=? emojiAnimated ]- ] -- | Represents a pack of standard stickers. data StickerPack = StickerPack
src/Discord/Internal/Types/Events.hs view
@@ -8,6 +8,7 @@ import Data.Time.ISO8601 (parseISO8601) import Data.Time (UTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Network.Socket (HostName) import Data.Aeson import Data.Aeson.Types@@ -24,7 +25,7 @@ -- | Represents possible events sent by discord. Detailed information can be found at <https://discord.com/developers/docs/topics/gateway>. data Event = -- | Contains the initial state information- Ready Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication+ Ready Int User [GuildUnavailable] T.Text HostName (Maybe Shard) PartialApplication -- | Response to a @Resume@ gateway command | Resumed [T.Text] -- | new guild channel created@@ -107,7 +108,7 @@ -- -- An application should never have to use those directly data EventInternalParse =- InternalReady Int User [Channel] [GuildUnavailable] T.Text (Maybe Shard) PartialApplication+ InternalReady Int User [GuildUnavailable] T.Text HostName (Maybe Shard) PartialApplication | InternalResumed [T.Text] | InternalChannelCreate Channel | InternalChannelUpdate Channel@@ -213,14 +214,25 @@ Left r -> fail r Right b -> pure b +-- | Remove the "wss://" and the trailing slash in a gateway URL, thereby returning+-- the hostname portion of the URL that we can connect to.+extractHostname :: String -> HostName+extractHostname ('w':'s':'s':':':'/':'/':rest) = extractHostname rest+extractHostname ('/':[]) = []+extractHostname (a:b) = a:(extractHostname b)+extractHostname [] = []+ -- | Parse an event from name and JSON data eventParse :: T.Text -> Object -> Parser EventInternalParse eventParse t o = case t of "READY" -> InternalReady <$> o .: "v" <*> o .: "user"- <*> o .: "private_channels" <*> o .: "guilds" <*> o .: "session_id"+ -- Discord can send us the resume gateway URL prefixed with "wss://",+ -- and suffixed with a trailing slash. This is not a valid HostName,+ -- so remove them both if they exist.+ <*> (extractHostname <$> o .: "resume_gateway_url") <*> o .: "shard" <*> o .: "application" "RESUMED" -> InternalResumed <$> o .: "_trace"
src/Discord/Internal/Types/Interactions.hs view
@@ -40,7 +40,7 @@ import Discord.Internal.Types.Channel (AllowedMentions, Attachment, Message) import Discord.Internal.Types.Components (ActionRow, TextInput) import Discord.Internal.Types.Embed (CreateEmbed, createEmbed)-import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, ChannelId, GuildId, InteractionId, InteractionToken, MessageId, RoleId, Snowflake, UserId)+import Discord.Internal.Types.Prelude (ApplicationCommandId, ApplicationId, ChannelId, GuildId, InteractionId, InteractionToken, MessageId, RoleId, Snowflake, UserId, objectFromMaybes, (.=?)) import Discord.Internal.Types.User (GuildMember, User) -- | An interaction received from discord.@@ -64,6 +64,8 @@ interactionVersion :: Int, -- | What message is associated with this interaction. interactionMessage :: Message,+ -- | What permissions does the app or bot have within the sent channel.+ interactionPermissions :: Maybe T.Text, -- | The invoking user's preferred locale. interactionLocale :: T.Text, -- | The invoking guild's preferred locale.@@ -77,7 +79,9 @@ -- | The unique token that represents this interaction. interactionToken :: InteractionToken, -- | What version of interaction is this (always 1).- interactionVersion :: Int+ interactionVersion :: Int,+ -- | What permissions does the app or bot have within the sent channel.+ interactionPermissions :: Maybe T.Text } | InteractionApplicationCommand { -- | The id of this interaction.@@ -96,6 +100,8 @@ interactionToken :: InteractionToken, -- | What version of interaction is this (always 1). interactionVersion :: Int,+ -- | What permissions does the app or bot have within the sent channel.+ interactionPermissions :: Maybe T.Text, -- | The invoking user's preferred locale. interactionLocale :: T.Text, -- | The invoking guild's preferred locale.@@ -118,6 +124,8 @@ interactionToken :: InteractionToken, -- | What version of interaction is this (always 1). interactionVersion :: Int,+ -- | What permissions does the app or bot have within the sent channel.+ interactionPermissions :: Maybe T.Text, -- | The invoking user's preferred locale. interactionLocale :: T.Text, -- | The invoking guild's preferred locale.@@ -140,6 +148,8 @@ interactionToken :: InteractionToken, -- | What version of interaction is this (always 1). interactionVersion :: Int,+ -- | What permissions does the app or bot have within the sent channel.+ interactionPermissions :: Maybe T.Text, -- | The invoking user's preferred locale. interactionLocale :: T.Text, -- | The invoking guild's preferred locale.@@ -159,9 +169,10 @@ tok <- v .: "token" version <- v .: "version" glocale <- v .:? "guild_locale"+ permissions <- v .:? "app_permissions" t <- v .: "type" :: Parser Int case t of- 1 -> return $ InteractionPing iid aid tok version+ 1 -> return $ InteractionPing iid aid tok version permissions 2 -> InteractionApplicationCommand iid aid <$> v .: "data"@@ -170,6 +181,7 @@ <*> parseJSON (Object v) <*> return tok <*> return version+ <*> return permissions <*> v .: "locale" <*> return glocale 3 ->@@ -181,6 +193,7 @@ <*> return tok <*> return version <*> v .: "message"+ <*> return permissions <*> v .: "locale" <*> return glocale 4 ->@@ -191,6 +204,7 @@ <*> parseJSON (Object v) <*> return tok <*> return version+ <*> return permissions <*> v .: "locale" <*> return glocale 5 ->@@ -201,6 +215,7 @@ <*> parseJSON (Object v) <*> return tok <*> return version+ <*> return permissions <*> v .: "locale" <*> return glocale _ -> fail "unknown interaction type"@@ -213,7 +228,7 @@ parseJSON = withObject "MemberOrUser"- ( \v -> MemberOrUser <$> ((Left <$> v .: "member") <|> (Right <$> v .: "user"))+ ( \v -> MemberOrUser <$> (Left <$> v .: "member" <|> Right <$> v .: "user") ) data ComponentData@@ -495,16 +510,13 @@ instance ToJSON ResolvedData where toJSON ResolvedData {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("users", resolvedDataUsers),- ("members", resolvedDataMembers),- ("roles", resolvedDataRoles),- ("channels", resolvedDataChannels),- ("messages", resolvedDataMessages),- ("attachments", resolvedDataAttachments)- ]+ objectFromMaybes+ [ "users" .=? resolvedDataUsers,+ "members" .=? resolvedDataMembers,+ "roles" .=? resolvedDataRoles,+ "channels" .=? resolvedDataChannels,+ "messages" .=? resolvedDataMessages,+ "attachments" .=? resolvedDataAttachments ] instance FromJSON ResolvedData where@@ -584,17 +596,14 @@ instance ToJSON InteractionResponseMessage where toJSON InteractionResponseMessage {..} =- object- [ (name, value)- | (name, Just value) <-- [ ("tts", toJSON <$> interactionResponseMessageTTS),- ("content", toJSON <$> interactionResponseMessageContent),- ("embeds", toJSON . (createEmbed <$>) <$> interactionResponseMessageEmbeds),- ("allowed_mentions", toJSON <$> interactionResponseMessageAllowedMentions),- ("flags", toJSON <$> interactionResponseMessageFlags),- ("components", toJSON <$> interactionResponseMessageComponents),- ("attachments", toJSON <$> interactionResponseMessageAttachments)- ]+ objectFromMaybes+ [ "tts" .=? interactionResponseMessageTTS,+ "content" .=? interactionResponseMessageContent,+ "embeds" .=? ((createEmbed <$>) <$> interactionResponseMessageEmbeds),+ "allowed_mentions" .=? interactionResponseMessageAllowedMentions,+ "flags" .=? interactionResponseMessageFlags,+ "components" .=? interactionResponseMessageComponents,+ "attachments" .=? interactionResponseMessageAttachments ] -- | Types of flags to attach to the interaction message.
src/Discord/Internal/Types/Prelude.hs view
@@ -3,24 +3,74 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-} -- | Provides base types and utility functions needed for modules in Discord.Internal.Types-module Discord.Internal.Types.Prelude where+module Discord.Internal.Types.Prelude+ ( Auth (..)+ , authToken -import Data.Bits-import Data.Word+ , Snowflake (..)+ , snowflakeCreationDate+ + , DiscordId (..)+ , ChannelId+ , StageId+ , GuildId+ , MessageId+ , AttachmentId+ , EmojiId+ , StickerId+ , UserId+ , RoleId+ , IntegrationId+ , WebhookId+ , ParentId+ , ApplicationId+ , ApplicationCommandId+ , InteractionId+ , ScheduledEventId+ , ScheduledEventEntityId + , DiscordToken (..)+ , InteractionToken+ , WebhookToken++ , Shard+ , epochTime++ , InternalDiscordEnum (..)++ , Base64Image (..)+ , getMimeType++ , (.==)+ , (.=?)+ , AesonKey+ , objectFromMaybes+ )++ where++import Data.Bifunctor (first)+import Data.Bits (Bits(shiftR))+import Data.Data (Data (dataTypeOf), dataTypeConstrs, fromConstr)+import Data.Word (Word64)+import Data.Maybe (catMaybes)+import Text.Read (readMaybe)+ import Data.Aeson.Types-import qualified Data.ByteString as B import Data.Time.Clock-import qualified Data.Text as T import Data.Time.Clock.POSIX import Web.Internal.HttpApiData -import Data.Bifunctor (first)-import Text.Read (readMaybe)-import Data.Data (Data (dataTypeOf), dataTypeConstrs, fromConstr)+import qualified Data.ByteString as B+import qualified Data.Text as T +#if MIN_VERSION_aeson(2, 0, 0)+import qualified Data.Aeson.Key as Key+#endif+ -- | Authorization token for the Discord API newtype Auth = Auth T.Text deriving (Show, Read, Eq, Ord)@@ -197,8 +247,27 @@ | fromIntegral (round i) == i = Just $ round i | otherwise = Nothing -toMaybeJSON :: (ToJSON a) => a -> Maybe Value-toMaybeJSON = return . toJSON+-- Aeson 2.0 uses KeyMaps with a defined Key type for its objects. Aeson up to+-- 1.5 uses HashMaps with Text for the key. Both types have an IsString instance.+-- To keep our version bounds as loose as possible while the Haskell ecosystem+-- (and thus our users) switch over to Aeson 2.0, we use some CPP to define a+-- AesonKey as an alias.+#if MIN_VERSION_aeson(2, 0, 0)+type AesonKey = Key.Key+#else+type AesonKey = T.Text+#endif+++(.==) :: ToJSON a => AesonKey -> a -> Maybe Pair+k .== v = Just (k .= v)++(.=?) :: ToJSON a => AesonKey -> Maybe a -> Maybe Pair+k .=? (Just v) = Just (k .= v)+_ .=? Nothing = Nothing++objectFromMaybes :: [Maybe Pair] -> Value+objectFromMaybes = object . catMaybes -- | @Base64Image mime data@ represents the base64 encoding of an image (as
src/Discord/Internal/Types/ScheduledEvents.hs view
@@ -33,7 +33,9 @@ , ScheduledEventEntityId , ScheduledEventId , UserId- , toMaybeJSON+ , (.==)+ , (.=?)+ , objectFromMaybes ) import Discord.Internal.Types.User ( GuildMember , User@@ -93,65 +95,55 @@ } instance ToJSON ScheduledEvent where- toJSON ScheduledEventStage {..} = object- [ (name, value)- | (name, Just value) <-- [ ("id" , toMaybeJSON scheduledEventStageId)- , ("guild_id" , toMaybeJSON scheduledEventStageGuildId)- , ("channel_id" , toMaybeJSON scheduledEventStageChannelId)- , ("creator_id" , toJSON <$> scheduledEventStageCreatorId)- , ("name" , toMaybeJSON scheduledEventStageName)- , ("description" , toJSON <$> scheduledEventStageDescription)- , ("scheduled_start_time", toMaybeJSON scheduledEventStageStartTime)- , ("scheduled_end_time" , toJSON <$> scheduledEventStageEndTime)- , ("privacy_level" , toMaybeJSON scheduledEventStagePrivacyLevel)- , ("entity_type" , Just $ Number 1)- , ("entity_id" , toJSON <$> scheduledEventStageEntityId)- , ("creator" , toJSON <$> scheduledEventStageCreator)- , ("user_count" , toJSON <$> scheduledEventStageUserCount)- , ("image" , toJSON <$> scheduledEventStageImage)+ toJSON ScheduledEventStage {..} = objectFromMaybes+ [ "id" .== scheduledEventStageId+ , "guild_id" .== scheduledEventStageGuildId+ , "channel_id" .== scheduledEventStageChannelId+ , "creator_id" .=? scheduledEventStageCreatorId+ , "name" .== scheduledEventStageName+ , "description" .=? scheduledEventStageDescription+ , "scheduled_start_time" .== scheduledEventStageStartTime+ , "scheduled_end_time" .=? scheduledEventStageEndTime+ , "privacy_level" .== scheduledEventStagePrivacyLevel+ , "entity_type" .== Number 1+ , "entity_id" .=? scheduledEventStageEntityId+ , "creator" .=? scheduledEventStageCreator+ , "user_count" .=? scheduledEventStageUserCount+ , "image" .=? scheduledEventStageImage ]- ]- toJSON ScheduledEventVoice {..} = object- [ (name, value)- | (name, Just value) <-- [ ("id" , toMaybeJSON scheduledEventVoiceId)- , ("guild_id" , toMaybeJSON scheduledEventVoiceGuildId)- , ("channel_id" , toMaybeJSON scheduledEventVoiceChannelId)- , ("creator_id" , toJSON <$> scheduledEventVoiceCreatorId)- , ("name" , toMaybeJSON scheduledEventVoiceName)- , ("description" , toJSON <$> scheduledEventVoiceDescription)- , ("scheduled_start_time", toMaybeJSON scheduledEventVoiceStartTime)- , ("scheduled_end_time" , toJSON <$> scheduledEventVoiceEndTime)- , ("privacy_level" , toMaybeJSON scheduledEventVoicePrivacyLevel)- , ("entity_type" , Just $ Number 2)- , ("entity_id" , toJSON <$> scheduledEventVoiceEntityId)- , ("creator" , toJSON <$> scheduledEventVoiceCreator)- , ("user_count" , toJSON <$> scheduledEventVoiceUserCount)- , ("image" , toJSON <$> scheduledEventVoiceImage)+ toJSON ScheduledEventVoice {..} = objectFromMaybes+ [ "id" .== scheduledEventVoiceId+ , "guild_id" .== scheduledEventVoiceGuildId+ , "channel_id" .== scheduledEventVoiceChannelId+ , "creator_id" .=? scheduledEventVoiceCreatorId+ , "name" .== scheduledEventVoiceName+ , "description" .=? scheduledEventVoiceDescription+ , "scheduled_start_time" .== scheduledEventVoiceStartTime+ , "scheduled_end_time" .=? scheduledEventVoiceEndTime+ , "privacy_level" .== scheduledEventVoicePrivacyLevel+ , "entity_type" .== Number 2+ , "entity_id" .=? scheduledEventVoiceEntityId+ , "creator" .=? scheduledEventVoiceCreator+ , "user_count" .=? scheduledEventVoiceUserCount+ , "image" .=? scheduledEventVoiceImage ]- ]- toJSON ScheduledEventExternal {..} = object- [ (name, value)- | (name, Just value) <-- [ ("id" , toMaybeJSON scheduledEventExternalId)- , ("guild_id" , toMaybeJSON scheduledEventExternalGuildId)- , ("creator_id" , toJSON <$> scheduledEventExternalCreatorId)- , ("name" , toMaybeJSON scheduledEventExternalName)- , ("description" , toJSON <$> scheduledEventExternalDescription)- , ("scheduled_start_time", toMaybeJSON scheduledEventExternalStartTime)- , ("scheduled_end_time" , toMaybeJSON scheduledEventExternalEndTime)- , ("privacy_level", toMaybeJSON scheduledEventExternalPrivacyLevel)- , ("entity_type" , Just $ Number 3)- , ("entity_id" , toJSON <$> scheduledEventExternalEntityId)- , ("creator" , toJSON <$> scheduledEventExternalCreator)- , ("user_count" , toJSON <$> scheduledEventExternalUserCount)- , ("image" , toJSON <$> scheduledEventExternalImage)- , ( "entity_metadata"- , Just $ object ["location" .= toJSON scheduledEventExternalLocation]- )+ toJSON ScheduledEventExternal {..} = objectFromMaybes+ [ "id" .== scheduledEventExternalId+ , "guild_id" .== scheduledEventExternalGuildId+ , "creator_id" .=? scheduledEventExternalCreatorId+ , "name" .== scheduledEventExternalName+ , "description" .=? scheduledEventExternalDescription+ , "scheduled_start_time" .== scheduledEventExternalStartTime+ , "scheduled_end_time" .== scheduledEventExternalEndTime+ , "privacy_level" .== scheduledEventExternalPrivacyLevel+ , "entity_type" .== Number 3+ , "entity_id" .=? scheduledEventExternalEntityId+ , "creator" .=? scheduledEventExternalCreator+ , "user_count" .=? scheduledEventExternalUserCount+ , "image" .=? scheduledEventExternalImage+ , "entity_metadata"+ .== object ["location" .= toJSON scheduledEventExternalLocation] ]- ] instance FromJSON ScheduledEvent where@@ -327,57 +319,37 @@ } instance ToJSON CreateScheduledEventData where- toJSON CreateScheduledEventDataStage {..} = object- [ (name, value)- | (name, Just value) <-- [ ("channel_id" , toMaybeJSON createScheduleEventDataStageChannelId)- , ("name" , toMaybeJSON createScheduleEventDataStageName)- , ("privacy_level", toMaybeJSON createScheduleEventDataStagePrivacyLevel)- , ( "scheduled_start_time"- , toMaybeJSON createScheduleEventDataStageStartTime- )- , ("scheduled_end_time", toJSON <$> createScheduleEventDataStageEndTime)- , ("description", toJSON <$> createScheduleEventDataStageDescription)- , ("entity_type" , Just $ Number 1)- , ("image" , toJSON <$> createScheduleEventDataStageImage)+ toJSON CreateScheduledEventDataStage {..} = objectFromMaybes+ [ "channel_id" .== createScheduleEventDataStageChannelId+ , "name" .== createScheduleEventDataStageName+ , "privacy_level" .== createScheduleEventDataStagePrivacyLevel+ , "scheduled_start_time" .== createScheduleEventDataStageStartTime+ , "scheduled_end_time" .=? createScheduleEventDataStageEndTime+ , "description" .=? createScheduleEventDataStageDescription+ , "entity_type" .== Number 1+ , "image" .=? createScheduleEventDataStageImage ]- ]- toJSON CreateScheduledEventDataVoice {..} = object- [ (name, value)- | (name, Just value) <-- [ ("channel_id" , toMaybeJSON createScheduleEventDataVoiceChannelId)- , ("name" , toMaybeJSON createScheduleEventDataVoiceName)- , ("privacy_level", toMaybeJSON createScheduleEventDataVoicePrivacyLevel)- , ( "scheduled_start_time"- , toMaybeJSON createScheduleEventDataVoiceStartTime- )- , ("scheduled_end_time", toJSON <$> createScheduleEventDataVoiceEndTime)- , ("description", toJSON <$> createScheduleEventDataVoiceDescription)- , ("entity_type" , Just $ Number 2)- , ("image" , toJSON <$> createScheduleEventDataVoiceImage)+ toJSON CreateScheduledEventDataVoice {..} = objectFromMaybes+ [ "channel_id" .== createScheduleEventDataVoiceChannelId+ , "name" .== createScheduleEventDataVoiceName+ , "privacy_level" .== createScheduleEventDataVoicePrivacyLevel+ , "scheduled_start_time" .== createScheduleEventDataVoiceStartTime+ , "scheduled_end_time" .=? createScheduleEventDataVoiceEndTime+ , "description" .=? createScheduleEventDataVoiceDescription+ , "entity_type" .== Number 2+ , "image" .=? createScheduleEventDataVoiceImage ]- ]- toJSON CreateScheduledEventDataExternal {..} = object- [ (name, value)- | (name, Just value) <-- [ ( "entity_metadata"- , Just $ object ["location" .= createScheduleEventDataExternalLocation]- )- , ("name", toMaybeJSON createScheduleEventDataExternalName)- , ( "privacy_level"- , toMaybeJSON createScheduleEventDataExternalPrivacyLevel- )- , ( "scheduled_start_time"- , toMaybeJSON createScheduleEventDataExternalStartTime- )- , ( "scheduled_end_time"- , toMaybeJSON createScheduleEventDataExternalEndTime- )- , ("description", toJSON <$> createScheduleEventDataExternalDescription)- , ("entity_type", Just $ Number 2)- , ("image", toJSON <$> createScheduleEventDataExternalImage)+ toJSON CreateScheduledEventDataExternal {..} = objectFromMaybes+ [ "entity_metadata"+ .== object ["location" .= createScheduleEventDataExternalLocation]+ , "name" .== createScheduleEventDataExternalName+ , "privacy_level" .== createScheduleEventDataExternalPrivacyLevel+ , "scheduled_start_time" .== createScheduleEventDataExternalStartTime+ , "scheduled_end_time" .== createScheduleEventDataExternalEndTime+ , "description" .=? createScheduleEventDataExternalDescription+ , "entity_type" .== Number 2+ , "image" .=? createScheduleEventDataExternalImage ]- ] instance FromJSON CreateScheduledEventData where parseJSON = withObject@@ -474,20 +446,17 @@ Nothing instance ToJSON ModifyScheduledEventData where- toJSON ModifyScheduledEventData {..} = object- [ (name, value)- | (name, Just value) <-- [ ("channel_id", toJSON <$> modifyScheduledEventDataChannelId)- , ("entity_metadata" , loc)- , ("name", toJSON <$> modifyScheduledEventDataName)- , ("scheduled_start_time", toJSON <$> modifyScheduledEventDataStartTime)- , ("scheduled_end_time", toJSON <$> modifyScheduledEventDataEndTime)- , ("description", toJSON <$> modifyScheduledEventDataDescription)- , ("entity_type", toJSON <$> modifyScheduledEventDataType)- , ("status", toJSON <$> modifyScheduledEventDataStatus)- , ("image", toJSON <$> modifyScheduledEventDataImage)+ toJSON ModifyScheduledEventData {..} = objectFromMaybes+ [ "channel_id" .=? modifyScheduledEventDataChannelId+ , "entity_metadata" .=? loc+ , "name" .=? modifyScheduledEventDataName+ , "scheduled_start_time" .=? modifyScheduledEventDataStartTime+ , "scheduled_end_time" .=? modifyScheduledEventDataEndTime+ , "description" .=? modifyScheduledEventDataDescription+ , "entity_type" .=? modifyScheduledEventDataType+ , "status" .=? modifyScheduledEventDataStatus+ , "image" .=? modifyScheduledEventDataImage ]- ] where loc = case modifyScheduledEventDataLocation of Nothing -> Nothing
src/Discord/Internal/Types/User.hs view
@@ -52,23 +52,23 @@ <*> o .:? "member" instance ToJSON User where- toJSON User{..} = object [(name,value) | (name, Just value) <-- [ ("id", toJSON <$> pure userId)- , ("username", toJSON <$> pure userName)- , ("discriminator", toJSON <$> userDiscrim)- , ("avatar", toJSON <$> userAvatar)- , ("bot", toJSON <$> pure userIsBot)- , ("system", toJSON <$> userIsSystem)- , ("mfa_enabled", toJSON <$> userMfa)- , ("banner", toJSON <$> userBanner)- , ("accent_color", toJSON <$> userAccentColor)- , ("verified", toJSON <$> userVerified)- , ("email", toJSON <$> userEmail)- , ("flags", toJSON <$> userFlags)- , ("premium_type", toJSON <$> userPremiumType)- , ("public_flags", toJSON <$> userPublicFlags)- , ("member", toJSON <$> userPublicFlags)- ] ]+ toJSON User{..} = objectFromMaybes+ [ "id" .== userId+ , "username" .== userName+ , "discriminator" .=? userDiscrim+ , "avatar" .=? userAvatar+ , "bot" .== userIsBot+ , "system" .=? userIsSystem+ , "mfa_enabled" .=? userMfa+ , "banner" .=? userBanner+ , "accent_color" .=? userAccentColor+ , "verified" .=? userVerified+ , "email" .=? userEmail+ , "flags" .=? userFlags+ , "premium_type" .=? userPremiumType+ , "public_flags" .=? userPublicFlags+ , "member" .=? userPublicFlags+ ] -- TODO: fully update webhook structure data Webhook = Webhook@@ -140,16 +140,16 @@ <*> o .:? "communication_disabled_until" instance ToJSON GuildMember where- toJSON GuildMember {..} = object [(name, value) | (name, Just value) <-- [ ("user", toJSON <$> memberUser)- , ("nick", toJSON <$> memberNick)- , ("avatar", toJSON <$> memberAvatar)- , ("roles", toJSON <$> pure memberRoles)- , ("joined_at", toJSON <$> pure memberJoinedAt)- , ("premium_since", toJSON <$> memberPremiumSince)- , ("deaf", toJSON <$> pure memberDeaf)- , ("mute", toJSON <$> pure memberMute)- , ("pending", toJSON <$> pure memberPending)- , ("permissions", toJSON <$> memberPermissions)- , ("communication_disabled_until", toJSON <$> memberTimeoutEnd)- ] ]+ toJSON GuildMember {..} = objectFromMaybes+ [ "user" .=? memberUser+ , "nick" .=? memberNick+ , "avatar" .=? memberAvatar+ , "roles" .== memberRoles+ , "joined_at" .== memberJoinedAt+ , "premium_since" .=? memberPremiumSince+ , "deaf" .== memberDeaf+ , "mute" .== memberMute+ , "pending" .== memberPending+ , "permissions" .=? memberPermissions+ , "communication_disabled_until" .=? memberTimeoutEnd+ ]