[WPB-22549] connect users to apps.

changelog.d/5-internal/WPB-22549-apps-vs-convs

@@ -0,0 +1 @@
+Fix: create team members for apps in galley, not just brig users.

integration/test/Test/Apps.hs

@@ -21,6 +21,7 @@ module Test.Apps where
 
 import API.Brig
 import qualified API.BrigInternal as BrigI
+import API.Galley
 import SetupHelpers
 import Testlib.Prelude
 
@@ -105,8 +106,18 @@ testCreateApp = do
       foundUserType searcher exactMatchTerm aTypes =
         searchContacts searcher exactMatchTerm OwnDomain `bindResponse` \resp -> do
           resp.status `shouldMatchInt` 200
-          foundDoc <- resp.json %. "documents" >>= asList
-          (%. "type") `mapM` foundDoc `shouldMatch` aTypes
+          foundDocs :: [Value] <- resp.json %. "documents" >>= asList
+          docsInTeam :: [Value] <- do
+            -- make sure that matches from previous test runs don't get in the way.
+            catMaybes
+              <$> forM
+                foundDocs
+                ( \doc -> do
+                    tidActual <- doc %. "team" & asString
+                    pure $ if tidActual == tid then Just doc else Nothing
+                )
+
+          (%. "type") `mapM` docsInTeam `shouldMatch` aTypes
 
   -- App's user is findable from /search/contacts
   BrigI.refreshIndex domain
@@ -121,6 +132,14 @@ testCreateApp = do
   memberName <- regularMember %. "name" & asString
   foundUserType owner memberName ["regular"]
 
+  -- GET /one2one-conversations/{usr_domain}/{usr}
+  getMLSOne2OneConversation regularMember appIdObject `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 200
+
+  -- POST /mls/key-packages/claim/{user_domain}/{user}
+  claimKeyPackages def regularMember appIdObject `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 200
+
 testRefreshAppCookie :: (HasCallStack) => App ()
 testRefreshAppCookie = do
   (alice, tid, [bob]) <- createTeam OwnDomain 2

integration/test/Test/Connection.hs

@@ -17,6 +17,7 @@
 module Test.Connection where
 
 import API.Brig (getConnection, postConnection, putConnection)
+import qualified API.Brig as Brig
 import API.BrigInternal
 import API.Galley
 import Notifications
@@ -25,6 +26,32 @@ import Testlib.Prelude
 import Testlib.VersionedFed
 import UnliftIO.Async (forConcurrently_)
 
+testAppConnection :: (HasCallStack) => App ()
+testAppConnection = do
+  domain <- make OwnDomain
+  (owner, tid, [mem1, mem2]) <- createTeam domain 3
+
+  let newApp :: Brig.NewApp
+      newApp =
+        def
+          { Brig.name = "chappie",
+            Brig.description = "some description of this app",
+            Brig.category = "ai"
+          }
+  app <- bindResponse (Brig.createApp owner tid newApp) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "user"
+
+  -- Users from the same team are not supposed to connect to each other
+  postConnection mem1 mem2 `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 403
+    resp.json %. "label" `shouldMatch` "same-binding-team-users"
+
+  -- the same goes for apps from the same team
+  postConnection mem1 app `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 404
+    resp.json %. "label" `shouldMatch` "not-found"
+
 testConnectWithRemoteUser :: (HasCallStack) => OneOf Domain AnyFedDomain -> App ()
 testConnectWithRemoteUser owningDomain = do
   let otherDomain = case owningDomain of

integration/test/Test/Conversation.hs

@@ -31,13 +31,65 @@ import Control.Monad.Reader
 import qualified Data.Aeson as Aeson
 import qualified Data.Text as T
 import GHC.Stack
+import MLS.Util
 import Notifications
 import SetupHelpers hiding (deleteUser)
 import Testlib.One2One (generateRemoteAndConvIdWithDomain)
 import Testlib.Prelude
 import Testlib.ResourcePool
 import Testlib.VersionedFed
 
+testConversationWithAppOwnTeam :: (HasCallStack) => App ()
+testConversationWithAppOwnTeam = do
+  domain <- make OwnDomain
+  (owner, tid, [mem1, mem2]) <- createTeam domain 3
+
+  let newApp :: NewApp
+      newApp =
+        def
+          { name = "chappie",
+            description = "some description of this app",
+            category = "ai"
+          }
+  app <- bindResponse (createApp owner tid newApp) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "user"
+
+  -- proteus
+  do
+    conv <- postConversation mem1 defProteus >>= getJSON 201
+    addMembers mem1 conv (def {users = [mem2]}) >>= assertSuccess
+    addMembers mem1 conv (def {users = [app]}) >>= assertLabel 403 "access-denied" -- apps don't support proteus.
+
+  -- mls
+  [mem1c, mem2c, appc] <- traverse (createMLSClient def) [mem1, mem2, app]
+
+  -- mls 1:1
+  do
+    -- mem2c needs 2 key packages
+    traverse_ (uploadNewKeyPackage def) [mem1c, mem2c, mem2c, appc]
+
+    let runCheck :: (HasCallStack) => Value -> ClientIdentity -> Value -> App ()
+        runCheck from fromc to = do
+          conv <- getMLSOne2OneConversation from to >>= getJSON 200
+          convId <- objConvId $ conv %. "conversation"
+
+          createGroup def fromc convId
+          msg1 <- createAddCommit fromc convId [to]
+          void (sendAndConsumeCommitBundle msg1)
+
+          msg2 <- createApplicationMessage convId fromc "hi new guy!"
+          void (sendAndConsumeMessage msg2)
+
+    -- regular to regular
+    runCheck mem1 mem1c mem2
+
+    -- regular to app
+    runCheck mem1 mem1c app
+
+    -- app to regular
+    runCheck app appc mem2
+
 testFederatedConversation :: (HasCallStack) => App ()
 testFederatedConversation = do
   -- This test was created to verify that the false positive log message:

integration/test/Test/UserGroup.hs

@@ -62,7 +62,7 @@ testUserGroupSmoke = do
 
   bindResponse (getUserGroup owner gid) $ \resp -> do
     resp.status `shouldMatchInt` 200
-    resp.json %. "members" `shouldMatch` [mem1id, mem2id]
+    resp.json %. "members" `shouldMatchSet` [mem1id, mem2id]
 
   bindResponse (updateUserGroup owner badGid (object ["name" .= ""])) $ \resp -> do
     resp.status `shouldMatchInt` 400
@@ -93,7 +93,7 @@ testUserGroupSmoke = do
   bindResponse (getUserGroup owner gid) $ \resp -> do
     resp.status `shouldMatchInt` 200
     resp.json %. "name" `shouldMatch` "also good"
-    resp.json %. "members" `shouldMatch` [mem2id, mem3id, mem4id, mem5id]
+    resp.json %. "members" `shouldMatchSet` [mem2id, mem3id, mem4id, mem5id]
 
   bindResponse (getUserGroups owner def) $ \resp -> do
     resp.status `shouldMatchInt` 200
@@ -131,7 +131,7 @@ testUserGroupSmoke = do
 
     bindResponse (getUserGroup owner ug2Id) $ \resp -> do
       resp.status `shouldMatchInt` 200
-      resp.json %. "members" `shouldMatch` [mem1id]
+      resp.json %. "members" `shouldMatchSet` [mem1id]
 
     bindResponse (updateUserGroupUsers owner ug2Id [mem8id, mem9id]) $ \resp -> do
       resp.status `shouldMatchInt` 200
@@ -142,7 +142,7 @@ testUserGroupSmoke = do
 
     bindResponse (getUserGroup owner ug2Id) $ \resp -> do
       resp.status `shouldMatchInt` 200
-      resp.json %. "members" `shouldMatch` [mem8id, mem9id]
+      resp.json %. "members" `shouldMatchSet` [mem8id, mem9id]
 
     bindResponse (updateUserGroupUsers owner ug2Id []) $ \resp -> do
       resp.status `shouldMatchInt` 200
@@ -153,7 +153,7 @@ testUserGroupSmoke = do
 
     bindResponse (getUserGroup owner ug2Id) $ \resp -> do
       resp.status `shouldMatchInt` 200
-      resp.json %. "members" `shouldMatch` ([] :: [()])
+      resp.json %. "members" `shouldMatchSet` ([] :: [()])
 
 testUserGroupAddGroupDenied :: (HasCallStack) => App ()
 testUserGroupAddGroupDenied = do

libs/wire-api/src/Wire/API/User/Activation.hs

@@ -168,6 +168,10 @@ instance ToSchema Activate where
 -- | Information returned as part of a successful activation.
 data ActivationResponse = ActivationResponse
   { -- | The activated / verified user identity.
+    --
+    -- FUTUREWORK(fisx): this is from the times when UserIdentity was
+    -- user or phone.  since SSO has been added to the type, we should
+    -- either use a different type here or change UserIdentity back.
     activatedIdentity :: UserIdentity,
     -- | Whether this is the first verified identity of the account.
     activatedFirst :: Bool

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

@@ -19,6 +19,7 @@ module Wire.AppSubsystem.Interpreter where
 
 import Data.ByteString.Conversion
 import Data.Id
+import Data.Json.Util
 import Data.Map qualified as Map
 import Data.Qualified
 import Data.RetryAfter
@@ -35,6 +36,7 @@ import System.Logger.Message qualified as Log
 import Wire.API.App qualified as Apps
 import Wire.API.Event.Team
 import Wire.API.Team.Member qualified as T
+import Wire.API.Team.Role qualified as R
 import Wire.API.User
 import Wire.API.User.Auth
 import Wire.AppStore (AppStore, StoredApp (..))
@@ -116,6 +118,8 @@ createAppImpl lusr tid (Apps.NewApp new password6) = do
   -- create app and user entries
   Store.createApp app
   Store.createUser u Nothing
+  now <- toUTCTimeMillis <$> get
+  void $ addTeamMember u.id tid (Just (tUnqualified lusr, now)) R.RoleMember
   internalUpdateSearchIndex u.id
 
   -- generate a team event

services/brig/src/Brig/API/MLS/KeyPackages.hs

@@ -139,6 +139,7 @@ claimLocalKeyPackages qusr skipOwn suite target = do
         uncurry (KeyPackageBundleEntry (tUntagged target) c)
           <$> wrapClientM (Data.claimKeyPackage target c suite)
 
+    -- FUTUREWORK: shouldn't this be defined elsewhere for general use?
     assertUserNotUnderLegalHold :: ExceptT ClientError (AppT r) ()
     assertUserNotUnderLegalHold = do
       -- this is okay because there can only be one StoredUser per UserId

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

@@ -452,6 +452,9 @@ createUser rateLimitKey new = do
       User ->
       StoredInvitation ->
       EmailKey ->
+      -- if you are surprised because apps don't even have a
+      -- UserIdentity: we're in createUser here, so apps are not in
+      -- the picture.
       UserIdentity ->
       ExceptT RegisterError (AppT r) ()
     acceptInvitationToTeam account inv uk ident = do
@@ -478,7 +481,14 @@ createUser rateLimitKey new = do
           UserPendingActivationStore.remove uid
           InvitationStore.deleteInvitation inv.teamId inv.invitationId
 
-    addUserToTeamSSO :: User -> TeamId -> UserIdentity -> ExceptT RegisterError (AppT r) CreateUserTeam
+    addUserToTeamSSO ::
+      User ->
+      TeamId ->
+      -- if you are surprised because apps don't even have a
+      -- UserIdentity: we're in createUser here, so apps are not in
+      -- the picture
+      UserIdentity ->
+      ExceptT RegisterError (AppT r) CreateUserTeam
     addUserToTeamSSO account tid ident = do
       let uid = userId account
       added <- lift $ liftSem $ GalleyAPIAccess.addTeamMember uid tid Nothing defaultRole
@@ -746,6 +756,8 @@ onActivated (AccountActivated account) = liftSem $ do
   Log.info $ field "user" (toByteString uid) . msg (val "User activated")
   User.internalUpdateSearchIndex uid
   Events.generateUserEvent uid Nothing $ UserActivated account
+  -- userIdentity is always Just at the time of writing this comment,
+  -- since account has been activated already.
   pure (uid, userIdentity account, True)
 onActivated (EmailActivated uid email) = liftSem $ do
   User.internalUpdateSearchIndex uid

services/brig/src/Brig/User/Auth.hs

@@ -354,6 +354,9 @@ validateLoginId :: LoginId -> Either EmailKey Handle
 validateLoginId (LoginByEmail email) = (Left . mkEmailKey) email
 validateLoginId (LoginByHandle h) = Right h
 
+-- Has a user been activated so they can login?  (This does not apply
+-- to apps, because they do not login, they already have their
+-- cookie.)
 isPendingActivation ::
   forall r.
   ( Member UserSubsystem r,

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

@@ -91,7 +91,7 @@ import Wire.TeamStore
 import Wire.TeamSubsystem (TeamSubsystem)
 import Wire.TeamSubsystem qualified as TeamSubsystem
 
-data UserType = User | Bot
+data UserType = User | Bot -- FUTUREWORK: there is UserType in Wire.API.User now, should we use that?  (there is also UserType variant for searcho/contacts, but there is a good reason for that one.)
 
 userToProtectee :: UserType -> UserId -> LegalholdProtectee
 userToProtectee User user = ProtectedUser user