{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Discord.Internal.Types.Channel where
import Control.Applicative (empty)
import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Time.Clock
import qualified Data.Text as T
import Discord.Internal.Types.Prelude
import Discord.Internal.Types.User (User(..))
import Discord.Internal.Types.Embed
data Channel
= ChannelText
{ channelId :: ChannelId
, channelGuild :: GuildId
, channelName :: T.Text
, channelPosition :: Integer
, channelPermissions :: [Overwrite]
, channelUserRateLimit :: Integer
, channelNSFW :: Bool
, channelTopic :: T.Text
, channelLastMessage :: Maybe MessageId
}
| ChannelNews
{ channelId :: ChannelId
, channelGuild :: GuildId
, channelName :: T.Text
, channelPosition :: Integer
, channelPermissions :: [Overwrite]
, channelNSFW :: Bool
, channelTopic :: T.Text
, channelLastMessage :: Maybe MessageId
}
| ChannelStorePage
{ channelId :: ChannelId
, channelGuild :: GuildId
, channelName :: T.Text
, channelPosition :: Integer
, channelNSFW :: Bool
, channelPermissions :: [Overwrite]
}
| ChannelVoice
{ channelId :: ChannelId
, channelGuild :: GuildId
, channelName :: T.Text
, channelPosition :: Integer
, channelPermissions :: [Overwrite]
, channelNSFW :: Bool
, channelBitRate :: Integer
, channelUserLimit :: Integer
}
| ChannelDirectMessage
{ channelId :: ChannelId
, channelRecipients :: [User]
, channelLastMessage :: Maybe MessageId
}
| ChannelGroupDM
{ channelId :: ChannelId
, channelRecipients :: [User]
, channelLastMessage :: Maybe MessageId
}
| ChannelGuildCategory
{ channelId :: ChannelId
, channelGuild :: GuildId
} deriving (Show, Eq, Ord)
instance FromJSON Channel where
parseJSON = withObject "Channel" $ \o -> do
type' <- (o .: "type") :: Parser Int
case type' of
0 ->
ChannelText <$> o .: "id"
<*> o .:? "guild_id" .!= 0
<*> o .: "name"
<*> o .: "position"
<*> o .: "permission_overwrites"
<*> o .: "rate_limit_per_user"
<*> o .:? "nsfw" .!= False
<*> o .:? "topic" .!= ""
<*> o .:? "last_message_id"
1 ->
ChannelDirectMessage <$> o .: "id"
<*> o .: "recipients"
<*> o .:? "last_message_id"
2 ->
ChannelVoice <$> o .: "id"
<*> o .:? "guild_id" .!= 0
<*> o .: "name"
<*> o .: "position"
<*> o .: "permission_overwrites"
<*> o .:? "nsfw" .!= False
<*> o .: "bitrate"
<*> o .: "user_limit"
3 ->
ChannelGroupDM <$> o .: "id"
<*> o .: "recipients"
<*> o .:? "last_message_id"
4 ->
ChannelGuildCategory <$> o .: "id"
<*> o .:? "guild_id" .!= 0
5 ->
ChannelNews <$> o .: "id"
<*> o .:? "guild_id" .!= 0
<*> o .: "name"
<*> o .: "position"
<*> o .: "permission_overwrites"
<*> o .:? "nsfw" .!= False
<*> o .:? "topic" .!= ""
<*> o .:? "last_message_id"
6 ->
ChannelStorePage <$> o .: "id"
<*> o .:? "guild_id" .!= 0
<*> o .: "name"
<*> o .: "position"
<*> o .:? "nsfw" .!= False
<*> o .: "permission_overwrites"
_ -> fail ("Unknown channel type:" <> show type')
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)
] ]
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)
, ("guild_id", toJSON <$> pure channelGuild)
] ]
channelIsInGuild :: Channel -> Bool
channelIsInGuild c = case c of
ChannelGuildCategory{..} -> True
ChannelText{..} -> True
ChannelVoice{..} -> True
ChannelNews{..} -> True
ChannelStorePage{..} -> True
_ -> False
data Overwrite = Overwrite
{ overwriteId :: OverwriteId
, overwriteType :: T.Text
, overwriteAllow :: Integer
, overwriteDeny :: Integer
} deriving (Show, Eq, Ord)
instance FromJSON Overwrite where
parseJSON = withObject "Overwrite" $ \o ->
Overwrite <$> o .: "id"
<*> o .: "type"
<*> o .: "allow"
<*> o .: "deny"
instance ToJSON Overwrite where
toJSON Overwrite{..} = object
[ ("id", toJSON overwriteId)
, ("type", toJSON overwriteType)
, ("allow", toJSON overwriteAllow)
, ("deny", toJSON overwriteDeny)
]
data Message = Message
{ messageId :: MessageId
, messageChannel :: ChannelId
, messageAuthor :: User
, messageText :: Text
, messageTimestamp :: UTCTime
, messageEdited :: Maybe UTCTime
, messageTts :: Bool
, messageEveryone :: Bool
, messageMentions :: [User]
, messageMentionRoles :: [RoleId]
, messageAttachments :: [Attachment]
, messageEmbeds :: [Embed]
, messageNonce :: Maybe Nonce
, messagePinned :: Bool
, messageGuild :: Maybe GuildId
} deriving (Show, Eq, Ord)
instance FromJSON Message where
parseJSON = withObject "Message" $ \o ->
Message <$> o .: "id"
<*> o .: "channel_id"
<*> (do isW <- o .:? "webhook_id"
a <- o .: "author"
case isW :: Maybe WebhookId of
Nothing -> pure a
Just _ -> pure $ a { userIsWebhook = True })
<*> 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
<*> o .:? "guild_id" .!= Nothing
data Attachment = Attachment
{ attachmentId :: Snowflake
, attachmentFilename :: T.Text
, attachmentSize :: Integer
, attachmentUrl :: T.Text
, attachmentProxy :: T.Text
, attachmentHeight :: Maybe Integer
, attachmentWidth :: Maybe Integer
} deriving (Show, Eq, Ord)
instance FromJSON Attachment where
parseJSON = withObject "Attachment" $ \o ->
Attachment <$> o .: "id"
<*> o .: "filename"
<*> o .: "size"
<*> o .: "url"
<*> o .: "proxy_url"
<*> o .:? "height"
<*> o .:? "width"
newtype Nonce = Nonce T.Text
deriving (Show, Eq, Ord)
instance FromJSON Nonce where
parseJSON (String nonce) = pure $ Nonce nonce
parseJSON (Number nonce) = pure . Nonce . T.pack . show $ nonce
parseJSON _ = empty