[SQSERVICES-1801] Prevent dead bots in database (#2870)

changelog.d/3-bug-fixes/pr-2870

@@ -0,0 +1 @@
+Prevention of storing unnecessary data in the database if adding a bot to a conversation fails.

services/brig/src/Brig/Provider/API.hs

@@ -898,6 +898,14 @@ addBot zuid zcon cid add = do
   let sid = addBotService add
   -- Get the conversation and check preconditions
   cnv <- lift (liftSem $ GalleyProvider.getConv zuid cid) >>= maybeConvNotFound
+  -- Check that the user is a conversation admin and therefore is allowed to add a bot to this conversation.
+  -- Note that this precondition is also checked in the internal galley API,
+  -- but by having this check here we prevent any (useless) data to be written to the database
+  -- as well as the unnecessary creation of the bot via the external service API call.
+  -- However, in case we refine the roles model in the future, this check might not be granular enough.
+  -- In that case we should rather do an internal call to galley to check for the correct permissions.
+  -- Also see `removeBot` for a similar check.
+  guardConvAdmin cnv
   let mems = cnvMembers cnv
   unless (cnvType cnv == RegularConv) $
     throwStd invalidConv
@@ -974,6 +982,12 @@ removeBot :: Members '[GalleyProvider] r => UserId -> ConnId -> ConvId -> BotId
 removeBot zusr zcon cid bid = do
   -- Get the conversation and check preconditions
   cnv <- lift (liftSem $ GalleyProvider.getConv zusr cid) >>= maybeConvNotFound
+  -- Check that the user is a conversation admin and therefore is allowed to remove a bot from the conversation.
+  -- Note that this precondition is also checked in the internal galley API.
+  -- However, in case we refine the roles model in the future, this check might not be granular enough.
+  -- In that case we should rather do an internal call to galley to check for the correct permissions.
+  -- Also see `addBot` for a similar check.
+  guardConvAdmin cnv
   let mems = cnvMembers cnv
   unless (cnvType cnv == RegularConv) $
     throwStd invalidConv
@@ -985,6 +999,11 @@ removeBot zusr zcon cid bid = do
     Just _ -> do
       lift $ Public.RemoveBotResponse <$$> wrapHttpClient (deleteBot zusr (Just zcon) bid cid)
 
+guardConvAdmin :: Conversation -> ExceptT Error (AppT r) ()
+guardConvAdmin conv = do
+  let selfMember = cmSelf . cnvMembers $ conv
+  unless (memConvRoleName selfMember == roleNameWireAdmin) $ throwStd accessDenied
+
 --------------------------------------------------------------------------------
 -- Bot API
 

services/brig/test/integration/API/Provider.hs

@@ -148,6 +148,7 @@ tests dom conf p db b c g = do
         testGroup
           "bot-teams"
           [ test p "add-remove" $ testAddRemoveBotTeam conf db b g c,
+            test p "add-remove-access-denied-for-non-conv-admin" $ testNonConvAdminCannotAddRemoveBot conf db b g,
             test p "team-only" $ testBotTeamOnlyConv conf db b g c,
             test p "message" $ testMessageBotTeam conf db b g c,
             test p "delete conv" $ testDeleteConvBotTeam conf db b g c,
@@ -566,6 +567,30 @@ testAddBotBlocked config db brig galley = withTestService config db brig defServ
     const 403 === statusCode
     const (Just "access-denied") === fmap Error.label . responseJsonMaybe
 
+testNonConvAdminCannotAddRemoveBot :: Config -> DB.ClientState -> Brig -> Galley -> Http ()
+testNonConvAdminCannotAddRemoveBot config db brig galley = withTestService config db brig defServiceApp $ \sref _buf -> do
+  let pid = sref ^. serviceRefProvider
+  let sid = sref ^. serviceRefId
+  (ownerId, tid) <- Team.createUserWithTeam brig
+  member <- Team.createTeamMember brig galley ownerId tid fullPermissions
+  let memberId = userId member
+  whitelistService brig ownerId tid pid sid
+  cid <- Team.createTeamConvWithRole roleNameWireMember galley tid ownerId [memberId] Nothing
+  addBot brig memberId pid sid cid !!! do
+    const 403 === statusCode
+    const (Just "access-denied") === fmap Error.label . responseJsonMaybe
+  rs <- responseJsonError =<< addBot brig ownerId pid sid cid <!! const 201 === statusCode
+  let bid = rsAddBotId rs
+      buid = botUserId bid
+  getUser brig ownerId buid !!! const 200 === statusCode
+  removeBot brig memberId cid bid !!! do
+    const 403 === statusCode
+    const (Just "access-denied") === fmap Error.label . responseJsonMaybe
+  -- also check the internal galley API
+  removeBotInternal galley memberId cid bid !!! do
+    const 403 === statusCode
+    const (Just "action-denied") === fmap Error.label . responseJsonMaybe
+
 testGetBotConvBlocked :: Config -> DB.ClientState -> Brig -> Galley -> Cannon -> Http ()
 testGetBotConvBlocked config db brig galley cannon = withTestService config db brig defServiceApp $ \sref buf -> do
   (user1, userId -> u2, _, tid, cid, pid, sid) <- prepareBotUsersTeam brig galley sref
@@ -1305,6 +1330,31 @@ removeBot brig uid cid bid =
       . header "Z-User" (toByteString' uid)
       . header "Z-Connection" "conn"
 
+data RemoveBot = RemoveBot
+  { _rmBotConv :: !ConvId,
+    _rmBotId :: !BotId
+  }
+
+instance ToJSON RemoveBot where
+  toJSON a =
+    object
+      [ "conversation" .= _rmBotConv a,
+        "bot" .= _rmBotId a
+      ]
+
+removeBotInternal ::
+  Galley ->
+  UserId ->
+  ConvId ->
+  BotId ->
+  Http ResponseLBS
+removeBotInternal galley uid cid bid =
+  delete $
+    galley
+      . paths ["i", "bots"]
+      . header "Z-User" (toByteString' uid)
+      . Bilge.json (RemoveBot cid bid)
+
 createConv ::
   Galley ->
   UserId ->

services/brig/test/integration/API/Team/Util.hs

@@ -214,10 +214,24 @@ updatePermissions from tid (to, perm) galley =
     changeMember = Member.mkNewTeamMember to perm Nothing
 
 createTeamConv :: HasCallStack => Galley -> TeamId -> UserId -> [UserId] -> Maybe Milliseconds -> Http ConvId
-createTeamConv g tid u us mtimer = do
+createTeamConv = createTeamConvWithRole roleNameWireAdmin
+
+createTeamConvWithRole :: HasCallStack => RoleName -> Galley -> TeamId -> UserId -> [UserId] -> Maybe Milliseconds -> Http ConvId
+createTeamConvWithRole role g tid u us mtimer = do
   let tinfo = Just $ ConvTeamInfo tid
   let conv =
-        NewConv us [] Nothing (Set.fromList []) Nothing tinfo mtimer Nothing roleNameWireAdmin ProtocolProteusTag Nothing
+        NewConv
+          us
+          []
+          Nothing
+          (Set.fromList [])
+          Nothing
+          tinfo
+          mtimer
+          Nothing
+          role
+          ProtocolProteusTag
+          Nothing
   r <-
     post
       ( g

services/galley/src/Galley/API/Update.hs

@@ -1571,6 +1571,8 @@ addBot lusr zcon b = do
       unless (tUnqualified lusr `isMember` users) $ throwS @'ConvNotFound
       ensureGroupConversation c
       self <- getSelfMemberFromLocals (tUnqualified lusr) users
+      -- Note that in brig from where this internal handler is called, we additionally check for conversation admin role.
+      -- Remember to change this if we ever want to allow non admins to add bots.
       ensureActionAllowed SAddConversationMember self
       unless (any ((== b ^. addBotId) . botMemId) bots) $ do
         let botId = qualifyAs lusr (botUserId (b ^. addBotId))
@@ -1587,7 +1589,8 @@ rmBotH ::
        Input (Local ()),
        Input UTCTime,
        MemberStore,
-       WaiRoutes
+       WaiRoutes,
+       ErrorS ('ActionDenied 'RemoveConversationMember)
      ]
     r =>
   UserId ::: Maybe ConnId ::: JsonRequest RemoveBot ->
@@ -1605,7 +1608,8 @@ rmBot ::
        ExternalAccess,
        GundeckAccess,
        Input UTCTime,
-       MemberStore
+       MemberStore,
+       ErrorS ('ActionDenied 'RemoveConversationMember)
      ]
     r =>
   Local UserId ->
@@ -1615,10 +1619,17 @@ rmBot ::
 rmBot lusr zcon b = do
   c <-
     E.getConversation (b ^. rmBotConv) >>= noteS @'ConvNotFound
-  let lcnv = qualifyAs lusr (Data.convId c)
+  let (bots, users) = localBotsAndUsers (Data.convLocalMembers c)
   unless (tUnqualified lusr `isMember` Data.convLocalMembers c) $
     throwS @'ConvNotFound
-  let (bots, users) = localBotsAndUsers (Data.convLocalMembers c)
+  -- A bot can remove itself (which will internally be triggered when a service is deleted),
+  -- otherwise we have to check for the correct permissions
+  unless (botUserId (b ^. rmBotId) == tUnqualified lusr) $ do
+    -- Note that in brig from where this internal handler is called, we additionally check for conversation admin role.
+    -- Remember to change this if we ever want to allow non admins to remove bots.
+    self <- getSelfMemberFromLocals (tUnqualified lusr) users
+    ensureActionAllowed SRemoveConversationMember self
+  let lcnv = qualifyAs lusr (Data.convId c)
   if not (any ((== b ^. rmBotId) . botMemId) bots)
     then pure Unchanged
     else do