diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -8,6 +8,9 @@ - +## 1.17.1 +- [L0neGamer](https://github.com/discord-haskell/discord-haskell/pull/211) Small interaction-related fixes, such as deferring ephemeral messages and exporting a necessary data structure + ## 1.17.0 - [S3NP41-v](https://github.com/discord-haskell/discord-haskell/pull/206) (and [2](https://github.com/discord-haskell/discord-haskell/pull/207)) Audit log and moderation types and gateway events as well as a new intent or two diff --git a/discord-haskell.cabal b/discord-haskell.cabal --- a/discord-haskell.cabal +++ b/discord-haskell.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: discord-haskell -version: 1.17.0 +version: 1.17.1 description: Functions and data types to write discord bots. Official discord docs . . diff --git a/examples/interaction-commands.hs b/examples/interaction-commands.hs --- a/examples/interaction-commands.hs +++ b/examples/interaction-commands.hs @@ -294,7 +294,7 @@ ( SelectMenu "user select menu" False - (SelectMenuDataUser) + SelectMenuDataUser (Just "this is a place holder") (Just 3) (Just 3) @@ -390,7 +390,9 @@ void ( do exampleImage <- liftIO getImage - aid <- readCache <&> cacheApplication <&> fullApplicationID + aid <- fullApplicationID . cacheApplication <$> readCache + -- to send an ephemeral follow up, you have to send an ephemeral defer + -- _ <- restCall (R.CreateInteractionResponse interactionId interactionToken (InteractionResponseDeferChannelMessageOpt (def { interactionResponseMessageFlags = Just (InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral]) }))) _ <- restCall (R.CreateInteractionResponse interactionId interactionToken InteractionResponseDeferChannelMessage) restCall ( R.CreateFollowupInteractionMessage diff --git a/src/Discord/Internal/Types/ApplicationCommands.hs b/src/Discord/Internal/Types/ApplicationCommands.hs --- a/src/Discord/Internal/Types/ApplicationCommands.hs +++ b/src/Discord/Internal/Types/ApplicationCommands.hs @@ -370,6 +370,18 @@ -- | The upper bound of values permitted. If choices are provided or autocomplete is on, this can be ignored optionValueNumberMaxVal :: Maybe Number } + | OptionValueAttachment + { -- | The name of the value + optionValueName :: T.Text, + -- | The localized name of the value + optionValueLocalizedName :: Maybe LocalizedText, + -- | The description of the value + optionValueDescription :: T.Text, + -- | The localized description of the value + optionValueLocalizedDescription :: Maybe LocalizedText, + -- | Whether this option is required + optionValueRequired :: Bool + } deriving (Show, Eq, Read) instance FromJSON OptionValue where @@ -406,6 +418,7 @@ 6 -> return $ OptionValueUser name lname desc ldesc required 8 -> return $ OptionValueRole name lname desc ldesc required 9 -> return $ OptionValueMentionable name lname desc ldesc required + 11 -> return $ OptionValueAttachment name lname desc ldesc required _ -> fail "unknown application command option value type" ) @@ -470,6 +483,7 @@ t OptionValueUser {} = 6 t OptionValueRole {} = 8 t OptionValueMentionable {} = 9 + t OptionValueAttachment {} = 11 t _ = -1 -- | Data type to be used when creating application commands. The specification diff --git a/src/Discord/Internal/Types/Interactions.hs b/src/Discord/Internal/Types/Interactions.hs --- a/src/Discord/Internal/Types/Interactions.hs +++ b/src/Discord/Internal/Types/Interactions.hs @@ -6,10 +6,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE PatternSynonyms #-} module Discord.Internal.Types.Interactions ( Interaction (..), ComponentData (..), + SelectMenuValues (..), ApplicationCommandData (..), OptionsData (..), OptionDataSubcommandOrGroup (..), @@ -19,7 +21,7 @@ ResolvedData (..), MemberOrUser (..), ModalData (..), - InteractionResponse (..), + InteractionResponse (.., InteractionResponseDeferChannelMessage), interactionResponseBasic, InteractionResponseAutocomplete (..), InteractionResponseMessage (..), @@ -226,7 +228,7 @@ newtype MemberOrUser = MemberOrUser (Either GuildMember User) deriving (Show, Read, Eq, Ord) -instance {-# OVERLAPPING #-} FromJSON MemberOrUser where +instance FromJSON MemberOrUser where parseJSON = withObject "MemberOrUser" @@ -242,7 +244,7 @@ { -- | The unique id of the component (up to 100 characters). componentDataCustomId :: T.Text, -- | Values for the select menu. - componentDataValues :: SelectMenuData + componentDataValues :: SelectMenuValues } deriving (Show, Read, Eq, Ord) @@ -261,29 +263,29 @@ _ -> fail $ "unknown interaction data component type: " <> show t ) -data SelectMenuData - = SelectMenuDataText [T.Text] -- ^ The values of text chosen options - | SelectMenuDataUser [UserId] -- ^ The users selected - | SelectMenuDataRole [RoleId] -- ^ The roles selected - | SelectMenuDataMentionable [Snowflake] -- ^ The users or roles selected - | SelectMenuDataChannels [ChannelId] -- ^ The channels selected +data SelectMenuValues + = SelectMenuValuesText [T.Text] -- ^ The values of text chosen options + | SelectMenuValuesUser [UserId] -- ^ The users selected + | SelectMenuValuesRole [RoleId] -- ^ The roles selected + | SelectMenuValuesMentionable [Snowflake] -- ^ The users or roles selected + | SelectMenuValuesChannels [ChannelId] -- ^ The channels selected deriving (Show, Read, Eq, Ord) -instance FromJSON SelectMenuData where +instance FromJSON SelectMenuValues where parseJSON = withObject - "SelectMenuData" + "SelectMenuValues" $ \v -> do t <- v .: "component_type" :: Parser Int - let cons :: forall a. FromJSON a => ([a] -> SelectMenuData) -> Parser SelectMenuData + let cons :: forall a. FromJSON a => ([a] -> SelectMenuValues) -> Parser SelectMenuValues cons f = f <$> v .: "values" case t of - 3 -> cons SelectMenuDataText - 5 -> cons SelectMenuDataUser - 6 -> cons SelectMenuDataRole - 7 -> cons SelectMenuDataMentionable - 8 -> cons SelectMenuDataChannels - _ -> fail $ "unknown SelectMenuData type: " <> show t + 3 -> cons SelectMenuValuesText + 5 -> cons SelectMenuValuesUser + 6 -> cons SelectMenuValuesRole + 7 -> cons SelectMenuValuesMentionable + 8 -> cons SelectMenuValuesChannels + _ -> fail $ "unknown SelectMenuValues type: " <> show t data ApplicationCommandData = ApplicationCommandDataUser @@ -325,7 +327,7 @@ ( \v -> do aci <- v .: "id" name <- v .: "name" - rd <- v .:? "resolved_data" + rd <- v .:? "resolved" t <- v .: "type" :: Parser Int case t of 1 -> @@ -449,6 +451,13 @@ { optionDataValueName :: T.Text, optionDataValueNumber :: Either T.Text Number } + | OptionDataValueAttachment + { optionDataValueName :: T.Text, + -- | This is a reference to the key in `ResolvedData`'s field resolvedDataAttachment. + -- + -- `ResolvedData` is sent back as a response with a map of `Snowflake` to attachment objects. + optionDataValueAttachment :: Snowflake + } deriving (Show, Read, Eq, Ord) instance FromJSON OptionDataValue where @@ -484,6 +493,9 @@ 9 -> OptionDataValueMentionable name <$> v .: "value" + 11 -> + OptionDataValueAttachment name + <$> v .: "value" _ -> fail $ "unexpected interaction data application command option value type: " ++ show t ) @@ -568,7 +580,9 @@ | -- | Respond to an interaction with a message InteractionResponseChannelMessage InteractionResponseMessage | -- | ACK an interaction and edit a response later (use `CreateFollowupInteractionMessage` and `InteractionResponseMessage` to do so). User sees loading state. - InteractionResponseDeferChannelMessage + -- + -- To make an ephemeral follow up message, the flags on the message here must also be ephemeral. + InteractionResponseDeferChannelMessageOpt InteractionResponseMessage | -- | for components, ACK an interaction and edit the original message later; the user does not see a loading state. InteractionResponseDeferUpdateMessage | -- | for components, edit the message the component was attached to @@ -579,13 +593,23 @@ InteractionResponseModal InteractionResponseModalData deriving (Show, Read, Eq, Ord) +-- | ACK an interaction and edit a response later (use `CreateFollowupInteractionMessage` and `InteractionResponseMessage` to do so). User sees loading state. +-- +-- See also `InteractionResponseDeferChannelMessageOpt`. +-- +-- This is a separate pattern synonym to allow for backwards compatibility. +pattern InteractionResponseDeferChannelMessage :: InteractionResponse +pattern InteractionResponseDeferChannelMessage <- InteractionResponseDeferChannelMessageOpt _ + where + InteractionResponseDeferChannelMessage = InteractionResponseDeferChannelMessageOpt def + -- | A basic interaction response, sending back the given text. interactionResponseBasic :: T.Text -> InteractionResponse interactionResponseBasic t = InteractionResponseChannelMessage (interactionResponseMessageBasic t) instance ToJSON InteractionResponse where toJSON InteractionResponsePong = object [("type", Number 1)] - toJSON InteractionResponseDeferChannelMessage = object [("type", Number 5)] + toJSON (InteractionResponseDeferChannelMessageOpt ms) = object [("type", Number 5), ("data", toJSON ms)] toJSON InteractionResponseDeferUpdateMessage = object [("type", Number 6)] toJSON (InteractionResponseChannelMessage ms) = object [("type", Number 4), ("data", toJSON ms)] toJSON (InteractionResponseUpdateMessage ms) = object [("type", Number 7), ("data", toJSON ms)] @@ -654,7 +678,7 @@ | otherwise = error $ "could not find InteractionCallbackDataFlag `" ++ show i ++ "`" instance ToJSON InteractionResponseMessageFlags where - toJSON (InteractionResponseMessageFlags fs) = Number $ fromInteger $ fromIntegral $ foldr (.|.) 0 (fromEnum <$> fs) + toJSON (InteractionResponseMessageFlags fs) = Number $ fromInteger $ fromIntegral $ foldr ((.|.) . fromEnum) 0 fs data InteractionResponseModalData = InteractionResponseModalData { interactionResponseModalCustomId :: T.Text,