[WPB-10708] personal account to own team (#4251)

* Add endpoint to upgrade a personal user to a team

* Test upgrading personal user to team

* Add CHANGELOG entry

---------

Co-authored-by: Paolo Capriotti <[email protected]>

changelog.d/1-api-changes/wpb-10708

@@ -0,0 +1 @@
+Add endpoint to upgrade a personal user to a team owner

integration/test/API/Brig.hs

@@ -815,3 +815,8 @@ updateEmail :: (HasCallStack, MakesValue user) => user -> String -> String -> St
 updateEmail user email cookie token = do
   req <- baseRequest user Brig Versioned $ joinHttpPath ["access", "self", "email"]
   submit "PUT" $ req & addJSONObject ["email" .= email] & setCookie cookie & addHeader "Authorization" ("Bearer " <> token)
+
+upgradePersonalToTeam :: (HasCallStack, MakesValue user) => user -> String -> App Response
+upgradePersonalToTeam user name = do
+  req <- baseRequest user Brig Versioned $ joinHttpPath ["upgrade-personal-to-team"]
+  submit "POST" $ req & addJSONObject ["name" .= name, "icon" .= "default"]

integration/test/API/Galley.hs

@@ -519,6 +519,12 @@ updateMessageTimer user qcnv update = do
   req <- baseRequest user Galley Versioned path
   submit "PUT" (addJSONObject ["message_timer" .= updateReq] req)
 
+getTeam :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> App Response
+getTeam user tid = do
+  tidStr <- asString tid
+  req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr])
+  submit "GET" req
+
 getTeamMembers :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> App Response
 getTeamMembers user tid = do
   tidStr <- asString tid

integration/test/Test/Teams.hs

@@ -20,7 +20,7 @@ module Test.Teams where
 import API.Brig
 import API.BrigInternal (createUser, getInvitationCode, refreshIndex)
 import API.Common
-import API.Galley (getTeamMembers)
+import API.Galley (getTeam, getTeamMembers)
 import API.GalleyInternal (setTeamFeatureStatus)
 import Control.Monad.Codensity (Codensity (runCodensity))
 import Control.Monad.Extra (findM)
@@ -172,3 +172,33 @@ testTeamUserCannotBeInvited = do
   (owner2, _, _) <- createTeam OwnDomain 0
   email <- tm %. "email" >>= asString
   postInvitation owner2 (PostInvitation (Just email) Nothing) >>= assertStatus 409
+
+testUpgradePersonalToTeam :: (HasCallStack) => App ()
+testUpgradePersonalToTeam = do
+  alice <- randomUser OwnDomain def
+  let teamName = "wonderland"
+  tid <- bindResponse (upgradePersonalToTeam alice teamName) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "team_name" `shouldMatch` teamName
+    resp.json %. "team_id"
+
+  alice' <- getUser alice alice >>= getJSON 200
+  alice' %. "team" `shouldMatch` tid
+
+  team <- getTeam alice tid >>= getJSON 200
+  team %. "name" `shouldMatch` teamName
+
+  bindResponse (getTeamMembers alice tid) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    owner <- asList (resp.json %. "members") >>= assertOne
+    owner %. "user" `shouldMatch` (alice %. "id")
+    shouldBeNull $ owner %. "created_at"
+    shouldBeNull $ owner %. "created_by"
+
+testUpgradePersonalToTeamAlreadyInATeam :: (HasCallStack) => App ()
+testUpgradePersonalToTeamAlreadyInATeam = do
+  (alice, _, _) <- createTeam OwnDomain 0
+
+  bindResponse (upgradePersonalToTeam alice "wonderland") $ \resp -> do
+    resp.status `shouldMatchInt` 403
+    resp.json %. "label" `shouldMatch` "user-already-in-a-team"

integration/test/Testlib/Assertions.hs

@@ -206,6 +206,9 @@ shouldMatchSet a b = do
 shouldBeEmpty :: (MakesValue a, HasCallStack) => a -> App ()
 shouldBeEmpty a = a `shouldMatch` (mempty :: [Value])
 
+shouldBeNull :: (MakesValue a, HasCallStack) => a -> App ()
+shouldBeNull a = a `shouldMatch` Aeson.Null
+
 shouldMatchOneOf ::
   (MakesValue a, MakesValue b, HasCallStack) =>
   a ->

libs/wire-api/src/Wire/API/Error/Brig.hs

@@ -99,6 +99,7 @@ data BrigError
   | TooManyProperties
   | PropertyKeyTooLarge
   | PropertyValueTooLarge
+  | UserAlreadyInATeam
 
 instance (Typeable (MapError e), KnownError (MapError e)) => IsSwaggerError (e :: BrigError) where
   addToOpenApi = addStaticErrorToSwagger @(MapError e)
@@ -295,3 +296,5 @@ type instance MapError 'TooManyProperties = 'StaticError 403 "too-many-propertie
 type instance MapError 'PropertyKeyTooLarge = 'StaticError 403 "property-key-too-large" "The property key is too large."
 
 type instance MapError 'PropertyValueTooLarge = 'StaticError 403 "property-value-too-large" "The property value is too large"
+
+type instance MapError 'UserAlreadyInATeam = 'StaticError 403 "user-already-in-a-team" "Switching teams is not allowed"

libs/wire-api/src/Wire/API/Routes/Public/Brig.hs

@@ -471,23 +471,36 @@ type UserHandleAPI =
            )
 
 type AccountAPI =
-  -- docs/reference/user/registration.md {#RefRegistration}
-  --
-  -- This endpoint can lead to the following events being sent:
-  -- - UserActivated event to created user, if it is a team invitation or user has an SSO ID
-  -- - UserIdentityUpdated event to created user, if email code or phone code is provided
   Named
-    "register"
-    ( Summary "Register a new user."
-        :> Description
-             "If the environment where the registration takes \
-             \place is private and a registered email address \
-             \is not whitelisted, a 403 error is returned."
-        :> MakesFederatedCall 'Brig "send-connection-action"
-        :> "register"
-        :> ReqBody '[JSON] NewUserPublic
-        :> MultiVerb 'POST '[JSON] RegisterResponses (Either RegisterError RegisterSuccess)
+    "upgrade-personal-to-team"
+    ( Summary "Upgrade personal user to team owner"
+        :> "upgrade-personal-to-team"
+        :> ZLocalUser
+        :> ReqBody '[JSON] BindingNewTeamUser
+        :> MultiVerb
+             'POST
+             '[JSON]
+             UpgradePersonalToTeamResponses
+             (Either UpgradePersonalToTeamError CreateUserTeam)
     )
+    :<|>
+    -- docs/reference/user/registration.md {#RefRegistration}
+    --
+    -- This endpoint can lead to the following events being sent:
+    -- - UserActivated event to created user, if it is a team invitation or user has an SSO ID
+    -- - UserIdentityUpdated event to created user, if email code or phone code is provided
+    Named
+      "register"
+      ( Summary "Register a new user."
+          :> Description
+               "If the environment where the registration takes \
+               \place is private and a registered email address \
+               \is not whitelisted, a 403 error is returned."
+          :> MakesFederatedCall 'Brig "send-connection-action"
+          :> "register"
+          :> ReqBody '[JSON] NewUserPublic
+          :> MultiVerb 'POST '[JSON] RegisterResponses (Either RegisterError RegisterSuccess)
+      )
     -- This endpoint can lead to the following events being sent:
     -- UserDeleted event to contacts of deleted user
     -- MemberLeave event to members for all conversations the user was in (via galley)

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

@@ -46,6 +46,11 @@ module Wire.API.User
     mkUserProfileWithEmail,
     userObjectSchema,
 
+    -- * UpgradePersonalToTeam
+    CreateUserTeam (..),
+    UpgradePersonalToTeamResponses,
+    UpgradePersonalToTeamError (..),
+
     -- * NewUser
     NewUserPublic (..),
     RegisterError (..),
@@ -772,6 +777,41 @@ isNewUserTeamMember u = case newUserTeam u of
 instance Arbitrary NewUserPublic where
   arbitrary = arbitrary `QC.suchThatMap` (rightMay . validateNewUserPublic)
 
+data CreateUserTeam = CreateUserTeam
+  { createdTeamId :: !TeamId,
+    createdTeamName :: !Text
+  }
+  deriving (Show)
+  deriving (FromJSON, ToJSON, S.ToSchema) via Schema CreateUserTeam
+
+instance ToSchema CreateUserTeam where
+  schema =
+    object "CreateUserTeam" $
+      CreateUserTeam
+        <$> createdTeamId .= field "team_id" schema
+        <*> createdTeamName .= field "team_name" schema
+
+data UpgradePersonalToTeamError = UpgradePersonalToTeamErrorAlreadyInATeam
+  deriving (Show)
+
+type UpgradePersonalToTeamResponses =
+  '[ ErrorResponse UserAlreadyInATeam,
+     Respond 200 "Team created" CreateUserTeam
+   ]
+
+instance
+  AsUnion
+    UpgradePersonalToTeamResponses
+    (Either UpgradePersonalToTeamError CreateUserTeam)
+  where
+  toUnion (Left UpgradePersonalToTeamErrorAlreadyInATeam) =
+    Z (I (dynError @(MapError UserAlreadyInATeam)))
+  toUnion (Right x) = S (Z (I x))
+
+  fromUnion (Z (I _)) = Left UpgradePersonalToTeamErrorAlreadyInATeam
+  fromUnion (S (Z (I x))) = Right x
+  fromUnion (S (S x)) = case x of {}
+
 data RegisterError
   = RegisterErrorAllowlistError
   | RegisterErrorInvalidInvitationCode

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

@@ -41,6 +41,7 @@ import Brig.Calling.API qualified as Calling
 import Brig.Data.Connection qualified as Data
 import Brig.Data.Nonce as Nonce
 import Brig.Data.User qualified as Data
+import Brig.Effects.ConnectionStore
 import Brig.Effects.JwtTools (JwtTools)
 import Brig.Effects.PublicKeyBundle (PublicKeyBundle)
 import Brig.Effects.SFT
@@ -82,6 +83,7 @@ import Data.Qualified
 import Data.Range
 import Data.Schema ()
 import Data.Text.Encoding qualified as Text
+import Data.Time.Clock
 import Data.ZAuth.Token qualified as ZAuth
 import FileEmbedLzma
 import Imports hiding (head)
@@ -161,6 +163,7 @@ import Wire.PropertySubsystem
 import Wire.Sem.Concurrency
 import Wire.Sem.Jwk (Jwk)
 import Wire.Sem.Now (Now)
+import Wire.Sem.Paging.Cassandra
 import Wire.UserKeyStore
 import Wire.UserSearch.Types
 import Wire.UserStore (UserStore)
@@ -267,10 +270,10 @@ servantSitemap ::
     Member (Embed IO) r,
     Member (Error UserSubsystemError) r,
     Member (Input (Local ())) r,
+    Member (Input UTCTime) r,
     Member (Input TeamTemplates) r,
     Member (UserPendingActivationStore p) r,
     Member AuthenticationSubsystem r,
-    Member BlockListStore r,
     Member DeleteQueue r,
     Member EmailSending r,
     Member EmailSubsystem r,
@@ -292,7 +295,9 @@ servantSitemap ::
     Member UserStore r,
     Member UserSubsystem r,
     Member VerificationCodeSubsystem r,
-    Member (Concurrency 'Unsafe) r
+    Member (Concurrency 'Unsafe) r,
+    Member BlockListStore r,
+    Member (ConnectionStore InternalPaging) r
   ) =>
   ServerT BrigAPI (Handler r)
 servantSitemap =
@@ -346,7 +351,8 @@ servantSitemap =
 
     accountAPI :: ServerT AccountAPI (Handler r)
     accountAPI =
-      Named @"register" (callsFed (exposeAnnotations createUser))
+      Named @"upgrade-personal-to-team" upgradePersonalToTeam
+        :<|> Named @"register" (callsFed (exposeAnnotations createUser))
         :<|> Named @"verify-delete" (callsFed (exposeAnnotations verifyDeleteUser))
         :<|> Named @"get-activate" (callsFed (exposeAnnotations activate))
         :<|> Named @"post-activate" (callsFed (exposeAnnotations activateKey))
@@ -696,6 +702,23 @@ createAccessToken method luid cid proof = do
   let link = safeLink (Proxy @api) (Proxy @endpoint) cid
   API.createAccessToken luid cid method link proof !>> certEnrollmentError
 
+upgradePersonalToTeam ::
+  ( Member (ConnectionStore InternalPaging) r,
+    Member (Embed HttpClientIO) r,
+    Member GalleyAPIAccess r,
+    Member (Input (Local ())) r,
+    Member (Input UTCTime) r,
+    Member NotificationSubsystem r,
+    Member TinyLog r,
+    Member UserSubsystem r
+  ) =>
+  Local UserId ->
+  Public.BindingNewTeamUser ->
+  Handler r (Either Public.UpgradePersonalToTeamError Public.CreateUserTeam)
+upgradePersonalToTeam luid bNewTeam =
+  lift . runExceptT $
+    API.upgradePersonalToTeam luid bNewTeam
+
 -- | docs/reference/user/registration.md {#RefRegistration}
 createUser ::
   ( Member BlockListStore r,
@@ -768,9 +791,9 @@ createUser (Public.NewUserPublic new) = lift . runExceptT $ do
       | otherwise =
           liftSem $ sendActivationMail email name key code locale
 
-    sendWelcomeEmail :: (Member EmailSending r) => Public.EmailAddress -> CreateUserTeam -> Public.NewTeamUser -> Maybe Public.Locale -> (AppT r) ()
+    sendWelcomeEmail :: (Member EmailSending r) => Public.EmailAddress -> Public.CreateUserTeam -> Public.NewTeamUser -> Maybe Public.Locale -> (AppT r) ()
     -- NOTE: Welcome e-mails for the team creator are not dealt by brig anymore
-    sendWelcomeEmail e (CreateUserTeam t n) newUser l = case newUser of
+    sendWelcomeEmail e (Public.CreateUserTeam t n) newUser l = case newUser of
       Public.NewTeamCreator _ ->
         pure ()
       Public.NewTeamMember _ ->

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

@@ -58,12 +58,6 @@ data CreateUserResult = CreateUserResult
   }
   deriving (Show)
 
-data CreateUserTeam = CreateUserTeam
-  { createdTeamId :: !TeamId,
-    createdTeamName :: !Text
-  }
-  deriving (Show)
-
 data ActivationResult
   = -- | The key/code was valid and successfully activated.
     ActivationSuccess !(Maybe UserIdentity) !Bool

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

@@ -20,6 +20,7 @@
 -- TODO: Move to Brig.User.Account
 module Brig.API.User
   ( -- * User Accounts / Profiles
+    upgradePersonalToTeam,
     createUser,
     createUserSpar,
     createUserInviteViaScim,
@@ -81,6 +82,7 @@ import Brig.Data.Connection (countConnections)
 import Brig.Data.Connection qualified as Data
 import Brig.Data.User
 import Brig.Data.User qualified as Data
+import Brig.Effects.ConnectionStore
 import Brig.Effects.UserPendingActivationStore (UserPendingActivation (..), UserPendingActivationStore)
 import Brig.Effects.UserPendingActivationStore qualified as UserPendingActivationStore
 import Brig.IO.Intra qualified as Intra
@@ -106,7 +108,7 @@ import Data.List1 as List1 (List1, singleton)
 import Data.Misc
 import Data.Qualified
 import Data.Range
-import Data.Time.Clock (addUTCTime)
+import Data.Time.Clock
 import Data.UUID.V4 (nextRandom)
 import Imports
 import Network.Wai.Utilities
@@ -146,6 +148,7 @@ import Wire.PasswordResetCodeStore (PasswordResetCodeStore)
 import Wire.PasswordStore (PasswordStore, lookupHashedPassword, upsertHashedPassword)
 import Wire.PropertySubsystem as PropertySubsystem
 import Wire.Sem.Concurrency
+import Wire.Sem.Paging.Cassandra
 import Wire.UserKeyStore
 import Wire.UserStore
 import Wire.UserSubsystem as User
@@ -253,6 +256,43 @@ createUserSpar new = do
       Team.TeamName nm <- lift $ liftSem $ GalleyAPIAccess.getTeamName tid
       pure $ CreateUserTeam tid nm
 
+upgradePersonalToTeam ::
+  forall r.
+  ( Member GalleyAPIAccess r,
+    Member UserSubsystem r,
+    Member TinyLog r,
+    Member (Embed HttpClientIO) r,
+    Member NotificationSubsystem r,
+    Member (Input (Local ())) r,
+    Member (Input UTCTime) r,
+    Member (ConnectionStore InternalPaging) r
+  ) =>
+  Local UserId ->
+  BindingNewTeamUser ->
+  ExceptT UpgradePersonalToTeamError (AppT r) CreateUserTeam
+upgradePersonalToTeam luid bNewTeam = do
+  -- check that the user is not part of a team
+  mSelfProfile <- lift $ liftSem $ getSelfProfile luid
+  let mTid = mSelfProfile >>= userTeam . selfUser
+  when (isJust mTid) $
+    throwE UpgradePersonalToTeamErrorAlreadyInATeam
+
+  lift $ do
+    -- generate team ID
+    tid <- randomId
+
+    let uid = tUnqualified luid
+    createUserTeam <- do
+      liftSem $ GalleyAPIAccess.createTeam uid (bnuTeam bNewTeam) tid
+      let BindingNewTeam newTeam = bNewTeam.bnuTeam
+      pure $ CreateUserTeam tid (fromRange (newTeam ^. newTeamName))
+
+    wrapClient $ updateUserTeam uid tid
+    liftSem $ Intra.sendUserEvent uid Nothing (teamUpdated uid tid)
+    initAccountFeatureConfig uid
+
+    pure $! createUserTeam
+
 -- docs/reference/user/registration.md {#RefRegistration}
 createUser ::
   forall r p.