diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Changelog for Calamity +## 0.1.24.2 + ++ Add event handlers for voice state update events: `'VoiceStateUpdateEvt` ++ Apply some fixes for a few memory leaks + ## 0.1.24.1 + Fix some memory leaks diff --git a/calamity.cabal b/calamity.cabal --- a/calamity.cabal +++ b/calamity.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 9feeea689fb0b9d305f0fe00b6993523fb12bc6e272225ca890b5af595a2dde9 +-- hash: a5c065a71cfed945f41be7a4a6f14517749ae7e80ebeb56e60944a845ef100a4 name: calamity -version: 0.1.24.1 +version: 0.1.24.2 synopsis: A library for writing discord bots in haskell description: Please see the README on GitHub at category: Network, Web diff --git a/src/Calamity/Client/Client.hs b/src/Calamity/Client/Client.hs --- a/src/Calamity/Client/Client.hs +++ b/src/Calamity/Client/Client.hs @@ -31,6 +31,7 @@ import Calamity.Types.Model.Guild import Calamity.Types.Model.Presence ( Presence(..) ) import Calamity.Types.Model.User +import qualified Calamity.Types.Model.Voice as V import Calamity.Types.Snowflake import Calamity.Types.Token import Calamity.Types.LogEff @@ -604,6 +605,11 @@ Just newUser <- getBotUser pure $ map ($ (oldUser, newUser)) (getEventHandlers @'UserUpdateEvt eh) +handleEvent' eh evt@(VoiceStateUpdate newVoiceState@V.VoiceState{guildID=Just guildID}) = do + oldVoiceState <- join . fmap (find ((==V.sessionID newVoiceState) . V.sessionID) . voiceStates) <$> getGuild guildID + updateCache evt + pure $ map ($ (oldVoiceState, newVoiceState)) (getEventHandlers @'VoiceStateUpdateEvt eh) + handleEvent' _ e = fail $ "Unhandled event: " <> show e updateCache :: P.Members '[CacheEff, P.Fail] r => DispatchData -> P.Sem r () @@ -712,6 +718,14 @@ updateCache (InviteCreate _) = pure () updateCache (InviteDelete _) = pure () --- we don't handle voice state currently -updateCache (VoiceStateUpdate _) = pure () +updateCache (VoiceStateUpdate voiceState@V.VoiceState{guildID=Just guildID}) = + updateGuild guildID (#voiceStates %~ updateVoiceStates) + where + updateVoiceStates [] = [voiceState] + updateVoiceStates (x:xs) + | V.sessionID x == V.sessionID voiceState = voiceState : xs + | otherwise = x : updateVoiceStates xs + + -- we don't handle voice server update and direct voice connections currently +updateCache (VoiceStateUpdate V.VoiceState{guildID=Nothing}) = pure () updateCache (VoiceServerUpdate _) = pure () diff --git a/src/Calamity/Client/Types.hs b/src/Calamity/Client/Types.hs --- a/src/Calamity/Client/Types.hs +++ b/src/Calamity/Client/Types.hs @@ -25,6 +25,7 @@ import Calamity.Types.Model.Channel.UpdatedMessage import Calamity.Types.Model.Guild import Calamity.Types.Model.User +import Calamity.Types.Model.Voice import Calamity.Types.Token import Calamity.Types.UnixTimestamp import Calamity.Types.Snowflake @@ -152,6 +153,8 @@ -- ^ Fired when all reactions are removed from a message. | TypingStartEvt | UserUpdateEvt + | VoiceStateUpdateEvt + -- ^ Sent when someone joins/leaves/moves voice channels | forall s a. CustomEvt s a -- ^ A custom event, @s@ is the name and @a@ is the data sent to the handler @@ -206,6 +209,7 @@ EHType 'RawMessageReactionRemoveAllEvt = Snowflake Message EHType 'TypingStartEvt = (Channel, Snowflake User, UnixTimestamp) EHType 'UserUpdateEvt = (User, User) + EHType 'VoiceStateUpdateEvt = (Maybe VoiceState, VoiceState) EHType ('CustomEvt s a) = a type StoredEHType t = EHType t -> IO () diff --git a/src/Calamity/Gateway/DispatchEvents.hs b/src/Calamity/Gateway/DispatchEvents.hs --- a/src/Calamity/Gateway/DispatchEvents.hs +++ b/src/Calamity/Gateway/DispatchEvents.hs @@ -14,6 +14,7 @@ import Calamity.Types.Model.Guild.UnavailableGuild import Calamity.Types.Model.Presence.Presence import Calamity.Types.Model.User +import Calamity.Types.Model.Voice import Calamity.Types.Snowflake import Calamity.Types.UnixTimestamp @@ -69,7 +70,7 @@ | PresenceUpdate !PresenceUpdateData | TypingStart !TypingStartData | UserUpdate !User - | VoiceStateUpdate !VoiceStateUpdateData + | VoiceStateUpdate !VoiceState | VoiceServerUpdate !VoiceServerUpdateData | WebhooksUpdate !WebhooksUpdateData deriving ( Show, Generic, CtorName ) @@ -219,10 +220,6 @@ } deriving ( Show, Generic ) deriving FromJSON via CalamityJSON TypingStartData - -newtype VoiceStateUpdateData = VoiceStateUpdateData Value - deriving newtype ( Show, Generic ) - deriving newtype ( ToJSON, FromJSON ) newtype VoiceServerUpdateData = VoiceServerUpdateData Value deriving newtype ( Show, Generic ) diff --git a/src/Calamity/Gateway/Shard.hs b/src/Calamity/Gateway/Shard.hs --- a/src/Calamity/Gateway/Shard.hs +++ b/src/Calamity/Gateway/Shard.hs @@ -15,7 +15,6 @@ import Calamity.Metrics.Eff import Calamity.Types.LogEff import Calamity.Types.Token - import Control.Concurrent import Control.Concurrent.Async import qualified Control.Concurrent.Chan.Unagi as UC @@ -26,17 +25,18 @@ import Control.Lens import Control.Monad import Control.Monad.State.Lazy - import qualified Data.Aeson as A +import qualified Data.ByteString.Lazy as LBS +import Data.Default.Class (def) import Data.Functor import Data.IORef import Data.Maybe import qualified Data.Text.Lazy as L - import DiPolysemy hiding (debug, error, info) - import Fmt - +import qualified Network.Connection as NC +import qualified Network.TLS as NT +import qualified Network.TLS.Extra as NT import Network.WebSockets ( Connection, ConnectionException (..), @@ -44,24 +44,17 @@ sendCloseCode, sendTextData, ) - +import qualified Network.WebSockets as NW +import qualified Network.WebSockets.Stream as NW import Polysemy (Sem) import qualified Polysemy as P import qualified Polysemy.Async as P import qualified Polysemy.AtomicState as P import qualified Polysemy.Error as P import qualified Polysemy.Resource as P - -import Prelude hiding (error) - -import qualified Data.ByteString.Lazy as LBS -import Data.Default.Class (def) -import qualified Network.Connection as NC -import qualified Network.TLS as NT -import qualified Network.TLS.Extra as NT -import qualified Network.WebSockets as NW -import qualified Network.WebSockets.Stream as NW import qualified System.X509 as X509 +import TextShow (showtl) +import Prelude hiding (error) runWebsocket :: P.Members '[P.Final IO, P.Embed IO] r => @@ -171,8 +164,8 @@ handleWSException :: SomeException -> IO (Either (ControlMessage, Maybe L.Text) a) handleWSException e = pure $ case fromException e of Just (CloseRequest code _) - | code `elem` [1000, 4004, 4010, 4011] -> - Left (ShutDownShard, Nothing) + | code `elem` [4004, 4010, 4011, 4012, 4013, 4014] -> + Left (ShutDownShard, Just . showtl $ code) e -> Left (RestartShard, Just . L.pack . show $ e) discordStream :: P.Members '[LogEff, MetricEff, P.Embed IO, P.Final IO] r => Connection -> TBMQueue ShardMsg -> Sem r ()