calamity 0.1.14.4 → 0.1.14.5

raw patch · 8 files changed

+54/−30 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• calamity.cabal +2/−2
• src/Calamity/HTTP/Internal/Ratelimit.hs +33/−21
• src/Calamity/HTTP/Internal/Request.hs +2/−2
• src/Calamity/HTTP/Internal/Route.hs +1/−1
• src/Calamity/HTTP/Internal/Types.hs +4/−1
• src/Calamity/HTTP/User.hs +1/−1
• src/Calamity/HTTP/Webhook.hs +2/−2

@@ -1,5 +1,14 @@ # Changelog for Calamity +## 0.1.14.5++*2020-06-18*++* The `DecodeError` variant of the `RestError` type has been renamed to+  `InternalClientError` as all issues in the rest client now end up here.+  +* We're now using `discord.com` instead of `discordapp.com`+ ## 0.1.14.4  *2020-06-11*

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f4c6fde3ae6f429b22eea33179e85d448bc6d821e6d0e78fdfa8bd664dc74dc5+-- hash: e8f0d2b37e6993b5feabb3a7bc1bd424330c236f6d3d984c68336bdf840118ba  name:           calamity-version:        0.1.14.4+version:        0.1.14.5 synopsis:       A library for writing discord bots description:    Please see the README on GitHub at <https://github.com/nitros12/calamity#readme> category:       Network, Web

@@ -23,6 +23,7 @@ import qualified Data.ByteString.Lazy         as LB import           Data.Functor import           Data.Maybe+import qualified Data.Text.Lazy               as LT import           Data.Time import           Data.Time.Clock.POSIX @@ -41,6 +42,7 @@ import           Prelude                      hiding ( error )  import qualified StmContainers.Map            as SC+import qualified Control.Exception.Safe as Ex  newRateLimitState :: IO RateLimitState newRateLimitState = RateLimitState <$> SC.newIO <*> E.newSet@@ -56,28 +58,34 @@  doDiscordRequest :: BotC r => IO (Response LB.ByteString) -> Sem r DiscordResponseType doDiscordRequest r = do-  r' <- P.embed r-  let status = r' ^. responseStatus-  if-    | statusIsSuccessful status -> do-      let resp = r' ^. responseBody-      debug $ "Got good response from discord: " +|| r' ^. responseStatus ||+ ""-      pure $ if isExhausted r'-             then ExhaustedBucket resp $ parseRateLimitHeader r'-             else Good resp-    | status == status429 -> do-      debug "Got 429 from discord, retrying."-      case asValue r' of-        Just rv -> pure $ Ratelimited (parseRetryAfter rv) (isGlobal rv)-        Nothing -> pure $ ClientError (status ^. statusCode) "429 with invalid json???"-    | statusIsClientError status -> do-      let err = r' ^. responseBody-      error $ "Something went wrong: " +|| err ||+ " response: " +|| r' ||+ ""-      pure $ ClientError (status ^. statusCode) err-    | otherwise -> do-      debug $ "Got server error from discord: " +| status ^. statusCode |+ ""-      pure $ ServerError (status ^. statusCode)+  r'' <- P.embed $ Ex.catchAny (Right <$> r) (pure . Left . Ex.displayException)+  case r'' of+    Right r' -> do+      let status = r' ^. responseStatus+      if+        | statusIsSuccessful status -> do+          let resp = r' ^. responseBody+          debug $ "Got good response from discord: " +|| r' ^. responseStatus ||+ ""+          pure $ if isExhausted r'+                then ExhaustedBucket resp $ parseRateLimitHeader r'+                else Good resp+        | status == status429 -> do+          debug "Got 429 from discord, retrying."+          case asValue r' of+            Just rv -> pure $ Ratelimited (parseRetryAfter rv) (isGlobal rv)+            Nothing -> pure $ ClientError (status ^. statusCode) "429 with invalid json???"+        | statusIsClientError status -> do+          let err = r' ^. responseBody+          error $ "Something went wrong: " +|| err ||+ " response: " +|| r' ||+ ""+          pure $ ClientError (status ^. statusCode) err+        | otherwise -> do+          debug $ "Got server error from discord: " +| status ^. statusCode |+ ""+          pure $ ServerError (status ^. statusCode)+    Left e -> do+      error $ "Something went wrong with the http client: " +| LT.pack e |+ ""+      pure . InternalResponseError $ LT.pack e + parseDiscordTime :: ByteString -> Maybe UTCTime parseDiscordTime s = httpDateToUTC <$> parseHTTPDate s @@ -172,6 +180,10 @@     ServerError c -> do       debug "Server failed, retrying"       pure $ Retry (HTTPError c Nothing)++    InternalResponseError c -> do+      debug "Internal error, retrying"+      pure $ Retry (InternalClientError c)      ClientError c v -> pure $ RFail (HTTPError c $ decode v) 

@@ -40,11 +40,11 @@  fromResult :: P.Member (P.Error RestError) r => Data.Aeson.Result a -> Sem r a fromResult (Success a) = pure a-fromResult (Error e) = P.throw (DecodeError . TL.pack $ e)+fromResult (Error e) = P.throw (InternalClientError . TL.pack $ e)  fromJSONDecode :: P.Member (P.Error RestError) r => Either String a -> Sem r a fromJSONDecode (Right a) = pure a-fromJSONDecode (Left e) = P.throw (DecodeError . TL.pack $ e)+fromJSONDecode (Left e) = P.throw (InternalClientError . TL.pack $ e)  extractRight :: P.Member (P.Error e) r => Either e a -> Sem r a extractRight (Left e) = P.throw e

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

@@ -21,11 +21,13 @@ import qualified StmContainers.Map             as SC  data RestError+  -- | An error response from discord   = HTTPError       { status   :: Int       , response :: Maybe Value       }-  | DecodeError Text+  -- | Something failed while making the request (after retrying a few times)+  | InternalClientError Text   deriving ( Show, Generic )  data RateLimitState = RateLimitState@@ -43,6 +45,7 @@       Bool -- ^ Global ratelimit   | ServerError Int -- ^ Discord's error, we should retry (HTTP 5XX)   | ClientError Int LB.ByteString -- ^ Our error, we should fail+  | InternalResponseError Text -- ^ Something went wrong with the http client  newtype GatewayResponse = GatewayResponse   { url :: Text

@@ -28,7 +28,7 @@  data ModifyUserData = ModifyUserData   { username :: Maybe Text-    -- | The avatar field should be in discord's image data format: https://discordapp.com/developers/docs/reference#image-data+    -- | The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data   , avatar   :: Maybe Text   }   deriving ( Show, Generic, Default )

@@ -29,7 +29,7 @@  data CreateWebhookData = CreateWebhookData   { username :: Maybe Text-    -- | The avatar field should be in discord's image data format: https://discordapp.com/developers/docs/reference#image-data+    -- | The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data   , avatar   :: Maybe Text   }   deriving ( Show, Generic, Default )@@ -37,7 +37,7 @@  data ModifyWebhookData = ModifyWebhookData   { username  :: Maybe Text-    -- | The avatar field should be in discord's image data format: https://discordapp.com/developers/docs/reference#image-data+    -- | The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data   , avatar    :: Maybe Text   , channelID :: Maybe (Snowflake Channel)   }