diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,10 +1,18 @@ -# discord-haskell [![Build Status](https://app.travis-ci.com/aquarial/discord-haskell.svg?branch=master)](https://app.travis-ci.com/github/aquarial/discord-haskell) [![Hackage version](http://img.shields.io/hackage/v/discord-haskell.svg?label=Hackage)](https://hackage.haskell.org/package/discord-haskell) +# discord-haskell [![Build Status](https://app.travis-ci.com/aquarial/discord-haskell.svg?branch=master)](https://app.travis-ci.com/github/aquarial/discord-haskell) [![Hackage version](http://img.shields.io/hackage/v/discord-haskell.svg?label=Hackage)](https://hackage.haskell.org/package/discord-haskell) [![Discord server](https://discord.com/api/guilds/918577626954739722/widget.png?style=shield)](https://discord.gg/eaRAGgX3bK) -Build that discord bot in Haskell! Also checkout the [calamity](https://github.com/nitros12/calamity) -haskell discord library for a more advanced interface than `discord-haskell`. +Build that discord bot in Haskell! Also checkout the [calamity haskell library](https://github.com/nitros12/calamity) +for a more advanced interface than `discord-haskell`. -This is an example bot that replies "pong" to messages that start with "ping". +### Discord Server +Created a discord server: https://discord.gg/eaRAGgX3bK + +Ask questions, get updates, request features, etc + +### Quickstart + +This is an example bot that replies "pong" to messages that start with "ping". Also checkout the [other examples](./examples/) + ```haskell {-# LANGUAGE OverloadedStrings #-} -- allows "string literals" to be Text @@ -55,10 +63,11 @@ ### Biggest TODOs -- [ ] APIv9 -- [x] rewrite eventloop [issue 70](https://github.com/aquarial/discord-haskell/issues/70) +- [ ] Add slash commands [issue](https://github.com/aquarial/discord-haskell/issues/59) +- [ ] APIv9 [issue](https://github.com/aquarial/discord-haskell/issues/72) - [ ] Event type includes roles and other cached info - [ ] higher level bot interface? easier to add state and stuff +- [x] rewrite eventloop [issue](https://github.com/aquarial/discord-haskell/issues/70) ### Installing @@ -149,7 +158,7 @@ #### Official discord docs -For a list of rest requests, gateway events, and gateway sendables go to the +For a list of rest requests, gateway events, and gateway sendables go ggto the [official discord documentation](https://discord.com/developers/docs/intro) The rest requests line up very closely. The documentation lists @@ -164,7 +173,3 @@ #### Open an Issue For deeper questions about how the library functions, feel free to open an issue. - -#### Discord server - -Coming sometime! diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -6,7 +6,16 @@ ## master + +## 1.10.0 + [drewolson](https://github.com/aquarial/discord-haskell/pull/80) allows parsing an optional guild region + +[L0neGamer](https://github.com/aquarial/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. + +Added `Read` instance to complement `Show` for lots of types. Removed ToJSON for `Channel`. ## 1.9.1 diff --git a/discord-haskell.cabal b/discord-haskell.cabal --- a/discord-haskell.cabal +++ b/discord-haskell.cabal @@ -1,7 +1,7 @@ cabal-version: 2.0 name: discord-haskell -- library version is also noted at src/Discord/Rest/Prelude.hs -version: 1.9.2 +version: 1.10.0 description: Functions and data types to write discord bots. Official discord docs . . diff --git a/src/Discord.hs b/src/Discord.hs --- a/src/Discord.hs +++ b/src/Discord.hs @@ -106,9 +106,10 @@ case next of Left err -> libError err Right (Right event) -> do + let userEvent = userFacingEvent event let action = if discordForkThreadForEvents opts then void . forkIO else id - action $ do me <- liftIO . runReaderT (try $ discordOnEvent opts event) $ handle + action $ do me <- liftIO . runReaderT (try $ discordOnEvent opts userEvent) $ handle case me of Left (e :: SomeException) -> writeChan (discordHandleLog handle) ("discord-haskell stopped on an exception:\n\n" <> T.pack (show e)) @@ -118,7 +119,7 @@ data RestCallErrorCode = RestCallErrorCode Int T.Text T.Text - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) -- | Execute one http request and get a response restCall :: (FromJSON a, Request (r a)) => r a -> DiscordHandler (Either RestCallErrorCode a) diff --git a/src/Discord/Internal/Gateway.hs b/src/Discord/Internal/Gateway.hs --- a/src/Discord/Internal/Gateway.hs +++ b/src/Discord/Internal/Gateway.hs @@ -18,20 +18,20 @@ import Data.IORef (newIORef) import qualified Data.Text as T -import Discord.Internal.Types (Auth, Event, GatewayIntent) +import Discord.Internal.Types (Auth, EventInternalParse, GatewayIntent) import Discord.Internal.Gateway.EventLoop (connectionLoop, GatewayHandle(..), GatewayException(..)) import Discord.Internal.Gateway.Cache (cacheLoop, Cache(..), CacheHandle(..)) startCacheThread :: Chan T.Text -> IO (CacheHandle, ThreadId) startCacheThread log = do - events <- newChan :: IO (Chan (Either GatewayException Event)) + events <- newChan :: IO (Chan (Either GatewayException EventInternalParse)) cache <- newEmptyMVar :: IO (MVar (Either (Cache, GatewayException) Cache)) let cacheHandle = CacheHandle events cache tid <- forkIO $ cacheLoop cacheHandle log pure (cacheHandle, tid) -- | Create a Chan for websockets. This creates a thread that --- writes all the received Events to the Chan +-- writes all the received EventsInternalParse to the Chan startGatewayThread :: Auth -> GatewayIntent -> CacheHandle -> Chan T.Text -> IO (GatewayHandle, ThreadId) startGatewayThread auth intent cacheHandle log = do events <- dupChan (cacheHandleEvents cacheHandle) diff --git a/src/Discord/Internal/Gateway/Cache.hs b/src/Discord/Internal/Gateway/Cache.hs --- a/src/Discord/Internal/Gateway/Cache.hs +++ b/src/Discord/Internal/Gateway/Cache.hs @@ -21,7 +21,7 @@ } deriving (Show) data CacheHandle = CacheHandle - { cacheHandleEvents :: Chan (Either GatewayException Event) + { cacheHandleEvents :: Chan (Either GatewayException EventInternalParse) , cacheHandleCache :: MVar (Either (Cache, GatewayException) Cache) } @@ -29,7 +29,7 @@ cacheLoop cacheHandle log = do ready <- readChan eventChan case ready of - Right (Ready _ user dmChannels _unavailableGuilds _) -> do + Right (InternalReady _ user dmChannels _unavailableGuilds _) -> do let dmChans = M.fromList (zip (map channelId dmChannels) dmChannels) putMVar cache (Right (Cache user dmChans M.empty M.empty)) loop @@ -51,23 +51,23 @@ Left e -> putMVar cache (Left (info, e)) Right event -> putMVar cache (Right (adjustCache info event)) -adjustCache :: Cache -> Event -> Cache +adjustCache :: Cache -> EventInternalParse -> Cache adjustCache minfo event = case event of - --ChannelCreate Channel - --ChannelUpdate Channel - --ChannelDelete Channel - GuildCreate guild info -> + --InternalChannelCreate Channel + --InternalChannelUpdate Channel + --InternalChannelDelete Channel + InternalGuildCreate guild info -> let newChans = map (setChanGuildID (guildId guild)) $ guildChannels info g = M.insert (guildId guild) (guild, info { guildChannels = newChans }) (cacheGuilds minfo) c = M.unionWith (\a _ -> a) (M.fromList [ (channelId ch, ch) | ch <- newChans ]) (cacheChannels minfo) in minfo { cacheGuilds = g, cacheChannels = c } - --GuildUpdate guild -> do + --InternalGuildUpdate guild -> do -- let g = M.insert (guildId guild) guild (cacheGuilds minfo) -- m2 = minfo { cacheGuilds = g } -- putMVar cache m2 - --GuildDelete guild -> do + --InternalGuildDelete guild -> do -- let g = M.delete (guildId guild) (cacheGuilds minfo) -- c = M.filterWithKey (\(keyGuildId,_) _ -> keyGuildId /= guildId guild) (cacheChannels minfo) -- m2 = minfo { cacheGuilds = g, cacheChannels = c } diff --git a/src/Discord/Internal/Gateway/EventLoop.hs b/src/Discord/Internal/Gateway/EventLoop.hs --- a/src/Discord/Internal/Gateway/EventLoop.hs +++ b/src/Discord/Internal/Gateway/EventLoop.hs @@ -27,7 +27,7 @@ data GatewayHandle = GatewayHandle - { gatewayHandleEvents :: Chan (Either GatewayException Event) + { gatewayHandleEvents :: Chan (Either GatewayException EventInternalParse) , gatewayHandleUserSendables :: Chan GatewaySendable , gatewayHandleLastStatus :: IORef (Maybe UpdateStatusOpts) , gatewayHandleLastSequenceId :: IORef Integer @@ -141,7 +141,7 @@ Right (Dispatch event sq) -> do writeIORef (gatewayHandleLastSequenceId thehandle) sq writeChan eventChan (Right event) case event of - (Ready _ _ _ _ seshID) -> + (InternalReady _ _ _ _ seshID) -> writeIORef (gatewayHandleSessionId thehandle) seshID _ -> writeIORef (startsendingUsers sendablesData) True loop diff --git a/src/Discord/Internal/Rest/Channel.hs b/src/Discord/Internal/Rest/Channel.hs --- a/src/Discord/Internal/Rest/Channel.hs +++ b/src/Discord/Internal/Rest/Channel.hs @@ -106,7 +106,7 @@ , messageDetailedFile :: Maybe (T.Text, B.ByteString) , messageDetailedAllowedMentions :: Maybe AllowedMentions , messageDetailedReference :: Maybe MessageReference - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance Default MessageDetailedOpts where def = MessageDetailedOpts { messageDetailedContent = "" @@ -125,7 +125,7 @@ , mentionUserIds :: [UserId] , mentionRoleIds :: [RoleId] , mentionRepliedUser :: Bool - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance Default AllowedMentions where def = AllowedMentions { mentionEveryone = False @@ -152,7 +152,7 @@ data ReactionTiming = BeforeReaction MessageId | AfterReaction MessageId | LatestReaction - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) reactionTimingToQuery :: ReactionTiming -> R.Option 'R.Https reactionTimingToQuery t = case t of @@ -165,7 +165,7 @@ | BeforeMessage MessageId | AfterMessage MessageId | LatestMessages - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) messageTimingToQuery :: MessageTiming -> R.Option 'R.Https messageTimingToQuery t = case t of @@ -179,7 +179,7 @@ , channelInviteOptsMaxUsages :: Maybe Integer , channelInviteOptsIsTemporary :: Maybe Bool , channelInviteOptsDontReuseSimilarInvite :: Maybe Bool - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON ChannelInviteOpts where toJSON ChannelInviteOpts{..} = object [(name, val) | (name, Just val) <- @@ -197,7 +197,7 @@ , modifyChannelUserRateLimit :: Maybe Integer , modifyChannelPermissionOverwrites :: Maybe [Overwrite] , modifyChannelParentId :: Maybe ChannelId - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON ModifyChannelOpts where toJSON ModifyChannelOpts{..} = object [(name, val) | (name, Just val) <- @@ -214,11 +214,11 @@ { channelPermissionsOptsAllow :: Integer , channelPermissionsOptsDeny :: Integer , channelPermissionsOptsType :: ChannelPermissionsOptsType - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) data ChannelPermissionsOptsType = ChannelPermissionsOptsUser | ChannelPermissionsOptsRole - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) instance ToJSON ChannelPermissionsOptsType where toJSON t = case t of ChannelPermissionsOptsUser -> String "member" @@ -234,7 +234,7 @@ { groupDMAddRecipientUserToAdd :: UserId , groupDMAddRecipientUserToAddNickName :: T.Text , groupDMAddRecipientGDMJoinAccessToken :: T.Text - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) channelMajorRoute :: ChannelRequest a -> String channelMajorRoute c = case c of diff --git a/src/Discord/Internal/Rest/Emoji.hs b/src/Discord/Internal/Rest/Emoji.hs --- a/src/Discord/Internal/Rest/Emoji.hs +++ b/src/Discord/Internal/Rest/Emoji.hs @@ -45,7 +45,7 @@ data ModifyGuildEmojiOpts = ModifyGuildEmojiOpts { modifyGuildEmojiName :: T.Text , modifyGuildEmojiRoles :: [RoleId] - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON ModifyGuildEmojiOpts where toJSON (ModifyGuildEmojiOpts name roles) = @@ -53,7 +53,7 @@ data EmojiImageParsed = EmojiImageParsed T.Text - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) parseEmojiImage :: B.ByteString -> Either T.Text EmojiImageParsed parseEmojiImage bs = diff --git a/src/Discord/Internal/Rest/Guild.hs b/src/Discord/Internal/Rest/Guild.hs --- a/src/Discord/Internal/Rest/Guild.hs +++ b/src/Discord/Internal/Rest/Guild.hs @@ -8,7 +8,6 @@ module Discord.Internal.Rest.Guild ( GuildRequest(..) , CreateGuildChannelOpts(..) - , CreateGuildOpts(..) , ModifyGuildOpts(..) , AddGuildMemberOpts(..) , ModifyGuildMemberOpts(..) @@ -34,7 +33,9 @@ -- | Data constructor for requests. See data GuildRequest a where - CreateGuild :: CreateGuildOpts -> GuildRequest Guild + -- -- Creating a guild with the API is annoying. Do it manually. + -- -- https://discord.com/developers/docs/resources/guild#create-guild + -- | Returns the new 'Guild' object for the given id GetGuild :: GuildId -> GuildRequest Guild -- | Modify a guild's settings. Returns the updated 'Guild' object on success. Fires a @@ -139,21 +140,11 @@ -- | Vanity URL GetGuildVanityURL :: GuildId -> GuildRequest T.Text -data CreateGuildOpts = CreateGuildOpts - { createGuildOptsName :: T.Text - , createGuildOptsChannels :: [Channel] - } deriving (Show, Eq, Ord) - -instance ToJSON CreateGuildOpts where - toJSON CreateGuildOpts{..} = object [(name, val) | (name, Just val) <- - [ ("name", toJSON <$> pure createGuildOptsName ) - , ("channels", toJSON <$> pure createGuildOptsChannels ) ]] - data ModifyGuildIntegrationOpts = ModifyGuildIntegrationOpts { modifyGuildIntegrationOptsExpireBehavior :: Integer , modifyGuildIntegrationOptsExpireGraceSeconds :: Integer , modifyGuildIntegrationOptsEmoticonsEnabled :: Bool - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON ModifyGuildIntegrationOpts where toJSON ModifyGuildIntegrationOpts{..} = object [(name, val) | (name, Just val) <- @@ -163,7 +154,7 @@ data CreateGuildIntegrationOpts = CreateGuildIntegrationOpts { createGuildIntegrationOptsType :: T.Text - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON CreateGuildIntegrationOpts where toJSON CreateGuildIntegrationOpts{..} = object [(name, val) | (name, Just val) <- @@ -172,7 +163,7 @@ data CreateGuildBanOpts = CreateGuildBanOpts { createGuildBanOptsDeleteLastNMessages :: Maybe Int , createGuildBanOptsReason :: Maybe T.Text - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON CreateGuildBanOpts where toJSON CreateGuildBanOpts{..} = object [(name, val) | (name, Just val) <- @@ -186,7 +177,7 @@ , modifyGuildRoleOptsColor :: Maybe ColorInteger , modifyGuildRoleOptsSeparateSidebar :: Maybe Bool , modifyGuildRoleOptsMentionable :: Maybe Bool - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON ModifyGuildRoleOpts where toJSON ModifyGuildRoleOpts{..} = object [(name, val) | (name, Just val) <- @@ -202,7 +193,7 @@ , addGuildMemberOptsRoles :: Maybe [RoleId] , addGuildMemberOptsIsMuted :: Maybe Bool , addGuildMemberOptsIsDeafened :: Maybe Bool - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON AddGuildMemberOpts where toJSON AddGuildMemberOpts{..} = object [(name, val) | (name, Just val) <- @@ -218,7 +209,7 @@ , modifyGuildMemberOptsIsMuted :: Maybe Bool , modifyGuildMemberOptsIsDeafened :: Maybe Bool , modifyGuildMemberOptsMoveToChannel :: Maybe ChannelId - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON ModifyGuildMemberOpts where toJSON ModifyGuildMemberOpts{..} = object [(name, val) | (name, Just val) <- @@ -238,7 +229,7 @@ , createGuildChannelOptsMaxUsers :: Maybe Integer , createGuildChannelOptsCategoryId :: Maybe ChannelId } | CreateGuildChannelOptsCategory - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) createChannelOptsToJSON :: T.Text -> [Overwrite] -> CreateGuildChannelOpts -> Value createChannelOptsToJSON name perms opts = object [(key, val) | (key, Just val) <- optsJSON] @@ -275,7 +266,7 @@ -- VerificationLevel -- DefaultMessageNotification -- ExplicitContentFilter - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON ModifyGuildOpts where toJSON ModifyGuildOpts{..} = object [(name, val) | (name, Just val) <- @@ -287,7 +278,7 @@ data GuildMembersTiming = GuildMembersTiming { guildMembersTimingLimit :: Maybe Int , guildMembersTimingAfter :: Maybe UserId - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) guildMembersTimingToQuery :: GuildMembersTiming -> R.Option 'R.Https guildMembersTimingToQuery (GuildMembersTiming mLimit mAfter) = @@ -301,7 +292,6 @@ guildMajorRoute :: GuildRequest a -> String guildMajorRoute c = case c of - (CreateGuild _) -> "guild " (GetGuild g) -> "guild " <> show g (ModifyGuild g _) -> "guild " <> show g (DeleteGuild g) -> "guild " <> show g @@ -344,9 +334,6 @@ guildJsonRequest :: GuildRequest r -> JsonRequest guildJsonRequest c = case c of - (CreateGuild opts) -> - Post (guilds) (pure (R.ReqBodyJson opts)) mempty - (GetGuild guild) -> Get (guilds // guild) mempty diff --git a/src/Discord/Internal/Rest/Prelude.hs b/src/Discord/Internal/Rest/Prelude.hs --- a/src/Discord/Internal/Rest/Prelude.hs +++ b/src/Discord/Internal/Rest/Prelude.hs @@ -29,7 +29,7 @@ where -- | https://discord.com/developers/docs/reference#user-agent -- Second place where the library version is noted - agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 1.9.2)" + agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 1.10.0)" -- Append to an URL infixl 5 // diff --git a/src/Discord/Internal/Rest/User.hs b/src/Discord/Internal/Rest/User.hs --- a/src/Discord/Internal/Rest/User.hs +++ b/src/Discord/Internal/Rest/User.hs @@ -54,7 +54,7 @@ -- | Formatted avatar data https://discord.com/developers/docs/resources/user#avatar-data data CurrentUserAvatar = CurrentUserAvatar T.Text - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) parseCurrentUserAvatar :: B.ByteString -> Either T.Text CurrentUserAvatar parseCurrentUserAvatar bs = diff --git a/src/Discord/Internal/Rest/Webhook.hs b/src/Discord/Internal/Rest/Webhook.hs --- a/src/Discord/Internal/Rest/Webhook.hs +++ b/src/Discord/Internal/Rest/Webhook.hs @@ -61,7 +61,7 @@ { modifyWebhookOptsName :: Maybe T.Text , modifyWebhookOptsAvatar :: Maybe T.Text , modifyWebhookOptsChannelId :: Maybe ChannelId - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON ModifyWebhookOpts where toJSON ModifyWebhookOpts{..} = object [(toKey name, val) | (name, Just val) <- @@ -72,7 +72,7 @@ data CreateWebhookOpts = CreateWebhookOpts { createWebhookOptsName :: T.Text , createWebhookOptsAvatar :: Maybe T.Text - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON CreateWebhookOpts where toJSON CreateWebhookOpts{..} = object [(name, val) | (name, Just val) <- @@ -82,12 +82,12 @@ data ExecuteWebhookWithTokenOpts = ExecuteWebhookWithTokenOpts { executeWebhookWithTokenOptsUsername :: Maybe T.Text , executeWebhookWithTokenOptsContent :: WebhookContent - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) data WebhookContent = WebhookContentText T.Text | WebhookContentFile T.Text B.ByteString | WebhookContentEmbeds [CreateEmbed] - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) webhookContentJson :: WebhookContent -> [(T.Text, Maybe Value)] webhookContentJson c = case c of diff --git a/src/Discord/Internal/Types.hs b/src/Discord/Internal/Types.hs --- a/src/Discord/Internal/Types.hs +++ b/src/Discord/Internal/Types.hs @@ -10,6 +10,7 @@ , module Discord.Internal.Types.Embed , module Data.Aeson , module Data.Time.Clock + , userFacingEvent ) where import Discord.Internal.Types.Channel @@ -22,3 +23,39 @@ import Data.Aeson (Object) import Data.Time.Clock (UTCTime(..)) + + +userFacingEvent :: EventInternalParse -> Event +userFacingEvent event = case event of + InternalReady a b c d e -> Ready a b c d e + InternalResumed a -> Resumed a + InternalChannelCreate a -> ChannelCreate a + InternalChannelUpdate a -> ChannelUpdate a + InternalChannelDelete a -> ChannelDelete a + InternalChannelPinsUpdate a b -> ChannelPinsUpdate a b + InternalGuildCreate a b -> GuildCreate a b + InternalGuildUpdate a -> GuildUpdate a + InternalGuildDelete a -> GuildDelete a + InternalGuildBanAdd a b -> GuildBanAdd a b + InternalGuildBanRemove a b -> GuildBanRemove a b + InternalGuildEmojiUpdate a b -> GuildEmojiUpdate a b + InternalGuildIntegrationsUpdate a -> GuildIntegrationsUpdate a + InternalGuildMemberAdd a b -> GuildMemberAdd a b + InternalGuildMemberRemove a b -> GuildMemberRemove a b + InternalGuildMemberUpdate a b c d -> GuildMemberUpdate a b c d + InternalGuildMemberChunk a b -> GuildMemberChunk a b + InternalGuildRoleCreate a b -> GuildRoleCreate a b + InternalGuildRoleUpdate a b -> GuildRoleUpdate a b + InternalGuildRoleDelete a b -> GuildRoleDelete a b + InternalMessageCreate a -> MessageCreate a + InternalMessageUpdate a b -> MessageUpdate a b + InternalMessageDelete a b -> MessageDelete a b + InternalMessageDeleteBulk a b -> MessageDeleteBulk a b + InternalMessageReactionAdd a -> MessageReactionAdd a + InternalMessageReactionRemove a -> MessageReactionRemove a + InternalMessageReactionRemoveAll a b -> MessageReactionRemoveAll a b + InternalMessageReactionRemoveEmoji a -> MessageReactionRemoveEmoji a + InternalPresenceUpdate a -> PresenceUpdate a + InternalTypingStart a -> TypingStart a + InternalUserUpdate a -> UserUpdate a + InternalUnknownEvent a b -> UnknownEvent a b diff --git a/src/Discord/Internal/Types/Channel.hs b/src/Discord/Internal/Types/Channel.hs --- a/src/Discord/Internal/Types/Channel.hs +++ b/src/Discord/Internal/Types/Channel.hs @@ -31,7 +31,7 @@ , channelTopic :: T.Text -- ^ The topic of the channel. (0 - 1024 chars). , channelLastMessage :: Maybe MessageId -- ^ The id of the last message sent in the -- channel - , parentId :: Maybe ParentId -- ^ The id of the parent channel (category) + , channelParentId :: Maybe ParentId -- ^ The id of the parent channel (category) } | ChannelNews { channelId :: ChannelId @@ -50,7 +50,7 @@ , channelPosition :: Integer , channelNSFW :: Bool , channelPermissions :: [Overwrite] - , parentId :: Maybe ParentId + , channelParentId :: Maybe ParentId } -- | A voice channel in a guild. | ChannelVoice @@ -62,7 +62,7 @@ , channelNSFW :: Bool , channelBitRate :: Integer -- ^ The bitrate (in bits) of the channel. , channelUserLimit :: Integer -- ^ The user limit of the voice channel. - , parentId :: Maybe ParentId + , channelParentId :: Maybe ParentId } -- | DM Channels represent a one-to-one conversation between two users, outside the scope -- of guilds @@ -92,7 +92,7 @@ | ChannelUnknownType { channelId :: ChannelId , channelJSON :: Text - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON Channel where parseJSON = withObject "Channel" $ \o -> do @@ -158,73 +158,6 @@ _ -> ChannelUnknownType <$> o .: "id" <*> pure (T.pack (show o)) -instance ToJSON Channel where - toJSON ChannelText{..} = object [(name,value) | (name, Just value) <- - [ ("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 parentId) - ] ] - toJSON ChannelNews{..} = object [(name,value) | (name, Just value) <- - [ ("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) - ] ] - toJSON ChannelStorePage{..} = object [(name,value) | (name, Just value) <- - [ ("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) <- - [ ("id", toJSON <$> pure channelId) - , ("recipients", toJSON <$> pure channelRecipients) - , ("last_message_id", toJSON <$> channelLastMessage) - ] ] - toJSON ChannelVoice{..} = object [(name,value) | (name, Just value) <- - [ ("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) <- - [ ("id", toJSON <$> pure channelId) - , ("recipients", toJSON <$> pure channelRecipients) - , ("last_message_id", toJSON <$> channelLastMessage) - ] ] - toJSON ChannelGuildCategory{..} = object [(name,value) | (name, Just value) <- - [ ("id", toJSON <$> pure channelId) - , ("name", toJSON <$> pure channelName) - , ("guild_id", toJSON <$> pure channelGuild) - ] ] - toJSON ChannelStage{..} = object [(name,value) | (name, Just value) <- - [ ("id", toJSON <$> pure channelId) - , ("guild_id", toJSON <$> pure channelGuild) - , ("channel_id", toJSON <$> pure channelStageId) - , ("topic", toJSON <$> pure channelStageTopic) - ] ] - toJSON ChannelUnknownType{..} = object [(name,value) | (name, Just value) <- - [ ("id", toJSON <$> pure channelId) - , ("json", toJSON <$> pure channelJSON) - ] ] - -- | If the channel is part of a guild (has a guild id field) channelIsInGuild :: Channel -> Bool channelIsInGuild c = case c of @@ -241,7 +174,7 @@ , overwriteType :: T.Text -- ^ Either "role" or "member , overwriteAllow :: Integer -- ^ Allowed permission bit set , overwriteDeny :: Integer -- ^ Denied permission bit set - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON Overwrite where parseJSON = withObject "Overwrite" $ \o -> @@ -285,7 +218,7 @@ , messageGuild :: Maybe GuildId -- ^ The guild the message went to , messageReference :: Maybe MessageReference -- ^ Reference IDs of the original message , referencedMessage :: Maybe Message -- ^ The full original message - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON Message where parseJSON = withObject "Message" $ \o -> @@ -317,7 +250,7 @@ { messageReactionCount :: Int , messageReactionMeIncluded :: Bool , messageReactionEmoji :: Emoji - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON MessageReaction where parseJSON = withObject "MessageReaction" $ \o -> @@ -327,12 +260,13 @@ -- | Represents an emoticon (emoji) data Emoji = Emoji - { emojiId :: Maybe EmojiId -- ^ The emoji id - , emojiName :: T.Text -- ^ The emoji name - , emojiRoles :: Maybe [RoleId] -- ^ Roles the emoji is active for - , emojiUser :: Maybe User -- ^ User that created this emoji - , emojiManaged :: Maybe Bool -- ^ Whether this emoji is managed - } deriving (Show, Eq, Ord) + { emojiId :: Maybe EmojiId -- ^ The emoji id + , emojiName :: T.Text -- ^ The emoji name + , emojiRoles :: Maybe [RoleId] -- ^ Roles the emoji is active for + , emojiUser :: Maybe User -- ^ User that created this emoji + , emojiManaged :: Maybe Bool -- ^ Whether this emoji is managed + , emojiAnimated :: Maybe Bool -- ^ Whether this emoji is animated + } deriving (Show, Read, Eq, Ord) instance FromJSON Emoji where parseJSON = withObject "Emoji" $ \o -> @@ -341,6 +275,7 @@ <*> o .:? "roles" <*> o .:? "user" <*> o .:? "managed" + <*> o .:? "animated" -- | Represents an attached to a message file. @@ -352,7 +287,7 @@ , attachmentProxy :: T.Text -- ^ Proxied url of file , attachmentHeight :: Maybe Integer -- ^ Height of file (if image) , attachmentWidth :: Maybe Integer -- ^ Width of file (if image) - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON Attachment where parseJSON = withObject "Attachment" $ \o -> @@ -367,7 +302,7 @@ newtype Nonce = Nonce T.Text - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) instance FromJSON Nonce where parseJSON (String nonce) = pure $ Nonce nonce @@ -381,7 +316,7 @@ , referenceChannelId :: Maybe ChannelId -- ^ id of the originating message's channel , referenceGuildId :: Maybe GuildId -- ^ id of the originating message's guild , failIfNotExists :: Bool -- ^ Whether to not send if reference not exist - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON MessageReference where parseJSON = withObject "MessageReference" $ \o -> diff --git a/src/Discord/Internal/Types/Embed.hs b/src/Discord/Internal/Types/Embed.hs --- a/src/Discord/Internal/Types/Embed.hs +++ b/src/Discord/Internal/Types/Embed.hs @@ -66,11 +66,11 @@ , createEmbedFooterIcon :: Maybe CreateEmbedImage , createEmbedColor :: Maybe ColorInteger --, createEmbedTimestamp :: Maybe UTCTime - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) data CreateEmbedImage = CreateEmbedImageUrl T.Text | CreateEmbedImageUpload B.ByteString - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) instance Default CreateEmbed where def = CreateEmbed "" "" Nothing "" "" Nothing "" [] Nothing "" Nothing Nothing -- Nothing @@ -90,7 +90,7 @@ , embedType :: Maybe T.Text -- ^ Type of embed (Always "rich" for users) , embedVideo :: Maybe EmbedVideo -- ^ Only present for "video" types , embedProvider :: Maybe EmbedProvider -- ^ Only present for "video" types - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) -- TODO instance ToJSON Embed where @@ -132,7 +132,7 @@ , embedThumbnailProxyUrl :: Maybe T.Text , embedThumbnailHeight :: Maybe Integer , embedThumbnailWidth :: Maybe Integer - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON EmbedThumbnail where toJSON (EmbedThumbnail a b c d) = object @@ -153,7 +153,7 @@ { embedVideoUrl :: Maybe T.Text , embedVideoHeight :: Maybe Integer , embedVideoWidth :: Maybe Integer - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON EmbedVideo where toJSON (EmbedVideo a b c) = object @@ -173,7 +173,7 @@ , embedImageProxyUrl :: Maybe T.Text , embedImageHeight :: Maybe Integer , embedImageWidth :: Maybe Integer - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON EmbedImage where toJSON (EmbedImage a b c d) = object @@ -193,7 +193,7 @@ data EmbedProvider = EmbedProvider { embedProviderName :: Maybe T.Text , embedProviderUrl :: Maybe T.Text - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON EmbedProvider where toJSON (EmbedProvider a b) = object @@ -211,7 +211,7 @@ , embedAuthorUrl :: Maybe T.Text , embedAuthorIconUrl :: Maybe T.Text , embedAuthorProxyIconUrl :: Maybe T.Text - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON EmbedAuthor where toJSON (EmbedAuthor a b c d) = object @@ -232,7 +232,7 @@ { embedFooterText :: T.Text , embedFooterIconUrl :: Maybe T.Text , embedFooterProxyIconUrl :: Maybe T.Text - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON EmbedFooter where toJSON (EmbedFooter a b c) = object @@ -251,7 +251,7 @@ { embedFieldName :: T.Text , embedFieldValue :: T.Text , embedFieldInline :: Maybe Bool - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance ToJSON EmbedField where toJSON (EmbedField a b c) = object diff --git a/src/Discord/Internal/Types/Events.hs b/src/Discord/Internal/Types/Events.hs --- a/src/Discord/Internal/Types/Events.hs +++ b/src/Discord/Internal/Types/Events.hs @@ -55,15 +55,52 @@ -- | VoiceStateUpdate -- | VoiceServerUpdate | UnknownEvent T.Text Object - deriving (Show, Eq) + deriving (Show, Read, Eq) +data EventInternalParse = + InternalReady Int User [Channel] [GuildUnavailable] T.Text + | InternalResumed [T.Text] + | InternalChannelCreate Channel + | InternalChannelUpdate Channel + | InternalChannelDelete Channel + | InternalChannelPinsUpdate ChannelId (Maybe UTCTime) + | InternalGuildCreate Guild GuildInfo + | InternalGuildUpdate Guild + | InternalGuildDelete GuildUnavailable + | InternalGuildBanAdd GuildId User + | InternalGuildBanRemove GuildId User + | InternalGuildEmojiUpdate GuildId [Emoji] + | InternalGuildIntegrationsUpdate GuildId + | InternalGuildMemberAdd GuildId GuildMember + | InternalGuildMemberRemove GuildId User + | InternalGuildMemberUpdate GuildId [RoleId] User (Maybe T.Text) + | InternalGuildMemberChunk GuildId [GuildMember] + | InternalGuildRoleCreate GuildId Role + | InternalGuildRoleUpdate GuildId Role + | InternalGuildRoleDelete GuildId RoleId + | InternalMessageCreate Message + | InternalMessageUpdate ChannelId MessageId + | InternalMessageDelete ChannelId MessageId + | InternalMessageDeleteBulk ChannelId [MessageId] + | InternalMessageReactionAdd ReactionInfo + | InternalMessageReactionRemove ReactionInfo + | InternalMessageReactionRemoveAll ChannelId MessageId + | InternalMessageReactionRemoveEmoji ReactionRemoveInfo + | InternalPresenceUpdate PresenceInfo + | InternalTypingStart TypingInfo + | InternalUserUpdate User + -- | InternalVoiceStateUpdate + -- | InternalVoiceServerUpdate + | InternalUnknownEvent T.Text Object + deriving (Show, Read, Eq) + data ReactionInfo = ReactionInfo { reactionUserId :: UserId , reactionGuildId :: Maybe GuildId , reactionChannelId :: ChannelId , reactionMessageId :: MessageId , reactionEmoji :: Emoji - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON ReactionInfo where parseJSON = withObject "ReactionInfo" $ \o -> @@ -78,7 +115,7 @@ , reactionRemoveGuildId :: GuildId , reactionRemoveMessageId :: MessageId , reactionRemoveEmoji :: Emoji - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON ReactionRemoveInfo where parseJSON = withObject "ReactionRemoveInfo" $ \o -> @@ -93,7 +130,7 @@ -- , presenceGame :: Maybe Activity , presenceGuildId :: GuildId , presenceStatus :: T.Text - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON PresenceInfo where parseJSON = withObject "PresenceInfo" $ \o -> @@ -107,7 +144,7 @@ { typingUserId :: UserId , typingChannelId :: ChannelId , typingTimestamp :: UTCTime - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON TypingInfo where parseJSON = withObject "TypingInfo" $ \o -> @@ -125,50 +162,50 @@ Left r -> fail r Right b -> pure b -eventParse :: T.Text -> Object -> Parser Event +eventParse :: T.Text -> Object -> Parser EventInternalParse eventParse t o = case t of - "READY" -> Ready <$> o .: "v" + "READY" -> InternalReady <$> o .: "v" <*> o .: "user" <*> o .: "private_channels" <*> o .: "guilds" <*> o .: "session_id" - "RESUMED" -> Resumed <$> o .: "_trace" - "CHANNEL_CREATE" -> ChannelCreate <$> reparse o - "CHANNEL_UPDATE" -> ChannelUpdate <$> reparse o - "CHANNEL_DELETE" -> ChannelDelete <$> reparse o + "RESUMED" -> InternalResumed <$> o .: "_trace" + "CHANNEL_CREATE" -> InternalChannelCreate <$> reparse o + "CHANNEL_UPDATE" -> InternalChannelUpdate <$> reparse o + "CHANNEL_DELETE" -> InternalChannelDelete <$> reparse o "CHANNEL_PINS_UPDATE" -> do id <- o .: "channel_id" stamp <- o .:? "last_pin_timestamp" let utc = stamp >>= parseISO8601 - pure (ChannelPinsUpdate id utc) - "GUILD_CREATE" -> GuildCreate <$> reparse o <*> reparse o - "GUILD_UPDATE" -> GuildUpdate <$> reparse o - "GUILD_DELETE" -> GuildDelete <$> reparse o - "GUILD_BAN_ADD" -> GuildBanAdd <$> o .: "guild_id" <*> o .: "user" - "GUILD_BAN_REMOVE" -> GuildBanRemove <$> o .: "guild_id" <*> o .: "user" - "GUILD_EMOJI_UPDATE" -> GuildEmojiUpdate <$> o .: "guild_id" <*> o .: "emojis" - "GUILD_INTEGRATIONS_UPDATE" -> GuildIntegrationsUpdate <$> o .: "guild_id" - "GUILD_MEMBER_ADD" -> GuildMemberAdd <$> o .: "guild_id" <*> reparse o - "GUILD_MEMBER_REMOVE" -> GuildMemberRemove <$> o .: "guild_id" <*> o .: "user" - "GUILD_MEMBER_UPDATE" -> GuildMemberUpdate <$> o .: "guild_id" - <*> o .: "roles" - <*> o .: "user" - <*> o .:? "nick" - "GUILD_MEMBERS_CHUNK" -> GuildMemberChunk <$> o .: "guild_id" <*> o .: "members" - "GUILD_ROLE_CREATE" -> GuildRoleCreate <$> o .: "guild_id" <*> o .: "role" - "GUILD_ROLE_UPDATE" -> GuildRoleUpdate <$> o .: "guild_id" <*> o .: "role" - "GUILD_ROLE_DELETE" -> GuildRoleDelete <$> o .: "guild_id" <*> o .: "role_id" - "MESSAGE_CREATE" -> MessageCreate <$> reparse o - "MESSAGE_UPDATE" -> MessageUpdate <$> o .: "channel_id" <*> o .: "id" - "MESSAGE_DELETE" -> MessageDelete <$> o .: "channel_id" <*> o .: "id" - "MESSAGE_DELETE_BULK" -> MessageDeleteBulk <$> o .: "channel_id" <*> o .: "ids" - "MESSAGE_REACTION_ADD" -> MessageReactionAdd <$> reparse o - "MESSAGE_REACTION_REMOVE" -> MessageReactionRemove <$> reparse o - "MESSAGE_REACTION_REMOVE_ALL" -> MessageReactionRemoveAll <$> o .: "channel_id" - <*> o .: "message_id" - "MESSAGE_REACTION_REMOVE_EMOJI" -> MessageReactionRemoveEmoji <$> reparse o - "PRESENCE_UPDATE" -> PresenceUpdate <$> reparse o - "TYPING_START" -> TypingStart <$> reparse o - "USER_UPDATE" -> UserUpdate <$> reparse o - -- "VOICE_STATE_UPDATE" -> VoiceStateUpdate <$> reparse o - -- "VOICE_SERVER_UPDATE" -> VoiceServerUpdate <$> reparse o - _other_event -> UnknownEvent t <$> reparse o + pure (InternalChannelPinsUpdate id utc) + "GUILD_CREATE" -> InternalGuildCreate <$> reparse o <*> reparse o + "GUILD_UPDATE" -> InternalGuildUpdate <$> reparse o + "GUILD_DELETE" -> InternalGuildDelete <$> reparse o + "GUILD_BAN_ADD" -> InternalGuildBanAdd <$> o .: "guild_id" <*> o .: "user" + "GUILD_BAN_REMOVE" -> InternalGuildBanRemove <$> o .: "guild_id" <*> o .: "user" + "GUILD_EMOJI_UPDATE" -> InternalGuildEmojiUpdate <$> o .: "guild_id" <*> o .: "emojis" + "GUILD_INTEGRATIONS_UPDATE" -> InternalGuildIntegrationsUpdate <$> o .: "guild_id" + "GUILD_MEMBER_ADD" -> InternalGuildMemberAdd <$> o .: "guild_id" <*> reparse o + "GUILD_MEMBER_REMOVE" -> InternalGuildMemberRemove <$> o .: "guild_id" <*> o .: "user" + "GUILD_MEMBER_UPDATE" -> InternalGuildMemberUpdate <$> o .: "guild_id" + <*> o .: "roles" + <*> o .: "user" + <*> o .:? "nick" + "GUILD_MEMBERS_CHUNK" -> InternalGuildMemberChunk <$> o .: "guild_id" <*> o .: "members" + "GUILD_ROLE_CREATE" -> InternalGuildRoleCreate <$> o .: "guild_id" <*> o .: "role" + "GUILD_ROLE_UPDATE" -> InternalGuildRoleUpdate <$> o .: "guild_id" <*> o .: "role" + "GUILD_ROLE_DELETE" -> InternalGuildRoleDelete <$> o .: "guild_id" <*> o .: "role_id" + "MESSAGE_CREATE" -> InternalMessageCreate <$> reparse o + "MESSAGE_UPDATE" -> InternalMessageUpdate <$> o .: "channel_id" <*> o .: "id" + "MESSAGE_DELETE" -> InternalMessageDelete <$> o .: "channel_id" <*> o .: "id" + "MESSAGE_DELETE_BULK" -> InternalMessageDeleteBulk <$> o .: "channel_id" <*> o .: "ids" + "MESSAGE_REACTION_ADD" -> InternalMessageReactionAdd <$> reparse o + "MESSAGE_REACTION_REMOVE" -> InternalMessageReactionRemove <$> reparse o + "MESSAGE_REACTION_REMOVE_ALL" -> InternalMessageReactionRemoveAll <$> o .: "channel_id" + <*> o .: "message_id" + "MESSAGE_REACTION_REMOVE_EMOJI"-> InternalMessageReactionRemoveEmoji <$> reparse o + "PRESENCE_UPDATE" -> InternalPresenceUpdate <$> reparse o + "TYPING_START" -> InternalTypingStart <$> reparse o + "USER_UPDATE" -> InternalUserUpdate <$> reparse o + -- "VOICE_STATE_UPDATE" -> InternalVoiceStateUpdate <$> reparse o + -- "VOICE_SERVER_UPDATE" -> InternalVoiceServerUpdate <$> reparse o + _other_event -> InternalUnknownEvent t <$> reparse o diff --git a/src/Discord/Internal/Types/Gateway.hs b/src/Discord/Internal/Types/Gateway.hs --- a/src/Discord/Internal/Types/Gateway.hs +++ b/src/Discord/Internal/Types/Gateway.hs @@ -23,21 +23,21 @@ -- | Sent by gateway data GatewayReceivable - = Dispatch Event Integer + = Dispatch EventInternalParse Integer | HeartbeatRequest Integer | Reconnect | InvalidSession Bool | Hello Integer | HeartbeatAck | ParseError T.Text - deriving (Show, Eq) + deriving (Show, Read, Eq) -- | Sent to gateway by our library data GatewaySendableInternal = Heartbeat Integer | Identify Auth GatewayIntent (Int, Int) | Resume Auth T.Text Integer - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) -- | https://discord.com/developers/docs/topics/gateway#list-of-intents @@ -57,7 +57,7 @@ , gatewayIntentDirectMessageChanges :: Bool , gatewayIntentDirectMessageReactions :: Bool , gatewayIntentDirectMessageTyping :: Bool - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance Default GatewayIntent where def = GatewayIntent { gatewayIntentGuilds = True @@ -103,13 +103,13 @@ = RequestGuildMembers RequestGuildMembersOpts | UpdateStatus UpdateStatusOpts | UpdateStatusVoice UpdateStatusVoiceOpts - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) data RequestGuildMembersOpts = RequestGuildMembersOpts { requestGuildMembersOptsGuildId :: GuildId , requestGuildMembersOptsNamesStartingWith :: T.Text , requestGuildMembersOptsLimit :: Integer } - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) data UpdateStatusVoiceOpts = UpdateStatusVoiceOpts { updateStatusVoiceOptsGuildId :: GuildId @@ -117,7 +117,7 @@ , updateStatusVoiceOptsIsMuted :: Bool , updateStatusVoiceOptsIsDeaf :: Bool } - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) data UpdateStatusOpts = UpdateStatusOpts { updateStatusOptsSince :: Maybe UTCTime @@ -125,20 +125,20 @@ , updateStatusOptsNewStatus :: UpdateStatusType , updateStatusOptsAFK :: Bool } - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) data Activity = Activity { activityName :: T.Text , activityType :: ActivityType , activityUrl :: Maybe T.Text } - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) data ActivityType = ActivityTypeGame | ActivityTypeStreaming | ActivityTypeListening | ActivityTypeCompeting - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) activityTypeId :: ActivityType -> Int activityTypeId a = case a of ActivityTypeGame -> 0 @@ -151,7 +151,7 @@ | UpdateStatusAwayFromKeyboard | UpdateStatusInvisibleOffline | UpdateStatusOffline - deriving (Show, Eq, Ord, Enum) + deriving (Show, Read, Eq, Ord, Enum) statusString :: UpdateStatusType -> T.Text statusString s = case s of @@ -169,7 +169,7 @@ ejson <- o .: "d" case ejson of Object hm -> Dispatch <$> eventParse etype hm <*> o .: "s" - _other -> Dispatch (UnknownEvent ("Dispatch payload wasn't an object") o) + _other -> Dispatch (InternalUnknownEvent ("Dispatch payload wasn't an object") o) <$> o .: "s" 1 -> HeartbeatRequest . fromMaybe 0 . readMaybe <$> o .: "d" 7 -> pure Reconnect diff --git a/src/Discord/Internal/Types/Guild.hs b/src/Discord/Internal/Types/Guild.hs --- a/src/Discord/Internal/Types/Guild.hs +++ b/src/Discord/Internal/Types/Guild.hs @@ -20,7 +20,7 @@ , memberJoinedAt :: UTCTime , memberDeaf :: Bool , memberMute :: Bool - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON GuildMember where parseJSON = withObject "GuildMember" $ \o -> @@ -56,7 +56,7 @@ , guildFeatures :: [T.Text] , guildMultiFactAuth :: !Integer , guildApplicationId :: Maybe Snowflake - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON Guild where parseJSON = withObject "Guild" $ \o -> @@ -82,7 +82,7 @@ data GuildUnavailable = GuildUnavailable { idOnceAvailable :: GuildId - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON GuildUnavailable where parseJSON = withObject "GuildUnavailable" $ \o -> @@ -96,7 +96,7 @@ , guildMembers :: [GuildMember] , guildChannels :: [Channel] -- ^ Channels in the guild (sent in GuildCreate) -- , guildPresences :: [Presence] - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON GuildInfo where parseJSON = withObject "GuildInfo" $ \o -> @@ -113,7 +113,7 @@ , partialGuildIcon :: Maybe T.Text , partialGuildOwner :: Bool , partialGuildPermissions :: Integer - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON PartialGuild where parseJSON = withObject "PartialGuild" $ \o -> @@ -138,7 +138,7 @@ , rolePerms :: Integer -- ^ Permission bit set , roleManaged :: Bool -- ^ Whether this role is managed by an integration , roleMention :: Bool -- ^ Whether this role is mentionable - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON Role where parseJSON = withObject "Role" $ \o -> @@ -159,7 +159,7 @@ , voiceRegionOptimal :: Bool -- ^ True for the closest server to a client , voiceRegionDeprecated :: Bool -- ^ Whether this is a deprecated region , voiceRegionCustom :: Bool -- ^ Whether this is a custom region - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON VoiceRegion where parseJSON = withObject "VoiceRegion" $ \o -> @@ -174,7 +174,7 @@ data GuildBan = GuildBan { guildBanReason :: T.Text , guildBanUser :: User - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON GuildBan where parseJSON = withObject "GuildBan" $ \o -> GuildBan <$> o .: "reason" <*> o .: "user" @@ -184,7 +184,7 @@ { inviteCode :: T.Text -- ^ The invite code , inviteGuildId :: Maybe GuildId -- ^ The guild the code will invite to , inviteChannelId :: ChannelId -- ^ The channel the code will invite to - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON Invite where parseJSON = withObject "Invite" $ \o -> @@ -209,7 +209,7 @@ , inviteTemp :: Bool -- ^ Whether this invite only grants temporary membership , inviteCreated :: UTCTime -- ^ When the invite was created , inviteRevoked :: Bool -- ^ If the invite is revoked - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON InviteMeta where parseJSON = withObject "InviteMeta" $ \o -> @@ -234,7 +234,7 @@ , integrationOwner :: User -- ^ The user of the integration , integrationAccount :: IntegrationAccount -- ^ The account the integration links to , integrationSync :: UTCTime -- ^ When the integration was last synced - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON Integration where parseJSON = withObject "Integration" $ \o -> @@ -254,7 +254,7 @@ data IntegrationAccount = IntegrationAccount { accountId :: T.Text -- ^ The id of the account. , accountName :: T.Text -- ^ The name of the account. - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON IntegrationAccount where parseJSON = withObject "IntegrationAccount" $ \o -> @@ -264,7 +264,7 @@ data GuildEmbed = GuildEmbed { embedEnabled :: Bool -- ^ Whether the embed is enabled , embedChannel :: ChannelId -- ^ The embed channel id - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON GuildEmbed where parseJSON = withObject "GuildEmbed" $ \o -> diff --git a/src/Discord/Internal/Types/Prelude.hs b/src/Discord/Internal/Types/Prelude.hs --- a/src/Discord/Internal/Types/Prelude.hs +++ b/src/Discord/Internal/Types/Prelude.hs @@ -18,7 +18,7 @@ -- | Authorization token for the Discord API data Auth = Auth T.Text - deriving (Show, Eq, Ord) + deriving (Show, Read, Eq, Ord) -- | Get the raw token formatted for use with the websocket gateway diff --git a/src/Discord/Internal/Types/User.hs b/src/Discord/Internal/Types/User.hs --- a/src/Discord/Internal/Types/User.hs +++ b/src/Discord/Internal/Types/User.hs @@ -20,7 +20,7 @@ , userMfa :: Maybe Bool -- ^ User has two factor authentication enabled on the account. , userVerified :: Maybe Bool -- ^ Whether the email has been verified. , userEmail :: Maybe T.Text -- ^ The user's email. - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON User where parseJSON = withObject "User" $ \o -> @@ -51,7 +51,7 @@ { webhookId :: WebhookId , webhookToken :: Text , webhookChannelId :: ChannelId - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON Webhook where parseJSON = withObject "Webhook" $ \o -> @@ -69,7 +69,7 @@ , connectionObjectFriendSyncOn :: Bool , connectionObjectShownInPresenceUpdates :: Bool , connectionObjectVisibleToOthers :: Bool - } deriving (Show, Eq, Ord) + } deriving (Show, Read, Eq, Ord) instance FromJSON ConnectionObject where parseJSON = withObject "ConnectionObject" $ \o -> do diff --git a/src/Discord/Types.hs b/src/Discord/Types.hs --- a/src/Discord/Types.hs +++ b/src/Discord/Types.hs @@ -3,6 +3,7 @@ ) where import Discord.Internal.Types hiding - ( GatewaySendableInternal - , GatewayReceivable + ( GatewaySendableInternal(..) + , GatewayReceivable(..) + , EventInternalParse(..) )