[WPB-22549] connect users to apps.

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,29 @@ import Testlib.Prelude
 import Testlib.VersionedFed
 import UnliftIO.Async (forConcurrently_)
 
+-- TODO: move this to a better location?
+-- TODO: brig probably shouldn't be so loud in this test?  `[brig@example.com] E, IO Exception occurred, message=Error {code = Status {statusCode = 404, statusMessage = "Not Found"}, label = "not-found", message = "User not found", errorData = Nothing, innerError = Nothing} HasCallStack backtrace:   collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:169:13 in ghc-internal:GHC.Internal.Exception   toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO   throwIO, called at libraries/exceptions/src/Control/Monad/Catch.hs:308:12 in exceptions-0.10.9-46ff:Control.Monad.Catch   throwM, called at src/Brig/App.hs:502:21 in brig-2.0-inplace:Brig.App   throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:614:19 in exceptions-0.10.9-46ff:Control.Monad.Catch   throwM, called at src/Brig/API/Connection.hs:213:16 in brig-2.0-inplace:Brig.API.Connection  , request=ebae05b9-b856-459b-b64f-f12d5a107823`
+testAppConnection :: (HasCallStack) => App ()
+testAppConnection = do
+  domain <- make OwnDomain
+  (owner, tid, [mem1]) <- createTeam domain 2
+  let newApp :: Brig.NewApp
+      newApp =
+        def
+          { Brig.name = "chappie",
+            Brig.description = "some description of this app",
+            Brig.category = "ai"
+          }
+  (app, _cookie) <- bindResponse (Brig.createApp owner tid newApp) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    app <- resp.json %. "user"
+    cookie <- resp.json %. "cookie" & asString
+    pure (app, cookie)
+  appId <- app %. "qualified_id"
+
+  postConnection mem1 appId `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 404
+
 testConnectWithRemoteUser :: (HasCallStack) => OneOf Domain AnyFedDomain -> App ()
 testConnectWithRemoteUser owningDomain = do
   let otherDomain = case owningDomain of

integration/test/Test/Conversation.hs

@@ -31,13 +31,61 @@ 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
 
+testConversationWithApp :: (HasCallStack) => App ()
+testConversationWithApp = 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
+  do
+    [mem1c, mem2c, appc] <- traverse (createMLSClient def) [mem1, mem2, app]
+    traverse_ (uploadNewKeyPackage def) [mem1c, mem2c, appc]
+
+    let runCheck :: (HasCallStack) => Value -> ClientIdentity -> Value -> App ()
+        runCheck from fromc to = do
+          conv <- postConversation from defMLS {team = Just tid} >>= getJSON 201
+          convId <- objConvId conv
+
+          createGroup def fromc convId
+          msg1 <- createAddCommit fromc convId [to]
+          void (sendAndConsumeCommitBundle msg1)
+
+          msg2 <- createApplicationMessage convId fromc "hi new guy!"
+          void (sendAndConsumeMessage msg2)
+
+    -- regular to app
+    runCheck mem1 mem1c app
+
+    -- app to regular
+    runCheck app appc mem2
+
+    -- regular to regular
+    runCheck mem1 mem1c mem2
+
 testFederatedConversation :: (HasCallStack) => App ()
 testFederatedConversation = do
   -- This test was created to verify that the false positive log message:

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

@@ -54,6 +54,7 @@ import Data.Aeson qualified as A
 import Data.Aeson.Types qualified as A
 import Data.ByteString (fromStrict, toStrict)
 import Data.ByteString.UTF8 qualified as UTF8
+import Data.Id
 import Data.OpenApi qualified as S
 import Data.Schema
 import Data.Text qualified as Text
@@ -84,6 +85,7 @@ import Wire.Arbitrary (Arbitrary, GenericUniform (..))
 data UserIdentity
   = EmailIdentity EmailAddress
   | SSOIdentity UserSSOId (Maybe EmailAddress)
+  | AppIdentity UserId
   deriving stock (Eq, Ord, Show, Generic)
   deriving (Arbitrary) via (GenericUniform UserIdentity)
 
@@ -117,6 +119,7 @@ maybeUserIdentityToComponents :: Maybe UserIdentity -> UserIdentityComponents
 maybeUserIdentityToComponents Nothing = (Nothing, Nothing)
 maybeUserIdentityToComponents (Just (EmailIdentity email)) = (Just email, Nothing)
 maybeUserIdentityToComponents (Just (SSOIdentity ssoid m_email)) = (m_email, Just ssoid)
+maybeUserIdentityToComponents (Just (AppIdentity uid)) = (Nothing, Nothing)
 
 newIdentity :: Maybe EmailAddress -> Maybe UserSSOId -> Maybe UserIdentity
 newIdentity email (Just sso) = Just $! SSOIdentity sso email
@@ -127,6 +130,7 @@ emailIdentity :: UserIdentity -> Maybe EmailAddress
 emailIdentity (EmailIdentity email) = Just email
 emailIdentity (SSOIdentity _ (Just email)) = Just email
 emailIdentity (SSOIdentity _ _) = Nothing
+emailIdentity (AppIdentity _) = Nothing
 
 ssoIdentity :: UserIdentity -> Maybe UserSSOId
 ssoIdentity (SSOIdentity ssoid _) = Just ssoid

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/User/Auth.hs

@@ -387,6 +387,7 @@ isPendingActivation ident = case ident of
        in statusAdmitsPending && case i of
             Just (EmailIdentity e) -> mkEmailKey e /= k
             Just SSOIdentity {} -> False -- sso-created users are activated immediately.
+            Just AppIdentity {} -> False -- apps are activated immediately.
             Nothing -> True
 
 -- | Validate a list of (User/LH) tokens potentially with an associated access token.

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

@@ -86,6 +86,7 @@ import Polysemy.Input
 import Polysemy.Resource
 import Polysemy.TinyLog
 import Polysemy.TinyLog qualified as P
+import System.IO.Unsafe (unsafePerformIO)
 import System.Logger qualified as Log
 import Wire.API.Connection (Relation (Accepted))
 import Wire.API.Conversation hiding (Conversation, Member)
@@ -674,11 +675,33 @@ performConversationJoin qusr lconv (ConversationJoin invited role joinType) = do
       [UserId] ->
       Sem r ()
     checkLocals lusr (Just tid) newUsers = do
+      unsafePerformIO
+        ( do
+            appendFile "/tmp/x" "\n>>>>>>>>>>>>>>> checkLocals [in]\n"
+        )
+        `seq` pure ()
+
       tms <-
         Map.fromList . map (view Wire.API.Team.Member.userId &&& Imports.id)
           <$> TeamSubsystem.internalSelectTeamMembers tid newUsers
       let userMembershipMap = map (Imports.id &&& flip Map.lookup tms) newUsers
+      unsafePerformIO
+        ( do
+            appendFile "/tmp/x" "\n>>>>>>>>>>>>>>> checkLocals [1]\n"
+            appendFile "/tmp/x" $ show userMembershipMap <> "\n\n"
+            -- conv has [TeamMemberAccessRole, NonTeamMemberAccessRole, ServiceAccessRole]
+            -- what do apps have?
+            -- do we need to add AppAccessRole, or should we reuse ServiceAccessRole?
+        )
+        `seq` pure ()
+
       ensureAccessRole (convAccessRoles conv) userMembershipMap
+      unsafePerformIO
+        ( do
+            appendFile "/tmp/x" "\n>>>>>>>>>>>>>>> checkLocals [2]\n"
+        )
+        `seq` pure ()
+
       ensureConnectedToLocalsOrSameTeam lusr newUsers
     checkLocals lusr Nothing newUsers = do
       ensureAccessRole (convAccessRoles conv) (map (,Nothing) newUsers)

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

@@ -54,6 +54,7 @@ import Polysemy
 import Polysemy.Error
 import Polysemy.Input
 import Polysemy.TinyLog qualified as P
+import System.IO.Unsafe
 import Wire.API.Connection
 import Wire.API.Conversation hiding (Member, cnvAccess, cnvAccessRoles, cnvName, cnvType)
 import Wire.API.Conversation qualified as Public
@@ -121,11 +122,27 @@ ensureAccessRole roles users = do
     when (any (isNothing . snd) users) $
       throwS @'NotATeamMember
   unless (Set.fromList [GuestAccessRole, ServiceAccessRole] `Set.isSubsetOf` roles) $ do
-    activated <- lookupActivatedUsers (fst <$> users)
+    activated <- lookupActivatedUsers (fst <$> users) -- this doesn't find the app
     let guestsExist = length activated /= length users
+    unsafePerformIO
+      ( do
+          appendFile "/tmp/x" "\n>>>>>>>>>>>>>>> ensureAccessRole [3] REACHED\n"
+          appendFile "/tmp/x" $ show (guestsExist, activated, users)
+      )
+      `seq` pure ()
     unless (not guestsExist || GuestAccessRole `Set.member` roles) $ throwS @'ConvAccessDenied
+    unsafePerformIO
+      ( do
+          appendFile "/tmp/x" "\n>>>>>>>>>>>>>>> ensureAccessRole [4] NOT REACHED\n"
+      )
+      `seq` pure ()
     let botsExist = any (isJust . userService) activated
     unless (not botsExist || ServiceAccessRole `Set.member` roles) $ throwS @'ConvAccessDenied
+    unsafePerformIO
+      ( do
+          appendFile "/tmp/x" "\n>>>>>>>>>>>>>>> ensureAccessRole [5]\n"
+      )
+      `seq` pure ()
 
 -- | Check that the given user is either part of the same team as the other
 -- users OR that there is a connection.