From b11cdf034174e9b246a275543d200be0ca444ba8 Mon Sep 17 00:00:00 2001 From: jschaul Date: Thu, 5 Oct 2017 16:37:58 +0200 Subject: [PATCH] Activate team on account activation only Add Pending state to Teams, which is their initial state. Upon the first user account activation, teams also become active. --- .../src/Galley/Types/Teams/Intra.hs | 4 ++++ services/brig/src/Brig/API/User.hs | 8 +++++++ services/brig/src/Brig/IO/Intra.hs | 13 +++++++++++ services/brig/test/integration/API/Team.hs | 20 ++++++++++++++++- services/galley/src/Galley/API.hs | 3 +++ services/galley/src/Galley/API/Teams.hs | 22 ++++++++++++++----- services/galley/src/Galley/Data.hs | 5 ++++- services/galley/src/Galley/Data/Instances.hs | 3 +++ services/galley/test/integration/API/Teams.hs | 6 ++--- services/galley/test/integration/API/Util.hs | 12 ++++++++-- 10 files changed, 83 insertions(+), 13 deletions(-) diff --git a/libs/galley-types/src/Galley/Types/Teams/Intra.hs b/libs/galley-types/src/Galley/Types/Teams/Intra.hs index c65f2cfda3..4da7b2f3f5 100644 --- a/libs/galley-types/src/Galley/Types/Teams/Intra.hs +++ b/libs/galley-types/src/Galley/Types/Teams/Intra.hs @@ -13,6 +13,7 @@ data TeamStatus | PendingDelete | Deleted | Suspended + | PendingActive deriving (Eq, Show) instance ToJSON TeamStatus where @@ -20,12 +21,14 @@ instance ToJSON TeamStatus where toJSON PendingDelete = String "pending_delete" toJSON Deleted = String "deleted" toJSON Suspended = String "suspended" + toJSON PendingActive = String "pending_active" instance FromJSON TeamStatus where parseJSON (String "active") = pure Active parseJSON (String "pending_delete") = pure PendingDelete parseJSON (String "deleted") = pure Deleted parseJSON (String "suspended") = pure Suspended + parseJSON (String "pending_active") = pure PendingActive parseJSON other = fail $ "Unknown TeamStatus: " <> show other data TeamData = TeamData @@ -56,3 +59,4 @@ instance FromJSON TeamStatusUpdate where instance ToJSON TeamStatusUpdate where toJSON s = object ["status" .= tuStatus s] + diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index e180368b55..cbc11aab07 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -111,6 +111,7 @@ import qualified Brig.Types.Team.Invitation as Team import qualified Brig.Team.DB as Team import qualified Data.Map.Strict as Map import qualified Galley.Types.Teams as Team +import qualified Galley.Types.Teams.Intra as Team import qualified System.Logger.Class as Log ------------------------------------------------------------------------------- @@ -469,6 +470,7 @@ onActivated (AccountActivated account) = do let uid = userId (accountUser account) Log.info $ field "user" (toByteString uid) . msg (val "User activated") Intra.onUserEvent uid Nothing $ UserActivated account + activateTeam uid return (userIdentity (accountUser account), True) onActivated (EmailActivated uid email) = do Intra.onUserEvent uid Nothing (emailUpdated uid email) @@ -477,6 +479,11 @@ onActivated (PhoneActivated uid phone) = do Intra.onUserEvent uid Nothing (phoneUpdated uid phone) return (Just (PhoneIdentity phone), False) +activateTeam :: UserId -> AppIO () +activateTeam uid = do + tid <- Intra.getTeamId uid + for_ tid $ flip Intra.changeTeamStatus Team.Active + sendActivationCode :: Either Email Phone -> Maybe Locale -> Bool -> ExceptT SendActivationCodeError AppIO () sendActivationCode emailOrPhone loc call = case emailOrPhone of Left email -> do @@ -774,3 +781,4 @@ fetchUserIdentity :: UserId -> AppIO (Maybe UserIdentity) fetchUserIdentity uid = lookupSelfProfile uid >>= maybe (throwM $ UserProfileNotFound uid) (return . userIdentity . selfUser) + diff --git a/services/brig/src/Brig/IO/Intra.hs b/services/brig/src/Brig/IO/Intra.hs index 66d3991762..2922972073 100644 --- a/services/brig/src/Brig/IO/Intra.hs +++ b/services/brig/src/Brig/IO/Intra.hs @@ -36,6 +36,7 @@ module Brig.IO.Intra , getTeamMember , getTeamMembers , getTeam + , getTeamId , getTeamContacts , changeTeamStatus ) where @@ -564,6 +565,17 @@ getTeamContacts u = do req = paths ["i", "users", toByteString' u, "team", "members"] . expect [status200, status404] +getTeamId :: UserId -> AppIO (Maybe TeamId) +getTeamId u = do + debug $ remote "galley" . msg (val "Get team from user") + rs <- galleyRequest GET req + case Bilge.statusCode rs of + 200 -> Just <$> decodeBody "galley" rs + _ -> return Nothing + where + req = paths ["i", "users", toByteString' u, "team"] + . expect [status200, status404] + getTeam :: TeamId -> AppIO Team.TeamData getTeam tid = do debug $ remote "galley" . msg (val "Get team info") @@ -582,3 +594,4 @@ changeTeamStatus tid s = do . header "Content-Type" "application/json" . expect2xx . lbytes (encode $ Team.TeamStatusUpdate s) + diff --git a/services/brig/test/integration/API/Team.hs b/services/brig/test/integration/API/Team.hs index 99238fdcf8..344aefe69d 100644 --- a/services/brig/test/integration/API/Team.hs +++ b/services/brig/test/integration/API/Team.hs @@ -35,6 +35,7 @@ import qualified Data.Text.Encoding as T import qualified Data.UUID.V4 as UUID import qualified Network.Wai.Utilities.Error as Error import qualified Galley.Types.Teams as Team +import qualified Galley.Types.Teams.Intra as Team import qualified Test.Tasty.Cannon as WS tests :: Manager -> Brig -> Cannon -> Galley -> IO TestTree @@ -113,7 +114,7 @@ testInvitationEmailAccepted brig galley = do Just inv <- decodeBody <$> postInvitation brig tid inviter invite Just inviteeCode <- getInvitationCode brig tid (inInvitation inv) rsp2 <- post (brig . path "/register" - . contentJson + . contentJson . body (accept inviteeEmail inviteeCode)) decodeBody rsp2 @@ -143,6 +144,17 @@ testCreateTeam brig galley = do inviteeEmail <- randomEmail let invite = InvitationRequest inviteeEmail (Name "Bob") Nothing postInvitation brig (team^.Team.teamId) uid invite !!! const 403 === statusCode + -- Verify that the team is still in status "pending" + team2 <- getTeam galley (team^.Team.teamId) + liftIO $ assertEqual "status" Team.PendingActive (Team.tdStatus team2) + -- Activate account + act <- getActivationCode brig (Left email) + case act of + Nothing -> liftIO $ assertFailure "activation key/code not found" + Just kc -> activate brig kc !!! const 200 === statusCode + -- Verify that Team has status Active now + team3 <- getTeam galley (team^.Team.teamId) + liftIO $ assertEqual "status" Team.Active (Team.tdStatus team3) testInvitationNoPermission :: Brig -> Http () testInvitationNoPermission brig = do @@ -398,6 +410,11 @@ unsuspendTeam brig t = post $ brig . paths ["i", "teams", toByteString' t, "unsuspend"] . contentJson +getTeam :: Galley -> TeamId -> Http Team.TeamData +getTeam galley t = do + r <- get $ galley . paths ["i", "teams", toByteString' t] + return $ fromMaybe (error "getTeam: failed to parse response") (decodeBody r) + getInvitationCode :: Brig -> TeamId -> InvitationId -> Http (Maybe InvitationCode) getInvitationCode brig t ref = do r <- get ( brig @@ -496,3 +513,4 @@ updatePermissions from tid (to, perm) galley = newTeam :: Team.BindingNewTeam newTeam = Team.BindingNewTeam $ Team.newNewTeam (unsafeRange "teamName") (unsafeRange "defaultIcon") + diff --git a/services/galley/src/Galley/API.hs b/services/galley/src/Galley/API.hs index e326d51e1e..c35e4405ba 100644 --- a/services/galley/src/Galley/API.hs +++ b/services/galley/src/Galley/API.hs @@ -681,6 +681,9 @@ sitemap = do get "/i/users/:uid/team/members" (continue getBindingTeamMembers) $ capture "uid" + get "/i/users/:uid/team" (continue getBindingTeamId) $ + capture "uid" + get "/i/test/clients" (continue getClients) zauthUserId diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 7f4a0c45ab..797dd9bb63 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -9,6 +9,7 @@ module Galley.API.Teams , updateTeamStatus , getTeam , getTeamInternal + , getBindingTeamId , getBindingTeamMembers , getManyTeams , deleteTeam @@ -107,12 +108,14 @@ createBindingTeam (zusr ::: tid ::: req ::: _) = do BindingNewTeam body <- fromBody req invalidPayload let owner = newTeamMember zusr fullPermissions team <- Data.createTeam (Just tid) zusr (body^.newTeamName) (body^.newTeamIcon) (body^.newTeamIconKey) Binding - Journal.teamCreate tid zusr finishCreateTeam team owner [] Nothing updateTeamStatus :: TeamId ::: Request ::: JSON ::: JSON -> Galley Response updateTeamStatus (tid ::: req ::: _) = do TeamStatusUpdate body <- fromBody req invalidPayload + team <- Data.team tid >>= ifNothing teamNotFound + when (body == Active && tdStatus team == PendingActive) $ + Journal.teamCreate tid $ (tdTeam team)^.teamCreator Data.updateTeamStatus tid body return empty @@ -391,12 +394,19 @@ finishCreateTeam team owner others zcon = do push1 $ newPush1 zusr (TeamEvent e) (list1 (userRecipient zusr) r) & pushConn .~ zcon pure (empty & setStatus status201 . location (team^.teamId)) -getBindingTeamMembers :: UserId -> Galley Response -getBindingTeamMembers zusr = do +withBindingTeam :: UserId -> (TeamId -> Galley b) -> Galley b +withBindingTeam zusr callback = do tid <- Data.oneUserTeam zusr >>= ifNothing teamNotFound binding <- Data.teamBinding tid >>= ifNothing teamNotFound case binding of - Binding -> do - members <- Data.teamMembers tid - pure $ json $ teamMemberListJson True (newTeamMemberList members) + Binding -> callback tid NonBinding -> throwM nonBindingTeam + +getBindingTeamId :: UserId -> Galley Response +getBindingTeamId zusr = withBindingTeam zusr $ pure . json + +getBindingTeamMembers :: UserId -> Galley Response +getBindingTeamMembers zusr = withBindingTeam zusr $ \tid -> do + members <- Data.teamMembers tid + pure $ json $ teamMemberListJson True (newTeamMemberList members) + diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 5f445a0d12..8b62bcfc4d 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -181,8 +181,11 @@ createTeam :: MonadClient m -> m Team createTeam t uid (fromRange -> n) (fromRange -> i) k b = do tid <- maybe (Id <$> liftIO nextRandom) return t - retry x5 $ write Cql.insertTeam (params Quorum (tid, uid, n, i, fromRange <$> k, Active, b)) + retry x5 $ write Cql.insertTeam (params Quorum (tid, uid, n, i, fromRange <$> k, initialStatus b, b)) pure (newTeam tid uid n i b & teamIconKey .~ (fromRange <$> k)) + where + initialStatus Binding = PendingActive -- Team becomes Active after User account activation + initialStatus NonBinding = Active deleteTeam :: MonadClient m => TeamId -> m () deleteTeam tid = do diff --git a/services/galley/src/Galley/Data/Instances.hs b/services/galley/src/Galley/Data/Instances.hs index bb549ffca2..4b80c190cb 100644 --- a/services/galley/src/Galley/Data/Instances.hs +++ b/services/galley/src/Galley/Data/Instances.hs @@ -100,11 +100,14 @@ instance Cql TeamStatus where toCql PendingDelete = CqlInt 1 toCql Deleted = CqlInt 2 toCql Suspended = CqlInt 3 + toCql PendingActive = CqlInt 4 fromCql (CqlInt i) = case i of 0 -> return Active 1 -> return PendingDelete 2 -> return Deleted 3 -> return Suspended + 4 -> return PendingActive n -> fail $ "unexpected team-status: " ++ show n fromCql _ = fail "team-status: int expected" + diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index bc1a61d84a..430db72cc8 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -81,8 +81,7 @@ testCreateMulitpleBindingTeams g b a = do assertQueue a tCreate -- Cannot create more teams if bound (used internal API) let nt = NonBindingNewTeam $ newNewTeam (unsafeRange "owner") (unsafeRange "icon") - void $ post (g . path "/teams" . zUser owner . zConn "conn" . json nt) do case evtData e of Just (Conv.EdMembers mm) -> mm @?= Conv.Members [usr] other -> assertFailure $ "Unexpected event data: " <> show other + diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 520f5c0e89..46da6c3823 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -29,6 +29,7 @@ import Data.Text.Encoding (decodeUtf8) import Data.UUID.V4 import Galley.Types import Galley.Types.Teams hiding (EventType (..)) +import Galley.Types.Teams.Intra import Gundeck.Types.Notification import Gundeck.Types.Push import Prelude hiding (head, mapM_) @@ -70,14 +71,21 @@ createTeam g name owner mems = do const True === isJust . getHeader "Location" fromBS (getHeader' "Location" resp) +changeTeamStatus :: Galley -> TeamId -> TeamStatus -> Http () +changeTeamStatus g tid s = put + ( g . paths ["i", "teams", toByteString' tid, "status"] + . json (TeamStatusUpdate s) + ) !!! const 200 === statusCode + createTeamInternal :: Galley -> Text -> UserId -> Http TeamId createTeamInternal g name owner = do tid <- randomId let nt = BindingNewTeam $ newNewTeam (unsafeRange name) (unsafeRange "icon") - resp <- put (g . paths ["/i/teams", toByteString' tid] . zUser owner . zConn "conn" . zType "access" . json nt) UserId -> TeamId -> Http Team getTeam g usr tid = do