Fix emtpy tuple

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
@@ -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
@@ -226,6 +226,16 @@ 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 <$> 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 =
@@ -568,17 +578,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]
 
@@ -631,7 +641,7 @@ 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 $
+  doRequestExpectEmptyResponse session "invite" $
       request { HTTP.method = "POST"
               , HTTP.requestBody = HTTP.RequestBodyLBS $ encode body
               }
@@ -671,57 +681,36 @@ 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
 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
 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
@@ -731,15 +720,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)
@@ -775,15 +759,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
@@ -1310,11 +1289,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 =