matrix-client 0.1.0.0 → 0.1.1.0

raw patch · 6 files changed

+159/−35 lines, 6 filesdep +aeson-prettydep +http-typesdep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: aeson-pretty, http-types

Dependency ranges changed: text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−1
• matrix-client.cabal +5/−2
• src/Network/Matrix/Client.hs +22/−0
• src/Network/Matrix/Internal.hs +64/−25
• src/Network/Matrix/Tutorial.hs +18/−0
• test/Spec.hs +40/−7

@@ -1,5 +1,14 @@ # Changelog -## 0.1.0.0 (next)+## 0.1.1.0++- Ensure aeson encoding test is reproducible using aeson-pretty+- Increase retry delay up to 2 minutes+- Add leaveRoomById client function+- Add joinRoom client function+- Handle 400s error message returned by the API+- Handle rate limit response in the retry helper++## 0.1.0.0  - Initial release

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                matrix-client-version:             0.1.0.0+version:             0.1.1.0 synopsis:            A matrix client library description:     Matrix client is a library to interface with https://matrix.org.@@ -51,6 +51,7 @@                      , hashable                      , http-client            >= 0.5.0    && < 0.8                      , http-client-tls        >= 0.2.0    && < 0.4+                     , http-types             >= 0.10.0   && < 0.13                      , retry                  ^>= 0.8                      , text                   >= 0.11.1.0 && < 1.3                      , time@@ -71,8 +72,10 @@   hs-source-dirs:     test, src   main-is:            Spec.hs   build-depends:      base-                    , matrix-client+                    , aeson-pretty                     , hspec >= 2+                    , matrix-client+                    , text  test-suite doctest   type:               exitcode-stdio-1.0

@@ -28,7 +28,9 @@     -- * Room membership     RoomID (..),     getJoinedRooms,+    joinRoom,     joinRoomById,+    leaveRoomById,   ) where @@ -36,7 +38,9 @@ import Data.Aeson (FromJSON (..), Value (Object), encode, (.:)) import Data.Hashable (Hashable) import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8, encodeUtf8) import qualified Network.HTTP.Client as HTTP+import Network.HTTP.Types.URI (urlEncode) import Network.Matrix.Events import Network.Matrix.Internal @@ -110,7 +114,25 @@   response <- doRequest session request   pure $ unRooms <$> response +-- | Note that this API takes either a room ID or alias, unlike 'joinRoomById'+joinRoom :: ClientSession -> Text -> MatrixIO RoomID+joinRoom session roomName = do+  request <- mkRequest session True $ "/_matrix/client/r0/join/" <> roomNameUrl+  doRequest session (request {HTTP.method = "POST"})+  where+    roomNameUrl = decodeUtf8 . urlEncode True . encodeUtf8 $ roomName+ joinRoomById :: ClientSession -> RoomID -> MatrixIO RoomID joinRoomById session (RoomID roomId) = do   request <- mkRequest session True $ "/_matrix/client/r0/rooms/" <> roomId <> "/join"   doRequest session (request {HTTP.method = "POST"})++leaveRoomById :: ClientSession -> RoomID -> MatrixIO ()+leaveRoomById session (RoomID roomId) = do+  request <- mkRequest session True $ "/_matrix/client/r0/rooms/" <> roomId <> "/leave"+  fmap ensureEmptyObject <$> doRequest session (request {HTTP.method = "POST"})+  where+    ensureEmptyObject :: Value -> ()+    ensureEmptyObject value = case value of+      Object xs | xs == mempty -> ()+      _anyOther -> error $ "Unknown leave response: " <> show value

@@ -1,22 +1,26 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-missing-export-lists #-}  -- | This module contains low-level HTTP utility module Network.Matrix.Internal where -import Control.Monad (mzero)-import Control.Monad.Catch (Handler (Handler), MonadMask)-import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Concurrent (threadDelay)+import Control.Exception (Exception, throw, throwIO)+import Control.Monad (mzero, unless, void)+import Control.Monad.Catch (Handler (Handler)) import Control.Retry (RetryStatus (..)) import qualified Control.Retry as Retry import Data.Aeson (FromJSON (..), Value (Object), eitherDecode, (.:), (.:?))-import Data.ByteString.Lazy (ByteString)+import Data.ByteString.Lazy (ByteString, toStrict)+import Data.Maybe (fromMaybe) import Data.Text (Text, pack, unpack) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.IO (hPutStrLn) import qualified Network.HTTP.Client as HTTP import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.HTTP.Types (Status (..)) import System.Environment (getEnv) import System.IO (stderr) @@ -31,13 +35,28 @@ mkManager :: IO HTTP.Manager mkManager = HTTP.newManager tlsManagerSettings +checkMatrixResponse :: HTTP.Request -> HTTP.Response HTTP.BodyReader -> IO ()+checkMatrixResponse req res =+  unless (200 <= code && code < 500) $ do+    chunk <- HTTP.brReadSome (HTTP.responseBody res) 1024+    throwResponseError req res chunk+  where+    Status code _ = HTTP.responseStatus res++throwResponseError :: HTTP.Request -> HTTP.Response body -> ByteString -> IO a+throwResponseError req res chunk =+  throwIO $ HTTP.HttpExceptionRequest req ex+  where+    ex = HTTP.StatusCodeException (void res) (toStrict chunk)+ mkRequest' :: Text -> MatrixToken -> Bool -> Text -> IO HTTP.Request mkRequest' baseUrl (MatrixToken token) auth path = do   initRequest <- HTTP.parseUrlThrow (unpack $ baseUrl <> path)   pure $     initRequest       { HTTP.requestHeaders =-          [("Content-Type", "application/json")] <> authHeaders+          [("Content-Type", "application/json")] <> authHeaders,+        HTTP.checkResponse = checkMatrixResponse       }   where     authHeaders =@@ -46,14 +65,16 @@ doRequest' :: FromJSON a => HTTP.Manager -> HTTP.Request -> IO (Either MatrixError a) doRequest' manager request = do   response <- HTTP.httpLbs request manager-  pure $ decodeResp (HTTP.responseBody response)+  case decodeResp (HTTP.responseBody response) of+    Nothing -> throwResponseError request response (HTTP.responseBody response)+    Just a -> pure a -decodeResp :: FromJSON a => ByteString -> Either MatrixError a+decodeResp :: FromJSON a => ByteString -> Maybe (Either MatrixError a) decodeResp resp = case eitherDecode resp of-  Right a -> pure a-  Left err -> case eitherDecode resp of-    Right me -> Left me-    Left _ -> error $ "Could not decode: " <> err+  Right a -> Just $ pure a+  Left _ -> case eitherDecode resp of+    Right me -> Just $ Left me+    Left _ -> Nothing  newtype UserID = UserID Text deriving (Show, Eq) @@ -68,6 +89,10 @@   }   deriving (Show, Eq) +data MatrixException = MatrixRateLimit deriving (Show)++instance Exception MatrixException+ instance FromJSON MatrixError where   parseJSON (Object v) =     MatrixError@@ -80,27 +105,41 @@ type MatrixIO a = IO (Either MatrixError a)  -- | Retry 5 times network action, doubling backoff each time-retry :: (MonadMask m, MonadIO m) => m a -> m a-retry action =+retry' :: Int -> (Text -> IO ()) -> MatrixIO a -> MatrixIO a+retry' limit logRetry action =   Retry.recovering-    (Retry.exponentialBackoff backoff <> Retry.limitRetries 5)-    [handler]-    (const action)+    (Retry.exponentialBackoff backoff <> Retry.limitRetries limit)+    [handler, rateLimitHandler]+    (const checkAction)   where-    backoff = 500000 -- 500ms+    checkAction = do+      res <- action+      case res of+        Left (MatrixError "M_LIMIT_EXCEEDED" err delayMS) -> do+          -- Reponse contains a retry_after_ms+          logRetry $ "RateLimit: " <> err <> " (delay: " <> pack (show delayMS) <> ")"+          threadDelay $ fromMaybe 5_000 delayMS * 1000+          throw MatrixRateLimit+        _ -> pure res++    backoff = 1000000 -- 1sec+    rateLimitHandler _ = Handler $ \case+      MatrixRateLimit -> pure True     -- Log network error     handler (RetryStatus num _ _) = Handler $ \case       HTTP.HttpExceptionRequest req ctx -> do         let url = decodeUtf8 (HTTP.host req) <> ":" <> pack (show (HTTP.port req)) <> decodeUtf8 (HTTP.path req)             arg = decodeUtf8 $ HTTP.queryString req             loc = if num == 0 then url <> arg else url-        liftIO $-          hPutStrLn stderr $-            "NetworkFailure: "-              <> pack (show num)-              <> "/5 "-              <> loc-              <> " failed: "-              <> pack (show ctx)+        logRetry $+          "NetworkFailure: "+            <> pack (show num)+            <> "/5 "+            <> loc+            <> " failed: "+            <> pack (show ctx)         pure True       HTTP.InvalidUrlException _ _ -> pure False++retry :: MatrixIO a -> MatrixIO a+retry = retry' 7 (hPutStrLn stderr)

@@ -21,6 +21,9 @@      -- * Create a session     -- $session++    -- * Lookup identity+    -- $identity   ) where @@ -53,3 +56,18 @@ --   > > sess <- createSession "https://matrix.org" token --   > > getTokenOwner sess --   > Right (WhoAmI "@tristanc_:matrix.org")++-- $identity+--  To use the Identity api you need another token. Get it by running these commands:+--+--  > $ MATRIX_OPENID=$(curl -XPOST https://matrix.org/_matrix/client/r0/user/${USER}/openid/request_token -H "Authorization: Bearer ${MATRIX_TOKEN}" -d '{}')+--  > $ export MATRIX_IDENTITY_TOKEN=$(curl -XPOST https://matrix.org/_matrix/identity/v2/account/register -d "${MATRIX_OPENID}" | jq -r '.access_token')+--+--  Then here is how to lookup a matrix identity:+--+--  > > import Network.Matrix.Identity+--  > > tokenId <- getTokenFromEnv "MATRIX_IDENTITY_TOKEN"+--  > > sessId <- createIdentitySession "https://matrix.org" tokenId+--  > > Right hd <- hashDetails sessId+--  > > identityLookup sessId hd (Email "tdecacqu@redhat.com")+--  > Right (Just (UserID "@tristanc_:matrix.org"))

@@ -1,11 +1,14 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}  -- | The matrix client specification tests module Main (main) where -import Data.Aeson (encode)+import Control.Monad (void)+import qualified Data.Aeson.Encode.Pretty as Aeson+import Data.Text (Text)+import Data.Time.Clock.System (SystemTime (..), getSystemTime) import Network.Matrix.Client-import Network.Matrix.Events import Network.Matrix.Internal import Test.Hspec @@ -14,12 +17,42 @@  spec :: Spec spec = describe "unit tests" $ do+  it "decode unknown" $+    (decodeResp "" :: Maybe (Either MatrixError String))+      `shouldBe` Nothing   it "decode error" $-    (decodeResp "{\"errcode\": \"TEST\", \"error\":\"a error\"}" :: Either MatrixError String)-      `shouldBe` Left (MatrixError "TEST" "a error" Nothing)+    (decodeResp "{\"errcode\": \"TEST\", \"error\":\"a error\"}" :: Maybe (Either MatrixError String))+      `shouldBe` (Just . Left $ MatrixError "TEST" "a error" Nothing)   it "decode response" $     decodeResp "{\"user_id\": \"@tristanc_:matrix.org\"}"-      `shouldBe` Right (UserID "@tristanc_:matrix.org")+      `shouldBe` (Just . Right $ UserID "@tristanc_:matrix.org")   it "encode room message" $-    encode (RoomMessageText (MessageText "Hello" Nothing Nothing))-      `shouldBe` "{\"msgtype\":\"m.text\",\"body\":\"Hello\"}"+    encodePretty (RoomMessageText (MessageText "Hello" Nothing Nothing))+      `shouldBe` "{\"body\":\"Hello\",\"msgtype\":\"m.text\"}"+  it "does not retry on success" $+    checkPause (<=) $ do+      let resp = Right True+      res <- retry (pure resp)+      res `shouldBe` resp+  it "does not retry on regular failre" $+    checkPause (<=) $ do+      let resp = Left $ MatrixError "test" "error" Nothing+      res <- (retry (pure resp) :: MatrixIO Int)+      res `shouldBe` resp+  it "retry on rate limit failure" $+    checkPause (>=) $ do+      let resp = Left $ MatrixError "M_LIMIT_EXCEEDED" "error" (Just 1000)+      (retry' 1 (const $ pure ()) (pure resp) :: MatrixIO Int)+        `shouldThrow` rateLimitSelector+  where+    rateLimitSelector :: MatrixException -> Bool+    rateLimitSelector MatrixRateLimit = True+    checkPause op action = do+      MkSystemTime start _ <- getSystemTime+      void action+      MkSystemTime end _ <- getSystemTime+      (end - start) `shouldSatisfy` (`op` 1)+    encodePretty =+      Aeson.encodePretty'+        ( Aeson.defConfig {Aeson.confIndent = Aeson.Spaces 0, Aeson.confCompare = compare @Text}+        )