diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,32 +5,7 @@ [calamity haskell library](https://github.com/nitros12/calamity) for a more advanced interface. - - -#### Local Documentation - -Documentation on specific features and metadata is in [the local documentation folder](./docs/README.md#Documentation) - -#### Discord Server - -Ask questions, get updates, request features, etc in the project discord server: - -#### Official Discord Documentation - -This api closley matches the [official discord documentation](https://discord.com/developers/docs/intro), -which lists the rest requests, gateway events, and gateway sendables. - -You can use the docs to check the name of something you want to do. For example: -the docs list a [Get Channel](https://discord.com/developers/docs/resources/channel#get-channel) API path, -which translates to discord-haskell's rest request ADT for `GetChannel` of type `ChannelId -> ChannelRequest Channel`. - -#### Open an Issue - -If something goes wrong: check the error message (optional: check [the debugging logs](./docs/debugging.md)), make sure you have the most recent version, ask on discord, or open a github issue. - -### Quickstart - -This is an example bot that replies "pong" to messages that start with "ping". Also checkout the [other examples](./examples/) for things like state management. +This is an example bot that replies "pong" to messages that start with "ping". Checkout the [other examples](./examples/) for things like state management. ```haskell {-# LANGUAGE OverloadedStrings #-} -- allows "string literals" to be Text @@ -45,7 +20,7 @@ -- | Replies "pong" to every message that starts with "ping" pingpongExample :: IO () -pingpongExample = do +pingpongExample = do userFacingError <- runDiscord $ def { discordToken = "Bot ZZZZZZZZZZZZZZZZZZZ" , discordOnEvent = eventHandler } @@ -55,11 +30,11 @@ eventHandler :: Event -> DiscordHandler () eventHandler event = case event of - MessageCreate m -> when (isPing m && (not (fromBot m)) $ do - void $ restCall (R.CreateReaction (messageChannelId m, messageId m) "eyes") - threadDelay (2 * 10^6) - void $ restCall (R.CreateMessage (messageChannelId m) "Pong!") - _ -> return () + MessageCreate m -> when (isPing m && (not (fromBot m)) $ do + void $ restCall (R.CreateReaction (messageChannelId m, messageId m) "eyes") + threadDelay (2 * 10^6) + void $ restCall (R.CreateMessage (messageChannelId m) "Pong!") + _ -> return () fromBot :: Message -> Bool fromBot = userIsBot . messageAuthor @@ -68,45 +43,43 @@ isPing = ("ping" `isPrefixOf`) . toLower . messageContent ``` -### Installing +### Documentation -discord-haskell is on hosted on hackage at https://hackage.haskell.org/package/discord-haskell, +### [installing](./docs/installing.md) -Add the following to your `stack.yaml` (if using stack) +### [debugging](./docs/debugging.md) -```yaml -extra-deps: -- emoji-0.1.0.2 -- discord-haskell-VERSION -``` +### [design](./docs/design.md) -And add this to the `project.cabal` +### [todo](./docs/todo.md) -```cabal -executable haskell-bot - main-is: src/Main.hs - default-language: Haskell2010 - ghc-options: -threaded - build-depends: base - , text - , discord-haskell - -- == VERSION (if using cabal) -``` +### [contributing](./docs/contributing.md) -For a more complete example with various options go to -[Installing the Library](https://github.com/aquarial/discord-haskell/wiki/Installing-the-Library) wiki page +### [applicationcommands](./docs/applicationcommands.md) -Also take a look at -[Creating your first Bot](https://github.com/aquarial/discord-haskell/wiki/Creating-your-first-Bot) -for some help setting up your bot token +### [components](./docs/components.md) +### [cache](./docs/cache.md) +### [embeds](./docs/embeds.md) -### Rough Roadmap +### [emoji](./docs/emoji.md) -- [ ] Add slash commands [issue](https://github.com/aquarial/discord-haskell/issues/59) -- [ ] APIv9 [issue](https://github.com/aquarial/discord-haskell/issues/72) -- [ ] Event type includes roles and other cached info -- [ ] higher level bot interface? easier to add state and stuff +### [voice](./docs/voice.md) - +#### Discord Server + +Ask questions, get updates, request features, etc in the project discord server: + +#### Official Discord Documentation + +This api closley matches the [official discord documentation](https://discord.com/developers/docs/intro), +which lists the rest requests, gateway events, and gateway sendables. + +You can use the docs to check the name of something you want to do. For example: +the docs list a [Get Channel](https://discord.com/developers/docs/resources/channel#get-channel) API path, +which translates to discord-haskell's rest request ADT for `GetChannel` of type `ChannelId -> ChannelRequest Channel`. + +#### Open an Issue + +If something goes wrong: check the error message (optional: check [the debugging logs](./docs/debugging.md)), make sure you have the most recent version, ask on discord, or open a github issue. diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -6,6 +6,8 @@ ## master +[L0neGamer](https://github.com/aquarial/discord-haskell/pull/107) `EditMessage` takes full `MessageDetailedOpts` + ## 1.12.1 [L0neGamer](https://github.com/aquarial/discord-haskell/pull/103) Add threads, switch api to V10, Update Guild data fields diff --git a/discord-haskell.cabal b/discord-haskell.cabal --- a/discord-haskell.cabal +++ b/discord-haskell.cabal @@ -1,7 +1,7 @@ cabal-version: 2.0 name: discord-haskell -- library version is also noted at src/Discord/Rest/Prelude.hs -version: 1.12.1 +version: 1.12.2 description: Functions and data types to write discord bots. Official discord docs . . diff --git a/examples/ping-pong.hs b/examples/ping-pong.hs --- a/examples/ping-pong.hs +++ b/examples/ping-pong.hs @@ -71,7 +71,8 @@ threadDelay (2 * 10 ^ (6 :: Int)) -- A very simple message. - void $ restCall (R.CreateMessage (messageChannelId m) "Pong!") + Right m' <- restCall (R.CreateMessage (messageChannelId m) "Pong") + void $ restCall (R.EditMessage (messageChannelId m, messageId m') (def {R.messageDetailedContent=messageContent m' <> "!"})) -- A more complex message. Text-to-speech, does not mention everyone nor -- the user, and uses Discord native replies. diff --git a/src/Discord/Internal/Rest/Channel.hs b/src/Discord/Internal/Rest/Channel.hs --- a/src/Discord/Internal/Rest/Channel.hs +++ b/src/Discord/Internal/Rest/Channel.hs @@ -55,8 +55,6 @@ GetChannelMessage :: (ChannelId, MessageId) -> ChannelRequest Message -- | Sends a message to a channel. CreateMessage :: ChannelId -> T.Text -> ChannelRequest Message - -- | Sends a message with a file to a channel. - CreateMessageUploadFile :: ChannelId -> T.Text -> B.ByteString -> ChannelRequest Message -- | Sends a message with granular controls. CreateMessageDetailed :: ChannelId -> MessageDetailedOpts -> ChannelRequest Message -- | Add an emoji reaction to a message. ID must be present for custom emoji @@ -72,7 +70,7 @@ -- | Delete all reactions on a message DeleteAllReactions :: (ChannelId, MessageId) -> ChannelRequest () -- | Edits a message content. - EditMessage :: (ChannelId, MessageId) -> T.Text -> Maybe CreateEmbed + EditMessage :: (ChannelId, MessageId) -> MessageDetailedOpts -> ChannelRequest Message -- | Deletes a message. DeleteMessage :: (ChannelId, MessageId) -> ChannelRequest () @@ -135,7 +133,7 @@ data MessageDetailedOpts = MessageDetailedOpts { messageDetailedContent :: T.Text , messageDetailedTTS :: Bool - , messageDetailedEmbeds :: Maybe [CreateEmbed] + , messageDetailedEmbeds :: Maybe [CreateEmbed] , messageDetailedFile :: Maybe (T.Text, B.ByteString) , messageDetailedAllowedMentions :: Maybe AllowedMentions , messageDetailedReference :: Maybe MessageReference @@ -203,8 +201,16 @@ , modifyChannelUserRateLimit :: Maybe Integer , modifyChannelPermissionOverwrites :: Maybe [Overwrite] , modifyChannelParentId :: Maybe ChannelId + , modifyChannelDefaultAutoArchive :: Maybe Integer + , modifyChannelThreadArchived :: Maybe Bool + , modifyChannelThreadAutoArchive :: Maybe Integer + , modifyChannelThreadLocked :: Maybe Bool + , modifyChannelThreadInvitiable :: Maybe Bool } deriving (Show, Read, Eq, Ord) +instance Default ModifyChannelOpts where + def = ModifyChannelOpts Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing + instance ToJSON ModifyChannelOpts where toJSON ModifyChannelOpts{..} = object [(name, val) | (name, Just val) <- [("name", toJSON <$> modifyChannelName), @@ -214,7 +220,12 @@ ("bitrate", toJSON <$> modifyChannelBitrate), ("user_limit", toJSON <$> modifyChannelUserRateLimit), ("permission_overwrites", toJSON <$> modifyChannelPermissionOverwrites), - ("parent_id", toJSON <$> modifyChannelParentId) ] ] + ("parent_id", toJSON <$> modifyChannelParentId), + ("default_auto_archive_duration", toJSON <$> modifyChannelDefaultAutoArchive), + ("archived", toJSON <$> modifyChannelThreadArchived), + ("auto_archive_duration", toJSON <$> modifyChannelThreadAutoArchive), + ("locked", toJSON <$> modifyChannelThreadLocked), + ("invitable", toJSON <$> modifyChannelThreadInvitiable) ] ] data ChannelPermissionsOpts = ChannelPermissionsOpts { channelPermissionsOptsAllow :: Integer @@ -299,7 +310,6 @@ (GetChannelMessages chan _) -> "msg " <> show chan (GetChannelMessage (chan, _)) -> "get_msg " <> show chan (CreateMessage chan _) -> "msg " <> show chan - (CreateMessageUploadFile chan _ _) -> "msg " <> show chan (CreateMessageDetailed chan _) -> "msg " <> show chan (CreateReaction (chan, _) _) -> "add_react " <> show chan (DeleteOwnReaction (chan, _) _) -> "react " <> show chan @@ -307,7 +317,7 @@ (DeleteSingleReaction (chan, _) _) -> "react " <> show chan (GetReactions (chan, _) _ _) -> "react " <> show chan (DeleteAllReactions (chan, _)) -> "react " <> show chan - (EditMessage (chan, _) _ _) -> "get_msg " <> show chan + (EditMessage (chan, _) _) -> "get_msg " <> show chan (DeleteMessage (chan, _)) -> "get_msg " <> show chan (BulkDeleteMessage (chan, _)) -> "del_msgs " <> show chan (EditChannelPermissions chan _ _) -> "perms " <> show chan @@ -368,11 +378,6 @@ body = pure $ R.ReqBodyJson $ object content in Post (channels // chan /: "messages") body mempty - (CreateMessageUploadFile chan fileName file) -> - let part = partFileRequestBody "file" (T.unpack fileName) $ RequestBodyBS file - body = R.reqBodyMultipart [part] - in Post (channels // chan /: "messages") body mempty - (CreateMessageDetailed chan msgOpts) -> let fileUpload = messageDetailedFile msgOpts filePart = @@ -427,11 +432,33 @@ (DeleteAllReactions (chan, msgid)) -> Delete (channels // chan /: "messages" // msgid /: "reactions" ) mempty - (EditMessage (chan, msg) new embed) -> - let partJson = toJSON $ object $ ["content" .= new] ++ case embed of - Just e -> ["embed" .= createEmbed e] - Nothing -> [] - body = pure (R.ReqBodyJson partJson) + -- copied from CreateMessageDetailed, should be outsourced to function probably + (EditMessage (chan, msg) msgOpts) -> + let fileUpload = messageDetailedFile msgOpts + filePart = + ( case fileUpload of + Nothing -> [] + Just f -> + [ partFileRequestBody + "file" + (T.unpack $ fst f) + (RequestBodyBS $ snd f) + ] + ) + ++ join (maybe [] (maybeEmbed . Just <$>) (messageDetailedEmbeds msgOpts)) + + payloadData = object $ [ "content" .= messageDetailedContent msgOpts + , "tts" .= messageDetailedTTS msgOpts ] ++ + [ name .= value | (name, Just value) <- + [ ("embeds", toJSON . (createEmbed <$>) <$> messageDetailedEmbeds msgOpts) + , ("allowed_mentions", toJSON <$> messageDetailedAllowedMentions msgOpts) + , ("message_reference", toJSON <$> messageDetailedReference msgOpts) + , ("components", toJSON <$> messageDetailedComponents msgOpts) + , ("sticker_ids", toJSON <$> messageDetailedStickerIds msgOpts) + ] ] + payloadPart = partBS "payload_json" $ BL.toStrict $ encode payloadData + + body = R.reqBodyMultipart (payloadPart : filePart) in Patch (channels // chan /: "messages" // msg) body mempty (DeleteMessage (chan, msg)) -> diff --git a/src/Discord/Internal/Rest/Prelude.hs b/src/Discord/Internal/Rest/Prelude.hs --- a/src/Discord/Internal/Rest/Prelude.hs +++ b/src/Discord/Internal/Rest/Prelude.hs @@ -34,7 +34,7 @@ where -- | https://discord.com/developers/docs/reference#user-agent -- Second place where the library version is noted - agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 1.12.1)" + agent = "DiscordBot (https://github.com/aquarial/discord-haskell, 1.12.2)" -- Append to an URL infixl 5 //