wireapp · jschaul · Oct 10, 2017 · Oct 5, 2017
@@ -13,19 +13,22 @@ data TeamStatus
     | PendingDelete
     | Deleted
     | Suspended
+    | PendingActive
     deriving (Eq, Show)
 
 instance ToJSON TeamStatus where
     toJSON Active        = String "active"
     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]
+
@@ -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)
+
@@ -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)
+
@@ -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))
                   <!! const 201 === statusCode
     let Just (invitee, Just email2) = (userId &&& userEmail) <$> 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")
+
@@ -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
 

@@ -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)
+
@@ -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

@@ -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"
+
@@ -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
-        const 403 === statusCode
+    void $ post (g . path "/teams" . zUser owner . zConn "conn" . json nt) !!! const 403 === statusCode
 
     -- If never used the internal API, can create multiple teams
     owner' <- Util.randomUser b
@@ -249,7 +248,7 @@ testRemoveBindingTeamMember g b c a = do
     assertQueue a $ tUpdate 2 [owner]
     Util.connectUsers b owner (singleton mext)
     cid1 <- Util.createTeamConv g owner (ConvTeamInfo tid False) [(mem1^.userId), mext] (Just "blaa")
-    
+
     -- Deleting from a binding team without a password is a bad request
     delete ( g
            . paths ["teams", toByteString' tid, "members", toByteString' (mem1^.userId)]
@@ -656,3 +655,4 @@ checkConvMemberLeaveEvent cid usr w = WS.assertMatch_ timeout w $ \notif -> do
         case evtData e of
             Just (Conv.EdMembers mm) -> mm @?= Conv.Members [usr]
             other                    -> assertFailure $ "Unexpected event data: " <> show other
+
@@ -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) <!! do
+    _ <- put (g . paths ["/i/teams", toByteString' tid] . zUser owner . zConn "conn" . zType "access" . json nt) <!! do
         const 201  === statusCode
         const True === isJust . getHeader "Location"
-    fromBS (getHeader' "Location" resp)
+    changeTeamStatus g tid Active
+    return tid
 
 getTeam :: Galley -> UserId -> TeamId -> Http Team
 getTeam g usr tid = do