calamity 0.1.21.0 → 0.1.22.0

raw patch · 14 files changed

+158/−120 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +11/−1
• README.md +1/−1
• calamity.cabal +2/−2
• src/Calamity/Client/Client.hs +10/−6
• src/Calamity/Client/ShardManager.hs +1/−22
• src/Calamity/Gateway/DispatchEvents.hs +1/−1
• src/Calamity/Gateway/Intents.hs +11/−1
• src/Calamity/Gateway/Shard.hs +2/−2
• src/Calamity/Gateway/Types.hs +10/−3
• src/Calamity/HTTP/Internal/Route.hs +1/−1
• src/Calamity/Types/Model/Channel/Message.hs +14/−0
• src/Calamity/Types/Model/Guild/Overwrite.hs +1/−2
• src/Calamity/Types/Model/Guild/Permissions.hs +88/−73
• src/Calamity/Utils/Permissions.hs +5/−5

@@ -1,8 +1,18 @@ # Changelog for Calamity +## 0.1.22.0++* Update to gateway/http endpoint v8.+* Updated the message types.+* Added `defaultIntents`, which is all but the privileged intents, also a+  Data.Default instance.+* `runBotIO` and `runBotIO'` now always take an `Intents` parameter.+* Users are cached from messages, as well as member create events.+* Fix `Overwrite`s having an incorrect `type_` field.+ ## 0.1.21.0 -- Fix ToJSON instance for `RawEmoji`+* Fix ToJSON instance for `RawEmoji`  ## 0.1.20.1 

@@ -110,7 +110,7 @@   token <- view packed <$> getEnv "BOT_TOKEN"   Di.new $ \di ->     void . P.runFinal . P.embedToFinal . DiP.runDiToIO di . runCounterAtomic . runCacheInMemory . runMetricsNoop . useConstantPrefix "!"-      $ runBotIO (BotToken token) $ do+      $ runBotIO (BotToken token) defaultIntents $ do       addCommands $ do         helpCommand         command @'[User] "utest" $ \ctx u -> do

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5fa37b5c8ac352c7170a1e67f6f1c722b1e1e041e5f49cd19058014ae1b1caf4+-- hash: b3783e8d7e7db062a2aa10f4642564dea368efe4f9130957aaa0259e2f96e54e  name:           calamity-version:        0.1.21.0+version:        0.1.22.0 synopsis:       A library for writing discord bots in haskell description:    Please see the README on GitHub at <https://github.com/nitros12/calamity#readme> category:       Network, Web

@@ -102,9 +102,11 @@ runBotIO :: forall r a.          (P.Members '[P.Embed IO, P.Final IO, CacheEff, MetricEff, LogEff] r, Typeable (SetupEff r))          => Token+         -> Intents+         -- ^ The intents the bot should use          -> P.Sem (SetupEff r) a          -> P.Sem r (Maybe StartupError)-runBotIO token setup = runBotIO' token Nothing Nothing Nothing setup+runBotIO token intents setup = runBotIO' token intents Nothing Nothing setup  resetDi :: BotC r => P.Sem r a -> P.Sem r a resetDi m = do@@ -117,15 +119,15 @@ runBotIO' :: forall r a.           (P.Members '[P.Embed IO, P.Final IO, CacheEff, MetricEff, LogEff] r, Typeable (SetupEff r))           => Token+          -> Intents+          -- ^ The intents the bot should use           -> Maybe Session           -- ^ The HTTP session to use, defaults to 'newAPISession'           -> Maybe StatusUpdateData           -- ^ The initial status to send to the gateway-          -> Maybe Intents-          -- ^ The intents to send to the gateway           -> P.Sem (SetupEff r) a           -> P.Sem r (Maybe StartupError)-runBotIO' token session status intents setup = do+runBotIO' token intents session status setup = do   initialDi <- Di.fetch   session' <- maybe (P.embed newAPISession) pure session   client <- P.embed $ newClient token session' initialDi@@ -517,7 +519,7 @@ handleEvent' eh (InviteDelete d) = do   pure $ map ($ d) (getEventHandlers @'InviteDeleteEvt eh) -handleEvent' eh evt@(MessageCreate msg) = do+handleEvent' eh evt@(MessageCreate msg _) = do   updateCache evt   pure $ map ($ msg) (getEventHandlers @'MessageCreateEvt eh) @@ -675,7 +677,9 @@ updateCache (GuildRoleDelete GuildRoleDeleteData { guildID, roleID }) =   updateGuild guildID (#roles %~ sans roleID) -updateCache (MessageCreate msg) = setMessage msg+updateCache (MessageCreate msg user) = do+  setMessage msg+  forM_ user setUser  updateCache (MessageUpdate msg) =   updateMessage (getID msg) (update msg)

@@ -26,7 +26,7 @@ mapLeft _ (Right b) = Right b  -- | Connects the bot to the gateway over n shards-shardBot :: BotC r => Maybe StatusUpdateData -> Maybe Intents -> Sem r (Either StartupError ())+shardBot :: BotC r => Maybe StatusUpdateData -> Intents -> Sem r (Either StartupError ()) shardBot initialStatus intents = (mapLeft StartupError <$>) . P.runFail $ do   numShardsVar <- P.asks numShards   shardsVar <- P.asks shards@@ -50,24 +50,3 @@    P.embed . atomically $ writeTVar shardsVar shards --- | Connects the bot to the gateway over 1 shard (userbot)--- shardUserBot :: BotM ()--- shardUserBot = do---   numShardsVar <- asks numShards---   shardsVar <- asks shards----   hasShards <- liftIO $ (not . null) <$> readTVarIO shardsVar---   when hasShards $ fail "don't use shardUserBot on an already running bot."----   token <- asks Calamity.Client.Types.token---   eventQueue <- asks eventQueue---   logEnv <- askLog----   gateway <- aa <$> invoke GetGateway----   let host = gateway ^. #url---   liftIO $ putMVar numShardsVar 1----   liftIO $ do---     shard <- newShard host 0 1 token logEnv eventQueue---     atomically $ writeTVar shardsVar [shard]

@@ -59,7 +59,7 @@   | GuildRoleDelete GuildRoleDeleteData   | InviteCreate InviteCreateData   | InviteDelete InviteDeleteData-  | MessageCreate Message+  | MessageCreate Message (Maybe User)   | MessageUpdate UpdatedMessage   | MessageDelete MessageDeleteData   | MessageDeleteBulk MessageDeleteBulkData

@@ -4,6 +4,7 @@ -- | Discord gateway intents module Calamity.Gateway.Intents     ( Intents(..)+    , defaultIntents     , intentGuilds     , intentGuildMembers     , intentGuildBans@@ -22,9 +23,10 @@  import           Data.Aeson    ( ToJSON ) import           Data.Bits-import           Data.Flags    ()+import           Data.Flags    (allBut, (.+.)) import           Data.Flags.TH import           Data.Word+import           Data.Default.Class  $(bitmaskWrapper "Intents" ''Word32 []    [ ("intentGuilds", 1 `shiftL` 0)@@ -44,3 +46,11 @@    , ("intentDirectMessageTyping", 1 `shiftL` 14)])  deriving via Word32 instance ToJSON Intents++-- | Default intents are all but the privileged intents: members and intents+defaultIntents :: Intents+defaultIntents = allBut (intentGuildMembers .+. intentGuildPresences)++-- | Default intents are all but the privileged intents: members and intents+instance Default Intents where+  def = defaultIntents

@@ -69,7 +69,7 @@          -> Int          -> Token          -> Maybe StatusUpdateData-         -> Maybe Intents+         -> Intents          -> UC.InChan CalamityEvent          -> Sem r (UC.InChan ControlMessage, Async (Maybe ())) newShard gateway id count token presence intents evtIn = do@@ -163,7 +163,7 @@     let host' =  fromMaybe host $ L.stripPrefix "wss://" host     info $ "starting up shard "+| (shard ^. #shardID) |+" of "+| (shard ^. #shardCount) |+"" -    innerLoopVal <- runWebsocket host' "/?v=6&encoding=json" innerloop+    innerLoopVal <- runWebsocket host' "/?v=8&encoding=json" innerloop      case innerLoopVal of       Just ShardFlowShutDown -> do

@@ -44,6 +44,10 @@ import qualified Polysemy.AtomicState             as P import qualified TextShow.Generic as TSG import TextShow (TextShow)+import Control.Lens.Operators ((^?))+import Data.Aeson.Types (parseMaybe)+import Control.Lens (Ixed(ix))+import Data.Aeson.Lens  type ShardC r = (P.Members '[LogEff, P.AtomicState ShardState, P.Embed IO, P.Final IO,   P.Async, MetricEff] r)@@ -109,7 +113,10 @@ parseDispatchData GUILD_ROLE_DELETE data'           = GuildRoleDelete <$> parseJSON data' parseDispatchData INVITE_CREATE data'               = InviteCreate <$> parseJSON data' parseDispatchData INVITE_DELETE data'               = InviteDelete <$> parseJSON data'-parseDispatchData MESSAGE_CREATE data'              = MessageCreate <$> parseJSON data'+parseDispatchData MESSAGE_CREATE data'              = do+  message <- parseJSON data'+  let user = parseMaybe parseJSON =<< (data' ^? _Object . ix "author")+  pure $ MessageCreate message user parseDispatchData MESSAGE_UPDATE data'              = MessageUpdate <$> parseJSON data' parseDispatchData MESSAGE_DELETE data'              = MessageDelete <$> parseJSON data' parseDispatchData MESSAGE_DELETE_BULK data'         = MessageDeleteBulk <$> parseJSON data'@@ -205,7 +212,7 @@   , largeThreshold :: Int   , shard          :: (Int, Int)   , presence       :: Maybe StatusUpdateData-  , intents        :: Maybe Intents+  , intents        :: Intents   }   deriving ( Show, Generic )   deriving ToJSON via CalamityJSON IdentifyData@@ -268,7 +275,7 @@   , shardState    :: IORef ShardState   , token         :: Text   , initialStatus :: Maybe StatusUpdateData-  , intents       :: Maybe Intents+  , intents       :: Intents   }   deriving ( Generic ) 

@@ -125,7 +125,7 @@   hashWithSalt s (Route _ ident c g) = hashWithSalt s (ident, c, g)  baseURL :: Text-baseURL = "https://discord.com/api/v7"+baseURL = "https://discord.com/api/v8"  buildRoute   :: forall (ids :: [(Type, RouteRequirement)])

@@ -65,6 +65,13 @@   | ChannelIconChange   | ChannelPinnedMessage   | GuildMemberJoin+  | UserPremiumGuildSubscription+  | UserPremiumGuildSubscriptionTier1+  | UserPremiumGuildSubscriptionTier2+  | UserPremiumGuildSubscriptionTier3+  | ChannelFollowAdd+  | GuildDiscoveryDisqualified+  | GuildDiscoveryRequalified   deriving ( Eq, Show, Enum, Generic )   deriving ( TextShow ) via TSG.FromGeneric MessageType @@ -79,5 +86,12 @@       5 -> pure ChannelIconChange       6 -> pure ChannelPinnedMessage       7 -> pure GuildMemberJoin+      8 -> pure UserPremiumGuildSubscription+      9 -> pure UserPremiumGuildSubscriptionTier1+      10 -> pure UserPremiumGuildSubscriptionTier2+      11 -> pure UserPremiumGuildSubscriptionTier3+      12 -> pure ChannelFollowAdd+      13 -> pure GuildDiscoveryDisqualified+      14 -> pure GuildDiscoveryRequalified       _ -> fail $ "Invalid MessageType: " <> show n     Nothing -> fail $ "Invalid MessageType: " <> show n

@@ -7,7 +7,6 @@ import           Calamity.Types.Snowflake  import           Data.Aeson-import           Data.Text.Lazy                         ( Text )  import           GHC.Generics @@ -16,7 +15,7 @@  data Overwrite = Overwrite   { id    :: Snowflake Overwrite-  , type_ :: Text+  , type_ :: Int   , allow :: Permissions   , deny  :: Permissions   }

@@ -1,83 +1,98 @@-{-# LANGUAGE NoDeriveAnyClass #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE NoDeriveAnyClass #-}  -- | Guild permissions module Calamity.Types.Model.Guild.Permissions-    ( Permissions(..)-    , createInstantInvite-    , kickMembers-    , banMembers-    , administrator-    , manageChannels-    , manageGuild-    , addReactions-    , viewAuditLog-    , prioritySpeaker-    , stream-    , viewChannel-    , sendMessages-    , sendTtsMessages-    , manageMessages-    , embedLinks-    , attachFiles-    , readMessageHistory-    , mentionEveryone-    , useExternalEmojis-    , viewGuildInsights-    , connect-    , speak-    , muteMembers-    , deafenMembers-    , moveMembers-    , useVad-    , changeNickname-    , manageNicknames-    , manageRoles-    , manageWebhooks-    , manageEmojis ) where--import           Data.Aeson    ( FromJSON, ToJSON )-import           Data.Flags    ()-import           Data.Flags.TH-import           Data.Word+  ( Permissions (..),+    createInstantInvite,+    kickMembers,+    banMembers,+    administrator,+    manageChannels,+    manageGuild,+    addReactions,+    viewAuditLog,+    prioritySpeaker,+    stream,+    viewChannel,+    sendMessages,+    sendTtsMessages,+    manageMessages,+    embedLinks,+    attachFiles,+    readMessageHistory,+    mentionEveryone,+    useExternalEmojis,+    viewGuildInsights,+    connect,+    speak,+    muteMembers,+    deafenMembers,+    moveMembers,+    useVad,+    changeNickname,+    manageNicknames,+    manageRoles,+    manageWebhooks,+    manageEmojis,+  )+where -import           TextShow+import Data.Aeson (FromJSON (..), ToJSON (..))+import Data.Aeson.Types (parseFail)+import Data.Flags ()+import Data.Flags.TH+import Data.Text.Read (decimal)+import Data.Word+import TextShow -$(bitmaskWrapper "Permissions" ''Word64 []-  [ ("createInstantInvite", 0x00000001)-  , ("kickMembers", 0x00000002)-  , ("banMembers", 0x00000004)-  , ("administrator", 0x00000008)-  , ("manageChannels", 0x00000010)-  , ("manageGuild", 0x00000020)-  , ("addReactions", 0x00000040)-  , ("viewAuditLog", 0x00000080)-  , ("prioritySpeaker", 0x00000100)-  , ("stream", 0x00000200)-  , ("viewChannel", 0x00000400)-  , ("sendMessages", 0x00000800)-  , ("sendTtsMessages", 0x00001000)-  , ("manageMessages", 0x00002000)-  , ("embedLinks", 0x00004000)-  , ("attachFiles", 0x00008000)-  , ("readMessageHistory", 0x00010000)-  , ("mentionEveryone", 0x00020000)-  , ("useExternalEmojis", 0x00040000)-  , ("viewGuildInsights", 0x00080000)-  , ("connect", 0x00100000)-  , ("speak", 0x00200000)-  , ("muteMembers", 0x00400000)-  , ("deafenMembers", 0x00800000)-  , ("moveMembers", 0x01000000)-  , ("useVad", 0x02000000)-  , ("changeNickname", 0x04000000)-  , ("manageNicknames", 0x08000000)-  , ("manageRoles", 0x10000000)-  , ("manageWebhooks", 0x20000000)-  , ("manageEmojis", 0x4000000)])+$( bitmaskWrapper+     "Permissions"+     ''Word64+     []+     [ ("createInstantInvite", 0x00000001),+       ("kickMembers", 0x00000002),+       ("banMembers", 0x00000004),+       ("administrator", 0x00000008),+       ("manageChannels", 0x00000010),+       ("manageGuild", 0x00000020),+       ("addReactions", 0x00000040),+       ("viewAuditLog", 0x00000080),+       ("prioritySpeaker", 0x00000100),+       ("stream", 0x00000200),+       ("viewChannel", 0x00000400),+       ("sendMessages", 0x00000800),+       ("sendTtsMessages", 0x00001000),+       ("manageMessages", 0x00002000),+       ("embedLinks", 0x00004000),+       ("attachFiles", 0x00008000),+       ("readMessageHistory", 0x00010000),+       ("mentionEveryone", 0x00020000),+       ("useExternalEmojis", 0x00040000),+       ("viewGuildInsights", 0x00080000),+       ("connect", 0x00100000),+       ("speak", 0x00200000),+       ("muteMembers", 0x00400000),+       ("deafenMembers", 0x00800000),+       ("moveMembers", 0x01000000),+       ("useVad", 0x02000000),+       ("changeNickname", 0x04000000),+       ("manageNicknames", 0x08000000),+       ("manageRoles", 0x10000000),+       ("manageWebhooks", 0x20000000),+       ("manageEmojis", 0x4000000)+     ]+ ) -deriving via Word64 instance ToJSON Permissions+instance ToJSON Permissions where+  toJSON = toJSON . showt+  toEncoding = toEncoding . showt -deriving via Word64 instance FromJSON Permissions+instance FromJSON Permissions where+  parseJSON a = do+    asText <- parseJSON a+    case decimal asText of+      Right (n, _) -> pure $ Permissions n+      Left e -> parseFail e  deriving via FromStringShow Permissions instance TextShow Permissions

@@ -58,6 +58,11 @@ -- | Things that 'Member's have 'Permissions' in class PermissionsIn a where   -- | Calculate a 'Member'\'s 'Permissions' in something+  --+  -- If permissions could not be calculated because something couldn't be found+  -- in the cache, this will return an empty set of permissions. Use+  -- 'permissionsIn'' if you want to handle cases where something might not exist+  -- in cache.   permissionsIn :: a -> Member -> Permissions  -- | A 'Member'\'s 'Permissions' in a channel are their roles and overwrites@@ -71,11 +76,6 @@ -- | A variant of 'PermissionsIn' that will use the cache/http. class PermissionsIn' a where   -- | Calculate the permissions of something that has a 'User' id-  ---  -- If permissions could not be calculated because something couldn't be found-  -- in the cache, this will return an empty set of permissions. Use-  -- 'permissionsIn' if you want to handle cases where something might not exist-  -- in cache.   permissionsIn' :: (BotC r, HasID User u) => a -> u -> P.Sem r Permissions  -- | A 'User''s 'Permissions' in a channel are their roles and overwrites