diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,57 @@ +# Changelog + +View on github for newest version: https://github.com/aquarial/discord-haskell/blob/master/changelog.md + +### master + +### 0.8.0 + +`MessageUpdate` does not contain a full Message object, just `ChannelId` `MessageId` + +Message Author changed from `User` to `Either WebhookId User` + +Add Webhook ADT + +Add requests: GetInvite, DeleteInvite + +UpdateStatusVoiceOpts takes Bool for Mute + +`Unavailable` becomes `GuildUnavailable` + +### 0.7.1 + +[t1m0thyj](https://github.com/aquarial/discord-haskell/pull/6/files) Typo in RequestGuildMemberOpts fields fixed. + +[t1m0thyj](https://github.com/aquarial/discord-haskell/pull/6/files) Added Activity, ActivityType ADT + +UpdateStatusTypes became UpdateStatusType (singular ADT) + +[t1m0thyj](https://github.com/aquarial/discord-haskell/pull/7) Retry connection on 1001 websocket close + +### 0.7.0 + +Snowflake -> named id + +Add requests: ModifyChanPositions, CreateGuildChannel + +Changed constructors of Channel to have prefix "Channel", isGuildChannel --> channelIsInGuild + +Change Emoji Id ADTs + +### 0.6.0 + +Add requests: CreateGuildEmoji, GroupDMRemoveRecipient, ModifyCurrentUser, EditChannelPermissions, CreateChannelInvite, GroupDMAddRecipient, ModifyGuild + +restCall, readCache pass errors as an ADT, including underling http exceptions + +Only add "Bot " prefix to secret token if it's not there + +### 0.5.1 + +sendCommand with GatewaySendable types + +### 0.5.0 + +restCall with Request types + +nextEvent with Event types diff --git a/discord-haskell.cabal b/discord-haskell.cabal --- a/discord-haskell.cabal +++ b/discord-haskell.cabal @@ -1,6 +1,6 @@ name: discord-haskell -- library version is also noted at src/Discord/Rest/Prelude.hs -version: 0.7.1 +version: 0.8.0 synopsis: Write bots for Discord in Haskell description: Functions and data types to write discord bots. Official discord docs . @@ -15,7 +15,7 @@ -- copyright: category: Network build-type: Simple --- extra-source-files: +extra-source-files: changelog.md cabal-version: >=1.10 library @@ -31,6 +31,7 @@ , Discord.Rest , Discord.Rest.Prelude , Discord.Rest.HTTP + , Discord.Rest.Invite , Discord.Rest.Emoji , Discord.Rest.User , Discord.Rest.Guild @@ -43,24 +44,24 @@ , Discord.Types.Guild build-depends: base >=4 && <5 - , aeson >=1.3.1.1 && < 1.4 + , aeson >=1.3.1.1 && <1.4 , async >=2.2.1 && <2.3 , bytestring >=0.10.8.2 && <0.11 - , base64-bytestring >= 1.0.0.1 && <1.1 - , containers >=0.5.10.2 && <0.6 + , base64-bytestring >=1.0.0.1 && <1.1 + , containers >=0.5.11.0 && <0.6 , data-default >=0.7.1.1 && <0.8 - , http-client >=0.5.12.1 && <0.6 - , iso8601-time >=0.1.4 && <0.2 - , MonadRandom >=0.5.1 && <0.6 + , http-client >=0.5.13.1 && <0.6 + , iso8601-time >=0.1.5 && <0.2 + , MonadRandom >=0.5.1.1 && <0.6 , req >=1.1.0 && <1.2 - , JuicyPixels >= 3.2.9.0 && < 3.3 + , JuicyPixels >=3.2.9.5 && <3.3 , safe-exceptions >=0.1.7.0 && <0.2 , text >=1.2.3.0 && <1.3 , time >=1.8.0.2 && <1.9 , unordered-containers >=0.2.9.0 && <0.3 , vector >=0.12.0.1 && <0.13 - , websockets >=0.12.4.1 && <0.13 - , wuss >=1.1.9 && <1.2 + , websockets >=0.12.5.1 && <0.13 + , wuss >=1.1.10 && <1.2 source-repository head type : git diff --git a/src/Discord.hs b/src/Discord.hs --- a/src/Discord.hs +++ b/src/Discord.hs @@ -5,6 +5,7 @@ , module Discord.Rest.Channel , module Discord.Rest.Guild , module Discord.Rest.User + , module Discord.Rest.Invite , module Discord.Rest.Emoji , Cache(..) , Gateway(..) @@ -34,6 +35,7 @@ import Discord.Rest.Channel import Discord.Rest.Guild import Discord.Rest.User +import Discord.Rest.Invite import Discord.Rest.Emoji import Discord.Types import Discord.Gateway diff --git a/src/Discord/Gateway/Cache.hs b/src/Discord/Gateway/Cache.hs --- a/src/Discord/Gateway/Cache.hs +++ b/src/Discord/Gateway/Cache.hs @@ -16,9 +16,9 @@ data Cache = Cache { _currentUser :: User - , _dmChannels :: M.Map Snowflake Channel - , _guilds :: M.Map Snowflake (Guild, GuildInfo) - , _channels :: M.Map Snowflake Channel + , _dmChannels :: M.Map ChannelId Channel + , _guilds :: M.Map GuildId (Guild, GuildInfo) + , _channels :: M.Map ChannelId Channel } deriving (Show) emptyCache :: IO (MVar (Either GatewayException Cache)) @@ -75,7 +75,7 @@ -- putMVar cache m2 _ -> minfo -setChanGuildID :: Snowflake -> Channel -> Channel +setChanGuildID :: GuildId -> Channel -> Channel setChanGuildID s c = if channelIsInGuild c then c { channelGuild = s } else c diff --git a/src/Discord/Rest.hs b/src/Discord/Rest.hs --- a/src/Discord/Rest.hs +++ b/src/Discord/Rest.hs @@ -14,7 +14,6 @@ ) where import Prelude hiding (log) -import Data.Either (fromRight) import Data.Aeson (FromJSON, eitherDecode) import Control.Concurrent.Chan import Control.Concurrent.MVar @@ -42,7 +41,8 @@ r <- readMVar m pure $ case eitherDecode <$> r of Right (Right o) -> Right o - Right (Left er) -> Left (RestCallNoParse er (fromRight "" r)) + Right (Left er) -> Left (RestCallNoParse er (case r of Right x -> x + Left _ -> "")) Left e -> Left e diff --git a/src/Discord/Rest/Invite.hs b/src/Discord/Rest/Invite.hs new file mode 100644 --- /dev/null +++ b/src/Discord/Rest/Invite.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Provides actions for Channel API interactions +module Discord.Rest.Invite + ( InviteRequest(..) + ) where + +import Data.Monoid (mempty) +import Network.HTTP.Req ((/:)) +import qualified Network.HTTP.Req as R +import qualified Data.Text as T + +import Discord.Rest.Prelude +import Discord.Types + +instance Request (InviteRequest a) where + majorRoute = inviteMajorRoute + jsonRequest = inviteJsonRequest + + +-- | Data constructor for requests. See +data InviteRequest a where + -- | Get invite for given code + GetInvite :: T.Text -> InviteRequest Invite + -- | Delete invite by code + DeleteInvite :: T.Text -> InviteRequest Invite + +inviteMajorRoute :: InviteRequest a -> String +inviteMajorRoute c = case c of + (GetInvite _) -> "invite " + (DeleteInvite _) -> "invite " + +-- | The base url (Req) for API requests +baseUrl :: R.Url 'R.Https +baseUrl = R.https "discordapp.com" R./: "api" R./: apiVersion + where apiVersion = "v6" + +invite :: R.Url 'R.Https +invite = baseUrl /: "invites" + +inviteJsonRequest :: InviteRequest r -> JsonRequest +inviteJsonRequest c = case c of + (GetInvite g) -> Get (invite R./: g) mempty + (DeleteInvite g) -> Delete (invite R./: g) mempty diff --git a/src/Discord/Rest/Prelude.hs b/src/Discord/Rest/Prelude.hs --- a/src/Discord/Rest/Prelude.hs +++ b/src/Discord/Rest/Prelude.hs @@ -24,7 +24,7 @@ where -- | https://discordapp.com/developers/docs/reference#user-agent -- Second place where the library version is noted - agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 0.7.1)" + agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 0.8.0)" -- Append to an URL infixl 5 // diff --git a/src/Discord/Types/Channel.hs b/src/Discord/Types/Channel.hs --- a/src/Discord/Types/Channel.hs +++ b/src/Discord/Types/Channel.hs @@ -17,7 +17,7 @@ -- | Represents information about a user. data User = User - { userId :: Snowflake -- ^ The user's id. + { userId :: UserId -- ^ The user's id. , userName :: String -- ^ The user's username, not unique across -- the platform. , userDiscrim :: String -- ^ The user's 4-digit discord-tag. @@ -29,11 +29,10 @@ , userVerified :: Maybe Bool -- ^ Whether the email on this account has -- been verified. , userEmail :: Maybe String -- ^ The user's email. - } - | Webhook deriving (Show, Eq) + } deriving (Show, Eq, Ord) instance FromJSON User where - parseJSON = withObject "Useer" $ \o -> + parseJSON = withObject "User" $ \o -> User <$> o .: "id" <*> o .: "username" <*> o .: "discriminator" @@ -43,24 +42,36 @@ <*> o .:? "verified" <*> o .:? "email" + +data Webhook = Webhook + { webhookId :: WebhookId + , webhookToken :: T.Text + } deriving (Show, Eq, Ord) + +instance FromJSON Webhook where + parseJSON = withObject "Webhook" $ \o -> + Webhook <$> o .: "id" + <*> o .: "token" + + -- | Guild channels represent an isolated set of users and messages in a Guild (Server) data Channel -- | A text channel in a guild. = ChannelText - { channelId :: Snowflake -- ^ The id of the channel (Will be equal to + { channelId :: ChannelId -- ^ The id of the channel (Will be equal to -- the guild if it's the "general" channel). - , channelGuild :: Snowflake -- ^ The id of the guild. + , channelGuild :: GuildId -- ^ The id of the guild. , channelName :: String -- ^ The name of the guild (2 - 1000 characters). , channelPosition :: Integer -- ^ The storing position of the channel. , channelPermissions :: [Overwrite] -- ^ An array of permission 'Overwrite's , channelTopic :: String -- ^ The topic of the channel. (0 - 1024 chars). - , channelLastMessage :: Maybe Snowflake -- ^ The id of the last message sent in the + , channelLastMessage :: Maybe MessageId -- ^ The id of the last message sent in the -- channel } -- | A voice channel in a guild. | ChannelVoice - { channelId :: Snowflake - , channelGuild :: Snowflake + { channelId :: ChannelId + , channelGuild :: GuildId , channelName :: String , channelPosition :: Integer , channelPermissions :: [Overwrite] @@ -70,19 +81,19 @@ -- | DM Channels represent a one-to-one conversation between two users, outside the scope -- of guilds | ChannelDirectMessage - { channelId :: Snowflake + { channelId :: ChannelId , channelRecipients :: [User] -- ^ The 'User' object(s) of the DM recipient(s). - , channelLastMessage :: Maybe Snowflake + , channelLastMessage :: Maybe MessageId } | ChannelGroupDM - { channelId :: Snowflake + { channelId :: ChannelId , channelRecipients :: [User] - , channelLastMessage :: Maybe Snowflake + , channelLastMessage :: Maybe MessageId } | ChannelGuildCategory - { channelId :: Snowflake - , channelGuild :: Snowflake - } deriving (Show, Eq) + { channelId :: ChannelId + , channelGuild :: GuildId + } deriving (Show, Eq, Ord) instance FromJSON Channel where parseJSON = withObject "Channel" $ \o -> do @@ -127,11 +138,11 @@ -- | Permission overwrites for a channel. data Overwrite = Overwrite - { overwriteId :: Snowflake -- ^ 'Role' or 'User' id + { overwriteId :: OverwriteId -- ^ 'Role' or 'User' id , overwriteType :: String -- ^ Either "role" or "member , overwriteAllow :: Integer -- ^ Allowed permission bit set , overwriteDeny :: Integer -- ^ Denied permission bit set - } deriving (Show, Eq) + } deriving (Show, Eq, Ord) instance FromJSON Overwrite where parseJSON = withObject "Overwrite" $ \o -> @@ -150,10 +161,10 @@ -- | Represents information about a message in a Discord channel. data Message = Message - { messageId :: Snowflake -- ^ The id of the message - , messageChannel :: Snowflake -- ^ Id of the channel the message + { messageId :: MessageId -- ^ The id of the message + , messageChannel :: ChannelId -- ^ Id of the channel the message -- was sent in - , messageAuthor :: User -- ^ The 'User' the message was sent + , messageAuthor :: Either WebhookId User -- ^ The 'User' the message was sent -- by , messageText :: T.Text -- ^ Contents of the message , messageTimestamp :: UTCTime -- ^ When the message was sent @@ -164,21 +175,24 @@ -- everyone , messageMentions :: [User] -- ^ 'User's specifically mentioned in -- the message - , messageMentionRoles :: [Snowflake] -- ^ 'Role's specifically mentioned in + , messageMentionRoles :: [RoleId] -- ^ 'Role's specifically mentioned in -- the message , messageAttachments :: [Attachment] -- ^ Any attached files , messageEmbeds :: [Embed] -- ^ Any embedded content , messageNonce :: Maybe Snowflake -- ^ Used for validating if a message -- was sent , messagePinned :: Bool -- ^ Whether this message is pinned - , messageGuild :: Maybe Snowflake -- ^ The guild the message went to + , messageGuild :: Maybe GuildId -- ^ The guild the message went to } deriving (Show, Eq) instance FromJSON Message where parseJSON = withObject "Message" $ \o -> Message <$> o .: "id" <*> o .: "channel_id" - <*> o .:? "author" .!= Webhook + <*> (do isW <- o .:? "webhook_id" + case isW :: Maybe WebhookId of + Nothing -> Right <$> o .: "author" + Just w -> pure (Left w)) <*> o .:? "content" .!= "" <*> o .:? "timestamp" .!= epochTime <*> o .:? "edited_timestamp" diff --git a/src/Discord/Types/Events.hs b/src/Discord/Types/Events.hs --- a/src/Discord/Types/Events.hs +++ b/src/Discord/Types/Events.hs @@ -13,41 +13,41 @@ import Data.Aeson.Types import qualified Data.Text as T -import Discord.Types.Prelude (Snowflake) +import Discord.Types.Prelude import Discord.Types.Channel -import Discord.Types.Guild (Guild, Unavailable, GuildInfo, +import Discord.Types.Guild (Guild, GuildUnavailable, GuildInfo, GuildMember, Role, Emoji) -- | Represents possible events sent by discord. Detailed information can be found at https://discordapp.com/developers/docs/topics/gateway. data Event = - Ready Int User [Channel] [Unavailable] String + Ready Int User [Channel] [GuildUnavailable] String | Resumed [T.Text] | ChannelCreate Channel | ChannelUpdate Channel | ChannelDelete Channel - | ChannelPinsUpdate Snowflake (Maybe UTCTime) + | ChannelPinsUpdate ChannelId (Maybe UTCTime) | GuildCreate Guild GuildInfo | GuildUpdate Guild - | GuildDelete Unavailable - | GuildBanAdd Snowflake User - | GuildBanRemove Snowflake User - | GuildEmojiUpdate Snowflake [Emoji] - | GuildIntegrationsUpdate Snowflake - | GuildMemberAdd Snowflake GuildMember - | GuildMemberRemove Snowflake User - | GuildMemberUpdate Snowflake [Snowflake] User (Maybe String) - | GuildMemberChunk Snowflake [GuildMember] - | GuildRoleCreate Snowflake Role - | GuildRoleUpdate Snowflake Role - | GuildRoleDelete Snowflake Snowflake + | GuildDelete GuildUnavailable + | GuildBanAdd GuildId User + | GuildBanRemove GuildId User + | GuildEmojiUpdate GuildId [Emoji] + | GuildIntegrationsUpdate GuildId + | GuildMemberAdd GuildId GuildMember + | GuildMemberRemove GuildId User + | GuildMemberUpdate GuildId [RoleId] User (Maybe String) + | GuildMemberChunk GuildId [GuildMember] + | GuildRoleCreate GuildId Role + | GuildRoleUpdate GuildId Role + | GuildRoleDelete GuildId RoleId | MessageCreate Message - | MessageUpdate Message - | MessageDelete Snowflake Snowflake - | MessageDeleteBulk Snowflake [Snowflake] + | MessageUpdate ChannelId MessageId + | MessageDelete ChannelId MessageId + | MessageDeleteBulk ChannelId [MessageId] | MessageReactionAdd ReactionInfo | MessageReactionRemove ReactionInfo - | MessageReactionRemoveAll Snowflake Snowflake + | MessageReactionRemoveAll ChannelId MessageId | PresenceUpdate PresenceInfo | TypingStart TypingInfo | UserUpdate User @@ -57,9 +57,9 @@ deriving Show data ReactionInfo = ReactionInfo - { reactionUserId :: Snowflake - , reactionChannelId :: Snowflake - , reactionMessageId :: Snowflake + { reactionUserId :: UserId + , reactionChannelId :: ChannelId + , reactionMessageId :: MessageId , reactionEmoji :: Emoji } deriving Show @@ -71,10 +71,10 @@ <*> o .: "emoji" data PresenceInfo = PresenceInfo - { presenceUserId :: Snowflake - , presenceRoles :: [Snowflake] + { presenceUserId :: UserId + , presenceRoles :: [RoleId] -- , presenceGame :: Maybe Activity - , presenceGuildId :: Snowflake + , presenceGuildId :: GuildId , presenceStatus :: String } deriving Show @@ -87,8 +87,8 @@ <*> o .: "status" data TypingInfo = TypingInfo - { typingUserId :: Snowflake - , typingChannelId :: Snowflake + { typingUserId :: UserId + , typingChannelId :: ChannelId , typingTimestamp :: UTCTime } deriving Show @@ -140,8 +140,8 @@ "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" - "MESSAGE_CREATE" -> MessageCreate <$> reparse o - "MESSAGE_UPDATE" -> MessageUpdate <$> reparse o + "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 diff --git a/src/Discord/Types/Gateway.hs b/src/Discord/Types/Gateway.hs --- a/src/Discord/Types/Gateway.hs +++ b/src/Discord/Types/Gateway.hs @@ -40,16 +40,16 @@ deriving (Show) data RequestGuildMembersOpts = RequestGuildMembersOpts - { requestGuildMembersGuildId :: Snowflake + { requestGuildMembersGuildId :: GuildId , requestGuildMembersSearchQuery :: T.Text , requestGuildMembersLimit :: Integer } deriving (Show) data UpdateStatusVoiceOpts = UpdateStatusVoiceOpts - { updateStatusVoiceGuildId :: Snowflake - , updateStatusVoiceChannelId :: Maybe Snowflake - , updateStatusVoiceIsMuted :: Snowflake - , updateStatusVoiceIsDeaf :: Snowflake + { updateStatusVoiceGuildId :: GuildId + , updateStatusVoiceChannelId :: Maybe ChannelId + , updateStatusVoiceIsMuted :: Bool + , updateStatusVoiceIsDeaf :: Bool } deriving (Show) diff --git a/src/Discord/Types/Guild.hs b/src/Discord/Types/Guild.hs --- a/src/Discord/Types/Guild.hs +++ b/src/Discord/Types/Guild.hs @@ -19,7 +19,7 @@ , memberJoinedAt :: UTCTime , memberDeaf :: Bool , memberMute :: Bool - } deriving Show + } deriving (Show, Eq, Ord) instance FromJSON GuildMember where parseJSON = withObject "GuildMember" $ \o -> @@ -36,26 +36,26 @@ -- | Guilds in Discord represent a collection of users and channels into an isolated -- "Server" data Guild = Guild - { guildId :: !Snowflake -- ^ Gulid id - , guildName :: T.Text -- ^ Guild name (2 - 100 chars) - , guildIcon :: Maybe T.Text -- ^ Icon hash - , guildSplash :: Maybe T.Text -- ^ Splash hash - , guildOwnerId :: !Snowflake -- ^ Guild owner id - , guildPermissions :: Maybe Integer - , guildRegion :: T.Text -- ^ Guild voice region - , guildAfkId :: Maybe Snowflake -- ^ Id of afk channel - , guildAfkTimeout :: !Integer -- ^ Afk timeout in seconds - , guildEmbedEnabled :: Maybe Bool -- ^ Id of embedded channel - , guildEmbedChannel :: Maybe Snowflake -- ^ Id of embedded channel - , guildVerificationLevel :: !Integer -- ^ Level of verification - , guildNotification :: !Integer -- ^ Level of default notifications - , guildExplicitFilterLevel :: !Integer + { guildId :: GuildId -- ^ Gulid id + , guildName :: T.Text -- ^ Guild name (2 - 100 chars) + , guildIcon :: Maybe T.Text -- ^ Icon hash + , guildSplash :: Maybe T.Text -- ^ Splash hash + , guildOwnerId :: UserId -- ^ Guild owner id + , guildPermissions :: Maybe Integer + , guildRegion :: T.Text -- ^ Guild voice region + , guildAfkId :: Maybe ChannelId -- ^ Id of afk channel + , guildAfkTimeout :: Integer -- ^ Afk timeout in seconds + , guildEmbedEnabled :: Maybe Bool -- ^ Id of embedded channel + , guildEmbedChannel :: Maybe ChannelId -- ^ Id of embedded channel + , guildVerificationLevel :: Integer -- ^ Level of verification + , guildNotification :: Integer -- ^ Level of default notifications + , guildExplicitFilterLevel :: Integer , guildRoles :: [Role] -- ^ Array of 'Role' objects , guildEmojis :: [Emoji] -- ^ Array of 'Emoji' objects , guildFeatures :: [T.Text] , guildMultiFactAuth :: !Integer - , guildApplicationId :: Maybe Snowflake - } deriving Show + , guildApplicationId :: Maybe Snowflake + } deriving (Show, Eq, Ord) instance FromJSON Guild where parseJSON = withObject "Guild" $ \o -> @@ -79,13 +79,13 @@ <*> o .: "mfa_level" <*> o .:? "application_id" -data Unavailable = Unavailable - { idOnceAvailable :: !Snowflake - } deriving Show +data GuildUnavailable = GuildUnavailable + { idOnceAvailable :: GuildId + } deriving (Show, Eq, Ord) -instance FromJSON Unavailable where - parseJSON = withObject "Unavailable" $ \o -> - Unavailable <$> o .: "id" +instance FromJSON GuildUnavailable where + parseJSON = withObject "GuildUnavailable" $ \o -> + GuildUnavailable <$> o .: "id" data GuildInfo = GuildInfo { guildJoinedAt :: UTCTime @@ -95,7 +95,7 @@ , guildMembers :: [GuildMember] , guildChannels :: [Channel] -- ^ Channels in the guild (sent in GuildCreate) -- , guildPresences :: [Presence] - } deriving Show + } deriving (Show, Eq, Ord) instance FromJSON GuildInfo where parseJSON = withObject "GuildInfo" $ \o -> @@ -107,28 +107,28 @@ <*> o .: "channels" data PartialGuild = PartialGuild - { partialGuildId :: Snowflake + { partialGuildId :: GuildId , partialGuildName :: T.Text , partialGuildIcon :: Maybe T.Text , partialGuildOwner :: Bool , partialGuildPermissions :: Integer - } deriving Show + } deriving (Show, Eq, Ord) instance FromJSON PartialGuild where parseJSON = withObject "PartialGuild" $ \o -> PartialGuild <$> o .: "id" <*> o .: "name" <*> o .:? "icon" - <*> o .: "owner" + <*> o .:? "owner" .!= False <*> o .: "permissions" -- | Represents an emoticon (emoji) data Emoji = Emoji - { emojiId :: Maybe Snowflake -- ^ The emoji id + { emojiId :: Maybe EmojiId -- ^ The emoji id , emojiName :: T.Text -- ^ The emoji name - , emojiRoles :: Maybe [Snowflake] -- ^ Roles the emoji is active for + , emojiRoles :: Maybe [RoleId] -- ^ Roles the emoji is active for , emojiManaged :: Maybe Bool -- ^ Whether this emoji is managed - } deriving (Show) + } deriving (Show, Eq, Ord) instance FromJSON Emoji where parseJSON = withObject "Emoji" $ \o -> @@ -143,7 +143,7 @@ -- (guild) and channel context. data Role = Role { - roleID :: !Snowflake -- ^ The role id + roleID :: RoleId -- ^ The role id , roleName :: T.Text -- ^ The role name , roleColor :: Integer -- ^ Integer representation of color code , roleHoist :: Bool -- ^ If the role is pinned in the user listing @@ -151,7 +151,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) + } deriving (Show, Eq, Ord) instance FromJSON Role where parseJSON = withObject "Role" $ \o -> @@ -167,7 +167,7 @@ -- | VoiceRegion is only refrenced in Guild endpoints, will be moved when voice support is added data VoiceRegion = VoiceRegion - { regionId :: !Snowflake -- ^ Unique id of the region + { regionId :: Snowflake -- ^ Unique id of the region , regionName :: T.Text -- ^ Name of the region , regionHostname :: T.Text -- ^ Example hostname for the region , regionPort :: Int -- ^ Example port for the region @@ -175,7 +175,7 @@ , regionOptimal :: Bool -- ^ True for the closest server to a client , regionDepreciated :: Bool -- ^ Whether this is a deprecated region , regionCustom :: Bool -- ^ Whether this is a custom region - } deriving (Show) + } deriving (Show, Eq, Ord) instance FromJSON VoiceRegion where parseJSON = withObject "VoiceRegion" $ \o -> @@ -190,16 +190,18 @@ -- | Represents a code to add a user to a guild data Invite = Invite - { inviteCode :: T.Text -- ^ The invite code - , inviteGuild :: !Snowflake -- ^ The guild the code will invite to - , inviteChan :: !Snowflake -- ^ The channel the code will invite to - } + { 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) instance FromJSON Invite where parseJSON = withObject "Invite" $ \o -> Invite <$> o .: "code" - <*> ((o .: "guild") >>= (.: "id")) - <*> ((o .: "channel") >>= (.: "id")) + <*> (do g <- o .:? "guild" + case g of Just g2 -> g2 .: "id" + Nothing -> pure Nothing) + <*> ((o .: "channel") >>= (.: "id")) -- | Invite code with additional metadata data InviteWithMeta = InviteWithMeta Invite InviteMeta @@ -237,13 +239,13 @@ , integrationType :: T.Text -- ^ Integration type (Twitch, Youtube, ect.) , integrationEnabled :: Bool -- ^ Is the integration enabled , integrationSyncing :: Bool -- ^ Is the integration syncing - , integrationRole :: Snowflake -- ^ Id the integration uses for "subscribers" + , integrationRole :: RoleId -- ^ Id the integration uses for "subscribers" , integrationBehavior :: Integer -- ^ The behavior of expiring subscribers , integrationGrace :: Integer -- ^ The grace period before expiring subscribers , 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) + } deriving (Show, Eq, Ord) instance FromJSON Integration where parseJSON = withObject "Integration" $ \o -> @@ -264,7 +266,7 @@ Account { accountId :: T.Text -- ^ The id of the account. , accountName :: T.Text -- ^ The name of the account. - } deriving (Show) + } deriving (Show, Eq, Ord) instance FromJSON IntegrationAccount where parseJSON = withObject "Account" $ \o -> @@ -273,8 +275,8 @@ -- | Represents an image to be used in third party sites to link to a discord channel data GuildEmbed = GuildEmbed - { embedEnabled :: !Bool -- ^ Whether the embed is enabled - , embedChannel :: !Snowflake -- ^ The embed channel id + { embedEnabled :: Bool -- ^ Whether the embed is enabled + , embedChannel :: ChannelId -- ^ The embed channel id } instance FromJSON GuildEmbed where diff --git a/src/Discord/Types/Prelude.hs b/src/Discord/Types/Prelude.hs --- a/src/Discord/Types/Prelude.hs +++ b/src/Discord/Types/Prelude.hs @@ -53,6 +53,7 @@ type OverwriteId = Snowflake type RoleId = Snowflake type IntegrationId = Snowflake +type WebhookId = Snowflake -- | Gets a creation date from a snowflake. snowflakeCreationDate :: Snowflake -> UTCTime