calamity 0.1.24.0 → 0.1.24.1

raw patch · 31 files changed

+1093/−1021 lines, 31 filesdep +connectiondep +tlsdep +x509-systemdep −wussPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: connection, tls, x509-system

Dependencies removed: wuss

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• calamity.cabal +5/−3
• src/Calamity/Cache/InMemory.hs +53/−55
• src/Calamity/Client/Client.hs +6/−6
• src/Calamity/Gateway/DispatchEvents.hs +34/−34
• src/Calamity/Gateway/Shard.hs +181/−141
• src/Calamity/HTTP/Internal/Ratelimit.hs +3/−3
• src/Calamity/Internal/BoundedStore.hs +30/−36
• src/Calamity/Internal/SnowflakeMap.hs +105/−110
• src/Calamity/Types/Model/Channel.hs +1/−1
• src/Calamity/Types/Model/Channel/Attachment.hs +6/−9
• src/Calamity/Types/Model/Channel/ChannelType.hs +1/−1
• src/Calamity/Types/Model/Channel/DM.hs +24/−21
• src/Calamity/Types/Model/Channel/Guild.hs +50/−48
• src/Calamity/Types/Model/Channel/Guild/Category.hs +23/−26
• src/Calamity/Types/Model/Channel/Guild/Text.hs +34/−34
• src/Calamity/Types/Model/Channel/Guild/Voice.hs +25/−28
• src/Calamity/Types/Model/Channel/Message.hs +5/−5
• src/Calamity/Types/Model/Channel/UpdatedMessage.hs +42/−41
• src/Calamity/Types/Model/Guild/AuditLog.hs +2/−2
• src/Calamity/Types/Model/Guild/Emoji.hs +52/−41
• src/Calamity/Types/Model/Guild/Guild.hs +102/−100
• src/Calamity/Types/Model/Guild/Member.hs +51/−42
• src/Calamity/Types/Model/Guild/Overwrite.hs +15/−15
• src/Calamity/Types/Model/Guild/Permissions.hs +2/−0
• src/Calamity/Types/Model/Guild/Role.hs +30/−23
• src/Calamity/Types/Model/Presence/Activity.hs +72/−72
• src/Calamity/Types/Model/Presence/Presence.hs +15/−15
• src/Calamity/Types/Model/User.hs +47/−44
• src/Calamity/Types/Model/Voice/VoiceState.hs +21/−21
• src/Calamity/Types/UnixTimestamp.hs +52/−44

@@ -1,5 +1,9 @@ # Changelog for Calamity +## 0.1.24.1+++ Fix some memory leaks+ ## 0.1.24.0  + Switch from using Wreq to Req

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 00a40615c76f1d2bb08dcb114163494c4189aa1e755216a1553cacaeba8bb83f+-- hash: 9feeea689fb0b9d305f0fe00b6993523fb12bc6e272225ca890b5af595a2dde9  name:           calamity-version:        0.1.24.0+version:        0.1.24.1 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@@ -143,6 +143,7 @@     , bytestring >=0.10 && <0.12     , colour >=2.3.5 && <2.4     , concurrent-extra >=0.7 && <0.8+    , connection >=0.2.6 && <0.4     , containers >=0.6 && <0.7     , data-default-class >=0.1 && <0.2     , data-flags >=0.0.3 && <0.1@@ -178,11 +179,12 @@     , text >=1.2 && <2     , text-show >=3.8 && <4     , time >=1.8 && <1.12+    , tls >=1.4 && <2     , typerep-map >=0.3 && <0.4     , unagi-chan >=0.4 && <0.5     , unboxing-vector >=0.2 && <0.3     , unordered-containers >=0.2 && <0.3     , vector >=0.12 && <0.13     , websockets >=0.12 && <0.13-    , wuss >=1.1 && <2+    , x509-system >=1.6.6 && <1.7   default-language: Haskell2010

@@ -1,53 +1,57 @@ -- | A 'Cache' handler that operates in memory-module Calamity.Cache.InMemory-    ( runCacheInMemory-    , runCacheInMemory'-    , runCacheInMemoryNoMsg ) where+module Calamity.Cache.InMemory (+  runCacheInMemory,+  runCacheInMemory',+  runCacheInMemoryNoMsg,+) where -import           Calamity.Cache.Eff+import Calamity.Cache.Eff import qualified Calamity.Internal.BoundedStore as BS import qualified Calamity.Internal.SnowflakeMap as SM-import           Calamity.Internal.Utils-import           Calamity.Types.Model.Channel-import           Calamity.Types.Model.Guild-import           Calamity.Types.Model.User-import           Calamity.Types.Snowflake+import Calamity.Internal.Utils+import Calamity.Types.Model.Channel+import Calamity.Types.Model.Guild+import Calamity.Types.Model.User+import Calamity.Types.Snowflake -import           Control.Lens-import           Control.Monad.State.Strict+import Control.Lens+import Control.Monad.State.Strict -import           Data.Foldable-import qualified Data.HashMap.Lazy              as LH-import qualified Data.HashSet                   as LS-import           Data.IORef+import Data.Foldable+import qualified Data.HashMap.Strict as SH+import qualified Data.HashSet as HS+import Data.IORef -import           GHC.Generics+import Control.DeepSeq+import GHC.Generics -import qualified Polysemy                       as P-import qualified Polysemy.AtomicState           as P+import qualified Polysemy as P+import qualified Polysemy.AtomicState as P  data Cache f = Cache-  { user              :: Maybe User-  , guilds            :: SM.SnowflakeMap Guild-  , dms               :: SM.SnowflakeMap DMChannel-  , guildChannels     :: LH.HashMap (Snowflake GuildChannel) Guild-  , users             :: SM.SnowflakeMap User-  , unavailableGuilds :: LS.HashSet (Snowflake Guild)-  , messages          :: f (BS.BoundedStore Message)+  { user :: Maybe User+  , guilds :: SM.SnowflakeMap Guild+  , dms :: SM.SnowflakeMap DMChannel+  , guildChannels :: SH.HashMap (Snowflake GuildChannel) Guild+  , users :: SM.SnowflakeMap User+  , unavailableGuilds :: HS.HashSet (Snowflake Guild)+  , messages :: f (BS.BoundedStore Message)   }-  deriving ( Generic )+  deriving (Generic) +instance NFData (f (BS.BoundedStore Message)) => NFData (Cache f)+ type CacheWithMsg = Cache Identity type CacheNoMsg = Cache (Const ())  emptyCache :: CacheWithMsg-emptyCache = Cache Nothing SM.empty SM.empty LH.empty SM.empty LS.empty (Identity $ BS.empty 1000)+emptyCache = Cache Nothing SM.empty SM.empty SH.empty SM.empty HS.empty (Identity $ BS.empty 1000)  emptyCacheNoMsg :: CacheNoMsg-emptyCacheNoMsg = Cache Nothing SM.empty SM.empty LH.empty SM.empty LS.empty (Const ())+emptyCacheNoMsg = Cache Nothing SM.empty SM.empty SH.empty SM.empty HS.empty (Const ())  emptyCache' :: Int -> CacheWithMsg-emptyCache' msgLimit = Cache Nothing SM.empty SM.empty LH.empty SM.empty LS.empty (Identity $ BS.empty msgLimit)+emptyCache' msgLimit = Cache Nothing SM.empty SM.empty SH.empty SM.empty HS.empty (Identity $ BS.empty msgLimit)  -- | Run the cache in memory with a default message cache size of 1000 runCacheInMemory :: P.Member (P.Embed IO) r => P.Sem (CacheEff ': r) a -> P.Sem r a@@ -68,7 +72,7 @@   P.runAtomicStateIORef var $ P.reinterpret runCache' m  runCache' :: (MessageMod (Cache t), P.Member (P.AtomicState (Cache t)) r) => CacheEff m a -> P.Sem r a-runCache' act = P.atomicState' ((swap .) . runState $ runCache act)+runCache' act = P.atomicState' ((swap .) . force . runState $ runCache act)  class MessageMod t where   setMessage' :: Message -> State t ()@@ -83,43 +87,37 @@   delMessage' mid = #messages . _Wrapped %= sans mid  instance MessageMod CacheNoMsg where-  setMessage' _ = pure ()-  getMessage' _ = pure Nothing+  setMessage' !_ = pure ()+  getMessage' !_ = pure Nothing   getMessages' = pure []-  delMessage' _ = pure ()+  delMessage' !_ = pure ()  runCache :: MessageMod (Cache t) => CacheEff m a -> State (Cache t) a- runCache (SetBotUser u) = #user ?= u-runCache GetBotUser     = use #user--runCache (SetGuild g)   = do+runCache GetBotUser = use #user+runCache (SetGuild g) = do   #guilds %= SM.insert g-  #guildChannels %= LH.filter (\v -> getID @Guild v /= getID @Guild g)-  #guildChannels %= LH.union (LH.fromList $ map (,g) (SM.keys (g ^. #channels)))+  #guildChannels %= SH.filter (\v -> getID @Guild v /= getID @Guild g)+  #guildChannels %= SH.union (SH.fromList $ map (,g) (SM.keys (g ^. #channels))) runCache (GetGuild gid) = use (#guilds . at gid) runCache (GetGuildChannel cid) = use (#guildChannels . at cid) <&> (>>= (^. #channels . at cid))-runCache GetGuilds      = SM.elems <$> use #guilds+runCache GetGuilds = SM.elems <$> use #guilds runCache (DelGuild gid) = do   #guilds %= sans gid-  #guildChannels %= LH.filter (\v -> getID @Guild v /= gid)--runCache (SetDM dm)  = #dms %= SM.insert dm+  #guildChannels %= SH.filter (\v -> getID @Guild v /= gid)+runCache (SetDM dm) = #dms %= SM.insert dm runCache (GetDM did) = use (#dms . at did)-runCache GetDMs      = SM.elems <$> use #dms+runCache GetDMs = SM.elems <$> use #dms runCache (DelDM did) = #dms %= sans did--runCache (SetUser u)   = #users %= SM.insert u+runCache (SetUser u) = #users %= SM.insert u runCache (GetUser uid) = use (#users . at uid)-runCache GetUsers      = SM.elems <$> use #users+runCache GetUsers = SM.elems <$> use #users runCache (DelUser uid) = #users %= sans uid--runCache (SetUnavailableGuild gid) = #unavailableGuilds %= LS.insert gid-runCache (IsUnavailableGuild gid)  = use (#unavailableGuilds . contains gid)-runCache GetUnavailableGuilds      = LS.toList <$> use #unavailableGuilds+runCache (SetUnavailableGuild gid) = #unavailableGuilds %= HS.insert gid+runCache (IsUnavailableGuild gid) = use (#unavailableGuilds . contains gid)+runCache GetUnavailableGuilds = HS.toList <$> use #unavailableGuilds runCache (DelUnavailableGuild gid) = #unavailableGuilds %= sans gid--runCache (SetMessage m)   = setMessage' m+runCache (SetMessage m) = setMessage' m runCache (GetMessage mid) = getMessage' mid-runCache GetMessages      = getMessages'+runCache GetMessages = getMessages' runCache (DelMessage mid) = delMessage' mid

@@ -326,11 +326,11 @@ clientLoop = do   outc <- P.asks (^. #eventsOut)   whileMFinalIO $ do-    evt' <- P.embed $ readChan outc+    !evt' <- P.embed $ readChan outc     case evt' of-      Dispatch sid evt -> handleEvent sid evt >> pure True-      Custom s d       -> handleCustomEvent s d >> pure True-      ShutDown         -> pure False+      Dispatch !sid !evt -> handleEvent sid evt >> pure True+      Custom !s !d       -> handleCustomEvent s d >> pure True+      ShutDown           -> pure False   debug "leaving client loop"  handleCustomEvent :: forall r. BotC r => TypeRep -> Dynamic -> P.Sem r ()@@ -671,9 +671,9 @@ updateCache (GuildRoleDelete GuildRoleDeleteData { guildID, roleID }) =   updateGuild guildID (#roles %~ sans roleID) -updateCache (MessageCreate msg user) = do+updateCache (MessageCreate !msg !user) = do   setMessage msg-  forM_ user setUser+  for_ user setUser  updateCache (MessageUpdate msg) =   updateMessage (getID msg) (update msg)

@@ -37,41 +37,41 @@   deriving ( Show, Generic )  data DispatchData-  = Ready ReadyData+  = Ready !ReadyData   | Resumed-  | ChannelCreate Channel-  | ChannelUpdate Channel-  | ChannelDelete Channel-  | ChannelPinsUpdate ChannelPinsUpdateData-  | GuildCreate Guild-  | GuildUpdate UpdatedGuild-  | GuildDelete UnavailableGuild-  | GuildBanAdd BanData-  | GuildBanRemove BanData-  | GuildEmojisUpdate GuildEmojisUpdateData-  | GuildIntegrationsUpdate GuildIntegrationsUpdateData-  | GuildMemberAdd Member-  | GuildMemberRemove GuildMemberRemoveData-  | GuildMemberUpdate GuildMemberUpdateData-  | GuildMembersChunk GuildMembersChunkData-  | GuildRoleCreate GuildRoleData-  | GuildRoleUpdate GuildRoleData-  | GuildRoleDelete GuildRoleDeleteData-  | InviteCreate InviteCreateData-  | InviteDelete InviteDeleteData-  | MessageCreate Message (Maybe User)-  | MessageUpdate UpdatedMessage-  | MessageDelete MessageDeleteData-  | MessageDeleteBulk MessageDeleteBulkData-  | MessageReactionAdd Reaction-  | MessageReactionRemove Reaction-  | MessageReactionRemoveAll MessageReactionRemoveAllData-  | PresenceUpdate PresenceUpdateData-  | TypingStart TypingStartData-  | UserUpdate User-  | VoiceStateUpdate VoiceStateUpdateData-  | VoiceServerUpdate VoiceServerUpdateData-  | WebhooksUpdate WebhooksUpdateData+  | ChannelCreate !Channel+  | ChannelUpdate !Channel+  | ChannelDelete !Channel+  | ChannelPinsUpdate !ChannelPinsUpdateData+  | GuildCreate !Guild+  | GuildUpdate !UpdatedGuild+  | GuildDelete !UnavailableGuild+  | GuildBanAdd !BanData+  | GuildBanRemove !BanData+  | GuildEmojisUpdate !GuildEmojisUpdateData+  | GuildIntegrationsUpdate !GuildIntegrationsUpdateData+  | GuildMemberAdd !Member+  | GuildMemberRemove !GuildMemberRemoveData+  | GuildMemberUpdate !GuildMemberUpdateData+  | GuildMembersChunk !GuildMembersChunkData+  | GuildRoleCreate !GuildRoleData+  | GuildRoleUpdate !GuildRoleData+  | GuildRoleDelete !GuildRoleDeleteData+  | InviteCreate !InviteCreateData+  | InviteDelete !InviteDeleteData+  | MessageCreate !Message !(Maybe User)+  | MessageUpdate !UpdatedMessage+  | MessageDelete !MessageDeleteData+  | MessageDeleteBulk !MessageDeleteBulkData+  | MessageReactionAdd !Reaction+  | MessageReactionRemove !Reaction+  | MessageReactionRemoveAll !MessageReactionRemoveAllData+  | PresenceUpdate !PresenceUpdateData+  | TypingStart !TypingStartData+  | UserUpdate !User+  | VoiceStateUpdate !VoiceStateUpdateData+  | VoiceServerUpdate !VoiceServerUpdateData+  | WebhooksUpdate !WebhooksUpdateData   deriving ( Show, Generic, CtorName )  data ReadyData = ReadyData

@@ -1,77 +1,119 @@--- | The shard logic {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE TemplateHaskell #-} -module Calamity.Gateway.Shard-    ( Shard(..)-    , newShard ) where+-- | The shard logic+module Calamity.Gateway.Shard (+  Shard (..),+  newShard,+) where -import           Calamity.Gateway.DispatchEvents-import           Calamity.Gateway.Intents-import           Calamity.Gateway.Types-import           Calamity.Internal.Utils-import           Calamity.Internal.RunIntoIO-import           Calamity.Metrics.Eff-import           Calamity.Types.LogEff-import           Calamity.Types.Token+import Calamity.Gateway.DispatchEvents+import Calamity.Gateway.Intents+import Calamity.Gateway.Types+import Calamity.Internal.RunIntoIO+import Calamity.Internal.Utils+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-import           Control.Concurrent.STM-import           Control.Concurrent.STM.TBMQueue-import           Control.Exception-import qualified Control.Exception.Safe          as Ex-import           Control.Lens-import           Control.Monad-import           Control.Monad.State.Lazy+import Control.Concurrent+import Control.Concurrent.Async+import qualified Control.Concurrent.Chan.Unagi as UC+import Control.Concurrent.STM+import Control.Concurrent.STM.TBMQueue+import Control.Exception+import qualified Control.Exception.Safe as Ex+import Control.Lens+import Control.Monad+import Control.Monad.State.Lazy -import qualified Data.Aeson                      as A-import           Data.Functor-import           Data.IORef-import           Data.Maybe-import qualified Data.Text.Lazy                  as L+import qualified Data.Aeson as A+import Data.Functor+import Data.IORef+import Data.Maybe+import qualified Data.Text.Lazy as L -import           DiPolysemy                      hiding ( debug, error, info )+import DiPolysemy hiding (debug, error, info) -import           Fmt+import Fmt -import           Network.WebSockets              ( Connection, ConnectionException(..), receiveData, sendCloseCode-                                                 , sendTextData )+import Network.WebSockets (+  Connection,+  ConnectionException (..),+  receiveData,+  sendCloseCode,+  sendTextData,+ ) -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 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 Prelude hiding (error) -import           Wuss+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 -runWebsocket :: P.Members '[P.Final IO, P.Embed IO] r-  => L.Text-  -> L.Text-  -> (Connection -> P.Sem r a)-  -> P.Sem r (Maybe a)+runWebsocket ::+  P.Members '[P.Final IO, P.Embed IO] r =>+  L.Text ->+  L.Text ->+  (Connection -> P.Sem r a) ->+  P.Sem r (Maybe a) runWebsocket host path ma = do   inner <- bindSemToIO ma-  P.embed $ runSecureClient (L.unpack host) 443 (L.unpack path) inner +  -- We have to do this all ourself I think?+  -- TODO: see if this isn't needed++  ctx <- P.embed NC.initConnectionContext+  certStore <- P.embed X509.getSystemCertificateStore+  let clientParams =+        (NT.defaultParamsClient (L.unpack host) "443")+          { NT.clientSupported = def{NT.supportedCiphers = NT.ciphersuite_default}+          , NT.clientShared =+              def+                { NT.sharedCAStore = certStore+                }+          }+  let tlsSettings = NC.TLSSettings clientParams+      connParams = NC.ConnectionParams (L.unpack host) 443 (Just tlsSettings) Nothing++  P.embed $+    Ex.bracket+      (NC.connectTo ctx connParams)+      NC.connectionClose+      ( \conn -> do+          stream <-+            NW.makeStream+              (Just <$> NC.connectionGetChunk conn)+              (maybe (pure ()) (NC.connectionPut conn . LBS.toStrict))+          NW.runClientWithStream stream (L.unpack host) (L.unpack path) NW.defaultConnectionOptions [] inner+      )+ newShardState :: Shard -> ShardState newShardState shard = ShardState shard Nothing Nothing False Nothing Nothing Nothing  -- | Creates and launches a shard-newShard :: P.Members '[LogEff, MetricEff, P.Embed IO, P.Final IO, P.Async] r-         => L.Text-         -> Int-         -> Int-         -> Token-         -> Maybe StatusUpdateData-         -> Intents-         -> UC.InChan CalamityEvent-         -> Sem r (UC.InChan ControlMessage, Async (Maybe ()))+newShard ::+  P.Members '[LogEff, MetricEff, P.Embed IO, P.Final IO, P.Async] r =>+  L.Text ->+  Int ->+  Int ->+  Token ->+  Maybe StatusUpdateData ->+  Intents ->+  UC.InChan CalamityEvent ->+  Sem r (UC.InChan ControlMessage, Async (Maybe ())) newShard gateway id count token presence intents evtIn = do   (cmdIn, cmdOut) <- P.embed UC.newChan   let shard = Shard id count gateway evtIn cmdOut (rawToken token) presence intents@@ -99,12 +141,12 @@   v' <- tryWriteTBMQueue q v   case v' of     Just False -> retry-    Just True  -> pure True-    Nothing    -> pure False+    Just True -> pure True+    Nothing -> pure False  restartUnless :: P.Members '[LogEff, P.Error ShardFlowControl] r => L.Text -> Maybe a -> P.Sem r a-restartUnless _   (Just a) = pure a-restartUnless msg Nothing  = do+restartUnless _ (Just a) = pure a+restartUnless msg Nothing = do   error msg   P.throw ShardFlowRestart @@ -119,12 +161,12 @@  where   controlStream :: Shard -> TBMQueue ShardMsg -> IO ()   controlStream shard outqueue = inner-    where-      q = shard ^. #cmdOut-      inner = do-        v <- UC.readChan q-        r <- atomically $ tryWriteTBMQueue' outqueue (Control v)-        when r inner+   where+    q = shard ^. #cmdOut+    inner = do+      v <- UC.readChan q+      r <- atomically $ tryWriteTBMQueue' outqueue (Control v)+      when r inner    handleWSException :: SomeException -> IO (Either (ControlMessage, Maybe L.Text) a)   handleWSException e = pure $ case fromException e of@@ -135,31 +177,29 @@    discordStream :: P.Members '[LogEff, MetricEff, P.Embed IO, P.Final IO] r => Connection -> TBMQueue ShardMsg -> Sem r ()   discordStream ws outqueue = inner-    where inner = do-            msg <- P.embed $ Ex.catchAny (Right <$> receiveData ws) handleWSException--            case msg of-              Left (c, reason) -> do-                whenJust reason (\r -> error $ "Shard closed with reason: " <> r)-                P.embed . atomically $ writeTBMQueue outqueue (Control c)--              Right msg' -> do-                let decoded = A.eitherDecode msg'-                r <- case decoded of-                  Right a ->-                    P.embed . atomically $ tryWriteTBMQueue' outqueue (Discord a)-                  Left e -> do-                    error $ "Failed to decode: "+|e|+""-                    pure True-                when r inner+   where+    inner = do+      msg <- P.embed $ Ex.catchAny (Right <$> receiveData ws) handleWSException -  -- | The outer loop, sets up the ws conn, etc handles reconnecting and such+      case msg of+        Left (c, reason) -> do+          whenJust reason (\r -> error $ "Shard closed with reason: " <> r)+          P.embed . atomically $ writeTBMQueue outqueue (Control c)+        Right msg' -> do+          let decoded = A.eitherDecode msg'+          r <- case decoded of+            Right a ->+              P.embed . atomically $ tryWriteTBMQueue' outqueue (Discord a)+            Left e -> do+              error $ "Failed to decode: " +| e |+ ""+              pure True+          when r inner   outerloop :: ShardC r => Sem r ()   outerloop = whileMFinalIO $ do     shard :: Shard <- P.atomicGets (^. #shardS)     let host = shard ^. #gateway-    let host' =  fromMaybe host $ L.stripPrefix "wss://" host-    info $ "starting up shard "+| (shard ^. #shardID) |+" of "+| (shard ^. #shardCount) |+""+    let host' = fromMaybe host $ L.stripPrefix "wss://" host+    info $ "starting up shard " +| (shard ^. #shardID) |+ " of " +| (shard ^. #shardCount) |+ ""      innerLoopVal <- runWebsocket host' "/?v=8&encoding=json" innerloop @@ -167,18 +207,16 @@       Just ShardFlowShutDown -> do         info "Shutting down shard"         pure False-       Just ShardFlowRestart -> do         info "Restaring shard"         pure True-        -- we restart normally when we loop+      -- we restart normally when we loop -      Nothing -> do -- won't happen unless innerloop starts using a non-deterministic effect+      Nothing -> do+        -- won't happen unless innerloop starts using a non-deterministic effect         info "Restarting shard (abnormal reasons?)"         pure True -  -- | The inner loop, handles receiving a message from discord or a command message-  -- and then decides what to do with it   innerloop :: ShardC r => Connection -> Sem r ShardFlowControl   innerloop ws = do     debug "Entering inner loop of shard"@@ -186,51 +224,62 @@     shard <- P.atomicGets (^. #shardS)     P.atomicModify' (#wsConn ?~ ws) -    seqNum'    <- P.atomicGets (^. #seqNum)+    seqNum' <- P.atomicGets (^. #seqNum)     sessionID' <- P.atomicGets (^. #sessionID)      case (seqNum', sessionID') of       (Just n, Just s) -> do-        debug $ "Resuming shard (sessionID: "+|s|+", seq: "+|n|+")"-        sendToWs (Resume ResumeData-                  { token = shard ^. #token-                  , sessionID = s-                  , seq = n-                  })+        debug $ "Resuming shard (sessionID: " +| s |+ ", seq: " +| n |+ ")"+        sendToWs+          ( Resume+              ResumeData+                { token = shard ^. #token+                , sessionID = s+                , seq = n+                }+          )       _noActiveSession -> do         debug "Identifying shard"-        sendToWs (Identify IdentifyData-                  { token = shard ^. #token-                  , properties = IdentifyProps-                                 { browser = "Calamity: https://github.com/nitros12/calamity"-                                 , device = "Calamity: https://github.com/nitros12/calamity"-                                 }-                  , compress = False-                  , largeThreshold = 250-                  , shard = (shard ^. #shardID,-                             shard ^. #shardCount)-                  , presence = shard ^. #initialStatus-                  , intents = shard ^. #intents-                  })+        sendToWs+          ( Identify+              IdentifyData+                { token = shard ^. #token+                , properties =+                    IdentifyProps+                      { browser = "Calamity: https://github.com/nitros12/calamity"+                      , device = "Calamity: https://github.com/nitros12/calamity"+                      }+                , compress = False+                , largeThreshold = 250+                , shard =+                    ( shard ^. #shardID+                    , shard ^. #shardCount+                    )+                , presence = shard ^. #initialStatus+                , intents = shard ^. #intents+                }+          ) -    result <- P.resourceToIOFinal $ P.bracket (P.embed $ newTBMQueueIO 1)-      (P.embed . atomically . closeTBMQueue)-      (\q -> do-        debug "handling events now"-        _controlThread <- P.async . P.embed $ controlStream shard q-        _discordThread <- P.async $ discordStream ws q-        P.raise . untilJustFinalIO . (leftToMaybe <$>) . P.runError $ do-          -- only we close the queue-          msg <- P.embed . atomically $ readTBMQueue q-          handleMsg =<< restartUnless "shard message stream closed by someone other than the sink" msg)+    result <-+      P.resourceToIOFinal $+        P.bracket+          (P.embed $ newTBMQueueIO 1)+          (P.embed . atomically . closeTBMQueue)+          ( \q -> do+              debug "handling events now"+              _controlThread <- P.async . P.embed $ controlStream shard q+              _discordThread <- P.async $ discordStream ws q+              P.raise . untilJustFinalIO . (leftToMaybe <$>) . P.runError $ do+                -- only we close the queue+                msg <- P.embed . atomically $ readTBMQueue q+                handleMsg =<< restartUnless "shard message stream closed by someone other than the sink" msg+          )      debug "Exiting inner loop of shard"      P.atomicModify' (#wsConn .~ Nothing)     haltHeartBeat     pure result--  -- | Handlers for each message, not sure what they'll need to do exactly yet   handleMsg :: (ShardC r, P.Member (P.Error ShardFlowControl) r) => ShardMsg -> Sem r ()   handleMsg (Discord msg) = case msg of     EvtDispatch sn data' -> do@@ -240,46 +289,37 @@       case data' of         Ready rdata' ->           P.atomicModify' (#sessionID ?~ (rdata' ^. #sessionID))-         _NotReady -> pure ()        shard <- P.atomicGets (^. #shardS)       P.embed $ UC.writeChan (shard ^. #evtIn) (Dispatch (shard ^. #shardID) data')-     HeartBeatReq -> do       debug "Received heartbeat request"       sendHeartBeat-     Reconnect -> do       debug "Being asked to restart by Discord"       P.throw ShardFlowRestart-     InvalidSession resumable -> do       if resumable-      then-        info "Received resumable invalid session"-      else do-        info "Received non-resumable invalid session, sleeping for 15 seconds then retrying"-        P.atomicModify' (#sessionID .~ Nothing)-        P.atomicModify' (#seqNum .~ Nothing)-        P.embed $ threadDelay (15 * 1000 * 1000)+        then info "Received resumable invalid session"+        else do+          info "Received non-resumable invalid session, sleeping for 15 seconds then retrying"+          P.atomicModify' (#sessionID .~ Nothing)+          P.atomicModify' (#seqNum .~ Nothing)+          P.embed $ threadDelay (15 * 1000 * 1000)       P.throw ShardFlowRestart-     Hello interval -> do-      info $ "Received hello, beginning to heartbeat at an interval of "+|interval|+"ms"+      info $ "Received hello, beginning to heartbeat at an interval of " +| interval |+ "ms"       startHeartBeatLoop interval-     HeartBeatAck -> do       debug "Received heartbeat ack"       P.atomicModify' (#hbResponse .~ True)-   handleMsg (Control msg) = case msg of     SendPresence data' -> do-      debug $ "Sending presence: ("+||data'||+")"+      debug $ "Sending presence: (" +|| data' ||+ ")"       sendToWs $ StatusUpdate data'--    RestartShard       -> P.throw ShardFlowRestart-    ShutDownShard      -> P.throw ShardFlowShutDown+    RestartShard -> P.throw ShardFlowRestart+    ShutDownShard -> P.throw ShardFlowShutDown  startHeartBeatLoop :: ShardC r => Int -> Sem r () startHeartBeatLoop interval = do@@ -294,7 +334,7 @@     #hbThread .= Nothing     pure thread   case thread of-    Just t  -> do+    Just t -> do       debug "Stopping heartbeat thread"       P.embed (void $ cancel t)     Nothing -> pure ()

@@ -74,7 +74,7 @@             pure $               if isExhausted r'                 then case parseRateLimitHeader r' of-                  Just sleepTime -> ExhaustedBucket resp sleepTime+                  Just !sleepTime -> ExhaustedBucket resp sleepTime                   Nothing -> ServerError (statusCode status)                 else Good resp           | status == status429 -> do@@ -98,9 +98,9 @@ parseDiscordTime s = httpDateToUTC <$> parseHTTPDate s  computeDiscordTimeDiff :: Double -> UTCTime -> Int-computeDiscordTimeDiff end now = round . (* 1000.0) $ diffUTCTime end' now+computeDiscordTimeDiff end !now = round . (* 1000.0) $! diffUTCTime end' now  where-  end' = end & toRational & fromRational & posixSecondsToUTCTime+  !end' = end & toRational & fromRational & posixSecondsToUTCTime  -- | Parse a ratelimit header returning the number of milliseconds until it resets parseRateLimitHeader :: HttpResponse r => r -> Maybe Int

@@ -1,34 +1,31 @@ -- | A thing for storing the last N things with IDs-module Calamity.Internal.BoundedStore-    ( BoundedStore-    , empty-    , addItem-    , getItem-    , dropItem ) where--import           Calamity.Internal.Utils-import           Calamity.Types.Snowflake--import           Control.Lens-import           Control.Monad.State.Lazy--import           Data.Default.Class-import           Data.Generics.Labels     ()-import           Data.HashMap.Lazy        ( HashMap )-import qualified Data.HashMap.Lazy        as H--import qualified Deque.Lazy               as DQ-import           Deque.Lazy               ( Deque )+module Calamity.Internal.BoundedStore (+  BoundedStore,+  empty,+  addItem,+  getItem,+  dropItem,+) where -import           GHC.Generics+import Calamity.Internal.Utils+import Calamity.Types.Snowflake+import Control.Lens+import Control.Monad.State.Lazy+import Data.Default.Class+import Data.Generics.Labels ()+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as H+import Deque.Lazy (Deque)+import qualified Deque.Lazy as DQ+import GHC.Generics  data BoundedStore a = BoundedStore   { itemQueue :: Deque (Snowflake a)-  , items     :: HashMap (Snowflake a) a-  , limit     :: Int-  , size      :: Int+  , items :: HashMap (Snowflake a) a+  , limit :: Int+  , size :: Int   }-  deriving ( Show, Generic )+  deriving (Show, Generic)  instance Foldable BoundedStore where   foldr f i = foldr f i . H.elems . items@@ -39,19 +36,19 @@ empty :: Int -> BoundedStore a empty limit = BoundedStore mempty mempty limit 0 -type instance (Index (BoundedStore a)) = Snowflake a+type instance Index (BoundedStore a) = Snowflake a -type instance (IxValue (BoundedStore a)) = a+type instance IxValue (BoundedStore a) = a  instance HasID' a => Ixed (BoundedStore a)  instance HasID' a => At (BoundedStore a) where-  at k f m = f mv <&> \case-    Nothing -> maybe m (const (dropItem k m)) mv-    Just v  -> addItem v m-    where-      mv = getItem k m-+  at k f m =+    f mv <&> \case+      Nothing -> maybe m (const (dropItem k m)) mv+      Just v -> addItem v m+   where+    mv = getItem k m   {-# INLINE at #-}  addItem :: HasID' a => a -> BoundedStore a -> BoundedStore a@@ -71,12 +68,10 @@     #size -= 1    #items %= H.insert (getID m) m- {-# INLINE addItem #-}  getItem :: Snowflake a -> BoundedStore a -> Maybe a getItem id s = H.lookup id (s ^. #items)- {-# INLINE getItem #-}  dropItem :: Snowflake a -> BoundedStore a -> BoundedStore a@@ -86,5 +81,4 @@    #itemQueue %= DQ.filter (/= id)   #items %= H.delete id- {-# INLINE dropItem #-}

@@ -1,36 +1,31 @@--- | Module for custom instance of Data.HashMap.Lazy that decodes from any list of objects that have an id field+-- | Module for custom instance of Data.HashMap.Strict that decodes from any list of objects that have an id field module Calamity.Internal.SnowflakeMap where -import           Calamity.Internal.Utils  ()-import           Calamity.Types.Snowflake--import           Control.DeepSeq-import           Control.Lens.At-import           Control.Lens.Iso-import           Control.Lens.Wrapped--import           Data.Aeson               ( FromJSON(..), ToJSON(..), withArray )-import           Data.Data-import qualified Data.Foldable            as F-import           Data.HashMap.Lazy        ( HashMap )-import qualified Data.HashMap.Lazy        as LH-import           Data.Hashable--import           GHC.Exts                 ( IsList )-import           GHC.Generics--import           TextShow-import qualified TextShow.Generic         as TSG--import           Unsafe.Coerce+import Calamity.Internal.Utils ()+import Calamity.Types.Snowflake+import Control.DeepSeq+import Control.Lens.At+import Control.Lens.Iso+import Control.Lens.Wrapped+import Data.Aeson (FromJSON (..), ToJSON (..), withArray)+import Data.Data+import qualified Data.Foldable as F+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as SH+import Data.Hashable+import GHC.Exts (IsList)+import GHC.Generics+import TextShow+import qualified TextShow.Generic as TSG+import Unsafe.Coerce  newtype SnowflakeMap a = SnowflakeMap   { unSnowflakeMap :: HashMap (Snowflake a) a   }-  deriving ( Generic, Eq, Data, Ord, Show )-  deriving ( TextShow ) via TSG.FromGeneric (SnowflakeMap a)-  deriving newtype ( IsList, Semigroup, Monoid )-  deriving newtype ( NFData, Hashable )+  deriving (Generic, Eq, Data, Ord, Show)+  deriving (TextShow) via TSG.FromGeneric (SnowflakeMap a)+  deriving newtype (IsList, Semigroup, Monoid)+  deriving newtype (NFData, Hashable)  -- instance At (SnowflakeMap a) where --   at k f m = at (unSnowflakeMap k) f m@@ -53,9 +48,9 @@    _Wrapped' = iso unSnowflakeMap SnowflakeMap -type instance (Index (SnowflakeMap a)) = Snowflake a+type instance Index (SnowflakeMap a) = Snowflake a -type instance (IxValue (SnowflakeMap a)) = a+type instance IxValue (SnowflakeMap a) = a  instance SnowflakeMap a ~ t => Rewrapped (SnowflakeMap b) a @@ -66,171 +61,171 @@   at i = _Wrapped . at i  over :: (HashMap (Snowflake a) a -> HashMap (Snowflake b) b) -> SnowflakeMap a -> SnowflakeMap b-over f =  SnowflakeMap . f . unSnowflakeMap-{-# INLINABLE over #-}+over f = SnowflakeMap . f . unSnowflakeMap+{-# INLINEABLE over #-}  -- SAFETY: 'Snowflake' always uses the underlying hash function (Word64) coerceSnowflakeMap :: HashMap (Snowflake a) v -> HashMap (Snowflake b) v coerceSnowflakeMap = unsafeCoerce-{-# INLINABLE coerceSnowflakeMap #-}+{-# INLINEABLE coerceSnowflakeMap #-}  empty :: SnowflakeMap a-empty = SnowflakeMap LH.empty-{-# INLINABLE empty #-}+empty = SnowflakeMap SH.empty+{-# INLINEABLE empty #-}  singleton :: HasID' a => a -> SnowflakeMap a-singleton v = SnowflakeMap $ LH.singleton (getID v) v-{-# INLINABLE singleton #-}+singleton v = SnowflakeMap $ SH.singleton (getID v) v+{-# INLINEABLE singleton #-}  null :: SnowflakeMap a -> Bool-null = LH.null . unSnowflakeMap-{-# INLINABLE null #-}+null = SH.null . unSnowflakeMap+{-# INLINEABLE null #-}  size :: SnowflakeMap a -> Int-size = LH.size . unSnowflakeMap-{-# INLINABLE size #-}+size = SH.size . unSnowflakeMap+{-# INLINEABLE size #-}  member :: Snowflake a -> SnowflakeMap a -> Bool-member k = LH.member k . unSnowflakeMap-{-# INLINABLE member #-}+member k = SH.member k . unSnowflakeMap+{-# INLINEABLE member #-}  lookup :: Snowflake a -> SnowflakeMap a -> Maybe a-lookup k = LH.lookup k . unSnowflakeMap-{-# INLINABLE lookup #-}+lookup k = SH.lookup k . unSnowflakeMap+{-# INLINEABLE lookup #-}  lookupDefault :: a -> Snowflake a -> SnowflakeMap a -> a-lookupDefault d k = LH.lookupDefault d k . unSnowflakeMap-{-# INLINABLE lookupDefault #-}+lookupDefault d k = SH.lookupDefault d k . unSnowflakeMap+{-# INLINEABLE lookupDefault #-}  (!) :: SnowflakeMap a -> Snowflake a -> a-(!) m k = unSnowflakeMap m LH.! k-{-# INLINABLE (!) #-}+(!) m k = unSnowflakeMap m SH.! k+{-# INLINEABLE (!) #-}  infixl 9 !  insert :: HasID' a => a -> SnowflakeMap a -> SnowflakeMap a-insert v = over $ LH.insert (getID v) v-{-# INLINABLE insert #-}+insert v = over $ SH.insert (getID v) v+{-# INLINEABLE insert #-}  insertWith :: HasID' a => (a -> a -> a) -> a -> SnowflakeMap a -> SnowflakeMap a-insertWith f v = over $ LH.insertWith f (getID v) v-{-# INLINABLE insertWith #-}+insertWith f v = over $ SH.insertWith f (getID v) v+{-# INLINEABLE insertWith #-}  delete :: Snowflake a -> SnowflakeMap a -> SnowflakeMap a-delete k = over $ LH.delete k-{-# INLINABLE delete #-}+delete k = over $ SH.delete k+{-# INLINEABLE delete #-}  adjust :: (a -> a) -> Snowflake a -> SnowflakeMap a -> SnowflakeMap a-adjust f k = over $ LH.adjust f k-{-# INLINABLE adjust #-}+adjust f k = over $ SH.adjust f k+{-# INLINEABLE adjust #-}  update :: (a -> Maybe a) -> Snowflake a -> SnowflakeMap a -> SnowflakeMap a-update f k = over $ LH.update f k-{-# INLINABLE update #-}+update f k = over $ SH.update f k+{-# INLINEABLE update #-}  alter :: (Maybe a -> Maybe a) -> Snowflake a -> SnowflakeMap a -> SnowflakeMap a-alter f k = over $ LH.alter f k-{-# INLINABLE alter #-}+alter f k = over $ SH.alter f k+{-# INLINEABLE alter #-}  union :: SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a-union m m' = SnowflakeMap $ LH.union (unSnowflakeMap m) (unSnowflakeMap m')-{-# INLINABLE union #-}+union m m' = SnowflakeMap $ SH.union (unSnowflakeMap m) (unSnowflakeMap m')+{-# INLINEABLE union #-}  unionWith :: (a -> a -> a) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a-unionWith f m m' = SnowflakeMap $ LH.unionWith f (unSnowflakeMap m) (unSnowflakeMap m')-{-# INLINABLE unionWith #-}+unionWith f m m' = SnowflakeMap $ SH.unionWith f (unSnowflakeMap m) (unSnowflakeMap m')+{-# INLINEABLE unionWith #-}  unionWithKey :: (Snowflake a -> a -> a -> a) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a-unionWithKey f m m' = SnowflakeMap $ LH.unionWithKey f (unSnowflakeMap m) (unSnowflakeMap m')-{-# INLINABLE unionWithKey #-}+unionWithKey f m m' = SnowflakeMap $ SH.unionWithKey f (unSnowflakeMap m) (unSnowflakeMap m')+{-# INLINEABLE unionWithKey #-}  unions :: [SnowflakeMap a] -> SnowflakeMap a-unions = SnowflakeMap . LH.unions . Prelude.map unSnowflakeMap-{-# INLINABLE unions #-}+unions = SnowflakeMap . SH.unions . Prelude.map unSnowflakeMap+{-# INLINEABLE unions #-}  map :: (a1 -> a2) -> SnowflakeMap a1 -> SnowflakeMap a2-map f = over $ coerceSnowflakeMap . LH.map f-{-# INLINABLE map #-}+map f = over $ coerceSnowflakeMap . SH.map f+{-# INLINEABLE map #-}  mapWithKey :: (Snowflake a1 -> a1 -> a2) -> SnowflakeMap a1 -> SnowflakeMap a2-mapWithKey f = over $ coerceSnowflakeMap . LH.mapWithKey f-{-# INLINABLE mapWithKey #-}+mapWithKey f = over $ coerceSnowflakeMap . SH.mapWithKey f+{-# INLINEABLE mapWithKey #-}  traverseWithKey :: Applicative f => (Snowflake a1 -> a1 -> f a2) -> SnowflakeMap a1 -> f (SnowflakeMap a2)-traverseWithKey f = fmap (SnowflakeMap . coerceSnowflakeMap) . LH.traverseWithKey f . unSnowflakeMap-{-# INLINABLE traverseWithKey #-}+traverseWithKey f = fmap (SnowflakeMap . coerceSnowflakeMap) . SH.traverseWithKey f . unSnowflakeMap+{-# INLINEABLE traverseWithKey #-}  difference :: SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a-difference m m' = SnowflakeMap $ LH.difference (unSnowflakeMap m) (unSnowflakeMap m')-{-# INLINABLE difference #-}+difference m m' = SnowflakeMap $ SH.difference (unSnowflakeMap m) (unSnowflakeMap m')+{-# INLINEABLE difference #-}  differenceWith :: (a -> a -> Maybe a) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a-differenceWith f m m' = SnowflakeMap $ LH.differenceWith f (unSnowflakeMap m) (unSnowflakeMap m')-{-# INLINABLE differenceWith #-}+differenceWith f m m' = SnowflakeMap $ SH.differenceWith f (unSnowflakeMap m) (unSnowflakeMap m')+{-# INLINEABLE differenceWith #-}  intersection :: SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap a-intersection m m' = SnowflakeMap $ LH.intersection (unSnowflakeMap m) (unSnowflakeMap m')-{-# INLINABLE intersection #-}+intersection m m' = SnowflakeMap $ SH.intersection (unSnowflakeMap m) (unSnowflakeMap m')+{-# INLINEABLE intersection #-}  intersectionWith :: (a -> a -> b) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap b-intersectionWith f m m' = SnowflakeMap . coerceSnowflakeMap $ LH.intersectionWith f (unSnowflakeMap m) (unSnowflakeMap m')-{-# INLINABLE intersectionWith #-}+intersectionWith f m m' = SnowflakeMap . coerceSnowflakeMap $ SH.intersectionWith f (unSnowflakeMap m) (unSnowflakeMap m')+{-# INLINEABLE intersectionWith #-}  intersectionWithKey :: (Snowflake a -> a -> a -> b) -> SnowflakeMap a -> SnowflakeMap a -> SnowflakeMap b-intersectionWithKey f m m' = SnowflakeMap . coerceSnowflakeMap $ LH.intersectionWithKey f (unSnowflakeMap m) (unSnowflakeMap m')-{-# INLINABLE intersectionWithKey #-}+intersectionWithKey f m m' = SnowflakeMap . coerceSnowflakeMap $ SH.intersectionWithKey f (unSnowflakeMap m) (unSnowflakeMap m')+{-# INLINEABLE intersectionWithKey #-}  foldl' :: (a -> b -> a) -> a -> SnowflakeMap b -> a-foldl' f s m = LH.foldl' f s $ unSnowflakeMap m-{-# INLINABLE foldl' #-}+foldl' f s m = SH.foldl' f s $ unSnowflakeMap m+{-# INLINEABLE foldl' #-}  foldlWithKey' :: (a -> Snowflake b -> b -> a) -> a -> SnowflakeMap b -> a-foldlWithKey' f s m = LH.foldlWithKey' f s $ unSnowflakeMap m-{-# INLINABLE foldlWithKey' #-}+foldlWithKey' f s m = SH.foldlWithKey' f s $ unSnowflakeMap m+{-# INLINEABLE foldlWithKey' #-}  foldr :: (b -> a -> a) -> a -> SnowflakeMap b -> a-foldr f s m = LH.foldr f s $ unSnowflakeMap m-{-# INLINABLE foldr #-}+foldr f s m = SH.foldr f s $ unSnowflakeMap m+{-# INLINEABLE foldr #-}  foldrWithKey :: (Snowflake b -> b -> a -> a) -> a -> SnowflakeMap b -> a-foldrWithKey f s m = LH.foldrWithKey f s $ unSnowflakeMap m-{-# INLINABLE foldrWithKey #-}+foldrWithKey f s m = SH.foldrWithKey f s $ unSnowflakeMap m+{-# INLINEABLE foldrWithKey #-}  filter :: (a -> Bool) -> SnowflakeMap a -> SnowflakeMap a-filter f = over $ LH.filter f-{-# INLINABLE filter #-}+filter f = over $ SH.filter f+{-# INLINEABLE filter #-}  filterWithKey :: (Snowflake a -> a -> Bool) -> SnowflakeMap a -> SnowflakeMap a-filterWithKey f = over $ LH.filterWithKey f-{-# INLINABLE filterWithKey #-}+filterWithKey f = over $ SH.filterWithKey f+{-# INLINEABLE filterWithKey #-}  mapMaybe :: (a -> Maybe b) -> SnowflakeMap a -> SnowflakeMap b-mapMaybe f = over $ coerceSnowflakeMap . LH.mapMaybe f-{-# INLINABLE mapMaybe #-}+mapMaybe f = over $ coerceSnowflakeMap . SH.mapMaybe f+{-# INLINEABLE mapMaybe #-}  mapMaybeWithKey :: (Snowflake a -> a -> Maybe b) -> SnowflakeMap a -> SnowflakeMap b-mapMaybeWithKey f = over $ coerceSnowflakeMap . LH.mapMaybeWithKey f-{-# INLINABLE mapMaybeWithKey #-}+mapMaybeWithKey f = over $ coerceSnowflakeMap . SH.mapMaybeWithKey f+{-# INLINEABLE mapMaybeWithKey #-}  keys :: SnowflakeMap a -> [Snowflake a]-keys = LH.keys . unSnowflakeMap-{-# INLINABLE keys #-}+keys = SH.keys . unSnowflakeMap+{-# INLINEABLE keys #-}  elems :: SnowflakeMap a -> [a]-elems = LH.elems . unSnowflakeMap-{-# INLINABLE elems #-}+elems = SH.elems . unSnowflakeMap+{-# INLINEABLE elems #-}  toList :: SnowflakeMap a -> [(Snowflake a, a)]-toList = LH.toList . unSnowflakeMap-{-# INLINABLE toList #-}+toList = SH.toList . unSnowflakeMap+{-# INLINEABLE toList #-}  fromList :: HasID' a => [a] -> SnowflakeMap a-fromList = SnowflakeMap . LH.fromList . Prelude.map (\v -> (getID v, v))-{-# INLINABLE fromList #-}+fromList = SnowflakeMap . SH.fromList . Prelude.map (\v -> (getID v, v))+{-# INLINEABLE fromList #-}  fromListWith :: HasID' a => (a -> a -> a) -> [a] -> SnowflakeMap a-fromListWith f = SnowflakeMap . LH.fromListWith f . Prelude.map (\v -> (getID v, v))-{-# INLINABLE fromListWith #-}+fromListWith f = SnowflakeMap . SH.fromListWith f . Prelude.map (\v -> (getID v, v))+{-# INLINEABLE fromListWith #-}  instance (FromJSON a, HasID' a) => FromJSON (SnowflakeMap a) where   parseJSON = withArray "SnowflakeMap" $ \l -> do

@@ -59,7 +59,7 @@ data instance Partial Channel = PartialChannel   { id       :: Snowflake Channel   , name     :: Text-  , type_    :: ChannelType+  , type_    :: !ChannelType   , parentID :: Maybe (Snowflake Category)   }   deriving ( Show, Eq, Generic )

@@ -4,29 +4,26 @@  import           Calamity.Internal.AesonThings () import           Calamity.Types.Snowflake- import           Data.Aeson import           Data.Text.Lazy                ( Text ) import           Data.Word- import           GHC.Generics- import           TextShow import qualified TextShow.Generic              as TSG  fuseTup2 :: Monad f => (f a, f b) -> f (a, b) fuseTup2 (a, b) = do-  a' <- a-  b' <- b+  !a' <- a+  !b' <- b   pure (a', b')  data Attachment = Attachment   { id         :: Snowflake Attachment-  , filename   :: Text+  , filename   :: !Text   , size       :: Word64-  , url        :: Text-  , proxyUrl   :: Text-  , dimensions :: Maybe (Word64, Word64)+  , url        :: !Text+  , proxyUrl   :: !Text+  , dimensions :: !(Maybe (Word64, Word64))   }   deriving ( Eq, Show, Generic )   deriving ( TextShow ) via TSG.FromGeneric Attachment

@@ -25,7 +25,7 @@  instance FromJSON ChannelType where   parseJSON = withScientific "ChannelType" $ \n -> case toBoundedInteger @Int n of-    Just v  -> case v of+    Just !v  -> case v of       0 -> pure GuildTextType       1 -> pure DMType       2 -> pure GuildVoiceType

@@ -1,32 +1,35 @@ -- | A DM channel with a single person-module Calamity.Types.Model.Channel.DM-    ( DMChannel(..) ) where+module Calamity.Types.Model.Channel.DM (DMChannel (..)) where -import           Calamity.Internal.AesonThings-import           Calamity.Internal.Utils              ()+import Calamity.Internal.AesonThings+import Calamity.Internal.Utils () import {-# SOURCE #-} Calamity.Types.Model.Channel import {-# SOURCE #-} Calamity.Types.Model.Channel.Message-import           Calamity.Types.Model.User-import           Calamity.Types.Snowflake+import Calamity.Types.Model.User+import Calamity.Types.Snowflake -import           Data.Aeson-import           Data.Time-import           Data.Vector.Unboxing                 ( Vector )+import Data.Aeson+import Data.Time+import Data.Vector.Unboxing (Vector) -import           GHC.Generics+import GHC.Generics -import           TextShow-import qualified TextShow.Generic                     as TSG+import Control.DeepSeq (NFData)+import TextShow+import qualified TextShow.Generic as TSG  data DMChannel = DMChannel-  { id               :: Snowflake DMChannel-  , lastMessageID    :: Maybe (Snowflake Message)+  { id :: Snowflake DMChannel+  , lastMessageID :: Maybe (Snowflake Message)   , lastPinTimestamp :: Maybe UTCTime-  , recipients       :: Vector (Snowflake User)+  , recipients :: Vector (Snowflake User)   }-  deriving ( Show, Eq, Generic )-  deriving ( TextShow ) via TSG.FromGeneric DMChannel-  deriving ( FromJSON ) via WithSpecialCases-      '["recipients" `ExtractArrayField` "id"] DMChannel-  deriving ( HasID DMChannel ) via HasIDField "id" DMChannel-  deriving ( HasID Channel ) via HasIDFieldCoerce' "id" DMChannel+  deriving (Show, Eq, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric DMChannel+  deriving+    (FromJSON)+    via WithSpecialCases+          '["recipients" `ExtractArrayField` "id"]+          DMChannel+  deriving (HasID DMChannel) via HasIDField "id" DMChannel+  deriving (HasID Channel) via HasIDFieldCoerce' "id" DMChannel

@@ -1,47 +1,49 @@ -- | The generic guild channel type-module Calamity.Types.Model.Channel.Guild-    ( GuildChannel(..)-    , module Calamity.Types.Model.Channel.Guild.Category-    , module Calamity.Types.Model.Channel.Guild.Text-    , module Calamity.Types.Model.Channel.Guild.Voice ) where+module Calamity.Types.Model.Channel.Guild (+  GuildChannel (..),+  module Calamity.Types.Model.Channel.Guild.Category,+  module Calamity.Types.Model.Channel.Guild.Text,+  module Calamity.Types.Model.Channel.Guild.Voice,+) where -import           Calamity.Internal.SnowflakeMap              ( SnowflakeMap )+import Calamity.Internal.SnowflakeMap (SnowflakeMap) import {-# SOURCE #-} Calamity.Types.Model.Channel-import           Calamity.Types.Model.Channel.ChannelType-import           Calamity.Types.Model.Channel.Guild.Category-import           Calamity.Types.Model.Channel.Guild.Text-import           Calamity.Types.Model.Channel.Guild.Voice+import Calamity.Types.Model.Channel.ChannelType+import Calamity.Types.Model.Channel.Guild.Category+import Calamity.Types.Model.Channel.Guild.Text+import Calamity.Types.Model.Channel.Guild.Voice import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild-import           Calamity.Types.Model.Guild.Overwrite-import           Calamity.Types.Snowflake+import Calamity.Types.Model.Guild.Overwrite+import Calamity.Types.Snowflake -import           Control.Lens+import Control.Lens -import           Data.Aeson-import           Data.Generics.Product.Fields-import           Data.Text.Lazy                              ( Text )+import Data.Aeson+import Data.Generics.Product.Fields+import Data.Text.Lazy (Text) -import           GHC.Generics+import GHC.Generics -import           TextShow-import qualified TextShow.Generic                            as TSG+import Control.DeepSeq (NFData)+import TextShow+import qualified TextShow.Generic as TSG  data GuildChannel   = GuildTextChannel TextChannel   | GuildVoiceChannel VoiceChannel   | GuildCategory Category-  deriving ( Show, Eq, Generic )-  deriving ( TextShow ) via TSG.FromGeneric GuildChannel+  deriving (Show, Eq, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric GuildChannel  instance FromJSON GuildChannel where   parseJSON = withObject "GuildChannel" $ \v -> do     type_ <- v .: "type"      case type_ of-      GuildTextType     -> GuildTextChannel <$> parseJSON (Object v)-      GuildVoiceType    -> GuildVoiceChannel <$> parseJSON (Object v)+      GuildTextType -> GuildTextChannel <$> parseJSON (Object v)+      GuildVoiceType -> GuildVoiceChannel <$> parseJSON (Object v)       GuildCategoryType -> GuildCategory <$> parseJSON (Object v)-      typ               -> fail $ "Not a valid guild channel: " <> show typ+      typ -> fail $ "Not a valid guild channel: " <> show typ  instance HasID GuildChannel GuildChannel where   getID (GuildTextChannel a) = coerceSnowflake $ a ^. field' @"id"@@ -56,35 +58,35 @@   getID (GuildVoiceChannel a) = coerceSnowflake $ a ^. field' @"guildID"   getID (GuildCategory a) = coerceSnowflake $ a ^. field' @"guildID" -instance {-# OVERLAPS #-}HasField' "name" GuildChannel Text where+instance {-# OVERLAPS #-} HasField' "name" GuildChannel Text where   field' = lens get set-    where-      get (GuildTextChannel (TextChannel { name })) = name-      get (GuildVoiceChannel (VoiceChannel { name })) = name-      get (GuildCategory (Category { name })) = name+   where+    get (GuildTextChannel (TextChannel{name})) = name+    get (GuildVoiceChannel (VoiceChannel{name})) = name+    get (GuildCategory (Category{name})) = name -      set (GuildTextChannel t) v = GuildTextChannel (t { name = v })-      set (GuildVoiceChannel t) v = GuildVoiceChannel (t { name = v })-      set (GuildCategory t) v = GuildCategory (t { name = v })+    set (GuildTextChannel t) v = GuildTextChannel (t{name = v})+    set (GuildVoiceChannel t) v = GuildVoiceChannel (t{name = v})+    set (GuildCategory t) v = GuildCategory (t{name = v}) -instance {-# OVERLAPS #-}HasField' "permissionOverwrites" GuildChannel (SnowflakeMap Overwrite) where+instance {-# OVERLAPS #-} HasField' "permissionOverwrites" GuildChannel (SnowflakeMap Overwrite) where   field' = lens get set-    where-      get (GuildTextChannel (TextChannel { permissionOverwrites })) = permissionOverwrites-      get (GuildVoiceChannel (VoiceChannel { permissionOverwrites })) = permissionOverwrites-      get (GuildCategory (Category { permissionOverwrites })) = permissionOverwrites+   where+    get (GuildTextChannel (TextChannel{permissionOverwrites})) = permissionOverwrites+    get (GuildVoiceChannel (VoiceChannel{permissionOverwrites})) = permissionOverwrites+    get (GuildCategory (Category{permissionOverwrites})) = permissionOverwrites -      set (GuildTextChannel t) v = GuildTextChannel (t { permissionOverwrites = v })-      set (GuildVoiceChannel t) v = GuildVoiceChannel (t { permissionOverwrites = v })-      set (GuildCategory t) v = GuildCategory (t { permissionOverwrites = v })+    set (GuildTextChannel t) v = GuildTextChannel (t{permissionOverwrites = v})+    set (GuildVoiceChannel t) v = GuildVoiceChannel (t{permissionOverwrites = v})+    set (GuildCategory t) v = GuildCategory (t{permissionOverwrites = v}) -instance {-# OVERLAPS #-}HasField' "position" GuildChannel Int where+instance {-# OVERLAPS #-} HasField' "position" GuildChannel Int where   field' = lens get set-    where-      get (GuildTextChannel (TextChannel { position })) = position-      get (GuildVoiceChannel (VoiceChannel { position })) = position-      get (GuildCategory (Category { position })) = position+   where+    get (GuildTextChannel (TextChannel{position})) = position+    get (GuildVoiceChannel (VoiceChannel{position})) = position+    get (GuildCategory (Category{position})) = position -      set (GuildTextChannel t) v = GuildTextChannel (t { position = v })-      set (GuildVoiceChannel t) v = GuildVoiceChannel (t { position = v })-      set (GuildCategory t) v = GuildCategory (t { position = v })+    set (GuildTextChannel t) v = GuildTextChannel (t{position = v})+    set (GuildVoiceChannel t) v = GuildVoiceChannel (t{position = v})+    set (GuildCategory t) v = GuildCategory (t{position = v})

@@ -1,33 +1,30 @@-module Calamity.Types.Model.Channel.Guild.Category-    ( Category(..) ) where+module Calamity.Types.Model.Channel.Guild.Category (Category (..)) where -import           Calamity.Internal.AesonThings-import           Calamity.Internal.SnowflakeMap       ( SnowflakeMap )-import           Calamity.Internal.Utils              ()+import Calamity.Internal.AesonThings+import Calamity.Internal.SnowflakeMap (SnowflakeMap)+import Calamity.Internal.Utils () import {-# SOURCE #-} Calamity.Types.Model.Channel import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild-import           Calamity.Types.Model.Guild.Overwrite-import           Calamity.Types.Snowflake--import           Data.Aeson-import           Data.Text.Lazy                       ( Text )--import           GHC.Generics--import           TextShow-import qualified TextShow.Generic                     as TSG+import Calamity.Types.Model.Guild.Overwrite+import Calamity.Types.Snowflake+import Control.DeepSeq (NFData)+import Data.Aeson+import Data.Text.Lazy (Text)+import GHC.Generics+import TextShow+import qualified TextShow.Generic as TSG  data Category = Category-  { id                   :: Snowflake Category+  { id :: Snowflake Category   , permissionOverwrites :: SnowflakeMap Overwrite-  , name                 :: Text-  , nsfw                 :: Bool-  , position             :: Int-  , guildID              :: Snowflake Guild+  , name :: Text+  , nsfw :: Bool+  , position :: Int+  , guildID :: Snowflake Guild   }-  deriving ( Show, Eq, Generic )-  deriving ( TextShow ) via TSG.FromGeneric Category-  deriving ( ToJSON ) via CalamityJSON Category-  deriving ( FromJSON ) via WithSpecialCases '[IfNoneThen "nsfw" DefaultToFalse] Category-  deriving ( HasID Category ) via HasIDField "id" Category-  deriving ( HasID Channel ) via HasIDFieldCoerce' "id" Category+  deriving (Show, Eq, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric Category+  deriving (ToJSON) via CalamityJSON Category+  deriving (FromJSON) via WithSpecialCases '[IfNoneThen "nsfw" DefaultToFalse] Category+  deriving (HasID Category) via HasIDField "id" Category+  deriving (HasID Channel) via HasIDFieldCoerce' "id" Category

@@ -1,44 +1,44 @@ -- | Text channels-module Calamity.Types.Model.Channel.Guild.Text-    ( TextChannel(..) ) where+module Calamity.Types.Model.Channel.Guild.Text (TextChannel (..)) where -import           Calamity.Internal.AesonThings-import           Calamity.Internal.SnowflakeMap              ( SnowflakeMap )-import           Calamity.Internal.Utils                     ()+import Calamity.Internal.AesonThings+import Calamity.Internal.SnowflakeMap (SnowflakeMap)+import Calamity.Internal.Utils () import {-# SOURCE #-} Calamity.Types.Model.Channel import {-# SOURCE #-} Calamity.Types.Model.Channel.Guild.Category import {-# SOURCE #-} Calamity.Types.Model.Channel.Message import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild-import           Calamity.Types.Model.Guild.Overwrite-import           Calamity.Types.Snowflake--import           Data.Aeson-import           Data.Text.Lazy                              ( Text )-import           Data.Time--import           GHC.Generics--import           TextShow-import qualified TextShow.Generic                            as TSG+import Calamity.Types.Model.Guild.Overwrite+import Calamity.Types.Snowflake+import Control.DeepSeq (NFData)+import Data.Aeson+import Data.Text.Lazy (Text)+import Data.Time+import GHC.Generics+import TextShow+import qualified TextShow.Generic as TSG  data TextChannel = TextChannel-  { id                   :: Snowflake TextChannel-  , guildID              :: Snowflake Guild-  , position             :: Int+  { id :: Snowflake TextChannel+  , guildID :: Snowflake Guild+  , position :: Int   , permissionOverwrites :: SnowflakeMap Overwrite-  , name                 :: Text-  , topic                :: Maybe Text-  , nsfw                 :: Bool-  , lastMessageID        :: Maybe (Snowflake Message)-  , lastPinTimestamp     :: Maybe UTCTime-  , rateLimitPerUser     :: Maybe Int-  , parentID             :: Maybe (Snowflake Category)+  , name :: Text+  , topic :: Maybe Text+  , nsfw :: Bool+  , lastMessageID :: Maybe (Snowflake Message)+  , lastPinTimestamp :: Maybe UTCTime+  , rateLimitPerUser :: Maybe Int+  , parentID :: Maybe (Snowflake Category)   }-  deriving ( Show, Eq, Generic )-  deriving ( TextShow ) via TSG.FromGeneric TextChannel-  deriving ( ToJSON ) via CalamityJSON TextChannel-  deriving ( FromJSON ) via WithSpecialCases '[IfNoneThen "nsfw" DefaultToFalse]-      TextChannel-  deriving ( HasID TextChannel ) via HasIDField "id" TextChannel-  deriving ( HasID Channel ) via HasIDFieldCoerce' "id" TextChannel-  deriving ( HasID Guild ) via HasIDField "guildID" TextChannel+  deriving (Show, Eq, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric TextChannel+  deriving (ToJSON) via CalamityJSON TextChannel+  deriving+    (FromJSON)+    via WithSpecialCases+          '[IfNoneThen "nsfw" DefaultToFalse]+          TextChannel+  deriving (HasID TextChannel) via HasIDField "id" TextChannel+  deriving (HasID Channel) via HasIDFieldCoerce' "id" TextChannel+  deriving (HasID Guild) via HasIDField "guildID" TextChannel

@@ -1,37 +1,34 @@ -- | Voice channels-module Calamity.Types.Model.Channel.Guild.Voice-    ( VoiceChannel(..) ) where+module Calamity.Types.Model.Channel.Guild.Voice (VoiceChannel (..)) where -import           Calamity.Internal.AesonThings-import           Calamity.Internal.SnowflakeMap              ( SnowflakeMap )-import           Calamity.Internal.Utils                     ()+import Calamity.Internal.AesonThings+import Calamity.Internal.SnowflakeMap (SnowflakeMap)+import Calamity.Internal.Utils () import {-# SOURCE #-} Calamity.Types.Model.Channel import {-# SOURCE #-} Calamity.Types.Model.Channel.Guild.Category import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild-import           Calamity.Types.Model.Guild.Overwrite-import           Calamity.Types.Snowflake--import           Data.Aeson-import           Data.Text.Lazy                              ( Text )--import           GHC.Generics--import           TextShow-import qualified TextShow.Generic                            as TSG+import Calamity.Types.Model.Guild.Overwrite+import Calamity.Types.Snowflake+import Control.DeepSeq (NFData)+import Data.Aeson+import Data.Text.Lazy (Text)+import GHC.Generics+import TextShow+import qualified TextShow.Generic as TSG  data VoiceChannel = VoiceChannel-  { id                   :: Snowflake VoiceChannel-  , guildID              :: Snowflake Guild-  , position             :: Int+  { id :: Snowflake VoiceChannel+  , guildID :: Snowflake Guild+  , position :: Int   , permissionOverwrites :: SnowflakeMap Overwrite-  , name                 :: Text-  , bitrate              :: Int-  , userLimit            :: Int-  , parentID             :: Maybe (Snowflake Category)+  , name :: Text+  , bitrate :: Int+  , userLimit :: Int+  , parentID :: Maybe (Snowflake Category)   }-  deriving ( Show, Eq, Generic )-  deriving ( TextShow ) via TSG.FromGeneric VoiceChannel-  deriving ( ToJSON, FromJSON ) via CalamityJSON VoiceChannel-  deriving ( HasID VoiceChannel ) via HasIDField "id" VoiceChannel-  deriving ( HasID Channel ) via HasIDFieldCoerce' "id" VoiceChannel-  deriving ( HasID Guild ) via HasIDField "guildID" VoiceChannel+  deriving (Show, Eq, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric VoiceChannel+  deriving (ToJSON, FromJSON) via CalamityJSON VoiceChannel+  deriving (HasID VoiceChannel) via HasIDField "id" VoiceChannel+  deriving (HasID Channel) via HasIDFieldCoerce' "id" VoiceChannel+  deriving (HasID Guild) via HasIDField "guildID" VoiceChannel

@@ -36,13 +36,13 @@   , mentions        :: UV.Vector (Snowflake User)   , mentionRoles    :: UV.Vector (Snowflake Role)   , mentionChannels :: Maybe (UV.Vector (Snowflake Channel))-  , attachments     :: [Attachment]-  , embeds          :: [Embed]-  , reactions       :: [Reaction]+  , attachments     :: ![Attachment]+  , embeds          :: ![Embed]+  , reactions       :: ![Reaction]   , nonce           :: Maybe (Snowflake Message)   , pinned          :: Bool   , webhookID       :: Maybe (Snowflake ())-  , type_           :: MessageType+  , type_           :: !MessageType   }   deriving ( Eq, Show, Generic )   deriving ( TextShow ) via TSG.FromGeneric Message@@ -77,7 +77,7 @@  instance FromJSON MessageType where   parseJSON = withScientific "MessageType" $ \n -> case toBoundedInteger @Int n of-    Just v  -> case v of+    Just !v  -> case v of       0 -> pure Default       1 -> pure RecipientAdd       2 -> pure RecipientRemove

@@ -1,45 +1,46 @@ -- | Updated messages-module Calamity.Types.Model.Channel.UpdatedMessage-    ( UpdatedMessage(..)-     ) where--import           Calamity.Internal.AesonThings-import           Calamity.Internal.Utils          ()-import           Calamity.Types.Model.Channel-import           Calamity.Types.Model.Guild.Role-import           Calamity.Types.Model.User-import           Calamity.Types.Snowflake--import           Data.Aeson-import           Data.Text.Lazy                   ( Text )-import           Data.Time-import qualified Data.Vector.Unboxing             as UV--import           GHC.Generics+module Calamity.Types.Model.Channel.UpdatedMessage (+    UpdatedMessage (..),+) where -import           TextShow-import qualified TextShow.Generic                 as TSG+import Calamity.Internal.AesonThings+import Calamity.Internal.Utils ()+import Calamity.Types.Model.Channel+import Calamity.Types.Model.Guild.Role+import Calamity.Types.Model.User+import Calamity.Types.Snowflake+import Data.Aeson+import Data.Text.Lazy (Text)+import Data.Time+import qualified Data.Vector.Unboxing as UV+import GHC.Generics+import TextShow+import qualified TextShow.Generic as TSG  data UpdatedMessage = UpdatedMessage-  { id              :: Snowflake Message-  , channelID       :: Snowflake Channel-  , content         :: Maybe Text-  , editedTimestamp :: Maybe UTCTime-  , tts             :: Maybe Bool-  , mentionEveryone :: Maybe Bool-  , mentions        :: Maybe (UV.Vector (Snowflake User))-  , mentionRoles    :: Maybe (UV.Vector (Snowflake Role))-  , mentionChannels :: Maybe (UV.Vector (Snowflake Channel))-  , attachments     :: Maybe [Attachment]-  , embeds          :: Maybe [Embed]-  , reactions       :: Maybe [Reaction]-  , pinned          :: Maybe Bool-  }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric UpdatedMessage-  deriving ( FromJSON ) via WithSpecialCases-      '["author" `ExtractFieldFrom` "id", "mentions" `ExtractArrayField` "id",-        "mention_channels" `ExtractArrayField` "id"]-      UpdatedMessage-  deriving ( HasID Message ) via HasIDField "id" UpdatedMessage-  deriving ( HasID Channel ) via HasIDField "channelID" UpdatedMessage+    { id :: Snowflake Message+    , channelID :: Snowflake Channel+    , content :: Maybe Text+    , editedTimestamp :: Maybe UTCTime+    , tts :: Maybe Bool+    , mentionEveryone :: Maybe Bool+    , mentions :: Maybe (UV.Vector (Snowflake User))+    , mentionRoles :: Maybe (UV.Vector (Snowflake Role))+    , mentionChannels :: Maybe (UV.Vector (Snowflake Channel))+    , attachments :: !(Maybe [Attachment])+    , embeds :: Maybe [Embed]+    , reactions :: Maybe [Reaction]+    , pinned :: Maybe Bool+    }+    deriving (Eq, Show, Generic)+    deriving (TextShow) via TSG.FromGeneric UpdatedMessage+    deriving+        (FromJSON)+        via WithSpecialCases+                '[ "author" `ExtractFieldFrom` "id"+                 , "mentions" `ExtractArrayField` "id"+                 , "mention_channels" `ExtractArrayField` "id"+                 ]+                UpdatedMessage+    deriving (HasID Message) via HasIDField "id" UpdatedMessage+    deriving (HasID Channel) via HasIDField "channelID" UpdatedMessage

@@ -35,7 +35,7 @@   , changes    :: [AuditLogChange]   , userID     :: Snowflake User   , id         :: Snowflake AuditLogEntry-  , actionType :: AuditLogAction+  , actionType :: !AuditLogAction   , options    :: Maybe AuditLogEntryInfo   , reason     :: Maybe Text   }@@ -185,7 +185,7 @@  instance FromJSON AuditLogAction where   parseJSON = withScientific "AuditLogAction" $ \n -> case toBoundedInteger @Int n of-    Just v  -> case v of --  no safe toEnum :S+    Just !v  -> case v of --  no safe toEnum :S       1  -> pure GUILD_UPDATE       10 -> pure CHANNEL_CREATE       11 -> pure CHANNEL_UPDATE

@@ -1,72 +1,83 @@ -- | Discord emojis-module Calamity.Types.Model.Guild.Emoji-    ( Emoji(..)-    , Partial(PartialEmoji)-    , RawEmoji(..)-    , emojiAsRawEmoji ) where+module Calamity.Types.Model.Guild.Emoji (+  Emoji (..),+  Partial (PartialEmoji),+  RawEmoji (..),+  emojiAsRawEmoji,+) where -import           Calamity.Internal.AesonThings-import           Calamity.Internal.Utils         ()-import           Calamity.Types.Model.Guild.Role-import           Calamity.Types.Model.User-import           Calamity.Types.Snowflake+import Calamity.Internal.AesonThings+import Calamity.Internal.Utils ()+import Calamity.Types.Model.Guild.Role+import Calamity.Types.Model.User+import Calamity.Types.Snowflake -import           Data.Aeson-import qualified Data.Text.Lazy                  as L-import           Data.Text.Lazy                  ( Text )-import           Data.Vector.Unboxing            ( Vector )+import Data.Aeson+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as L+import Data.Vector.Unboxing (Vector) -import           GHC.Generics+import GHC.Generics -import           TextShow-import qualified TextShow.Generic                as TSG+import Control.DeepSeq (NFData) import Data.Generics.Product+import TextShow+import qualified TextShow.Generic as TSG  data Emoji = Emoji-  { id            :: Snowflake Emoji-  , name          :: Text-  , roles         :: Vector (Snowflake Role)-  , user          :: Maybe (Snowflake User)+  { id :: Snowflake Emoji+  , name :: Text+  , roles :: Vector (Snowflake Role)+  , user :: Maybe (Snowflake User)   , requireColons :: Bool-  , managed       :: Bool-  , animated      :: Bool+  , managed :: Bool+  , animated :: Bool   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric Emoji-  deriving ( ToJSON ) via CalamityJSON Emoji-  deriving ( FromJSON ) via WithSpecialCases '["user" `ExtractFieldFrom` "id"-                                              ,"roles" `IfNoneThen` DefaultToEmptyArray-                                              ] Emoji-  deriving ( HasID Emoji ) via HasIDField "id" Emoji+  deriving (Eq, Show, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric Emoji+  deriving (ToJSON) via CalamityJSON Emoji+  deriving+    (FromJSON)+    via WithSpecialCases+          '[ "user" `ExtractFieldFrom` "id"+           , "roles" `IfNoneThen` DefaultToEmptyArray+           ]+          Emoji+  deriving (HasID Emoji) via HasIDField "id" Emoji  emojiAsRawEmoji :: Emoji -> RawEmoji emojiAsRawEmoji = CustomEmoji . upcast  data instance Partial Emoji = PartialEmoji-  { id   :: Snowflake Emoji+  { id :: Snowflake Emoji   , name :: Text   , animated :: Bool   }-  deriving ( Eq, Generic )-  deriving ( ToJSON ) via CalamityJSON (Partial Emoji)-  deriving ( FromJSON ) via WithSpecialCases-      '["animated" `IfNoneThen` DefaultToFalse] (Partial Emoji)-  deriving ( HasID Emoji ) via HasIDField "id" (Partial Emoji)+  deriving (Eq, Generic)+  deriving (ToJSON) via CalamityJSON (Partial Emoji)+  deriving+    (FromJSON)+    via WithSpecialCases+          '["animated" `IfNoneThen` DefaultToFalse]+          (Partial Emoji)+  deriving (HasID Emoji) via HasIDField "id" (Partial Emoji)  instance Show (Partial Emoji) where-  show PartialEmoji { id, name, animated } =+  show PartialEmoji{id, name, animated} =     "<" <> a <> ":" <> L.unpack name <> ":" <> show id <> ">"-    where a = if animated then "a" else ""+   where+    a = if animated then "a" else ""  instance TextShow (Partial Emoji) where-  showb PartialEmoji { id, name, animated } =+  showb PartialEmoji{id, name, animated} =     "<" <> a <> ":" <> fromLazyText name <> ":" <> showb id <> ">"-    where a = if animated then "a" else ""+   where+    a = if animated then "a" else ""  data RawEmoji   = UnicodeEmoji Text   | CustomEmoji (Partial Emoji)-  deriving ( Eq, Generic )+  deriving (Eq, Generic)  instance Show RawEmoji where   show (UnicodeEmoji v) = L.unpack v

@@ -1,74 +1,72 @@ -- | Discord Guilds-module Calamity.Types.Model.Guild.Guild-    ( Guild(..)-    , Partial(PartialGuild)-    , UpdatedGuild(..) ) where+module Calamity.Types.Model.Guild.Guild (+  Guild (..),+  Partial (PartialGuild),+  UpdatedGuild (..),+) where -import           Calamity.Internal.AesonThings-import qualified Calamity.Internal.SnowflakeMap         as SM-import           Calamity.Internal.SnowflakeMap         ( SnowflakeMap )-import           Calamity.Internal.Utils                ()-import           Calamity.Types.Model.Channel-import           Calamity.Types.Model.Guild.Emoji+import Calamity.Internal.AesonThings+import Calamity.Internal.SnowflakeMap (SnowflakeMap)+import qualified Calamity.Internal.SnowflakeMap as SM+import Calamity.Internal.Utils ()+import Calamity.Types.Model.Channel+import Calamity.Types.Model.Guild.Emoji import {-# SOURCE #-} Calamity.Types.Model.Guild.Member-import           Calamity.Types.Model.Guild.Role-import           Calamity.Types.Model.Presence.Presence-import           Calamity.Types.Model.User-import           Calamity.Types.Model.Voice.VoiceState-import           Calamity.Types.Snowflake--import           Control.Lens                           ( (^.) )--import           Data.Aeson-import           Data.Generics.Product.Fields-import           Data.HashMap.Lazy                      ( HashMap )-import qualified Data.HashMap.Lazy                      as LH-import           Data.Text.Lazy                         ( Text )-import           Data.Time-import           Data.Word--import           GHC.Generics--import           TextShow-import qualified TextShow.Generic                       as TSG+import Calamity.Types.Model.Guild.Role+import Calamity.Types.Model.Presence.Presence+import Calamity.Types.Model.User+import Calamity.Types.Model.Voice.VoiceState+import Calamity.Types.Snowflake+import Control.DeepSeq+import Control.Lens ((^.))+import Data.Aeson+import Data.Generics.Product.Fields+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as LH+import Data.Text.Lazy (Text)+import Data.Time+import Data.Word+import GHC.Generics+import TextShow+import qualified TextShow.Generic as TSG  data Guild = Guild-  { id                          :: Snowflake Guild-  , name                        :: Text-  , icon                        :: Maybe Text-  , splash                      :: Maybe Text-  , owner                       :: Maybe Bool-  , ownerID                     :: Snowflake User-  , permissions                 :: Word64-  , region                      :: Text-  , afkChannelID                :: Maybe (Snowflake GuildChannel)-  , afkTimeout                  :: Int-  , embedEnabled                :: Bool-  , embedChannelID              :: Maybe (Snowflake GuildChannel)-  , verificationLevel           :: Int+  { id :: Snowflake Guild+  , name :: Text+  , icon :: Maybe Text+  , splash :: Maybe Text+  , owner :: Maybe Bool+  , ownerID :: Snowflake User+  , permissions :: Word64+  , region :: Text+  , afkChannelID :: Maybe (Snowflake GuildChannel)+  , afkTimeout :: Int+  , embedEnabled :: Bool+  , embedChannelID :: Maybe (Snowflake GuildChannel)+  , verificationLevel :: Int   , defaultMessageNotifications :: Int-  , explicitContentFilter       :: Int-  , roles                       :: SnowflakeMap Role-  , emojis                      :: SnowflakeMap Emoji-  , features                    :: [Text]-  , mfaLevel                    :: Int-  , applicationID               :: Maybe (Snowflake User)-  , widgetEnabled               :: Bool-  , widgetChannelID             :: Maybe (Snowflake GuildChannel)-  , systemChannelID             :: Maybe (Snowflake GuildChannel)-    -- NOTE: Below are only sent on GuildCreate-  , joinedAt                    :: Maybe UTCTime-  , large                       :: Bool-  , unavailable                 :: Bool-  , memberCount                 :: Int-  , voiceStates                 :: [VoiceState]-  , members                     :: SnowflakeMap Member-  , channels                    :: SnowflakeMap GuildChannel-  , presences                   :: HashMap (Snowflake User) Presence+  , explicitContentFilter :: Int+  , roles :: SnowflakeMap Role+  , emojis :: SnowflakeMap Emoji+  , features :: [Text]+  , mfaLevel :: Int+  , applicationID :: Maybe (Snowflake User)+  , widgetEnabled :: Bool+  , widgetChannelID :: Maybe (Snowflake GuildChannel)+  , systemChannelID :: Maybe (Snowflake GuildChannel)+  , -- NOTE: Below are only sent on GuildCreate+    joinedAt :: Maybe UTCTime+  , large :: Bool+  , unavailable :: Bool+  , memberCount :: Int+  , voiceStates :: [VoiceState]+  , members :: SnowflakeMap Member+  , channels :: SnowflakeMap GuildChannel+  , presences :: HashMap (Snowflake User) Presence   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric Guild-  deriving ( HasID Guild ) via HasIDField "id" Guild+  deriving (Eq, Show, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric Guild+  deriving (HasID Guild) via HasIDField "id" Guild  instance FromJSON Guild where   parseJSON = withObject "Guild" $ \v -> do@@ -84,9 +82,13 @@      presences' <- do       presences' <- v .: "presences"-      LH.fromList <$> traverse (\m -> do-                                  p <- parseJSON $ Object (m <> "guild_id" .= id)-                                  pure (getID $ p ^. field @"user", p)) presences'+      LH.fromList+        <$> traverse+          ( \m -> do+              p <- parseJSON $ Object (m <> "guild_id" .= id)+              pure (getID $ p ^. field @"user", p)+          )+          presences'      Guild id       <$> v .: "name"@@ -94,11 +96,11 @@       <*> v .:? "splash"       <*> v .:? "owner"       <*> v .: "owner_id"-      <*> v .:? "permissions"    .!= 0+      <*> v .:? "permissions" .!= 0       <*> v .: "region"       <*> v .:? "afk_channel_id"       <*> v .: "afk_timeout"-      <*> v .:? "embed_enabled"  .!= False+      <*> v .:? "embed_enabled" .!= False       <*> v .:? "embed_channel_id"       <*> v .: "verification_level"       <*> v .: "default_message_notifications"@@ -121,40 +123,40 @@       <*> pure presences'  data instance Partial Guild = PartialGuild-  { id   :: Snowflake Guild+  { id :: Snowflake Guild   , name :: Text   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric (Partial Guild)-  deriving ( ToJSON, FromJSON ) via CalamityJSON (Partial Guild)-  deriving ( HasID Guild ) via HasIDField "id" (Partial Guild)+  deriving (Eq, Show, Generic)+  deriving (TextShow) via TSG.FromGeneric (Partial Guild)+  deriving (ToJSON, FromJSON) via CalamityJSON (Partial Guild)+  deriving (HasID Guild) via HasIDField "id" (Partial Guild)  data UpdatedGuild = UpdatedGuild-  { id                          :: Snowflake Guild-  , name                        :: Text-  , icon                        :: Maybe Text-  , splash                      :: Maybe Text-  , owner                       :: Maybe Bool-  , ownerID                     :: Snowflake User-  , permissions                 :: Maybe Word64-  , region                      :: Text-  , afkChannelID                :: Maybe (Snowflake GuildChannel)-  , afkTimeout                  :: Int-  , embedEnabled                :: Maybe Bool-  , embedChannelID              :: Maybe (Snowflake GuildChannel)-  , verificationLevel           :: Int+  { id :: Snowflake Guild+  , name :: Text+  , icon :: Maybe Text+  , splash :: Maybe Text+  , owner :: Maybe Bool+  , ownerID :: Snowflake User+  , permissions :: Maybe Word64+  , region :: Text+  , afkChannelID :: Maybe (Snowflake GuildChannel)+  , afkTimeout :: Int+  , embedEnabled :: Maybe Bool+  , embedChannelID :: Maybe (Snowflake GuildChannel)+  , verificationLevel :: Int   , defaultMessageNotifications :: Int-  , explicitContentFilter       :: Int-  , roles                       :: SnowflakeMap Role-  , emojis                      :: SnowflakeMap Emoji-  , features                    :: [Text]-  , mfaLevel                    :: Int-  , applicationID               :: Maybe (Snowflake User)-  , widgetEnabled               :: Maybe Bool-  , widgetChannelID             :: Maybe (Snowflake GuildChannel)-  , systemChannelID             :: Maybe (Snowflake GuildChannel)+  , explicitContentFilter :: Int+  , roles :: SnowflakeMap Role+  , emojis :: SnowflakeMap Emoji+  , features :: [Text]+  , mfaLevel :: Int+  , applicationID :: Maybe (Snowflake User)+  , widgetEnabled :: Maybe Bool+  , widgetChannelID :: Maybe (Snowflake GuildChannel)+  , systemChannelID :: Maybe (Snowflake GuildChannel)   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric UpdatedGuild-  deriving ( FromJSON ) via CalamityJSON UpdatedGuild-  deriving ( HasID Guild ) via HasIDField "id" UpdatedGuild+  deriving (Eq, Show, Generic)+  deriving (TextShow) via TSG.FromGeneric UpdatedGuild+  deriving (FromJSON) via CalamityJSON UpdatedGuild+  deriving (HasID Guild) via HasIDField "id" UpdatedGuild

@@ -1,50 +1,59 @@ -- | Guild Members-module Calamity.Types.Model.Guild.Member-    ( Member(..) ) where+module Calamity.Types.Model.Guild.Member (Member (..)) where -import           Calamity.Internal.AesonThings-import           Calamity.Internal.Utils          ()+import Calamity.Internal.AesonThings+import Calamity.Internal.Utils () import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild-import           Calamity.Types.Model.Guild.Role-import           Calamity.Types.Model.User-import           Calamity.Types.Snowflake---import           Data.Aeson-import           Data.Text.Lazy                   ( Text )-import           Data.Time-import           Data.Vector.Unboxing             ( Vector )--import           GHC.Generics--import           TextShow-import qualified TextShow.Generic                 as TSG+import Calamity.Types.Model.Guild.Role+import Calamity.Types.Model.User+import Calamity.Types.Snowflake+import Control.DeepSeq (NFData)+import Data.Aeson+import Data.Text.Lazy (Text)+import Data.Time+import Data.Vector.Unboxing (Vector) import Data.Word (Word64)+import GHC.Generics+import TextShow+import qualified TextShow.Generic as TSG  data Member = Member-  { id            :: Snowflake User-  , username      :: Text+  { id :: Snowflake User+  , username :: Text   , discriminator :: Text-  , bot           :: Maybe Bool-  , avatar        :: Maybe Text-  , mfaEnabled    :: Maybe Bool-  , verified      :: Maybe Bool-  , email         :: Maybe Text-  , flags         :: Maybe Word64-  , premiumType   :: Maybe Word64-  , guildID       :: Snowflake Guild-  , nick          :: Maybe Text-  , roles         :: Vector (Snowflake Role)-  , joinedAt      :: UTCTime-  , deaf          :: Bool-  , mute          :: Bool+  , bot :: Maybe Bool+  , avatar :: Maybe Text+  , mfaEnabled :: Maybe Bool+  , verified :: Maybe Bool+  , email :: Maybe Text+  , flags :: Maybe Word64+  , premiumType :: Maybe Word64+  , guildID :: Snowflake Guild+  , nick :: Maybe Text+  , roles :: Vector (Snowflake Role)+  , joinedAt :: UTCTime+  , deaf :: Bool+  , mute :: Bool   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric Member-  deriving ( FromJSON ) via WithSpecialCases '[-    "user" `ExtractFields` ["id", "username", "discriminator",-                            "bot", "avatar", "mfa_enabled",-                            "verified", "email", "flags", "premium_type"]] Member-  deriving ( HasID Guild ) via HasIDField "guildID" Member-  deriving ( HasID Member ) via HasIDFieldCoerce "id" Member User-  deriving ( HasID User ) via HasIDField "id" Member+  deriving (Eq, Show, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric Member+  deriving+    (FromJSON)+    via WithSpecialCases+          '[ "user"+              `ExtractFields` [ "id"+                              , "username"+                              , "discriminator"+                              , "bot"+                              , "avatar"+                              , "mfa_enabled"+                              , "verified"+                              , "email"+                              , "flags"+                              , "premium_type"+                              ]+           ]+          Member+  deriving (HasID Guild) via HasIDField "guildID" Member+  deriving (HasID Member) via HasIDFieldCoerce "id" Member User+  deriving (HasID User) via HasIDField "id" Member

@@ -1,25 +1,25 @@ -- | Permission overwrites-module Calamity.Types.Model.Guild.Overwrite-    ( Overwrite(..) ) where+module Calamity.Types.Model.Guild.Overwrite (Overwrite (..)) where -import           Calamity.Internal.AesonThings-import           Calamity.Types.Model.Guild.Permissions-import           Calamity.Types.Snowflake+import Calamity.Internal.AesonThings+import Calamity.Types.Model.Guild.Permissions+import Calamity.Types.Snowflake -import           Data.Aeson+import Data.Aeson -import           GHC.Generics+import GHC.Generics -import           TextShow-import qualified TextShow.Generic                       as TSG+import Control.DeepSeq (NFData)+import TextShow+import qualified TextShow.Generic as TSG  data Overwrite = Overwrite-  { id    :: Snowflake Overwrite+  { id :: Snowflake Overwrite   , type_ :: Int   , allow :: Permissions-  , deny  :: Permissions+  , deny :: Permissions   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric Overwrite-  deriving ( ToJSON, FromJSON ) via CalamityJSON Overwrite-  deriving ( HasID Overwrite ) via HasIDField "id" Overwrite+  deriving (Eq, Show, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric Overwrite+  deriving (ToJSON, FromJSON) via CalamityJSON Overwrite+  deriving (HasID Overwrite) via HasIDField "id" Overwrite

@@ -45,6 +45,7 @@ import Data.Text.Read (decimal) import Data.Word import TextShow+import Control.DeepSeq (NFData)  $( bitmaskWrapper      "Permissions"@@ -96,3 +97,4 @@       Left e -> parseFail e  deriving via FromStringShow Permissions instance TextShow Permissions+deriving via Word64 instance NFData Permissions

@@ -1,33 +1,40 @@ -- | Guild roles-module Calamity.Types.Model.Guild.Role-    ( Role(..) ) where+module Calamity.Types.Model.Guild.Role (Role (..)) where -import           Calamity.Internal.AesonThings-import           Calamity.Internal.IntColour            ()-import           Calamity.Internal.Utils                ()-import           Calamity.Types.Model.Guild.Permissions-import           Calamity.Types.Snowflake+import Calamity.Internal.AesonThings+import Calamity.Internal.IntColour ()+import Calamity.Internal.Utils ()+import Calamity.Types.Model.Guild.Permissions+import Calamity.Types.Snowflake -import           Data.Aeson-import           Data.Colour-import           Data.Text.Lazy                         ( Text )+import Data.Aeson+import Data.Colour+import Data.Text.Lazy (Text) -import           GHC.Generics+import GHC.Generics -import           TextShow-import qualified TextShow.Generic                       as TSG+import Control.DeepSeq (NFData (rnf), rwhnf)+import TextShow+import qualified TextShow.Generic as TSG  data Role = Role-  { id          :: Snowflake Role-  , name        :: Text-  , color       :: Colour Double-  , hoist       :: Bool-  , position    :: Int+  { id :: Snowflake Role+  , name :: Text+  , color :: Colour Double+  , hoist :: Bool+  , position :: Int   , permissions :: Permissions-  , managed     :: Bool+  , managed :: Bool   , mentionable :: Bool   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric Role-  deriving ( ToJSON, FromJSON ) via CalamityJSON Role-  deriving ( HasID Role ) via HasIDField "id" Role+  deriving (Eq, Show, Generic)+  deriving (TextShow) via TSG.FromGeneric Role+  deriving (ToJSON, FromJSON) via CalamityJSON Role+  deriving (HasID Role) via HasIDField "id" Role++instance NFData Role where+  rnf (Role id name color hoist position permissions managed mentionable) =+    rnf id `seq` rnf name `seq` rwhnf color `seq` rnf hoist `seq` rnf position+      `seq` rnf permissions+      `seq` rnf managed+      `seq` rnf mentionable

@@ -1,27 +1,26 @@ -- | User activities-module Calamity.Types.Model.Presence.Activity-    ( Activity(..)-    , activity-    , ActivityType(..)-    , ActivityTimestamps(..)-    , ActivityParty(..)-    , ActivityAssets(..)-    , ActivitySecrets(..) ) where--import           Calamity.Internal.AesonThings-import           Calamity.Internal.Utils-import           Calamity.Types.Snowflake-import           Calamity.Types.UnixTimestamp--import           Data.Aeson-import           Data.Scientific-import           Data.Text.Lazy                ( Text )-import           Data.Word--import           GHC.Generics+module Calamity.Types.Model.Presence.Activity (+  Activity (..),+  activity,+  ActivityType (..),+  ActivityTimestamps (..),+  ActivityParty (..),+  ActivityAssets (..),+  ActivitySecrets (..),+) where -import           TextShow-import qualified TextShow.Generic              as TSG+import Calamity.Internal.AesonThings+import Calamity.Internal.Utils+import Calamity.Types.Snowflake+import Calamity.Types.UnixTimestamp+import Control.DeepSeq (NFData)+import Data.Aeson+import Data.Scientific+import Data.Text.Lazy (Text)+import Data.Word+import GHC.Generics+import TextShow+import qualified TextShow.Generic as TSG  data ActivityType   = Game@@ -29,8 +28,8 @@   | Listening   | Custom   | Other Int-  deriving ( Eq, Generic, Show )-  deriving ( TextShow ) via TSG.FromGeneric ActivityType+  deriving (Eq, Generic, Show, NFData)+  deriving (TextShow) via TSG.FromGeneric ActivityType  instance ToJSON ActivityType where   toJSON Game = Number 0@@ -41,7 +40,7 @@  instance FromJSON ActivityType where   parseJSON = withScientific "ActivityType" $ \n -> case toBoundedInteger @Int n of-    Just v  -> case v of+    Just !v -> case v of       0 -> pure Game       1 -> pure Streaming       2 -> pure Listening@@ -50,51 +49,52 @@     Nothing -> fail $ "Invalid ActivityType: " <> show n  data Activity = Activity-  { name          :: Text-  , type_         :: ActivityType-  , url           :: Maybe Text-  , timestamps    :: Maybe ActivityTimestamps+  { name :: Text+  , type_ :: !ActivityType+  , url :: Maybe Text+  , timestamps :: Maybe ActivityTimestamps   , applicationID :: Maybe (Snowflake ())-  , details       :: Maybe Text-  , state         :: Maybe Text-  , party         :: Maybe ActivityParty-  , assets        :: Maybe ActivityAssets-  , secrets       :: Maybe ActivitySecrets-  , instance_     :: Maybe Bool-  , flags         :: Maybe Word64+  , details :: Maybe Text+  , state :: Maybe Text+  , party :: Maybe ActivityParty+  , assets :: Maybe ActivityAssets+  , secrets :: Maybe ActivitySecrets+  , instance_ :: Maybe Bool+  , flags :: Maybe Word64   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric Activity-  deriving ( ToJSON, FromJSON ) via CalamityJSON Activity+  deriving (Eq, Show, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric Activity+  deriving (ToJSON, FromJSON) via CalamityJSON Activity  -- | Make an 'Activity' with all optional fields set to Nothing activity :: Text -> ActivityType -> Activity-activity name type_ =+activity !name !type_ =   Activity-    { name = name,-      type_ = type_,-      url = Nothing,-      timestamps = Nothing,-      applicationID = Nothing,-      details = Nothing,-      state = Nothing,-      party = Nothing,-      assets = Nothing,-      secrets = Nothing,-      instance_ = Nothing,-      flags = Nothing+    { name = name+    , type_ = type_+    , url = Nothing+    , timestamps = Nothing+    , applicationID = Nothing+    , details = Nothing+    , state = Nothing+    , party = Nothing+    , assets = Nothing+    , secrets = Nothing+    , instance_ = Nothing+    , flags = Nothing     }  data ActivityTimestamps = ActivityTimestamps-  { start :: Maybe UnixTimestamp-  , end   :: Maybe UnixTimestamp+  { start :: !(Maybe UnixTimestamp)+  , end :: !(Maybe UnixTimestamp)   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric ActivityTimestamps+  deriving (Eq, Show, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric ActivityTimestamps  instance ToJSON ActivityTimestamps where-  toJSON ActivityTimestamps { start, end } = object-    ["start" .= (unixToMilliseconds <$> start), "end" .= (unixToMilliseconds <$> end)]+  toJSON ActivityTimestamps{start, end} =+    object+      ["start" .= (unixToMilliseconds <$> start), "end" .= (unixToMilliseconds <$> end)]  instance FromJSON ActivityTimestamps where   parseJSON = withObject "ActivityTimestamps" $ \v -> do@@ -104,28 +104,28 @@     pure $ ActivityTimestamps start end  data ActivityParty = ActivityParty-  { id   :: Maybe Text+  { id :: Maybe Text   , size :: Maybe (Int, Int)   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric ActivityParty-  deriving ( ToJSON, FromJSON ) via CalamityJSON ActivityParty+  deriving (Eq, Show, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric ActivityParty+  deriving (ToJSON, FromJSON) via CalamityJSON ActivityParty  data ActivityAssets = ActivityAssets   { largeImage :: Maybe Text-  , largeText  :: Maybe Text+  , largeText :: Maybe Text   , smallImage :: Maybe Text-  , smallText  :: Maybe Text+  , smallText :: Maybe Text   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric ActivityAssets-  deriving ( ToJSON, FromJSON ) via CalamityJSON ActivityAssets+  deriving (Eq, Show, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric ActivityAssets+  deriving (ToJSON, FromJSON) via CalamityJSON ActivityAssets  data ActivitySecrets = ActivitySecrets-  { join     :: Maybe Text+  { join :: Maybe Text   , spectate :: Maybe Text-  , match    :: Maybe Text+  , match :: Maybe Text   }-  deriving ( Eq, Show, Generic )-  deriving ( TextShow ) via TSG.FromGeneric ActivitySecrets-  deriving ( ToJSON, FromJSON ) via CalamityJSON ActivitySecrets+  deriving (Eq, Show, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric ActivitySecrets+  deriving (ToJSON, FromJSON) via CalamityJSON ActivitySecrets

@@ -1,15 +1,15 @@ -- | User presences-module Calamity.Types.Model.Presence.Presence-  ( Presence (..),-    ClientStatus (..),-  )-where+module Calamity.Types.Model.Presence.Presence (+  Presence (..),+  ClientStatus (..),+) where  import Calamity.Internal.AesonThings import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild import Calamity.Types.Model.Presence.Activity import Calamity.Types.Model.User import Calamity.Types.Snowflake+import Control.DeepSeq (NFData) import Data.Aeson import qualified Data.Override as O import Data.Override.Aeson ()@@ -19,13 +19,13 @@ import qualified TextShow.Generic as TSG  data Presence = Presence-  { user :: Snowflake User,-    guildID :: Snowflake Guild,-    status :: StatusType,-    activities :: [Activity],-    clientStatus :: ClientStatus+  { user :: Snowflake User+  , guildID :: Snowflake Guild+  , status :: StatusType+  , activities :: [Activity]+  , clientStatus :: ClientStatus   }-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, NFData)   deriving (TextShow) via TSG.FromGeneric Presence   deriving     (ToJSON)@@ -40,10 +40,10 @@   deriving (HasID Guild) via HasIDField "guildID" Presence  data ClientStatus = ClientStatus-  { desktop :: Maybe Text,-    mobile :: Maybe Text,-    web :: Maybe Text+  { desktop :: Maybe Text+  , mobile :: Maybe Text+  , web :: Maybe Text   }-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, NFData)   deriving (TextShow) via TSG.FromGeneric ClientStatus   deriving (ToJSON, FromJSON) via CalamityJSON ClientStatus

@@ -1,47 +1,49 @@ -- | A User-module Calamity.Types.Model.User-    ( User(..)-    , Partial(PartialUser)-    , StatusType(..) ) where+module Calamity.Types.Model.User (+  User (..),+  Partial (PartialUser),+  StatusType (..),+) where -import           Calamity.Internal.AesonThings+import Calamity.Internal.AesonThings import {-# SOURCE #-} Calamity.Types.Model.Guild.Member-import           Calamity.Types.Partial-import           Calamity.Types.Snowflake+import Calamity.Types.Partial+import Calamity.Types.Snowflake -import           Data.Aeson-import           Data.Text.Lazy                    ( Text )-import           Data.Word+import Data.Aeson+import Data.Text.Lazy (Text)+import Data.Word -import           GHC.Generics-import           TextShow-import qualified TextShow.Generic                     as TSG+import Control.DeepSeq+import GHC.Generics+import TextShow+import qualified TextShow.Generic as TSG  data User = User-  { id            :: Snowflake User-  , username      :: Text+  { id :: Snowflake User+  , username :: Text   , discriminator :: Text-  , bot           :: Maybe Bool-  , avatar        :: Maybe Text-  , mfaEnabled    :: Maybe Bool-  , verified      :: Maybe Bool-  , email         :: Maybe Text-  , flags         :: Maybe Word64-  , premiumType   :: Maybe Word64+  , bot :: Maybe Bool+  , avatar :: Maybe Text+  , mfaEnabled :: Maybe Bool+  , verified :: Maybe Bool+  , email :: Maybe Text+  , flags :: Maybe Word64+  , premiumType :: Maybe Word64   }-  deriving ( Show, Eq, Generic )-  deriving ( TextShow ) via TSG.FromGeneric User-  deriving ( ToJSON, FromJSON ) via CalamityJSON User-  deriving ( HasID User ) via HasIDField "id" User-  deriving ( HasID Member ) via HasIDFieldCoerce' "id" User+  deriving (Show, Eq, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric User+  deriving (ToJSON, FromJSON) via CalamityJSON User+  deriving (HasID User) via HasIDField "id" User+  deriving (HasID Member) via HasIDFieldCoerce' "id" User  newtype instance Partial User = PartialUser   { id :: Snowflake User   }-  deriving ( Show, Eq, Generic )-  deriving ( TextShow ) via TSG.FromGeneric (Partial User)-  deriving ( ToJSON, FromJSON ) via CalamityJSON (Partial User)-  deriving ( HasID User ) via HasIDField "id" (Partial User)+  deriving (Show, Eq, Generic)+  deriving (TextShow) via TSG.FromGeneric (Partial User)+  deriving (ToJSON, FromJSON) via CalamityJSON (Partial User)+  deriving (HasID User) via HasIDField "id" (Partial User)  data StatusType   = Idle@@ -49,22 +51,23 @@   | Online   | Offline   | Invisible-  deriving ( Eq, Show, Enum, Generic )-  deriving ( TextShow ) via TSG.FromGeneric StatusType+  deriving (Eq, Show, Enum, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric StatusType  instance FromJSON StatusType where   parseJSON = withText "StatusType" $ \case-    "idle"      -> pure Idle-    "dnd"       -> pure DND-    "online"    -> pure Online-    "offline"   -> pure Offline+    "idle" -> pure Idle+    "dnd" -> pure DND+    "online" -> pure Online+    "offline" -> pure Offline     "invisible" -> pure Invisible-    _           -> fail "Unknown status type"+    _ -> fail "Unknown status type"  instance ToJSON StatusType where-  toJSON = String . \case-    Idle      -> "idle"-    DND       -> "dnd"-    Online    -> "online"-    Offline   -> "offline"-    Invisible -> "invisible"+  toJSON =+    String . \case+      Idle -> "idle"+      DND -> "dnd"+      Online -> "online"+      Offline -> "offline"+      Invisible -> "invisible"

@@ -1,31 +1,31 @@-module Calamity.Types.Model.Voice.VoiceState-    ( VoiceState(..) ) where+module Calamity.Types.Model.Voice.VoiceState (VoiceState (..)) where -import           Calamity.Internal.AesonThings-import           Calamity.Types.Model.Channel.Guild.Voice+import Calamity.Internal.AesonThings+import Calamity.Types.Model.Channel.Guild.Voice import {-# SOURCE #-} Calamity.Types.Model.Guild.Guild-import           Calamity.Types.Model.User-import           Calamity.Types.Snowflake+import Calamity.Types.Model.User+import Calamity.Types.Snowflake -import           Data.Aeson-import           Data.Text.Lazy                           ( Text )+import Data.Aeson+import Data.Text.Lazy (Text) -import           GHC.Generics+import GHC.Generics -import           TextShow-import qualified TextShow.Generic                         as TSG+import Control.DeepSeq (NFData)+import TextShow+import qualified TextShow.Generic as TSG  data VoiceState = VoiceState-  { guildID   :: Maybe (Snowflake Guild)+  { guildID :: Maybe (Snowflake Guild)   , channelID :: Maybe (Snowflake VoiceChannel)-  , userID    :: Snowflake User+  , userID :: Snowflake User   , sessionID :: Text-  , deaf      :: Bool-  , mute      :: Bool-  , selfDeaf  :: Bool-  , selfMute  :: Bool-  , suppress  :: Bool+  , deaf :: Bool+  , mute :: Bool+  , selfDeaf :: Bool+  , selfMute :: Bool+  , suppress :: Bool   }-  deriving ( Show, Eq, Generic )-  deriving ( TextShow ) via TSG.FromGeneric VoiceState-  deriving ( ToJSON, FromJSON ) via CalamityJSON VoiceState+  deriving (Show, Eq, Generic, NFData)+  deriving (TextShow) via TSG.FromGeneric VoiceState+  deriving (ToJSON, FromJSON) via CalamityJSON VoiceState

@@ -1,60 +1,68 @@ -- | Parsing of unix timestamps-module Calamity.Types.UnixTimestamp-    ( UnixTimestamp(..)-    , unixToMilliseconds-    , millisecondsToUnix ) where+module Calamity.Types.UnixTimestamp (+    UnixTimestamp (..),+    unixToMilliseconds,+    millisecondsToUnix,+) where -import           Calamity.Internal.Utils ()+import Calamity.Internal.Utils () -import           Control.Arrow+import Control.Arrow -import           Data.Aeson-import           Data.Aeson.Encoding     ( word64 )-import           Data.Time-import           Data.Time.Clock.POSIX-import           Data.Word+import Data.Aeson+import Data.Aeson.Encoding (word64)+import Data.Time+import Data.Time.Clock.POSIX+import Data.Word -import           GHC.Generics+import GHC.Generics -import           TextShow-import qualified TextShow.Generic        as TSG+import Control.DeepSeq (NFData)+import TextShow+import qualified TextShow.Generic as TSG  newtype UnixTimestamp = UnixTimestamp-  { unUnixTimestamp :: UTCTime-  }-  deriving ( Show, Eq, Generic )-  deriving ( TextShow ) via TSG.FromGeneric UnixTimestamp+    { unUnixTimestamp :: UTCTime+    }+    deriving (Show, Eq, Generic)+    deriving newtype (NFData)+    deriving (TextShow) via TSG.FromGeneric UnixTimestamp  unixToMilliseconds :: UnixTimestamp -> Word64-unixToMilliseconds = unUnixTimestamp-                     >>> utcTimeToPOSIXSeconds-                     >>> toRational-                     >>> (* 1000)-                     >>> round+unixToMilliseconds =+    unUnixTimestamp+        >>> utcTimeToPOSIXSeconds+        >>> toRational+        >>> (* 1000)+        >>> round  millisecondsToUnix :: Word64 -> UnixTimestamp-millisecondsToUnix = toRational-                     >>> fromRational-                     >>> (/ 1000)-                     >>> posixSecondsToUTCTime-                     >>> UnixTimestamp+millisecondsToUnix =+    toRational+        >>> fromRational+        >>> (/ 1000)+        >>> posixSecondsToUTCTime+        >>> UnixTimestamp  instance ToJSON UnixTimestamp where-  toJSON = unUnixTimestamp-               >>> utcTimeToPOSIXSeconds-               >>> toRational-               >>> round-               >>> toJSON @Word64-  toEncoding = unUnixTimestamp-               >>> utcTimeToPOSIXSeconds-               >>> toRational-               >>> round-               >>> word64+    toJSON =+        unUnixTimestamp+            >>> utcTimeToPOSIXSeconds+            >>> toRational+            >>> round+            >>> toJSON @Word64+    toEncoding =+        unUnixTimestamp+            >>> utcTimeToPOSIXSeconds+            >>> toRational+            >>> round+            >>> word64  instance FromJSON UnixTimestamp where-  parseJSON = withScientific "UnixTimestamp" $-    toRational-    >>> fromRational-    >>> posixSecondsToUTCTime-    >>> UnixTimestamp-    >>> pure+    parseJSON =+        withScientific "UnixTimestamp" $+            toRational+                >>> fromRational+                >>> posixSecondsToUTCTime+                >>> UnixTimestamp+                >>> pure