From 07e7f62191ca7e6876c54291bb6361d7d2193f30 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= <jschoett@gmail.com>
Date: Tue, 14 Mar 2023 12:57:14 +0100
Subject: [PATCH 1/5] Fix for issue #32

---
 matrix-client/src/Network/Matrix/Client.hs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/matrix-client/src/Network/Matrix/Client.hs b/matrix-client/src/Network/Matrix/Client.hs
index beb2875..50089d7 100644
--- a/matrix-client/src/Network/Matrix/Client.hs
+++ b/matrix-client/src/Network/Matrix/Client.hs
@@ -631,10 +631,10 @@ inviteToRoom :: ClientSession -> RoomID -> UserID -> Maybe T.Text -> MatrixIO ()
 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 $
+  fmap (ensureEmptyObject "invite") <$> (doRequest session $
       request { HTTP.method = "POST"
               , HTTP.requestBody = HTTP.RequestBodyLBS $ encode body
-              }
+              })
 
 -- | Note that this API takes either a room ID or alias, unlike 'joinRoomById'
 -- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3joinroomidoralias
@@ -1352,3 +1352,8 @@ tshow = T.pack . show
 
 escapeUriComponent :: T.Text -> T.Text
 escapeUriComponent = T.pack . URI.escapeURIString URI.isUnreserved . T.unpack
+
+ensureEmptyObject :: String -> Value -> ()
+ensureEmptyObject apiName value = case value of
+  Object xs | xs == mempty -> ()
+  _ -> error $ "Unknown " <> apiName <> " response: " <> show value

From d37476001f486e55a4aa0995f8786d5da75af158 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= <jschoett@gmail.com>
Date: Tue, 14 Mar 2023 13:12:09 +0100
Subject: [PATCH 2/5] Refactor

---
 matrix-client/src/Network/Matrix/Client.hs | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/matrix-client/src/Network/Matrix/Client.hs b/matrix-client/src/Network/Matrix/Client.hs
index 50089d7..0072e9b 100644
--- a/matrix-client/src/Network/Matrix/Client.hs
+++ b/matrix-client/src/Network/Matrix/Client.hs
@@ -226,6 +226,9 @@ mkRequest ClientSession {..} = mkRequest' baseUrl token
 doRequest :: FromJSON a => ClientSession -> HTTP.Request -> MatrixIO a
 doRequest ClientSession {..} = doRequest' manager
 
+doRequestExpectEmptyResponse :: ClientSession -> String -> HTTP.Request -> MatrixIO ()
+doRequestExpectEmptyResponse sess apiName request = fmap (ensureEmptyObject apiName) <$> doRequest sess request
+
 -- | 'getTokenOwner' gets information about the owner of a given access token.
 getTokenOwner :: ClientSession -> MatrixIO UserID
 getTokenOwner session =
@@ -631,10 +634,10 @@ inviteToRoom :: ClientSession -> RoomID -> UserID -> Maybe T.Text -> MatrixIO ()
 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]
-  fmap (ensureEmptyObject "invite") <$> (doRequest session $
+  doRequestExpectEmptyResponse session "invite" $
       request { HTTP.method = "POST"
               , HTTP.requestBody = HTTP.RequestBodyLBS $ encode body
-              })
+              }
 
 -- | Note that this API takes either a room ID or alias, unlike 'joinRoomById'
 -- https://spec.matrix.org/v1.1/client-server-api/#post_matrixclientv3joinroomidoralias

From b6b15815c272264c027154d4aef813141df10268 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= <jschoett@gmail.com>
Date: Tue, 14 Mar 2023 13:31:20 +0100
Subject: [PATCH 3/5] Refactor: Unify hadling of {}/()

---
 matrix-client/src/Network/Matrix/Client.hs | 59 +++++-----------------
 1 file changed, 14 insertions(+), 45 deletions(-)

diff --git a/matrix-client/src/Network/Matrix/Client.hs b/matrix-client/src/Network/Matrix/Client.hs
index 0072e9b..02cf201 100644
--- a/matrix-client/src/Network/Matrix/Client.hs
+++ b/matrix-client/src/Network/Matrix/Client.hs
@@ -200,9 +200,9 @@ mkLogoutRequest ClientSession {..} = mkLogoutRequest' baseUrl token
 
 -- | '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
@@ -571,17 +571,17 @@ resolveRoomAlias session r@(RoomAlias alias) = do
 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]
 
@@ -674,25 +674,14 @@ knockOnRoom session room servers reason = do
 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
@@ -700,15 +689,10 @@ kickUser :: ClientSession -> RoomID -> UserID -> Maybe T.Text -> MatrixIO ()
 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
@@ -716,15 +700,10 @@ banUser :: ClientSession -> RoomID -> UserID -> Maybe T.Text -> MatrixIO ()
 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
@@ -734,15 +713,10 @@ unbanUser :: ClientSession -> RoomID -> UserID -> Maybe T.Text -> MatrixIO ()
 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)
@@ -778,15 +752,10 @@ setRoomVisibility :: ClientSession -> RoomID -> Visibility -> MatrixIO ()
 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
@@ -1313,11 +1282,10 @@ getAccountData' session userID t =
 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 =
@@ -1356,6 +1324,7 @@ tshow = T.pack . show
 escapeUriComponent :: T.Text -> T.Text
 escapeUriComponent = T.pack . URI.escapeURIString URI.isUnreserved . T.unpack
 
+
 ensureEmptyObject :: String -> Value -> ()
 ensureEmptyObject apiName value = case value of
   Object xs | xs == mempty -> ()

From ec97628631cf544da064804cd5045ff4a193f85d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= <jschoett@gmail.com>
Date: Tue, 14 Mar 2023 13:32:38 +0100
Subject: [PATCH 4/5] Refactor and documentation

---
 matrix-client/src/Network/Matrix/Client.hs | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/matrix-client/src/Network/Matrix/Client.hs b/matrix-client/src/Network/Matrix/Client.hs
index 02cf201..58b4f26 100644
--- a/matrix-client/src/Network/Matrix/Client.hs
+++ b/matrix-client/src/Network/Matrix/Client.hs
@@ -226,8 +226,15 @@ mkRequest ClientSession {..} = mkRequest' baseUrl token
 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 apiName) <$> doRequest sess request
+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
@@ -1323,9 +1330,3 @@ tshow = T.pack . show
 
 escapeUriComponent :: T.Text -> T.Text
 escapeUriComponent = T.pack . URI.escapeURIString URI.isUnreserved . T.unpack
-
-
-ensureEmptyObject :: String -> Value -> ()
-ensureEmptyObject apiName value = case value of
-  Object xs | xs == mempty -> ()
-  _ -> error $ "Unknown " <> apiName <> " response: " <> show value

From e62fd897ac24aeb9393cac01860d4c846f2e1c3f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= <jschoett@gmail.com>
Date: Tue, 14 Mar 2023 13:37:07 +0100
Subject: [PATCH 5/5] Remove unused import

---
 matrix-client/src/Network/Matrix/Client.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/matrix-client/src/Network/Matrix/Client.hs b/matrix-client/src/Network/Matrix/Client.hs
index 58b4f26..7db32dd 100644
--- a/matrix-client/src/Network/Matrix/Client.hs
+++ b/matrix-client/src/Network/Matrix/Client.hs
@@ -137,7 +137,7 @@ module Network.Matrix.Client
   )
 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