{-# LANGUAGE TemplateHaskell #-} -- | A message from a channel module Calamity.Types.Model.Channel.Message ( Message (..), MessageAuthor (..), MessageAuthorWebhook (..), ChannelMention (..), MessageType (..), MessageReference (..), Partial (PartialMessage), ) where import Calamity.Internal.Utils (AesonVector (..), CalamityToJSON (..), CalamityToJSON' (..), (.=), (.?=)) import {-# SOURCE #-} Calamity.Types.Model.Channel import Calamity.Types.Model.Channel.Attachment import Calamity.Types.Model.Channel.ChannelType (ChannelType) import Calamity.Types.Model.Channel.Component import Calamity.Types.Model.Channel.Embed import Calamity.Types.Model.Channel.Reaction import Calamity.Types.Model.Channel.Webhook import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild import Calamity.Types.Model.Guild.Role import Calamity.Types.Model.User import Calamity.Types.Snowflake import Data.Aeson ((.!=), (.:), (.:?)) import Data.Aeson qualified as Aeson import Data.Maybe (isJust) import Data.Scientific import Data.Text (Text) import Data.Time import Data.Vector.Unboxing qualified as UV import Data.Word (Word64) import Optics.TH import TextShow qualified import TextShow.TH data MessageAuthorWebhook = MessageAuthorWebhook { id :: Snowflake Webhook , username :: Text , avatar :: Maybe Text } deriving (Show) deriving (HasID Webhook) via HasIDField "id" MessageAuthorWebhook data MessageAuthor = User' User | Webhook' MessageAuthorWebhook deriving (Show) instance HasID User MessageAuthor where getID (User' u) = getID u getID (Webhook' MessageAuthorWebhook {id}) = coerceSnowflake id data ChannelMention = ChannelMention { id :: Snowflake Channel , guildID :: Snowflake Guild , type_ :: ChannelType , name :: Text } deriving (Show) deriving (HasID Channel) via HasIDField "id" ChannelMention instance Aeson.FromJSON ChannelMention where parseJSON = Aeson.withObject "Message.ChannelMention" $ \v -> ChannelMention <$> v .: "id" <*> v .: "guild_id" <*> v .: "type" <*> v .: "name" data Message = Message { id :: Snowflake Message , channelID :: Snowflake Channel , guildID :: Maybe (Snowflake Guild) , author :: MessageAuthor , content :: Text , timestamp :: UTCTime , editedTimestamp :: Maybe UTCTime , tts :: Bool , mentionEveryone :: Bool , mentions :: [User] , mentionRoles :: UV.Vector (Snowflake Role) , mentionChannels :: [ChannelMention] , attachments :: [Attachment] , embeds :: [Embed] , reactions :: [Reaction] , nonce :: Maybe Aeson.Value , pinned :: Bool , webhookID :: Maybe (Snowflake Webhook) , type_ :: MessageType , activity :: Maybe Aeson.Object , application :: Maybe Aeson.Object , messageReference :: Maybe MessageReference , flags :: Word64 , referencedMessage :: Maybe Message , interaction :: Maybe Aeson.Object , components :: [Component] } deriving (Show) deriving (TextShow.TextShow) via TextShow.FromStringShow Message deriving (HasID Message) via HasIDField "id" Message deriving (HasID Channel) via HasIDField "channelID" Message deriving (HasID User) via HasIDField "author" Message instance Aeson.FromJSON Message where parseJSON = Aeson.withObject "Message" $ \v -> do webhookID <- v .:? "webhook_id" let author = if isJust webhookID then Aeson.withObject "Message.author" ( \v -> Webhook' <$> ( MessageAuthorWebhook <$> v .: "id" <*> v .: "username" <*> v .:? "avatar" ) ) =<< v .: "author" else User' <$> (Aeson.parseJSON =<< (v .: "author")) Message <$> v .: "id" <*> v .: "channel_id" <*> v .:? "guild_id" <*> author <*> v .: "content" <*> v .: "timestamp" <*> v .:? "edited_timestamp" <*> v .: "tts" <*> v .: "mention_everyone" <*> v .: "mentions" <*> (unAesonVector <$> v .: "mention_roles") <*> v .:? "mention_channels" .!= [] <*> v .: "attachments" <*> v .: "embeds" <*> v .:? "reactions" .!= [] <*> v .:? "nonce" <*> v .: "pinned" <*> pure webhookID <*> v .: "type" <*> v .:? "activity" <*> v .:? "application" <*> v .:? "message_reference" <*> v .:? "flags" .!= 0 <*> v .:? "referenced_message" <*> v .:? "interaction" <*> v .:? "components" .!= [] data instance Partial Message = PartialMessage { channelID :: Snowflake Channel , guildID :: Maybe (Snowflake Guild) } deriving (Show) deriving (HasID Channel) via HasIDField "channelID" (Partial Message) instance Aeson.FromJSON (Partial Message) where parseJSON = Aeson.withObject "Partial Message" $ \v -> PartialMessage <$> v .: "channel_id" <*> v .:? "guild_id" data MessageReference = MessageReference { messageID :: Maybe (Snowflake Message) , channelID :: Maybe (Snowflake Channel) , guildID :: Maybe (Snowflake Guild) , failIfNotExists :: Bool } deriving (Eq, Show) deriving (Aeson.ToJSON) via CalamityToJSON MessageReference instance CalamityToJSON' MessageReference where toPairs MessageReference {..} = [ "message_id" .?= messageID , "channel_id" .?= channelID , "guild_id" .?= guildID , "fail_if_not_exists" .= failIfNotExists ] instance Aeson.FromJSON MessageReference where parseJSON = Aeson.withObject "MessageReference" $ \v -> MessageReference <$> v .:? "message_id" <*> v .:? "channel_id" <*> v .:? "guild_id" <*> v .:? "fail_if_not_exists" .!= False -- Thanks sbrg (https://github.com/saevarb/haskord/blob/d1bb07bcc4f3dbc29f2dfd3351ff9f16fc100c07/haskord-lib/src/Haskord/Types/Common.hs#L264) data MessageType = Default | RecipientAdd | RecipientRemove | Call | ChannelNameChange | ChannelIconChange | ChannelPinnedMessage | GuildMemberJoin | UserPremiumGuildSubscription | UserPremiumGuildSubscriptionTier1 | UserPremiumGuildSubscriptionTier2 | UserPremiumGuildSubscriptionTier3 | ChannelFollowAdd | GuildDiscoveryDisqualified | GuildDiscoveryRequalified | Reply | ApplicationCommmand deriving (Eq, Show, Enum) instance Aeson.FromJSON MessageType where parseJSON = Aeson.withScientific "MessageType" $ \n -> case toBoundedInteger @Int n of Just v -> case v of 0 -> pure Default 1 -> pure RecipientAdd 2 -> pure RecipientRemove 3 -> pure Call 4 -> pure ChannelNameChange 5 -> pure ChannelIconChange 6 -> pure ChannelPinnedMessage 7 -> pure GuildMemberJoin 8 -> pure UserPremiumGuildSubscription 9 -> pure UserPremiumGuildSubscriptionTier1 10 -> pure UserPremiumGuildSubscriptionTier2 11 -> pure UserPremiumGuildSubscriptionTier3 12 -> pure ChannelFollowAdd 14 -> pure GuildDiscoveryDisqualified 15 -> pure GuildDiscoveryRequalified 19 -> pure Reply 20 -> pure ApplicationCommmand _ -> fail $ "Invalid MessageType: " <> show n Nothing -> fail $ "Invalid MessageType: " <> show n $(deriveTextShow ''MessageAuthorWebhook) $(deriveTextShow 'PartialMessage) $(deriveTextShow ''ChannelMention) $(deriveTextShow ''MessageType) $(makeFieldLabelsNoPrefix ''MessageAuthorWebhook) $(makeFieldLabelsNoPrefix ''ChannelMention) $(makeFieldLabelsNoPrefix 'PartialMessage) $(makeFieldLabelsNoPrefix ''Message) $(makeFieldLabelsNoPrefix ''MessageReference)