Team collaborator: Implicit connection permission [1] (#4692)

Allow team collaborators to create 1:1 conversations via POST
/one2one-conversations if they've the implicit_connection permission.


---------

Co-authored-by: Gautier DI FOLCO <[email protected]>

Author: supersven

changelog.d/2-features/WPB-18195

@@ -0,0 +1 @@
+Allow team collaborators with `implicit_connection` permission to create a One2One conversation with a team member.

integration/test/API/Galley.hs

@@ -383,6 +383,28 @@ getMLSOne2OneConversation self other = do
       $ joinHttpPath ["one2one-conversations", domain, uid]
   submit "GET" req
 
+postOne2OneConversation ::
+  (HasCallStack, MakesValue self, MakesValue other) =>
+  self ->
+  other ->
+  String ->
+  String ->
+  App Response
+postOne2OneConversation self other tid convName = do
+  qUid <- objQidObject other
+  req <-
+    baseRequest self Galley Versioned
+      $ joinHttpPath ["one2one-conversations"]
+  submit
+    "POST"
+    ( req
+        & addJSONObject
+          [ "name" .= convName,
+            "qualified_users" .= [qUid],
+            "team" .= Aeson.object ["teamid" .= tid, "managed" .= False]
+          ]
+    )
+
 getGroupClients ::
   (HasCallStack, MakesValue user) =>
   user ->

integration/test/Test/TeamCollaborators.hs

@@ -95,3 +95,49 @@ testCollaboratorCanCreateTeamConv (TaggedBool collaboratorHasTeam) = do
   postConversation collaborator (defMLS {team = Just team}) `bindResponse` \resp -> do
     resp.status `shouldMatchInt` 201
     resp.json %. "team" `shouldMatch` team
+
+testImplicitConnectionAllowed :: (HasCallStack) => App ()
+testImplicitConnectionAllowed = do
+  (owner, team, [alice]) <- createTeam OwnDomain 2
+
+  -- At the time of writing, it wasn't clear if this should be a bot instead.
+  bob <- randomUser OwnDomain def
+  addTeamCollaborator
+    owner
+    team
+    bob
+    ["implicit_connection"]
+    >>= assertSuccess
+
+  postOne2OneConversation bob alice team "chit-chat" >>= assertSuccess
+
+testImplicitConnectionNotConfigured :: (HasCallStack) => App ()
+testImplicitConnectionNotConfigured = do
+  (owner, team, [alice]) <- createTeam OwnDomain 2
+
+  -- At the time of writing, it wasn't clear if this should be a bot instead.
+  bob <- randomUser OwnDomain def
+  addTeamCollaborator
+    owner
+    team
+    bob
+    []
+    >>= assertSuccess
+
+  postOne2OneConversation bob alice team "chit-chat" >>= assertLabel 403 "operation-denied"
+
+testImplicitConnectionNoCollaborator :: (HasCallStack) => App ()
+testImplicitConnectionNoCollaborator = do
+  (_owner0, team0, [alice]) <- createTeam OwnDomain 2
+  (owner1, team1, _users1) <- createTeam OwnDomain 2
+
+  -- At the time of writing, it wasn't clear if this should be a bot instead.
+  bob <- randomUser OwnDomain def
+  addTeamCollaborator
+    owner1
+    team1
+    bob
+    ["implicit_connection"]
+    >>= assertSuccess
+
+  postOne2OneConversation bob alice team0 "chit-chat" >>= assertLabel 403 "no-team-member"

libs/wire-api/src/Wire/API/Team/Member.hs

@@ -631,7 +631,7 @@ collaboratorToTeamPermissions =
   foldMap
     ( \case
         Collaborator.CreateTeamConversation -> Set.fromList [CreateConversation, AddRemoveConvMember]
-        Collaborator.ImplicitConnection -> mempty
+        Collaborator.ImplicitConnection -> Set.singleton CreateConversation
     )
 
 ----------------------------------------------------------------------

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

@@ -490,7 +490,8 @@ createOne2OneConversation ::
     Member NotificationSubsystem r,
     Member Now r,
     Member TeamStore r,
-    Member P.TinyLog r
+    Member P.TinyLog r,
+    Member TeamCollaboratorsSubsystem r
   ) =>
   Local UserId ->
   ConnId ->
@@ -533,17 +534,20 @@ createOne2OneConversation lusr zcon j =
         Member (ErrorS 'NotATeamMember) r,
         Member (ErrorS OperationDenied) r,
         Member (ErrorS 'TeamNotFound) r,
+        Member TeamCollaboratorsSubsystem r,
         Member TeamStore r
       ) =>
       Local UserId ->
       TeamId ->
       Sem r (Maybe TeamId)
     checkBindingTeamPermissions lother tid = do
+      mTeamCollaborator <- internalGetTeamCollaborator tid (tUnqualified lusr)
       zusrMembership <- E.getTeamMember tid (tUnqualified lusr)
-      void $ permissionCheck CreateConversation zusrMembership
+      void $ permissionCheck CreateConversation $ (Left <$> zusrMembership) <|> (Right <$> mTeamCollaborator)
       E.getTeamBinding tid >>= \case
         Just Binding -> do
-          verifyMembership tid (tUnqualified lusr)
+          when (isJust zusrMembership) $
+            verifyMembership tid (tUnqualified lusr)
           verifyMembership tid (tUnqualified lother)
           pure (Just tid)
         Just _ -> throwS @'NonBindingTeam