calamity 0.1.2.0 → 0.1.3.0
raw patch · 11 files changed
+80/−21 lines, 11 files
Files
- ChangeLog.md +14/−0
- calamity.cabal +2/−2
- src/Calamity/Client/Client.hs +25/−2
- src/Calamity/Gateway/Shard.hs +9/−1
- src/Calamity/HTTP/Emoji.hs +3/−1
- src/Calamity/HTTP/Guild.hs +3/−1
- src/Calamity/HTTP/Internal/Ratelimit.hs +3/−9
- src/Calamity/HTTP/Internal/Request.hs +21/−2
- src/Calamity/Types/Model/Channel.hs +0/−1
- src/Calamity/Types/Model/Guild/Emoji.hs +0/−1
- src/Calamity/Types/Model/Guild/Guild.hs +0/−1
ChangeLog.md view
@@ -1,5 +1,19 @@ # Changelog for Calamity +## 0.1.3.0++*2020-04-27*++* Removed extra exports of `Calamity.Types.Partial` from+ `Calamity.Types.Model.Guild.Guild`, `Calamity.Type.Model.Guild.Emoji`, and+ `Calamity.Types.Model.Channel`++* Added missing exports of `CreateGuildEmojiOptions` and+ `ModifyGuildEmojiOptions` from `Calamity.HTTP.Emoji`++* Added missing exports of `CreateGuildData` and `ModifyGuildData` from+ `Calamity.HTTP.Guild`+ ## 0.1.2.0 *2020-04-27*
calamity.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: d58d4118390485680eba20c1d9dbc30df68a2f58ff358e7fd5f1a04be6a5b3c0+-- hash: 525b50a7c1b1574b82da4f18a4b57db60bd0960b53b7017d5b7192d954310744 name: calamity-version: 0.1.2.0+version: 0.1.3.0 synopsis: A library for writing discord bots description: Please see the README on GitHub at <https://github.com/nitros12/calamity#readme> category: Network, Web
src/Calamity/Client/Client.hs view
@@ -30,6 +30,8 @@ import Data.Dynamic import Data.Foldable import Data.Maybe+import Data.Time.Clock+import Data.Time.Clock.POSIX import Data.Traversable import qualified Data.TypeRepMap as TM @@ -47,6 +49,15 @@ import qualified Polysemy.Reader as P +timeA :: P.Member (P.Embed IO) r => P.Sem r a -> P.Sem r (Double, a)+timeA m = do+ start <- P.embed getPOSIXTime+ res <- m+ end <- P.embed getPOSIXTime+ let duration = fromRational . toRational $ end - start+ pure (duration, res)++ newClient :: Token -> IO Client newClient token = do shards' <- newTVarIO []@@ -107,9 +118,19 @@ handleEvent data' = do debug "handling an event" eventHandlers <- P.atomicGet- actions <- P.runFail $ handleEvent' eventHandlers data'++ actions <- P.runFail $ do+ cacheUpdateHisto <- registerHistogram "cache_update" mempty [10, 20..100]+ (time, res) <- timeA $ handleEvent' eventHandlers data'+ void $ observeHistogram time cacheUpdateHisto+ pure res++ eventHandleHisto <- registerHistogram "event_handle" mempty [10, 20..100]+ case actions of- Right actions -> for_ actions P.async+ Right actions -> for_ actions $ \action -> P.async $ do+ (time, _) <- timeA action+ void $ observeHistogram time eventHandleHisto Left err -> debug $ "Failed handling actions for event: " +| err |+ "" -- NOTE: We have to be careful with how we run event handlers@@ -266,6 +287,8 @@ pure $ map (\f -> f guild role) (unwrapEvent @"guildroledelete" eh) handleEvent' eh evt@(MessageCreate msg) = do+ messagesReceived <- registerCounter "messages_received" mempty+ void $ addCounter 1 messagesReceived updateCache evt pure $ map ($ msg) (unwrapEvent @"messagecreate" eh)
src/Calamity/Gateway/Shard.hs view
@@ -45,6 +45,8 @@ import Prelude hiding ( error ) +import TextShow+ import Wuss data Websocket m a where@@ -130,7 +132,10 @@ -- | The loop a shard will run on shardLoop :: ShardC r => Sem r () shardLoop = do+ activeShards <- registerGauge "active_shards" mempty+ void $ modifyGauge succ activeShards void outerloop+ void $ modifyGauge pred activeShards debug "Shard shut down" where controlStream :: Shard -> TBMQueue ShardMsg -> IO ()@@ -225,14 +230,17 @@ , presence = Nothing }) + receivedMessages <- registerCounter "received_messages" [("shard", showt $ shard ^. #shardID)]+ result <- P.runResource $ P.bracket (P.embed $ newTBMQueueIO 1)- (\q -> P.embed . atomically $ closeTBMQueue q)+ (P.embed . atomically . closeTBMQueue) (\q -> do debug "handling events now" _controlThread <- P.async . P.embed $ controlStream shard q _discordThread <- P.async $ discordStream ws q (fromEitherVoid <$>) . P.raise . P.runError . forever $ do -- only we close the queue+ void $ addCounter 1 receivedMessages msg <- P.embed . atomically $ readTBMQueue q handleMsg $ fromJust msg)
src/Calamity/HTTP/Emoji.hs view
@@ -1,6 +1,8 @@ -- | Emoji endpoints module Calamity.HTTP.Emoji- ( EmojiRequest(..) ) where+ ( EmojiRequest(..)+ , CreateGuildEmojiOptions(..)+ , ModifyGuildEmojiOptions(..) ) where import Calamity.HTTP.Internal.Request import Calamity.HTTP.Internal.Route
src/Calamity/HTTP/Guild.hs view
@@ -1,6 +1,8 @@ -- | Guild endpoints module Calamity.HTTP.Guild- ( GuildRequest(..) ) where+ ( GuildRequest(..)+ , CreateGuildData(..)+ , ModifyGuildData(..) ) where import Calamity.HTTP.Internal.Request import Calamity.HTTP.Internal.Route
src/Calamity/HTTP/Internal/Ratelimit.hs view
@@ -175,12 +175,7 @@ ClientError c v -> pure $ RFail (HTTPError c $ decode v) -doRequest- :: BotC r- => RateLimitState- -> Route- -> IO (Response LB.ByteString)- -> Sem r (Either RestError LB.ByteString)+doRequest :: BotC r => RateLimitState -> Route -> IO (Response LB.ByteString) -> Sem r (Either RestError LB.ByteString) doRequest rlState route action = do P.embed $ E.wait (globalLock rlState) @@ -189,6 +184,5 @@ L.acquire lock pure lock - retryRequest 5- (doSingleRequest (globalLock rlState) ratelimit action)- (P.embed . atomically $ L.release ratelimit)+ retryRequest 5 (doSingleRequest (globalLock rlState) ratelimit action)+ (P.embed . atomically $ L.release ratelimit)
src/Calamity/HTTP/Internal/Request.hs view
@@ -12,9 +12,12 @@ import Calamity.HTTP.Internal.Ratelimit import Calamity.HTTP.Internal.Route import Calamity.HTTP.Internal.Types+import Calamity.Internal.Utils+import Calamity.Metrics.Eff import Calamity.Types.Token import Control.Lens+import Control.Monad import Data.Aeson hiding ( Options ) import Data.ByteString ( ByteString )@@ -22,6 +25,7 @@ import qualified Data.Text as TS import qualified Data.Text.Encoding as TS import qualified Data.Text.Lazy as TL+import Data.Text.Strict.Lens import DiPolysemy hiding ( debug, error, info ) @@ -33,6 +37,8 @@ import qualified Polysemy.Error as P import qualified Polysemy.Reader as P +import TextShow+ fromResult :: P.Member (P.Error RestError) r => Result a -> Sem r a fromResult (Success a) = pure a fromResult (Error e) = P.throw (DecodeError . TL.pack $ e)@@ -67,8 +73,21 @@ rlState' <- P.asks rlState token' <- P.asks token - resp <- attr "route" (toRoute a ^. #path) $ doRequest rlState' (toRoute a)- (toAction a (requestOptions token') (Calamity.HTTP.Internal.Request.url a))+ let route = toRoute a++ inFlightRequests <- registerGauge "inflight_requests" [("route", route ^. #path)]+ totalRequests <- registerCounter "total_requests" [("route", route ^. #path)]+ void $ modifyGauge succ inFlightRequests+ void $ addCounter 1 totalRequests++ whenJust (route ^. #guildID) $ \guildID -> do+ totalRequestsGuild <- registerCounter "total_requests" [("guild", showt guildID)]+ void $ addCounter 1 totalRequestsGuild++ resp <- attr "route" (toRoute a ^. #path) $ doRequest rlState' route+ (toAction a (requestOptions token') (route ^. #path . unpacked))++ void $ modifyGauge pred inFlightRequests P.runError $ (fromResult . fromJSON) =<< (fromJSONDecode . readResp) =<< extractRight resp
src/Calamity/Types/Model/Channel.hs view
@@ -1,7 +1,6 @@ -- | The generic channel type module Calamity.Types.Model.Channel ( Channel(..)- , Partial(PartialChannel) , module Calamity.Types.Model.Channel.DM , module Calamity.Types.Model.Channel.Group , module Calamity.Types.Model.Channel.Guild
src/Calamity/Types/Model/Guild/Emoji.hs view
@@ -1,7 +1,6 @@ -- | Discord emojis module Calamity.Types.Model.Guild.Emoji ( Emoji(..)- , Partial(PartialEmoji) , RawEmoji(..) ) where import Calamity.Internal.AesonThings
src/Calamity/Types/Model/Guild/Guild.hs view
@@ -1,7 +1,6 @@ -- | Discord Guilds module Calamity.Types.Model.Guild.Guild ( Guild(..)- , Partial(PartialGuild) , UpdatedGuild(..) ) where import Calamity.Internal.AesonThings