matrix-client 0.1.4.3 → 0.1.5.0
raw patch · 4 files changed
+48/−59 lines, 4 filesdep ~aesondep ~base64dep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson, base64, bytestring, containers, exceptions, hashable, network-uri, profunctors, text, time, unordered-containers
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- matrix-client.cabal +1/−1
- src/Network/Matrix/Client.hs +28/−50
- test/Spec.hs +14/−8
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Changelog +## 0.1.5.0++- Convert userDisplayName into a Maybe value [#30](https://github.com/softwarefactory-project/matrix-client-haskell/issues/30)+- Improve empty response handling [#32](https://github.com/softwarefactory-project/matrix-client-haskell/issues/32)+ ## 0.1.4.3 - Add missing export for Dir.
matrix-client.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: matrix-client-version: 0.1.4.3+version: 0.1.5.0 synopsis: A matrix client library description: Matrix client is a library to interface with https://matrix.org.
src/Network/Matrix/Client.hs view
@@ -137,7 +137,7 @@ ) where -import Control.Monad (mzero, void)+import Control.Monad (mzero) import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.Aeson (FromJSON (..), ToJSON (..), Value (Object, String), encode, genericParseJSON, genericToJSON, object, withObject, withText, (.:), (.:?), (.=)) import qualified Data.Aeson as Aeson@@ -200,9 +200,9 @@ -- | 'logout' allows you to destroy a session token. logout :: ClientSession -> MatrixIO ()-logout session@ClientSession {..} = do+logout session = do req <- mkLogoutRequest session- fmap (() <$) $ doRequest' @Value manager req+ doRequestExpectEmptyResponse session "logout" req -- | The session record, use 'createSession' to create it. data ClientSession = ClientSession@@ -226,6 +226,16 @@ doRequest :: FromJSON a => ClientSession -> HTTP.Request -> MatrixIO a doRequest ClientSession {..} = doRequest' manager +-- | Same as 'doRequest' but expect an empty JSON response @{}@+-- which is converted to an empty Haskell tuple @()@.+doRequestExpectEmptyResponse :: ClientSession -> String -> HTTP.Request -> MatrixIO ()+doRequestExpectEmptyResponse sess apiName request = fmap ensureEmptyObject <$> doRequest sess request+ where+ ensureEmptyObject :: Value -> ()+ ensureEmptyObject value = case value of+ Object xs | xs == mempty -> ()+ _ -> error $ "Unknown " <> apiName <> " response: " <> show value+ -- | 'getTokenOwner' gets information about the owner of a given access token. getTokenOwner :: ClientSession -> MatrixIO UserID getTokenOwner session =@@ -249,12 +259,12 @@ request <- mkRequest session True $ "/_matrix/client/v3/rooms/" <> rid <> "/event/" <> eid doRequest session request -data User = User { userDisplayName :: T.Text, userAvatarUrl :: Maybe T.Text }+data User = User { userDisplayName :: Maybe T.Text, userAvatarUrl :: Maybe T.Text } deriving Show instance FromJSON User where parseJSON = withObject "User" $ \o -> do- userDisplayName <- o .: "display_name"+ userDisplayName <- o .:? "display_name" userAvatarUrl <- o .:? "avatar_url" pure $ User {..} @@ -529,7 +539,7 @@ Right crr -> case (crrID crr, crrMessage crr) of (Just roomID, _) -> pure $ RoomID roomID (_, Just message) -> Left $ MatrixError "UNKNOWN" message Nothing- _ -> Left $ MatrixError "UNKOWN" "" Nothing+ _ -> Left $ MatrixError "UNKNOWN" "" Nothing newtype RoomAlias = RoomAlias T.Text deriving (Show, Eq, Ord, Hashable) @@ -568,17 +578,17 @@ setRoomAlias :: ClientSession -> RoomAlias -> RoomID -> MatrixIO () setRoomAlias session (RoomAlias alias) (RoomID roomId)= do request <- mkRequest session True $ "/_matrix/client/v3/directory/room/" <> escapeUriComponent alias- doRequest- session $+ doRequestExpectEmptyResponse session "set room alias" $ request { HTTP.method = "PUT" , HTTP.requestBody = HTTP.RequestBodyLBS $ encode $ object [("room_id" .= roomId)] }+ -- | Delete a mapping of room alias to room ID. -- https://spec.matrix.org/v1.1/client-server-api/#delete_matrixclientv3directoryroomroomalias deleteRoomAlias :: ClientSession -> RoomAlias -> MatrixIO () deleteRoomAlias session (RoomAlias alias) = do request <- mkRequest session True $ "/_matrix/client/v3/directory/room/" <> escapeUriComponent alias- doRequest session $ request { HTTP.method = "DELETE" }+ doRequestExpectEmptyResponse session "delete room alias" $ request { HTTP.method = "DELETE" } data ResolvedAliases = ResolvedAliases [RoomAlias] @@ -631,7 +641,7 @@ inviteToRoom session (RoomID rid) (UserID uid) reason = do request <- mkRequest session True $ "/_matrix/client/v3/rooms/" <> rid <> "/invite" let body = object $ [("user_id", toJSON uid)] <> catMaybes [fmap (("reason",) . toJSON) reason]- doRequest session $+ doRequestExpectEmptyResponse session "invite" $ request { HTTP.method = "POST" , HTTP.requestBody = HTTP.RequestBodyLBS $ encode body }@@ -671,25 +681,14 @@ forgetRoom :: ClientSession -> RoomID -> MatrixIO () forgetRoom session (RoomID roomId) = do request <- mkRequest session True $ "/_matrix/client/v3/rooms/" <> roomId <> "/forget"- fmap ensureEmptyObject <$> doRequest session (request {HTTP.method = "POST"})- where- ensureEmptyObject :: Value -> ()- ensureEmptyObject value = case value of- Object xs | xs == mempty -> ()- _anyOther -> error $ "Unknown forget response: " <> show value- + doRequestExpectEmptyResponse session "forget" (request {HTTP.method = "POST"}) -- | Stop participating in a particular room. -- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3roomsroomidleave 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+ doRequestExpectEmptyResponse session "leave" (request {HTTP.method = "POST"}) -- | Kick a user from the room. -- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3roomsroomidkick@@ -697,15 +696,10 @@ kickUser session (RoomID roomId) (UserID uid) reason = do request <- mkRequest session True $ "/_matrix/client/v3/rooms/" <> roomId <> "/kick" let body = object $ [("user_id", toJSON uid)] <> catMaybes [fmap (("reason",) . toJSON) reason]- fmap (fmap ensureEmptyObject) $ doRequest session $+ doRequestExpectEmptyResponse session "kick" $ request { HTTP.method = "POST" , HTTP.requestBody = HTTP.RequestBodyLBS $ encode body }- where- ensureEmptyObject :: Value -> ()- ensureEmptyObject value = case value of- Object xs | xs == mempty -> ()- _anyOther -> error $ "Unknown leave response: " <> show value -- | Ban a user in the room. If the user is currently in the room, also kick them. -- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3roomsroomidban@@ -713,15 +707,10 @@ banUser session (RoomID roomId) (UserID uid) reason = do request <- mkRequest session True $ "/_matrix/client/v3/rooms/" <> roomId <> "/ban" let body = object $ [("user_id", toJSON uid)] <> catMaybes [fmap (("reason",) . toJSON) reason]- fmap (fmap ensureEmptyObject) $ doRequest session $+ doRequestExpectEmptyResponse session "ban" $ request { HTTP.method = "POST" , HTTP.requestBody = HTTP.RequestBodyLBS $ encode body }- where- ensureEmptyObject :: Value -> ()- ensureEmptyObject value = case value of- Object xs | xs == mempty -> ()- _anyOther -> error $ "Unknown leave response: " <> show value -- | Unban a user from the room. This allows them to be invited to the -- room, and join if they would otherwise be allowed to join according@@ -731,15 +720,10 @@ unbanUser session (RoomID roomId) (UserID uid) reason = do request <- mkRequest session True $ "/_matrix/client/v3/rooms/" <> roomId <> "/unban" let body = object $ [("user_id", toJSON uid)] <> catMaybes [fmap (("reason",) . toJSON) reason]- fmap (fmap ensureEmptyObject) $ doRequest session $+ doRequestExpectEmptyResponse session "unban" $ request { HTTP.method = "POST" , HTTP.requestBody = HTTP.RequestBodyLBS $ encode body }- where- ensureEmptyObject :: Value -> ()- ensureEmptyObject value = case value of- Object xs | xs == mempty -> ()- _anyOther -> error $ "Unknown leave response: " <> show value data Visibility = Public | Private deriving (Show)@@ -775,15 +759,10 @@ setRoomVisibility session (RoomID rid) visibility = do request <- mkRequest session True $ "/_matrix/client/v3/directory/list/room/" <> rid let body = object $ [("visibility", toJSON visibility)]- fmap (fmap ensureEmptyObject) $ doRequest session $+ doRequestExpectEmptyResponse session "set room visibility" $ request { HTTP.method = "PUT" , HTTP.requestBody = HTTP.RequestBodyLBS $ encode body }- where- ensureEmptyObject :: Value -> ()- ensureEmptyObject value = case value of- Object xs | xs == mempty -> ()- _anyOther -> error $ "Unknown setRoomVisibility response: " <> show value -- | A pagination token from a previous request, allowing clients to -- get the next (or previous) batch of rooms. The direction of@@ -1310,11 +1289,10 @@ setAccountData' :: (ToJSON a) => ClientSession -> UserID -> T.Text -> a -> MatrixIO () setAccountData' session userID t value = do request <- mkRequest session True $ accountDataPath userID t- void <$> (doRequest session $ request+ doRequestExpectEmptyResponse session "set account data" $ request { HTTP.method = "PUT" , HTTP.requestBody = HTTP.RequestBodyLBS $ encode value- } :: MatrixIO Aeson.Object- )+ } accountDataPath :: UserID -> T.Text -> T.Text accountDataPath (UserID userID) t =
test/Spec.hs view
@@ -26,7 +26,7 @@ _ -> do putStrLn "Skipping integration test" pure $ pure mempty- hspec (parallel $ spec >> runIntegration)+ hspec (parallel spec >> runIntegration) integration :: ClientSession -> ClientSession -> Spec integration sess1 sess2 = do@@ -44,26 +44,32 @@ ) case resp of Left err -> meError err `shouldBe` "Alias already exists"- Right (RoomID roomID) -> roomID `shouldSatisfy` (/= mempty)+ Right (RoomID room) -> room `shouldSatisfy` (/= mempty) it "join room" $ do resp <- joinRoom sess1 "#test:localhost" case resp of Left err -> error (show err)- Right (RoomID roomID) -> roomID `shouldSatisfy` (/= mempty)+ Right (RoomID room) -> room `shouldSatisfy` (/= mempty) resp' <- joinRoom sess2 "#test:localhost" case resp' of Left err -> error (show err)- Right (RoomID roomID) -> roomID `shouldSatisfy` (/= mempty)+ Right (RoomID room) -> room `shouldSatisfy` (/= mempty) it "send message and reply" $ do -- Flush previous events Right sr <- sync sess2 Nothing Nothing Nothing Nothing- Right [room] <- getJoinedRooms sess1+ Right (room:_) <- getJoinedRooms sess1 let msg body = RoomMessageText $ MessageText body TextType Nothing Nothing let since = srNextBatch sr Right eventID <- sendMessage sess1 room (EventRoomMessage $ msg "Hello") (TxnID since) Right reply <- sendMessage sess2 room (EventRoomReply eventID $ msg "Hi!") (TxnID since) reply `shouldNotBe` eventID + it "invite private room" $ do+ Right room <- createRoom sess1 $ RoomCreateRequest PrivateChat "private" "private-test" "A test"+ Right user <- getTokenOwner sess2+ Right inviteResult <- inviteToRoom sess1 room user (Just "Welcome!")+ inviteResult `shouldBe` ()+ spec :: Spec spec = describe "unit tests" $ do it "decode unknown" $@@ -112,10 +118,10 @@ rateLimitSelector :: MatrixException -> Bool rateLimitSelector MatrixRateLimit = True checkPause op action = do- MkSystemTime start _ <- getSystemTime+ MkSystemTime startTS _ <- getSystemTime void action- MkSystemTime end _ <- getSystemTime- (end - start) `shouldSatisfy` (`op` 1)+ MkSystemTime endTS _ <- getSystemTime+ (endTS - startTS) `shouldSatisfy` (`op` 1) encodePretty = Aeson.encodePretty' ( Aeson.defConfig {Aeson.confIndent = Aeson.Spaces 0, Aeson.confCompare = compare @Text}