discord-haskell 1.12.1 → 1.12.2

raw patch · 6 files changed

+85/−82 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +35/−62
• changelog.md +2/−0
• discord-haskell.cabal +1/−1
• examples/ping-pong.hs +2/−1
• src/Discord/Internal/Rest/Channel.hs +44/−17
• src/Discord/Internal/Rest/Prelude.hs +1/−1

@@ -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: <https://discord.gg/eaRAGgX3bK>--#### 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: <https://discord.gg/eaRAGgX3bK>++#### 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.

@@ -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

@@ -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 <https://discord.com/developers/docs/reference>.                      .

@@ -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.

@@ -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)) ->

@@ -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 //