From 43dfc72914932f4e1abe13c32736bb40e744536a Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Fri, 8 Sep 2023 19:09:02 +0100 Subject: [PATCH 1/8] upgrade resolver to ghc-9.2.8's --- stack.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stack.yaml b/stack.yaml index a4bbee2a..35f438fb 100644 --- a/stack.yaml +++ b/stack.yaml @@ -2,7 +2,7 @@ extra-package-dbs: [] packages: - '.' -resolver: lts-18.28 +resolver: lts-20.26 extra-deps: - emojis-0.1.3 From f5dd2a0843b52ea8112ea7fbf9470c59e81069c4 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Fri, 8 Sep 2023 19:15:05 +0100 Subject: [PATCH 2/8] only use aeson 2+ --- discord-haskell.cabal | 2 +- src/Discord/Internal/Rest/Webhook.hs | 3 ++- src/Discord/Internal/Types/Prelude.hs | 21 ++------------------- 3 files changed, 5 insertions(+), 21 deletions(-) diff --git a/discord-haskell.cabal b/discord-haskell.cabal index 8d13b4a5..c76ba32e 100644 --- a/discord-haskell.cabal +++ b/discord-haskell.cabal @@ -161,7 +161,7 @@ library -- https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/libraries/version-history -- below also sets the GHC version effectively. set to == 8.10.*, == 9.0.*., == 9.2.*, == 9.4.*, == 9.6.* base == 4.14.* || == 4.15.* || == 4.16.* || == 4.17.* || == 4.18.*, - aeson >= 1.5 && < 1.6 || >= 2.0 && < 2.3, + aeson >= 2.0 && < 2.3, async >=2.2 && <2.3, bytestring >=0.10 && <0.13, base64-bytestring >=1.1 && <1.3, diff --git a/src/Discord/Internal/Rest/Webhook.hs b/src/Discord/Internal/Rest/Webhook.hs index 7b4a545c..be39b093 100644 --- a/src/Discord/Internal/Rest/Webhook.hs +++ b/src/Discord/Internal/Rest/Webhook.hs @@ -13,6 +13,7 @@ module Discord.Internal.Rest.Webhook ) where import Data.Aeson +import qualified Data.Aeson.Key as Key import qualified Data.Text as T import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL @@ -124,7 +125,7 @@ data WebhookContent = WebhookContentText T.Text | WebhookContentEmbeds [CreateEmbed] deriving (Show, Read, Eq, Ord) -webhookContentJson :: WebhookContent -> [(AesonKey, Value)] +webhookContentJson :: WebhookContent -> [(Key.Key, Value)] webhookContentJson c = case c of WebhookContentText t -> [("content", toJSON t)] WebhookContentFile _ _ -> [] diff --git a/src/Discord/Internal/Types/Prelude.hs b/src/Discord/Internal/Types/Prelude.hs index fd49a158..4ed336fc 100644 --- a/src/Discord/Internal/Types/Prelude.hs +++ b/src/Discord/Internal/Types/Prelude.hs @@ -3,7 +3,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} -- | Provides base types and utility functions needed for modules in Discord.Internal.Types @@ -49,7 +48,6 @@ module Discord.Internal.Types.Prelude , (.==) , (.=?) - , AesonKey , objectFromMaybes , ChannelTypeOption (..) @@ -71,10 +69,7 @@ import Web.Internal.HttpApiData import qualified Data.ByteString as B import qualified Data.Text as T - -#if MIN_VERSION_aeson(2, 0, 0) import qualified Data.Aeson.Key as Key -#endif -- | Authorization token for the Discord API newtype Auth = Auth T.Text @@ -272,22 +267,10 @@ class Data a => InternalDiscordEnum a where | fromIntegral (round i) == i = Just $ round i | otherwise = Nothing --- Aeson 2.0 uses KeyMaps with a defined Key type for its objects. Aeson up to --- 1.5 uses HashMaps with Text for the key. Both types have an IsString instance. --- To keep our version bounds as loose as possible while the Haskell ecosystem --- (and thus our users) switch over to Aeson 2.0, we use some CPP to define a --- AesonKey as an alias. -#if MIN_VERSION_aeson(2, 0, 0) -type AesonKey = Key.Key -#else -type AesonKey = T.Text -#endif - - -(.==) :: ToJSON a => AesonKey -> a -> Maybe Pair +(.==) :: ToJSON a => Key.Key -> a -> Maybe Pair k .== v = Just (k .= v) -(.=?) :: ToJSON a => AesonKey -> Maybe a -> Maybe Pair +(.=?) :: ToJSON a => Key.Key -> Maybe a -> Maybe Pair k .=? (Just v) = Just (k .= v) _ .=? Nothing = Nothing From b46c07245e655b9a9769b86fc48a309695b6ecc4 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Fri, 8 Sep 2023 19:39:02 +0100 Subject: [PATCH 3/8] remove excess permissions from snowflake, discordid, and RolePermissions --- src/Discord/Internal/Types/Prelude.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Discord/Internal/Types/Prelude.hs b/src/Discord/Internal/Types/Prelude.hs index 4ed336fc..e4f14f95 100644 --- a/src/Discord/Internal/Types/Prelude.hs +++ b/src/Discord/Internal/Types/Prelude.hs @@ -84,7 +84,7 @@ authToken (Auth tok) = let token = T.strip tok -- | A unique integer identifier. Can be used to calculate the creation date of an entity. newtype Snowflake = Snowflake { unSnowflake :: Word64 } - deriving (Ord, Eq, Num, Integral, Enum, Real, Bits) + deriving (Ord, Eq) instance Show Snowflake where show (Snowflake a) = show a @@ -109,7 +109,7 @@ instance ToHttpApiData Snowflake where toUrlPiece = T.pack . show newtype RolePermissions = RolePermissions { getRolePermissions :: Integer } - deriving (Eq, Ord, Num, Bits, Enum, Real, Integral) + deriving (Eq, Ord, Bits) instance Read RolePermissions where readsPrec p = fmap (first RolePermissions) . readsPrec p @@ -129,7 +129,7 @@ instance Show RolePermissions where show = show . getRolePermissions newtype DiscordId a = DiscordId { unId :: Snowflake } - deriving (Ord, Eq, Num, Integral, Enum, Real, Bits) + deriving (Ord, Eq) instance Show (DiscordId a) where show = show . unId @@ -223,7 +223,7 @@ type Shard = (Int, Int) -- | Gets a creation date from a snowflake. snowflakeCreationDate :: Snowflake -> UTCTime -snowflakeCreationDate x = posixSecondsToUTCTime . realToFrac +snowflakeCreationDate (Snowflake x) = posixSecondsToUTCTime . realToFrac $ 1420070400 + quot (shiftR x 22) 1000 -- | Default timestamp From 2bdc3e9e57b0be5b860b87a70fb2d204ad491a90 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Fri, 8 Sep 2023 19:39:38 +0100 Subject: [PATCH 4/8] fix rolepermissions based on prev commit --- src/Discord/Internal/Types/RolePermissions.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Discord/Internal/Types/RolePermissions.hs b/src/Discord/Internal/Types/RolePermissions.hs index 3044e9e3..dcf0ceb0 100644 --- a/src/Discord/Internal/Types/RolePermissions.hs +++ b/src/Discord/Internal/Types/RolePermissions.hs @@ -18,7 +18,7 @@ import Discord.Internal.Types.Guild Role (rolePerms), roleIdToRole, ) -import Discord.Internal.Types.Prelude (RolePermissions) +import Discord.Internal.Types.Prelude (RolePermissions (..)) import Discord.Internal.Types.User (GuildMember (memberRoles)) data PermissionFlag @@ -66,7 +66,7 @@ data PermissionFlag deriving (Eq, Ord, Enum, Show) permissionBits :: PermissionFlag -> RolePermissions -permissionBits p = shift 1 (fromEnum p) +permissionBits p = shift (RolePermissions 1) (fromEnum p) -- | Check if a given role has all the permissions hasRolePermissions :: [PermissionFlag] -> RolePermissions -> Bool @@ -76,7 +76,7 @@ hasRolePermissions permissions rolePermissions = (.&.) combinedPermissions roleP -- | Check if a given role has the permission hasRolePermission :: PermissionFlag -> RolePermissions -> Bool -hasRolePermission p r = (.&.) (permissionBits p) r > 0 +hasRolePermission p r = getRolePermissions (permissionBits p .&. r) > 0 -- | Replace a users rolePerms -- with a complete new set of permissions From dc3f0bc9bbbd5f8648cbc8eeb23583767f7a7eb5 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Fri, 8 Sep 2023 19:40:03 +0100 Subject: [PATCH 5/8] use foldl' to be slightly more space efficient about consuming a list --- src/Discord/Internal/Types/RolePermissions.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Discord/Internal/Types/RolePermissions.hs b/src/Discord/Internal/Types/RolePermissions.hs index dcf0ceb0..6a760d73 100644 --- a/src/Discord/Internal/Types/RolePermissions.hs +++ b/src/Discord/Internal/Types/RolePermissions.hs @@ -20,6 +20,7 @@ import Discord.Internal.Types.Guild ) import Discord.Internal.Types.Prelude (RolePermissions (..)) import Discord.Internal.Types.User (GuildMember (memberRoles)) +import Data.Foldable (foldl') data PermissionFlag = CREATE_INSTANT_INVITE @@ -105,7 +106,7 @@ clearRolePermission :: PermissionFlag -> RolePermissions -> RolePermissions clearRolePermission p = (.&.) (complement . permissionBits $ p) combinePermissions :: [PermissionFlag] -> RolePermissions -combinePermissions = foldr ((.|.) . permissionBits) 0 +combinePermissions = foldl' (\rp -> (rp .|.) . permissionBits) (RolePermissions 0) -- | Check if any Role of an GuildMember has the needed permission -- If the result of roleIdToRole is Nothing, it prepends a "False" From 9a7b84db30c60974d0d0e133ef0e87915b8f6aac Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Fri, 8 Sep 2023 19:40:23 +0100 Subject: [PATCH 6/8] guildid will always be present for these channel types --- src/Discord/Internal/Types/Channel.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Discord/Internal/Types/Channel.hs b/src/Discord/Internal/Types/Channel.hs index 9f4671a4..62cb85d8 100644 --- a/src/Discord/Internal/Types/Channel.hs +++ b/src/Discord/Internal/Types/Channel.hs @@ -170,7 +170,7 @@ instance FromJSON Channel where case type' of 0 -> ChannelText <$> o .: "id" - <*> o .:? "guild_id" .!= 0 + <*> o .: "guild_id" <*> o .: "name" <*> o .: "position" <*> o .: "permission_overwrites" @@ -185,7 +185,7 @@ instance FromJSON Channel where <*> o .:? "last_message_id" 2 -> ChannelVoice <$> o .: "id" - <*> o .:? "guild_id" .!= 0 + <*> o .: "guild_id" <*> o .: "name" <*> o .: "position" <*> o .: "permission_overwrites" @@ -199,13 +199,13 @@ instance FromJSON Channel where <*> o .:? "last_message_id" 4 -> ChannelGuildCategory <$> o .: "id" - <*> o .:? "guild_id" .!= 0 + <*> o .: "guild_id" <*> o .: "name" <*> o .: "position" <*> o .: "permission_overwrites" 5 -> ChannelNews <$> o .: "id" - <*> o .:? "guild_id" .!= 0 + <*> o .: "guild_id" <*> o .: "name" <*> o .: "position" <*> o .: "permission_overwrites" @@ -215,14 +215,14 @@ instance FromJSON Channel where <*> o .:? "parent_id" 6 -> ChannelStorePage <$> o .: "id" - <*> o .:? "guild_id" .!= 0 + <*> o .: "guild_id" <*> o .: "name" <*> o .: "position" <*> o .:? "nsfw" .!= False <*> o .: "permission_overwrites" <*> o .:? "parent_id" 10 -> ChannelNewsThread <$> o.: "id" - <*> o .:? "guild_id" .!= 0 + <*> o .: "guild_id" <*> o .:? "name" <*> o .:? "rate_limit_per_user" <*> o .:? "last_message_id" @@ -230,7 +230,7 @@ instance FromJSON Channel where <*> o .:? "thread_metadata" <*> o .:? "member" 11 -> ChannelPublicThread <$> o.: "id" - <*> o .:? "guild_id" .!= 0 + <*> o .: "guild_id" <*> o .:? "name" <*> o .:? "rate_limit_per_user" <*> o .:? "last_message_id" @@ -238,7 +238,7 @@ instance FromJSON Channel where <*> o .:? "thread_metadata" <*> o .:? "member" 12 -> ChannelPrivateThread <$> o.: "id" - <*> o .:? "guild_id" .!= 0 + <*> o .: "guild_id" <*> o .:? "name" <*> o .:? "rate_limit_per_user" <*> o .:? "last_message_id" @@ -247,7 +247,7 @@ instance FromJSON Channel where <*> o .:? "member" 13 -> ChannelStage <$> o .: "id" - <*> o .:? "guild_id" .!= 0 + <*> o .: "guild_id" <*> o .: "id" <*> o .:? "topic" .!= "" _ -> ChannelUnknownType <$> o .: "id" From 6d6f777c80b210218a696a8108ef5de6ff4b1212 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Fri, 8 Sep 2023 20:28:22 +0100 Subject: [PATCH 7/8] store the bytestring for the base64 image. theoretically could lead to a more efficient encoding where one does not have to go via ByteString, but mostly this is so that the conversion from base64 bytestring to Text happens when turning the value into a JSON value --- src/Discord/Internal/Rest/Emoji.hs | 11 +++++------ src/Discord/Internal/Rest/User.hs | 3 +-- src/Discord/Internal/Types/Prelude.hs | 13 +++++++------ 3 files changed, 13 insertions(+), 14 deletions(-) diff --git a/src/Discord/Internal/Rest/Emoji.hs b/src/Discord/Internal/Rest/Emoji.hs index 2a521713..e8491230 100644 --- a/src/Discord/Internal/Rest/Emoji.hs +++ b/src/Discord/Internal/Rest/Emoji.hs @@ -20,7 +20,6 @@ import Data.Aeson import qualified Data.ByteString as B import qualified Data.ByteString.Base64 as B64 import qualified Data.Text as T -import qualified Data.Text.Encoding as TE import Discord.Internal.Rest.Prelude import Discord.Internal.Types import Network.HTTP.Req ((/:), (/~)) @@ -65,7 +64,7 @@ instance ToJSON ModifyGuildEmojiOpts where parseEmojiImage :: B.ByteString -> Either T.Text (Base64Image Emoji) parseEmojiImage bs | B.length bs > 256000 = Left "Cannot create emoji - File is larger than 256kb" - | Just mime <- getMimeType bs = Right (Base64Image mime (TE.decodeUtf8 (B64.encode bs))) + | Just mime <- getMimeType bs = Right (Base64Image mime (B64.encode bs)) | otherwise = Left "Unsupported image format provided" emojiMajorRoute :: EmojiRequest a -> String @@ -112,13 +111,13 @@ emojiJsonRequest c = case c of parseStickerImage :: B.ByteString -> Either T.Text (Base64Image Sticker) parseStickerImage bs | B.length bs > 512000 - = Left "Cannot create sticker - File is larger than 512kb" + = Left "Cannot create sticker - File is larger than 512kb" | Just "image/png" <- getMimeType bs - = Right (Base64Image "image/png" (TE.decodeUtf8 (B64.encode bs))) + = Right (Base64Image "image/png" (B64.encode bs)) | not (B.null bs) && B.head bs == 0x7b -- '{' - = Right (Base64Image "application/json" (TE.decodeUtf8 (B64.encode bs))) + = Right (Base64Image "application/json" (B64.encode bs)) | otherwise - = Left "Unsupported image format provided" + = Left "Unsupported image format provided" -- | Options for `CreateGuildSticker` data CreateGuildStickerOpts = CreateGuildStickerOpts diff --git a/src/Discord/Internal/Rest/User.hs b/src/Discord/Internal/Rest/User.hs index 28c05058..2ab9c242 100644 --- a/src/Discord/Internal/Rest/User.hs +++ b/src/Discord/Internal/Rest/User.hs @@ -15,7 +15,6 @@ import Data.Aeson import Network.HTTP.Req ((/:), (/~)) import qualified Network.HTTP.Req as R import qualified Data.Text as T -import qualified Data.Text.Encoding as TE import qualified Data.ByteString as B import qualified Data.ByteString.Base64 as B64 @@ -58,7 +57,7 @@ data UserRequest a where -- This function accepts all file types accepted by 'getMimeType'. parseAvatarImage :: B.ByteString -> Either T.Text (Base64Image User) parseAvatarImage bs - | Just mime <- getMimeType bs = Right (Base64Image mime (TE.decodeUtf8 (B64.encode bs))) + | Just mime <- getMimeType bs = Right (Base64Image mime (B64.encode bs)) | otherwise = Left "Unsupported image format provided" userMajorRoute :: UserRequest a -> String diff --git a/src/Discord/Internal/Types/Prelude.hs b/src/Discord/Internal/Types/Prelude.hs index e4f14f95..c56a3188 100644 --- a/src/Discord/Internal/Types/Prelude.hs +++ b/src/Discord/Internal/Types/Prelude.hs @@ -70,6 +70,7 @@ import Web.Internal.HttpApiData import qualified Data.ByteString as B import qualified Data.Text as T import qualified Data.Aeson.Key as Key +import qualified Data.Text.Encoding as T.E -- | Authorization token for the Discord API newtype Auth = Auth T.Text @@ -284,7 +285,7 @@ objectFromMaybes = object . catMaybes -- -- Public creation of this datatype should be done using the relevant smart -- constructors for Emoji, Sticker, or Avatar. -data Base64Image a = Base64Image T.Text T.Text +data Base64Image a = Base64Image { mimeType :: T.Text, base64Data :: B.StrictByteString } deriving (Show, Read, Eq, Ord) -- | The ToJSON instance for Base64Image creates a string representation of the @@ -292,7 +293,7 @@ data Base64Image a = Base64Image T.Text T.Text -- -- The format is: @data:%MIME%;base64,%DATA%@. instance ToJSON (Base64Image a) where - toJSON (Base64Image mime im) = String $ "data:" <> mime <> ";base64," <> im + toJSON (Base64Image mime im) = String $ "data:" <> mime <> ";base64," <> T.E.decodeUtf8 im -- | @getMimeType bs@ returns a possible mimetype for the given bytestring, -- based on the first few magic bytes. It may return any of PNG/JPEG/GIF or WEBP @@ -308,13 +309,13 @@ instance ToJSON (Base64Image a) where getMimeType :: B.ByteString -> Maybe T.Text getMimeType bs | B.take 8 bs == "\x89\x50\x4E\x47\x0D\x0A\x1A\x0A" - = Just "image/png" + = Just "image/png" | B.take 3 bs == "\xff\xd8\xff" || B.take 4 (B.drop 6 bs) `elem` ["JFIF", "Exif"] - = Just "image/jpeg" + = Just "image/jpeg" | B.take 6 bs == "\x47\x49\x46\x38\x37\x61" || B.take 6 bs == "\x47\x49\x46\x38\x39\x61" - = Just "image/gif" + = Just "image/gif" | B.take 4 bs == "RIFF" && B.take 4 (B.drop 8 bs) == "WEBP" - = Just "image/webp" + = Just "image/webp" | otherwise = Nothing -- | The different channel types. Used for application commands and components. From 3f2f7d37683153d58c59d3e6e9e2cf50fc15f3a6 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Sat, 9 Sep 2023 16:31:19 +0100 Subject: [PATCH 8/8] only 8.10.7 breaking change fixed --- src/Discord/Internal/Types/Prelude.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Discord/Internal/Types/Prelude.hs b/src/Discord/Internal/Types/Prelude.hs index c56a3188..67b3ec25 100644 --- a/src/Discord/Internal/Types/Prelude.hs +++ b/src/Discord/Internal/Types/Prelude.hs @@ -285,7 +285,7 @@ objectFromMaybes = object . catMaybes -- -- Public creation of this datatype should be done using the relevant smart -- constructors for Emoji, Sticker, or Avatar. -data Base64Image a = Base64Image { mimeType :: T.Text, base64Data :: B.StrictByteString } +data Base64Image a = Base64Image { mimeType :: T.Text, base64Data :: B.ByteString } deriving (Show, Read, Eq, Ord) -- | The ToJSON instance for Base64Image creates a string representation of the