discord-types (empty) → 0.2.2
raw patch · 9 files changed
+925/−0 lines, 9 filesdep +aesondep +basedep +hashablesetup-changed
Dependencies added: aeson, base, hashable, text, time, transformers, unordered-containers, vector
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- discord-types.cabal +40/−0
- src/Network/Discord/Types.hs +28/−0
- src/Network/Discord/Types/Channel.hs +328/−0
- src/Network/Discord/Types/Events.hs +94/−0
- src/Network/Discord/Types/Gateway.hs +114/−0
- src/Network/Discord/Types/Guild.hs +238/−0
- src/Network/Discord/Types/Prelude.hs +61/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Joshua Koike++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ discord-types.cabal view
@@ -0,0 +1,40 @@+name: discord-types+version: 0.2.2+synopsis: Type information for discord-hs+description: Type information for discord-hs+homepage: https://github.com/jano017/Discord.hs+license: MIT+license-file: LICENSE+author: Joshua Koike+maintainer: jkoike2013@gmail.com+category: Network+build-type: Simple+cabal-version: >=1.10++Flag disable-docs+ Description: Disable documentation generation+ Manual: True+ Default: False++library+ exposed-modules: Network.Discord.Types+ , Network.Discord.Types.Channel+ , Network.Discord.Types.Guild+ , Network.Discord.Types.Events+ , Network.Discord.Types.Gateway+ other-modules: Network.Discord.Types.Prelude+ build-depends: base==4.*+ , aeson>=1.0 && <1.2+ , text==1.2.*+ , time>=1.6 && <1.9+ , hashable==1.2.*+ , vector>=0.10 && <0.13+ , unordered-containers==0.2.*+ , transformers==0.5.*+ ghc-options: -Wall+ hs-source-dirs: src+ default-language: Haskell2010++source-repository head+ type : git+ location: https://github.com/jano017/Discord.hs
+ src/Network/Discord/Types.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE RankNTypes, ExistentialQuantification, GeneralizedNewtypeDeriving #-}+{-# OPTIONS_HADDOCK prune, not-home #-}+-- | Provides types and encoding/decoding code. Types should be identical to those provided+-- in the Discord API documentation.+module Network.Discord.Types+ ( module Network.Discord.Types+ , module Network.Discord.Types.Prelude+ , module Network.Discord.Types.Channel+ , module Network.Discord.Types.Events+ , module Network.Discord.Types.Gateway+ , module Network.Discord.Types.Guild+ , module Data.Aeson+ ) where+ import Control.Monad (MonadPlus)++ import Network.Discord.Types.Channel+ import Network.Discord.Types.Events+ import Network.Discord.Types.Gateway+ import Network.Discord.Types.Guild+ import Network.Discord.Types.Prelude++ import Control.Monad.IO.Class+ import Data.Aeson (Object)++ class (MonadIO m, MonadPlus m) => DiscordAuth m where+ auth :: m Auth+ version :: m String+ runIO :: m a -> IO a
+ src/Network/Discord/Types/Channel.hs view
@@ -0,0 +1,328 @@+{-# LANGUAGE OverloadedStrings, MultiWayIf #-}+{-# LANGUAGE RecordWildCards #-}+-- | Data structures pertaining to Discord Channels+module Network.Discord.Types.Channel where+ import Control.Monad (mzero)+ import Data.Text as Text (pack, Text)++ import Data.Aeson+ import Data.Aeson.Types (Parser)+ import Data.Time.Clock+ import Data.Vector (toList)+ import qualified Data.HashMap.Strict as HM+ import qualified Data.Vector as V++ import Network.Discord.Types.Prelude++ -- |Represents information about a user.+ data User = User+ { userId :: {-# UNPACK #-} !Snowflake -- ^ The user's id.+ , userName :: String -- ^ The user's username, not unique across+ -- the platform.+ , userDiscrim :: String -- ^ The user's 4-digit discord-tag.+ , userAvatar :: Maybe String -- ^ The user's avatar hash.+ , userIsBot :: Bool -- ^ Whether the user belongs to an OAuth2+ -- application.+ , userMfa :: Maybe Bool -- ^ Whether the user has two factor+ -- authentication enabled on the account.+ , userVerified :: Maybe Bool -- ^ Whether the email on this account has+ -- been verified.+ , userEmail :: Maybe String -- ^ The user's email.+ }+ | Webhook deriving (Show, Eq)++ instance FromJSON User where+ parseJSON (Object o) =+ User <$> o .: "id"+ <*> o .: "username"+ <*> o .: "discriminator"+ <*> o .:? "avatar"+ <*> o .:? "bot" .!= False+ <*> o .:? "mfa_enabled"+ <*> o .:? "verified"+ <*> o .:? "email"+ parseJSON _ = mzero++ -- | Guild channels represent an isolated set of users and messages in a Guild (Server)+ data Channel+ -- | A text channel in a guild.+ = Text+ { channelId :: Snowflake -- ^ The id of the channel (Will be equal to+ -- the guild if it's the "general" channel).+ , channelGuild :: Snowflake -- ^ 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 :: Snowflake -- ^ The id of the last message sent in the+ -- channel+ }+ -- |A voice channel in a guild.+ | Voice+ { channelId:: Snowflake+ , channelGuild:: Snowflake+ , channelName:: String+ , channelPosition:: Integer+ , channelPermissions:: [Overwrite]+ , channelBitRate:: Integer -- ^ The bitrate (in bits) of the channel.+ , channelUserLimit:: Integer -- ^ The user limit of the voice channel.+ }+ -- | DM Channels represent a one-to-one conversation between two users, outside the scope+ -- of guilds+ | DirectMessage+ { channelId :: Snowflake+ , channelRecipients :: [User] -- ^ The 'User' object(s) of the DM recipient(s).+ , channelLastMessage :: Snowflake+ } deriving (Show, Eq)++ instance FromJSON Channel where+ parseJSON = withObject "text or voice" $ \o -> do+ type' <- (o .: "type") :: Parser Int+ case type' of+ 0 ->+ Text <$> o .: "id"+ <*> o .: "guild_id"+ <*> o .: "name"+ <*> o .: "position"+ <*> o .: "permission_overwrites"+ <*> o .:? "topic" .!= ""+ <*> o .:? "last_message_id" .!= 0+ 1 ->+ DirectMessage <$> o .: "id"+ <*> o .: "recipients"+ <*> o .:? "last_message_id" .!= 0+ 2 ->+ Voice <$> o .: "id"+ <*> o .: "guild_id"+ <*> o .: "name"+ <*> o .: "position"+ <*> o .: "permission_overwrites"+ <*> o .: "bitrate"+ <*> o .: "user_limit"+ _ -> mzero++ -- | Permission overwrites for a channel.+ data Overwrite = Overwrite+ { overwriteId:: {-# UNPACK #-} !Snowflake -- ^ '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)++ instance FromJSON Overwrite where+ parseJSON (Object o) =+ Overwrite <$> o .: "id"+ <*> o .: "type"+ <*> o .: "allow"+ <*> o .: "deny"+ parseJSON _ = mzero++ -- | Represents information about a message in a Discord channel.+ data Message = Message+ { messageId :: {-# UNPACK #-} !Snowflake -- ^ The id of the message+ , messageChannel :: {-# UNPACK #-} !Snowflake -- ^ Id of the channel the message+ -- was sent in+ , messageAuthor :: User -- ^ The 'User' the message was sent+ -- by+ , messageContent :: Text -- ^ Contents of the message+ , messageTimestamp :: UTCTime -- ^ When the message was sent+ , messageEdited :: Maybe UTCTime -- ^ When/if the message was edited+ , messageTts :: Bool -- ^ Whether this message was a TTS+ -- message+ , messageEveryone :: Bool -- ^ Whether this message mentions+ -- everyone+ , messageMentions :: [User] -- ^ 'User's specifically mentioned in+ -- the message+ , messageMentionRoles :: [Snowflake] -- ^ '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+ } deriving (Show, Eq)++ instance FromJSON Message where+ parseJSON (Object o) =+ Message <$> o .: "id"+ <*> o .: "channel_id"+ <*> o .:? "author" .!= Webhook+ <*> o .:? "content" .!= ""+ <*> o .:? "timestamp" .!= epochTime+ <*> o .:? "edited_timestamp"+ <*> o .:? "tts" .!= False+ <*> o .:? "mention_everyone" .!= False+ <*> o .:? "mentions" .!= []+ <*> o .:? "mention_roles" .!= []+ <*> o .:? "attachments" .!= []+ <*> o .: "embeds"+ <*> o .:? "nonce"+ <*> o .:? "pinned" .!= False+ parseJSON _ = mzero++ -- |Represents an attached to a message file.+ data Attachment = Attachment+ { attachmentId :: {-# UNPACK #-} !Snowflake -- ^ Attachment id+ , attachmentFilename :: String -- ^ Name of attached file+ , attachmentSize :: Integer -- ^ Size of file (in bytes)+ , attachmentUrl :: String -- ^ Source of file+ , attachmentProxy :: String -- ^ Proxied url of file+ , attachmentHeight :: Maybe Integer -- ^ Height of file (if image)+ , attachmentWidth :: Maybe Integer -- ^ Width of file (if image)+ } deriving (Show, Eq)++ instance FromJSON Attachment where+ parseJSON (Object o) =+ Attachment <$> o .: "id"+ <*> o .: "filename"+ <*> o .: "size"+ <*> o .: "url"+ <*> o .: "proxy_url"+ <*> o .:? "height"+ <*> o .:? "width"+ parseJSON _ = mzero++ -- |An embed attached to a message.+ data Embed = Embed+ { embedTitle :: String -- ^ Title of the embed+ , embedType :: String -- ^ Type of embed (Always "rich" for webhooks)+ , embedDesc :: String -- ^ Description of embed+ , embedUrl :: String -- ^ URL of embed+ , embedTime :: UTCTime -- ^ The time of the embed content+ , embedColor :: Integer -- ^ The embed color+ , embedFields ::[SubEmbed] -- ^ Fields of the embed+ } deriving (Show, Read, Eq)++ instance FromJSON Embed where+ parseJSON (Object o) =+ Embed <$> o .:? "title" .!= "Untitled"+ <*> o .: "type"+ <*> o .:? "description" .!= ""+ <*> o .:? "url" .!= ""+ <*> o .:? "timestamp" .!= epochTime+ <*> o .:? "color" .!= 0+ <*> sequence (HM.foldrWithKey to_embed [] o)+ where+ to_embed k (Object v) a+ | k == pack "footer" =+ (Footer <$> v .: "text"+ <*> v .:? "icon_url" .!= ""+ <*> v .:? "proxy_icon_url" .!= "") : a+ | k == pack "image" =+ (Image <$> v .: "url"+ <*> v .: "proxy_url"+ <*> v .: "height"+ <*> v .: "width") : a+ | k == pack "thumbnail" =+ (Thumbnail <$> v .: "url"+ <*> v .: "proxy_url"+ <*> v .: "height"+ <*> v .: "width") : a+ | k == pack "video" =+ (Video <$> v .: "url"+ <*> v .: "height"+ <*> v .: "width") : a+ | k == pack "provider" =+ (Provider <$> v .: "name"+ <*> v .:? "url" .!= "") : a+ | k == pack "author" =+ (Author <$> v .: "name"+ <*> v .:? "url" .!= ""+ <*> v .:? "icon_url" .!= ""+ <*> v .:? "proxy_icon_url" .!= "") : a+ to_embed k (Array v) a+ | k == pack "fields" =+ [Field <$> i .: "name"+ <*> i .: "value"+ <*> i .: "inline"+ | Object i <- toList v] ++ a+ to_embed _ _ a = a++ parseJSON _ = mzero++ instance ToJSON Embed where+ toJSON (Embed {..}) = object+ [ "title" .= embedTitle+ , "type" .= embedType+ , "description" .= embedDesc+ , "url" .= embedUrl+ , "timestamp" .= embedTime+ , "color" .= embedColor+ ] |> makeSubEmbeds embedFields+ where+ (Object o) |> hm = Object $ HM.union o hm+ _ |> _ = error "Type mismatch"+ makeSubEmbeds = foldr embed HM.empty+ embed (Thumbnail url _ height width) =+ HM.alter (\_ -> Just $ object+ [ "url" .= url+ , "height" .= height+ , "width" .= width+ ]) "thumbnail"+ embed (Image url _ height width) =+ HM.alter (\_ -> Just $ object+ [ "url" .= url+ , "height" .= height+ , "width" .= width+ ]) "image"+ embed (Author name url icon _) =+ HM.alter (\_ -> Just $ object+ [ "name" .= name+ , "url" .= url+ , "icon_url" .= icon+ ]) "author"+ embed (Footer text icon _) =+ HM.alter (\_ -> Just $ object+ [ "text" .= text+ , "icon_url" .= icon+ ]) "footer"+ embed (Field name value inline) =+ HM.alter (\val -> case val of+ Just (Array a) -> Just . Array $ V.cons (object+ [ "name" .= name+ , "value" .= value+ , "inline" .= inline+ ]) a+ _ -> Just $ toJSON [+ object+ [ "name" .= name+ , "value" .= value+ , "inline" .= inline+ ]+ ]+ ) "fields"+ embed _ = id++ -- |Represents a part of an embed.+ data SubEmbed+ = Thumbnail+ String+ String+ Integer+ Integer+ | Video+ String+ Integer+ Integer+ | Image+ String+ String+ Integer+ Integer+ | Provider+ String+ String+ | Author+ String+ String+ String+ String+ | Footer+ String+ String+ String+ | Field+ String+ String+ Bool+ deriving (Show, Read, Eq)
+ src/Network/Discord/Types/Events.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings, GADTs #-}+-- | Data structures pertaining to gateway dispatch 'Event's+module Network.Discord.Types.Events where+ import Control.Monad (mzero)++ import Data.Aeson++ import Network.Discord.Types.Channel+ import Network.Discord.Types.Gateway+ import Network.Discord.Types.Guild (Member, Guild)+ import Network.Discord.Types.Prelude++ -- |Represents data sent on READY event.+ data Init = Init Int User [Channel] [Guild] String deriving Show++ -- |Allows Init type to be generated using a JSON response by Discord.+ instance FromJSON Init where+ parseJSON (Object o) = Init <$> o .: "v"+ <*> o .: "user"+ <*> o .: "private_channels"+ <*> o .: "guilds"+ <*> o .: "session_id"+ parseJSON _ = mzero++ -- |Represents possible events sent by discord. Detailed information can be found at https://discordapp.com/developers/docs/topics/gateway.+ data Event =+ Ready Init+ | Resumed Object+ | ChannelCreate Channel+ | ChannelUpdate Channel+ | ChannelDelete Channel+ | GuildCreate Guild+ | GuildUpdate Guild+ | GuildDelete Guild+ | GuildBanAdd Member+ | GuildBanRemove Member+ | GuildEmojiUpdate Object+ | GuildIntegrationsUpdate Object+ | GuildMemberAdd Member+ | GuildMemberRemove Member+ | GuildMemberUpdate Member+ | GuildMemberChunk Object+ | GuildRoleCreate Object+ | GuildRoleUpdate Object+ | GuildRoleDelete Object+ | MessageCreate Message+ | MessageUpdate Message+ | MessageDelete Object+ | MessageDeleteBulk Object+ | PresenceUpdate Object+ | TypingStart Object+ | UserSettingsUpdate Object+ | UserUpdate Object+ | VoiceStateUpdate Object+ | VoiceServerUpdate Object+ | UnknownEvent String Object+ | Nil+ deriving Show++ -- |Parses JSON stuff by Discord to an event type.+ parseDispatch :: Payload -> Either String Event+ parseDispatch (Dispatch ob _ ev) = case ev of+ "READY" -> Ready <$> reparse o+ "RESUMED" -> Resumed <$> reparse o+ "CHANNEL_CREATE" -> ChannelCreate <$> reparse o+ "CHANNEL_UPDATE" -> ChannelUpdate <$> reparse o+ "CHANNEL_DELETE" -> ChannelDelete <$> reparse o+ "GUILD_CREATE" -> GuildCreate <$> reparse o+ "GUILD_UPDATE" -> GuildUpdate <$> reparse o+ "GUILD_DELETE" -> GuildDelete <$> reparse o+ "GUILD_BAN_ADD" -> GuildBanAdd <$> reparse o+ "GUILD_BAN_REMOVE" -> GuildBanRemove <$> reparse o+ "GUILD_EMOJI_UPDATE" -> GuildEmojiUpdate <$> reparse o+ "GUILD_INTEGRATIONS_UPDATE" -> GuildIntegrationsUpdate <$> reparse o+ "GUILD_MEMBER_ADD" -> GuildMemberAdd <$> reparse o+ "GUILD_MEMBER_UPDATE" -> GuildMemberUpdate <$> reparse o+ "GUILD_MEMBER_REMOVE" -> GuildMemberRemove <$> reparse o+ "GUILD_MEMBER_CHUNK" -> GuildMemberChunk <$> reparse o+ "GUILD_ROLE_CREATE" -> GuildRoleCreate <$> reparse o+ "GUILD_ROLE_UPDATE" -> GuildRoleUpdate <$> reparse o+ "GUILD_ROLE_DELETE" -> GuildRoleDelete <$> reparse o+ "MESSAGE_CREATE" -> MessageCreate <$> reparse o+ "MESSAGE_UPDATE" -> MessageUpdate <$> reparse o+ "MESSAGE_DELETE" -> MessageDelete <$> reparse o+ "MESSAGE_DELETE_BULK" -> MessageDeleteBulk <$> reparse o+ "PRESENCE_UPDATE" -> PresenceUpdate <$> reparse o+ "TYPING_START" -> TypingStart <$> reparse o+ "USER_SETTINGS_UPDATE" -> UserSettingsUpdate <$> reparse o+ "VOICE_STATE_UPDATE" -> VoiceStateUpdate <$> reparse o+ "VOICE_SERVER_UPDATE" -> VoiceServerUpdate <$> reparse o+ _ -> UnknownEvent ev <$> reparse o+ where o = Object ob+ parseDispatch _ = error "Tried to parse non-Dispatch payload"+
+ src/Network/Discord/Types/Gateway.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Data structures needed for interfacing with the Websocket+-- Gateway+module Network.Discord.Types.Gateway where+ import Control.Monad (mzero)+ import System.Info++ import Data.Aeson+ import Data.Aeson.Types++ import Network.Discord.Types.Prelude++ -- |Represents all sorts of things that we can send to Discord.+ data Payload+ = Dispatch+ Object+ Integer+ String+ | Heartbeat+ Integer+ | Identify+ Auth+ Bool+ Integer+ (Int, Int)+ | StatusUpdate+ (Maybe Integer)+ (Maybe String)+ | VoiceStatusUpdate+ {-# UNPACK #-} !Snowflake+ !(Maybe Snowflake)+ Bool+ Bool+ | Resume+ String+ String+ Integer+ | Reconnect+ | RequestGuildMembers+ {-# UNPACK #-} !Snowflake+ String+ Integer+ | InvalidSession+ | Hello+ Int+ | HeartbeatAck+ | ParseError String+ deriving Show++ instance FromJSON Payload where+ parseJSON = withObject "payload" $ \o -> do+ op <- o .: "op" :: Parser Int+ case op of+ 0 -> Dispatch <$> o .: "d" <*> o .: "s" <*> o .: "t"+ 1 -> Heartbeat <$> o .: "d"+ 7 -> return Reconnect+ 9 -> return InvalidSession+ 10 -> (\od -> Hello <$> od .: "heartbeat_interval") =<< o .: "d"+ 11 -> return HeartbeatAck+ _ -> mzero++ instance ToJSON Payload where+ toJSON (Heartbeat i) = object [ "op" .= (1 :: Int), "d" .= i ]+ toJSON (Identify token compress large shard) = object [+ "op" .= (2 :: Int)+ , "d" .= object [+ "token" .= authToken token+ , "properties" .= object [+ "$os" .= os+ , "$browser" .= ("discord.hs" :: String)+ , "$device" .= ("discord.hs" :: String)+ , "$referrer" .= ("" :: String)+ , "$referring_domain" .= ("" :: String)+ ]+ , "compress" .= compress+ , "large_threshold" .= large+ , "shard" .= shard+ ]+ ]+ toJSON (StatusUpdate idle game) = object [+ "op" .= (3 :: Int)+ , "d" .= object [+ "idle_since" .= idle+ , "game" .= object [+ "name" .= game+ ]+ ]+ ]+ toJSON (VoiceStatusUpdate guild channel mute deaf) = object [+ "op" .= (4 :: Int)+ , "d" .= object [+ "guild_id" .= guild+ , "channel_id" .= channel+ , "self_mute" .= mute+ , "self_deaf" .= deaf+ ]+ ]+ toJSON (Resume token session seqId) = object [+ "op" .= (6 :: Int)+ , "d" .= object [+ "token" .= token+ , "session_id" .= session+ , "seq" .= seqId+ ]+ ]+ toJSON (RequestGuildMembers guild query limit) = object [+ "op" .= (8 :: Int)+ , "d" .= object [+ "guild_id" .= guild+ , "query" .= query+ , "limit" .= limit+ ]+ ]+ toJSON _ = object []
+ src/Network/Discord/Types/Guild.hs view
@@ -0,0 +1,238 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Types relating to Discord Guilds (servers)+module Network.Discord.Types.Guild where+ import Data.Time.Clock++ import Data.Aeson+ import Control.Applicative ((<|>))+ import Control.Monad (mzero)++ import Network.Discord.Types.Channel+ import Network.Discord.Types.Prelude++ -- |Representation of a guild member.+ data Member = GuildMember {-# UNPACK #-} !Snowflake User+ | MemberShort User (Maybe String) ![Snowflake]+ deriving Show+ instance FromJSON Member where+ parseJSON (Object o) =+ GuildMember <$> o .: "guild_id" <*> o .: "user"+ parseJSON _ = mzero++ -- | Guilds in Discord represent a collection of users and channels into an isolated+ -- "Server"+ data Guild+ = Guild+ { guildId :: {-# UNPACK #-} !Snowflake -- ^ Gulid id+ , guildName :: String -- ^ Guild name (2 - 100 chars)+ , guildIcon :: String -- ^ Icon hash+ , guildSplash :: String -- ^ Splash hash+ , guildOwner :: !Snowflake -- ^ Guild owner id+ , guildRegion :: String -- ^ Guild voice region+ , guildAfkId :: !Snowflake -- ^ Id of afk channel+ , guildAfkTimeout :: !Integer -- ^ Afk timeout in seconds+ , guildEmbedEnabled :: !Bool -- ^ Is this guild embeddable?+ , guildEmbedChannel :: !Snowflake -- ^ Id of embedded channel+ , guildVerification :: !Integer -- ^ Level of verification+ , guildNotification :: !Integer -- ^ Level of default notifications+ , guildRoles :: [Role] -- ^ Array of 'Role' objects+ , guildEmojis :: [Emoji] -- ^ Array of 'Emoji' objects+ }+ | Unavailable+ { guildId :: {-# UNPACK #-} !Snowflake+ } deriving Show++ instance FromJSON Guild where+ parseJSON (Object o) = do+ short <- o .:? "unavailable" .!= False+ if short+ then Unavailable <$> o .: "id"+ else+ Guild <$> o .: "id"+ <*> o .: "name"+ <*> o .:? "icon" .!= ""+ <*> o .:? "hash" .!= ""+ <*> o .: "owner_id"+ <*> o .: "region"+ <*> o .:? "afk_channel_id" .!= 0+ <*> o .:? "afk_timeout" .!= 0+ <*> o .:? "embed_enabled" .!= False+ <*> o .:? "embed_channel_id" .!= 0+ <*> o .: "verification_level"+ <*> o .: "default_message_notifications"+ <*> o .: "roles"+ <*> o .: "emojis"+ parseJSON _ = mzero++ -- | Represents an emoticon (emoji)+ data Emoji = Emoji+ { emojiId :: {-# UNPACK #-} !Snowflake -- ^ The emoji id+ , emojiName :: String -- ^ The emoji name+ , emojiRoles :: ![Snowflake] -- ^ Roles the emoji is active for+ , emojiManaged :: !Bool -- ^ Whether this emoji is managed+ } deriving (Show)++ instance FromJSON Emoji where+ parseJSON (Object o) =+ Emoji <$> o .: "id"+ <*> o .: "name"+ <*> o .: "roles"+ <*> o .: "managed"+ parseJSON _ = mzero++ -- | Roles represent a set of permissions attached to a group of users. Roles have unique+ -- names, colors, and can be "pinned" to the side bar, causing their members to be listed separately.+ -- Roles are unique per guild, and can have separate permission profiles for the global context+ -- (guild) and channel context.+ data Role =+ Role {+ roleID :: {-# UNPACK #-} !Snowflake -- ^ The role id+ , roleName :: String -- ^ The role name+ , roleColor :: Integer -- ^ Integer representation of color code+ , roleHoist :: Bool -- ^ If the role is pinned in the user listing+ , rolePos :: Integer -- ^ Position of this role+ , 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)++ instance FromJSON Role where+ parseJSON (Object o) = Role+ <$> o .: "id"+ <*> o .: "name"+ <*> o .: "color"+ <*> o .: "hoist"+ <*> o .: "position"+ <*> o .: "permissions"+ <*> o .: "managed"+ <*> o .: "mentionable"+ parseJSON _ = mzero++ -- | VoiceRegion is only refrenced in Guild endpoints, will be moved when voice support is added+ data VoiceRegion =+ VoiceRegion+ { regionId :: {-# UNPACK #-} !Snowflake -- ^ Unique id of the region+ , regionName :: String -- ^ Name of the region+ , regionHostname :: String -- ^ Example hostname for the region+ , regionPort :: Int -- ^ Example port for the region+ , regionVip :: Bool -- ^ True if this is a VIP only server+ , 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)++ instance FromJSON VoiceRegion where+ parseJSON (Object o) = VoiceRegion+ <$> o .: "id"+ <*> o .: "name"+ <*> o .: "sample_hostname"+ <*> o .: "sample_port"+ <*> o .: "vip"+ <*> o .: "optimal"+ <*> o .: "deprecated"+ <*> o .: "custom"+ parseJSON _ = mzero++ -- | Represents a code to add a user to a guild+ data Invite =+ Invite {+ inviteCode :: String -- ^ The invite code+ , inviteGuild :: !Snowflake -- ^ The guild the code will invite to+ , inviteChan :: !Snowflake -- ^ The channel the code will invite to+ }+ -- | Invite code with additional metadata+ | InviteLong Invite InviteMeta++ instance FromJSON Invite where+ parseJSON ob@(Object o) =+ InviteLong <$> parseJSON ob <*> parseJSON ob+ <|> Invite+ <$> o .: "code"+ <*> ((o .: "guild") >>= (.: "id"))+ <*> ((o .: "channel") >>= (.: "id"))+ parseJSON _ = mzero++ -- | Additional metadata about an invite.+ data InviteMeta =+ InviteMeta {+ inviteCreator :: User -- ^ The user that created the invite+ , inviteUses :: Integer -- ^ Number of times the invite has been used+ , inviteMax :: Integer -- ^ Max number of times the invite can be used+ , inviteAge :: Integer -- ^ The duration (in seconds) after which the invite expires+ , inviteTemp :: Bool -- ^ Whether this invite only grants temporary membership+ , inviteCreated :: UTCTime -- ^ When the invite was created+ , inviteRevoked :: Bool -- ^ If the invite is revoked+ }++ instance FromJSON InviteMeta where+ parseJSON (Object o) = InviteMeta+ <$> o .: "inviter"+ <*> o .: "uses"+ <*> o .: "max_uses"+ <*> o .: "max_age"+ <*> o .: "temporary"+ <*> o .: "created_at"+ <*> o .: "revoked"+ parseJSON _ = mzero++ -- | Represents the behavior of a third party account link.+ data Integration =+ Integration+ { integrationId :: {-# UNPACK #-} !Snowflake -- ^ Integration id+ , integrationName :: String -- ^ Integration name+ , integrationType :: String -- ^ 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"+ , 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)++ instance FromJSON Integration where+ parseJSON (Object o) = Integration+ <$> o .: "id"+ <*> o .: "name"+ <*> o .: "type"+ <*> o .: "enabled"+ <*> o .: "syncing"+ <*> o .: "role_id"+ <*> o .: "expire_behavior"+ <*> o .: "expire_grace_period"+ <*> o .: "user"+ <*> o .: "account"+ <*> o .: "synced_at"+ parseJSON _ = mzero++ -- | Represents a third party account link.+ data IntegrationAccount =+ Account+ { accountId :: String -- ^ The id of the account.+ , accountName :: String -- ^ The name of the account.+ } deriving (Show)++ instance FromJSON IntegrationAccount where+ parseJSON (Object o) = Account+ <$> o .: "id"+ <*> o .: "name"+ parseJSON _ = mzero++ -- | 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 :: {-# UNPACK #-} !Snowflake -- ^ The embed channel id+ }+ instance FromJSON GuildEmbed where+ parseJSON (Object o) = GuildEmbed+ <$> o .: "enabled"+ <*> o .: "snowflake"+ parseJSON _ = mzero++ instance ToJSON GuildEmbed where+ toJSON (GuildEmbed enabled snowflake) = object+ [ "enabled" .= enabled+ , "snowflake" .= snowflake+ ]
+ src/Network/Discord/Types/Prelude.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE ExistentialQuantification, TypeSynonymInstances, GeneralizedNewtypeDeriving #-}+-- | Provides base types and utility functions needed for modules in Network.Discord.Types+module Network.Discord.Types.Prelude where+ import Data.Bits+ import Data.Word++ import Data.Aeson.Types+ import Data.Hashable+ import Data.Text+ import Data.Time.Clock+ import Data.Time.Clock.POSIX+ import Control.Monad (mzero)++ -- | Authorization token for the Discord API+ data Auth = Bot String+ | Client String+ | Bearer String++ -- | Formats the token for use with the REST API+ instance Show Auth where+ show (Bot token) = "Bot " ++ token+ show (Client token) = token+ show (Bearer token) = "Bearer " ++ token++ -- | Get the raw token formatted for use with the websocket gateway+ authToken :: Auth -> String+ authToken (Bot token) = token+ authToken (Client token) = token+ authToken (Bearer token) = token++ -- | A unique integer identifier. Can be used to calculate the creation date of an entity.+ newtype Snowflake = Snowflake Word64+ deriving (Ord, Eq, Num, Integral, Enum, Real, Bits, Hashable)++ instance Show Snowflake where+ show (Snowflake a) = show a++ instance ToJSON Snowflake where+ toJSON (Snowflake snowflake) = String . pack $ show snowflake++ instance FromJSON Snowflake where+ parseJSON (String snowflake) = Snowflake <$> (return . read $ unpack snowflake)+ parseJSON _ = mzero++ -- |Gets a creation date from a snowflake.+ creationDate :: Snowflake -> UTCTime+ creationDate x = posixSecondsToUTCTime . realToFrac+ $ 1420070400 + quot (shiftR x 22) 1000++ -- | Default timestamp+ epochTime :: UTCTime+ epochTime = posixSecondsToUTCTime 0++ -- | Return only the Right vaule from an either+ justRight :: (Show a) => Either a b -> b+ justRight (Right b) = b+ justRight (Left a) = error $ show a++ -- | Convert ToJSON values to FromJSON values+ reparse :: (ToJSON a, FromJSON b) => a -> Either String b+ reparse val = parseEither parseJSON $ toJSON val