WPB-21785 [fix] BrigAPIAccess interpreter sometimes throws 5 xx when it shouldn't (#4865)

Author: battermann

changelog.d/5-internal/WPB-21785

@@ -0,0 +1 @@
+Fix: Inappropriate 500 errors removed from BrigAPIAccess interpreter

libs/bilge/src/Bilge/Request.hs

@@ -70,6 +70,7 @@ module Bilge.Request
     Rq.applyBasicAuth,
     Rq.urlEncodedBody,
     Rq.getUri,
+    expect2xxOr404,
   )
 where
 
@@ -153,6 +154,9 @@ expect3xx = expectStatus ((== 3) . (`div` 100))
 expect4xx :: Request -> Request
 expect4xx = expectStatus ((== 4) . (`div` 100))
 
+expect2xxOr404 :: Request -> Request
+expect2xxOr404 = expectStatus (\code -> code == 404 || (code >= 200 && code < 300))
+
 expectStatus :: (Int -> Bool) -> Request -> Request
 expectStatus property r = r {Rq.checkResponse = check}
   where

libs/wire-subsystems/src/Wire/BrigAPIAccess.hs

@@ -162,7 +162,7 @@ data BrigAPIAccess m a where
   CreateGroupInternal :: ManagedBy -> TeamId -> Maybe UserId -> NewUserGroup -> BrigAPIAccess m (Either Wai.Error UserGroup)
   GetGroupInternal :: TeamId -> UserGroupId -> Bool -> BrigAPIAccess m (Maybe UserGroup)
   GetGroupsInternal :: TeamId -> Maybe Scim.Filter -> BrigAPIAccess m UserGroupPage
-  UpdateGroup :: UpdateGroupInternalRequest -> BrigAPIAccess m ()
+  UpdateGroup :: UpdateGroupInternalRequest -> BrigAPIAccess m (Either Wai.Error ())
   DeleteGroupInternal :: ManagedBy -> TeamId -> UserGroupId -> BrigAPIAccess m (Either DeleteGroupManagedError ())
 
 makeSem ''BrigAPIAccess

libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs

@@ -212,7 +212,7 @@ deleteBot cid bot = do
         . header "Z-Type" "bot"
         . header "Z-Bot" (toByteString' bot)
         . header "Z-Conversation" (toByteString' cid)
-        . expect2xx
+        . expect2xxOr404
 
 -- | Calls 'Brig.User.API.Auth.reAuthUserH'.
 reAuthUser ::
@@ -296,7 +296,7 @@ deleteUser uid = do
     brigRequest $
       method DELETE
         . paths ["/i/users", toByteString' uid]
-        . expect2xx
+        . expect2xxOr404
 
 -- | Calls 'Brig.API.getContactListH'.
 getContactList ::
@@ -333,10 +333,12 @@ getUserExportData ::
 getUserExportData uid = do
   resp <-
     brigRequest $
-      method GET
+      check [status200, status404]
+        . method GET
         . paths ["i/users", toByteString' uid, "export-data"]
-        . expect2xx
-  decodeBodyOrThrow "brig" resp
+  if statusCode resp == 404
+    then pure Nothing
+    else decodeBodyOrThrow "brig" resp
 
 getAccountConferenceCallingConfigClient ::
   (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
@@ -415,7 +417,7 @@ notifyClientsAboutLegalHoldRequest requesterUid targetUid lastPrekey' = do
     method POST
       . paths ["i", "clients", "legalhold", toByteString' targetUid, "request"]
       . json (LegalHoldClientRequest requesterUid lastPrekey')
-      . expect2xx
+      . expect2xxOr404
 
 -- | Calls 'Brig.User.API.Auth.legalHoldLoginH'.
 getLegalHoldAuthToken ::
@@ -476,7 +478,7 @@ removeLegalHoldClientFromUser targetUid = do
     method DELETE
       . paths ["i", "clients", "legalhold", toByteString' targetUid]
       . contentJson
-      . expect2xx
+      . expect2xxOr404
 
 -- | Calls 'Brig.API.addClientInternalH'.
 brigAddClient ::
@@ -579,7 +581,7 @@ createGroupInternal managedBy teamId creatorUserId newGroup = do
       method POST
         . path "/i/user-groups/full"
         . json req
-  if statusCode r >= 200 && statusCode r < 300
+  if is2xx r
     then Right <$> decodeBodyOrThrow @UserGroup "brig" r
     else Left <$> decodeBodyOrThrow @Wai.Error "brig" r
 
@@ -592,10 +594,12 @@ getGroupInternal ::
 getGroupInternal tid gid includeChannels = do
   r <-
     brigRequest $
-      method GET
+      check [status200, status404]
+        . method GET
         . paths ["i", "user-groups", toByteString' tid, toByteString' gid, toByteString' includeChannels]
-        . expect2xx
-  decodeBodyOrThrow "brig" r
+  if statusCode r == 404
+    then pure Nothing
+    else decodeBodyOrThrow "brig" r
 
 getGroupsInternal ::
   (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
@@ -617,16 +621,18 @@ getGroupsInternal tid mbFilter = do
   decodeBodyOrThrow "brig" r
 
 updateGroup ::
-  (Member Rpc r, Member (Input Endpoint) r) =>
+  (Member Rpc r, Member (Input Endpoint) r, Member (Error ParseException) r) =>
   UpdateGroupInternalRequest ->
-  Sem r ()
-updateGroup reqBody =
-  void $
+  Sem r (Either Wai.Error ())
+updateGroup reqBody = do
+  resp <-
     brigRequest $
       method PUT
         . paths ["i", "user-groups"]
         . json reqBody
-        . expect2xx
+  if is2xx resp
+    then pure (Right ())
+    else Left <$> decodeBodyOrThrow @Wai.Error "brig" resp
 
 deleteGroupInternal ::
   ( Member Rpc r,
@@ -643,7 +649,8 @@ deleteGroupInternal managedBy teamId groupId = do
       method DELETE
         . paths ["i", "user-groups", toByteString' teamId, toByteString' groupId, "managed", toByteString' managedBy]
   case (statusCode resp, errorLabel resp) of
-    (status, _) | status >= 200 && status < 300 -> pure $ Right ()
+    (status, _) | statusIs2xx status -> pure $ Right ()
+    (404, _) -> pure $ Right ()
     (403, Just "user-group-managed-by-mismatch") -> pure $ Left DeleteGroupManagedManagedByMismatch
     (status, label) ->
       throw $
@@ -654,3 +661,9 @@ deleteGroupInternal managedBy teamId groupId = do
   where
     errorLabel :: ResponseLBS -> Maybe LText
     errorLabel = fmap Wai.label . responseJsonMaybe
+
+is2xx :: ResponseLBS -> Bool
+is2xx = statusIs2xx . statusCode
+
+statusIs2xx :: Int -> Bool
+statusIs2xx s = s >= 200 && s < 300

libs/wire-subsystems/src/Wire/ScimSubsystem/Interpreter.hs

@@ -27,6 +27,7 @@ import Data.Text qualified as Text
 import Data.UUID qualified as UUID
 import Data.Vector qualified as V
 import Imports
+import Network.HTTP.Types.Status (notFound404)
 import Network.URI (parseURI)
 import Network.Wai.Utilities.Error qualified as Wai
 import Polysemy
@@ -185,8 +186,13 @@ scimUpdateUserGroupImpl teamId gid grp = do
       [] -> pure ()
       (u : _) -> scimThrow $ notFound "User" (idToText u)
 
-  -- replace the members of the user group
-  BrigAPI.updateGroup (UpdateGroupInternalRequest teamId gid (Just ugName) (Just reqMemberIds))
+  -- replace the members of the user group; propagate Brig errors
+  BrigAPI.updateGroup (UpdateGroupInternalRequest teamId gid (Just ugName) (Just reqMemberIds)) >>= \case
+    Right () -> pure ()
+    Left err ->
+      if err.code == notFound404
+        then scimThrow $ notFound "Group" (UUID.toText $ gid.toUUID)
+        else throw (ScimSubsystemInternal err)
 
   ScimSubsystemConfig scimBaseUri <- input
   maybe (scimThrow $ notFound "Group" (UUID.toText $ gid.toUUID)) (pure . toStoredGroup scimBaseUri)