Merge pull request discord-haskell#188 from L0neGamer/upgrade-resolver

Upgrade resolver and some other clean ups

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,

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

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

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 _ _  -> []

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,30 +215,30 @@ 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"
                               <*> o .:? "parent_id"
                               <*> 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"
                                 <*> o .:? "parent_id"
                                 <*> 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"

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,15 +285,15 @@ 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
 -- image's base-64 data, suited for using as JSON values.
 --
 -- 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.

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"

stack.yaml

@@ -2,7 +2,7 @@ extra-package-dbs: []
 packages:
 - '.'
 
-resolver: lts-18.28
+resolver: lts-20.26
 
 extra-deps:
   - emojis-0.1.3