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/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/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/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" diff --git a/src/Discord/Internal/Types/Prelude.hs b/src/Discord/Internal/Types/Prelude.hs index fd49a158..67b3ec25 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,8 @@ 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 +import qualified Data.Text.Encoding as T.E -- | Authorization token for the Discord API newtype Auth = Auth T.Text @@ -89,7 +85,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 @@ -114,7 +110,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 @@ -134,7 +130,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 @@ -228,7 +224,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 @@ -272,22 +268,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 @@ -301,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.ByteString } deriving (Show, Read, Eq, Ord) -- | The ToJSON instance for Base64Image creates a string representation of the @@ -309,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 @@ -325,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. diff --git a/src/Discord/Internal/Types/RolePermissions.hs b/src/Discord/Internal/Types/RolePermissions.hs index 3044e9e3..6a760d73 100644 --- a/src/Discord/Internal/Types/RolePermissions.hs +++ b/src/Discord/Internal/Types/RolePermissions.hs @@ -18,8 +18,9 @@ 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)) +import Data.Foldable (foldl') data PermissionFlag = CREATE_INSTANT_INVITE @@ -66,7 +67,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 +77,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 @@ -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" 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