Merge branch 'wireapp:develop' into develop

changelog.d/5-internal/test-csv-export

@@ -0,0 +1 @@
+Move CSV export test to integration

integration/test/API/BrigInternal.hs

@@ -303,3 +303,29 @@ getPasswordResetCode :: (HasCallStack, MakesValue domain) => domain -> String ->
 getPasswordResetCode domain email = do
   req <- baseRequest domain Brig Unversioned "i/users/password-reset-code"
   submit "GET" $ req & addQueryParams [("email", email)]
+
+data PutSSOId = PutSSOId
+  { scimExternalId :: Maybe String,
+    subject :: Maybe String,
+    tenant :: Maybe String
+  }
+
+instance Default PutSSOId where
+  def =
+    PutSSOId
+      { scimExternalId = Nothing,
+        subject = Nothing,
+        tenant = Nothing
+      }
+
+putSSOId :: (HasCallStack, MakesValue user) => user -> PutSSOId -> App Response
+putSSOId user args = do
+  uid <- objId user
+  req <- baseRequest user Brig Unversioned (joinHttpPath ["i", "users", uid, "sso-id"])
+  submit "PUT" $
+    req
+      & addJSONObject
+        [ "scim_external_id" .= args.scimExternalId,
+          "subject" .= args.subject,
+          "tenant" .= args.tenant
+        ]

integration/test/API/Galley.hs

@@ -727,3 +727,9 @@ getTeamNotifications user mSince =
   baseRequest user Galley Versioned "teams/notifications" >>= \req ->
     submit "GET"
       $ addQueryParams [("since", since) | since <- maybeToList mSince] req
+
+-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_teams__tid__members_csv
+getTeamMembersCsv :: (HasCallStack, MakesValue user) => user -> String -> App Response
+getTeamMembersCsv user tid = do
+  req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tid, "members", "csv"])
+  submit "GET" req

integration/test/SetupHelpers.hs

@@ -43,26 +43,35 @@ createTeam :: (HasCallStack, MakesValue domain) => domain -> Int -> App (Value,
 createTeam domain memberCount = do
   owner <- createUser domain def {team = True} >>= getJSON 201
   tid <- owner %. "team" & asString
-  members <- for [2 .. memberCount] $ \_ -> createTeamMember owner tid
+  members <- for [2 .. memberCount] $ \_ -> createTeamMember owner def
   pure (owner, tid, members)
 
-createTeamMember ::
-  (HasCallStack, MakesValue inviter) =>
-  inviter ->
-  String ->
-  App Value
-createTeamMember inviter tid = createTeamMemberWithRole inviter tid "member"
+data CreateTeamMember = CreateTeamMember
+  { role :: String
+  }
 
-createTeamMemberWithRole ::
+instance Default CreateTeamMember where
+  def = CreateTeamMember {role = "member"}
+
+createTeamMember ::
   (HasCallStack, MakesValue inviter) =>
   inviter ->
-  String ->
-  String ->
+  CreateTeamMember ->
   App Value
-createTeamMemberWithRole inviter _ role = do
+createTeamMember inviter args = do
   newUserEmail <- randomEmail
-  invitation <- postInvitation inviter (PostInvitation (Just newUserEmail) (Just role)) >>= getJSON 201
-  invitationCode <- getInvitationCode inviter invitation >>= getJSON 200 >>= (%. "code") & asString
+  invitation <-
+    postInvitation
+      inviter
+      def
+        { email = Just newUserEmail,
+          role = Just args.role
+        }
+      >>= getJSON 201
+  invitationCode <-
+    (getInvitationCode inviter invitation >>= getJSON 200)
+      %. "code"
+      & asString
   let body =
         AddUser
           { name = Just newUserEmail,

integration/test/Test/Conversation.hs

@@ -667,7 +667,7 @@ testDeleteTeamMemberLimitedEventFanout :: (HasCallStack) => App ()
 testDeleteTeamMemberLimitedEventFanout = do
   -- Alex will get removed from the team
   (alice, team, [alex, alison]) <- createTeam OwnDomain 3
-  ana <- createTeamMemberWithRole alice team "admin"
+  ana <- createTeamMember alice def {role = "admin"}
   [amy, bob] <- for [OwnDomain, OtherDomain] $ flip randomUser def
   forM_ [amy, bob] $ connectTwoUsers alice
   [aliceId, alexId, amyId, alisonId, anaId, bobId] <- do

integration/test/Test/ExternalPartner.hs

@@ -29,7 +29,7 @@ testExternalPartnerPermissions :: (HasCallStack) => App ()
 testExternalPartnerPermissions = do
   (owner, tid, u1 : u2 : u3 : _) <- createTeam OwnDomain 4
 
-  partner <- createTeamMemberWithRole owner tid "partner"
+  partner <- createTeamMember owner def {role = "partner"}
 
   -- a partner should not be able to create conversation with 2 additional users or more
   void $ postConversation partner (defProteus {team = Just tid, qualifiedUsers = [u1, u2]}) >>= getJSON 403
@@ -58,23 +58,23 @@ testExternalPartnerPermissions = do
 testExternalPartnerPermissionsMls :: (HasCallStack) => App ()
 testExternalPartnerPermissionsMls = do
   -- external partners should not be able to create (MLS) conversations
-  (owner, tid, _) <- createTeam OwnDomain 2
-  bobExt <- createTeamMemberWithRole owner tid "partner"
+  (owner, _, _) <- createTeam OwnDomain 2
+  bobExt <- createTeamMember owner def {role = "partner"}
   bobExtClient <- createMLSClient def bobExt
   bindResponse (postConversation bobExtClient defMLS) $ \resp -> do
     resp.status `shouldMatchInt` 403
 
 testExternalPartnerPermissionMlsOne2One :: (HasCallStack) => App ()
 testExternalPartnerPermissionMlsOne2One = do
-  (owner, tid, alice : _) <- createTeam OwnDomain 2
-  bobExternal <- createTeamMemberWithRole owner tid "partner"
+  (owner, _, alice : _) <- createTeam OwnDomain 2
+  bobExternal <- createTeamMember owner def {role = "partner"}
   void $ getMLSOne2OneConversation alice bobExternal >>= getJSON 200
 
 testExternalPartnerPermissionsConvName :: (HasCallStack) => App ()
 testExternalPartnerPermissionsConvName = do
   (owner, tid, u1 : _) <- createTeam OwnDomain 2
 
-  partner <- createTeamMemberWithRole owner tid "partner"
+  partner <- createTeamMember owner def {role = "partner"}
 
   conv <- postConversation partner (defProteus {team = Just tid, qualifiedUsers = [u1]}) >>= getJSON 201
 

integration/test/Test/MLS/Services.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS -Wno-ambiguous-fields #-}
 module Test.MLS.Services where
 
 import API.Brig
@@ -13,7 +14,7 @@ testWhitelistUpdatePermissions = do
   (owner, tid, []) <- createTeam OwnDomain 1
 
   -- Create a team admin
-  admin <- createTeamMemberWithRole owner tid "admin"
+  admin <- createTeamMember owner def {role = "admin"}
 
   -- Create a service
   email <- randomEmail

integration/test/Test/Search.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS -Wno-ambiguous-fields #-}
 module Test.Search where
 
 import qualified API.Brig as BrigP
@@ -19,9 +20,9 @@ testSearchContactForExternalUsers = do
   owner <- randomUser OwnDomain def {BrigI.team = True}
   tid <- owner %. "team" & asString
 
-  partner <- createTeamMemberWithRole owner tid "partner"
-  tm1 <- createTeamMember owner tid
-  tm2 <- createTeamMember owner tid
+  partner <- createTeamMember owner def {role = "partner"}
+  tm1 <- createTeamMember owner def
+  tm2 <- createTeamMember owner def
 
   -- a team member can search for contacts
   bindResponse (BrigP.searchContacts tm1 (owner %. "name") OwnDomain) $ \resp ->

integration/test/Test/TeamSettings.hs

@@ -26,7 +26,7 @@ import Testlib.Prelude
 testTeamSettingsUpdate :: (HasCallStack) => App ()
 testTeamSettingsUpdate = do
   (ownerA, tidA, [mem]) <- createTeam OwnDomain 2
-  partner <- createTeamMemberWithRole ownerA tidA "partner"
+  partner <- createTeamMember ownerA def {role = "partner"}
 
   bindResponse (putAppLockSettings tidA ownerA def) $ \resp -> do
     resp.status `shouldMatchInt` 200
@@ -45,7 +45,7 @@ testTeamSettingsUpdate = do
 testTeamPropertiesUpdate :: (HasCallStack) => App ()
 testTeamPropertiesUpdate = do
   (ownerA, tidA, [mem]) <- createTeam OwnDomain 2
-  partner <- createTeamMemberWithRole ownerA tidA "partner"
+  partner <- createTeamMember ownerA def {role = "partner"}
 
   bindResponse (putTeamProperties tidA ownerA def) $ \resp -> do
     resp.status `shouldMatchInt` 200

integration/test/Test/Teams.hs

@@ -18,13 +18,17 @@
 module Test.Teams where
 
 import API.Brig
-import API.BrigInternal (createUser, getInvitationCode, refreshIndex)
+import qualified API.BrigInternal as I
 import API.Common
-import API.Galley (getTeam, getTeamMembers, getTeamNotifications)
+import API.Galley (getTeam, getTeamMembers, getTeamMembersCsv, getTeamNotifications)
 import API.GalleyInternal (setTeamFeatureStatus)
 import Control.Monad.Codensity (Codensity (runCodensity))
 import Control.Monad.Extra (findM)
 import Control.Monad.Reader (asks)
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.Map as Map
+import Data.Time.Clock
+import Data.Time.Format
 import Notifications
 import SetupHelpers
 import Testlib.JSON
@@ -52,13 +56,13 @@ testInvitePersonalUserToTeam = do
 
         ownerId <- owner %. "id" & asString
         setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" >>= assertSuccess
-        user <- createUser domain def >>= getJSON 201
+        user <- I.createUser domain def >>= getJSON 201
         uid <- user %. "id" >>= asString
         email <- user %. "email" >>= asString
 
         inv <- postInvitation owner (PostInvitation (Just email) Nothing) >>= getJSON 201
         checkListInvitations owner tid email
-        code <- getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
+        code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
         inv %. "url" & asString >>= assertUrlContainsCode code
         acceptTeamInvitation user code Nothing >>= assertStatus 400
         acceptTeamInvitation user code (Just "wrong-password") >>= assertStatus 403
@@ -105,7 +109,7 @@ testInvitePersonalUserToTeam = do
           ids <- for documents ((%. "id") >=> asString)
           ids `shouldContain` [ownerId]
 
-        refreshIndex domain
+        I.refreshIndex domain
         -- a team member can now search for the former personal user
         bindResponse (searchContacts tm (user %. "name") domain) $ \resp -> do
           resp.status `shouldMatchInt` 200
@@ -140,11 +144,11 @@ testInvitePersonalUserToLargeTeam = do
   teamSize <- readServiceConfig Galley %. "settings.maxFanoutSize" & asInt <&> (+ 1)
   (owner, tid, (alice : otherTeamMembers)) <- createTeam OwnDomain teamSize
   -- User to be invited to the team
-  knut <- createUser OwnDomain def >>= getJSON 201
+  knut <- I.createUser OwnDomain def >>= getJSON 201
 
   -- Non team friends of knut
-  dawn <- createUser OwnDomain def >>= getJSON 201
-  eli <- createUser OtherDomain def >>= getJSON 201
+  dawn <- I.createUser OwnDomain def >>= getJSON 201
+  eli <- I.createUser OtherDomain def >>= getJSON 201
 
   -- knut is also friends with alice, but not any other team members.
   traverse_ (connectTwoUsers knut) [alice, dawn, eli]
@@ -159,7 +163,7 @@ testInvitePersonalUserToLargeTeam = do
 
       knutEmail <- knut %. "email" >>= asString
       inv <- postInvitation owner (PostInvitation (Just knutEmail) Nothing) >>= getJSON 201
-      code <- getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
+      code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
 
       withWebSockets [owner, alice, dawn, eli, head otherTeamMembers] $ \[wsOwner, wsAlice, wsDawn, wsEli, wsOther] -> do
         acceptTeamInvitation knut code (Just defPassword) >>= assertSuccess
@@ -204,16 +208,16 @@ testInvitePersonalUserToTeamMultipleInvitations :: (HasCallStack) => App ()
 testInvitePersonalUserToTeamMultipleInvitations = do
   (owner, tid, _) <- createTeam OwnDomain 0
   (owner2, _, _) <- createTeam OwnDomain 0
-  user <- createUser OwnDomain def >>= getJSON 201
+  user <- I.createUser OwnDomain def >>= getJSON 201
   email <- user %. "email" >>= asString
   inv <- postInvitation owner (PostInvitation (Just email) Nothing) >>= getJSON 201
   inv2 <- postInvitation owner2 (PostInvitation (Just email) Nothing) >>= getJSON 201
-  code <- getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
+  code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
   acceptTeamInvitation user code (Just defPassword) >>= assertSuccess
   bindResponse (getSelf user) $ \resp -> do
     resp.status `shouldMatchInt` 200
     resp.json %. "team" `shouldMatch` tid
-  code2 <- getInvitationCode owner2 inv2 >>= getJSON 200 >>= (%. "code") & asString
+  code2 <- I.getInvitationCode owner2 inv2 >>= getJSON 200 >>= (%. "code") & asString
   bindResponse (acceptTeamInvitation user code2 (Just defPassword)) $ \resp -> do
     resp.status `shouldMatchInt` 403
     resp.json %. "label" `shouldMatch` "cannot-join-multiple-teams"
@@ -227,10 +231,10 @@ testInvitationTypesAreDistinct = do
   -- We are only testing one direction because the other is not possible
   -- because the non-existing user cannot have a valid session
   (owner, _, _) <- createTeam OwnDomain 0
-  user <- createUser OwnDomain def >>= getJSON 201
+  user <- I.createUser OwnDomain def >>= getJSON 201
   email <- user %. "email" >>= asString
   inv <- postInvitation owner (PostInvitation (Just email) Nothing) >>= getJSON 201
-  code <- getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
+  code <- I.getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
   let body =
         AddUser
           { name = Just email,
@@ -276,3 +280,52 @@ testUpgradePersonalToTeamAlreadyInATeam = do
   bindResponse (upgradePersonalToTeam alice "wonderland") $ \resp -> do
     resp.status `shouldMatchInt` 403
     resp.json %. "label" `shouldMatch` "user-already-in-a-team"
+
+-- for additional tests of the CSV download particularly with SCIM users, please refer to 'Test.Spar.Scim.UserSpec'
+testTeamMemberCsvExport :: (HasCallStack) => App ()
+testTeamMemberCsvExport = do
+  (owner, tid, members) <- createTeam OwnDomain 10
+  let numClients = [0, 1, 2] <> repeat 0
+  modifiedMembers <- for (zip numClients (owner : members)) $ \(n, m) -> do
+    handle <- randomHandle
+    putHandle m handle >>= assertSuccess
+    replicateM_ n $ addClient m def
+    void $ I.putSSOId m def {I.scimExternalId = Just "foo"} >>= getBody 200
+    setField "handle" handle m
+      >>= setField "role" (if m == owner then "owner" else "member")
+      >>= setField "num_clients" (show n)
+
+  memberMap :: Map.Map String Value <- fmap Map.fromList $ for (modifiedMembers) $ \m -> do
+    uid <- m %. "id" & asString
+    pure (uid, m)
+
+  bindResponse (getTeamMembersCsv owner tid) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    let rows = sort $ tail $ B8.lines $ resp.body
+    length rows `shouldMatchInt` 10
+    for_ rows $ \row -> do
+      let cols = B8.split ',' row
+      let uid = read $ B8.unpack $ cols !! 11
+      let mem = memberMap Map.! uid
+
+      ownerId <- owner %. "id" & asString
+      let ownerMember = memberMap Map.! ownerId
+
+      let parseField = unquote . read . B8.unpack . (cols !!)
+
+      parseField 0 `shouldMatch` (mem %. "name")
+      parseField 1 `shouldMatch` (mem %. "handle")
+      parseField 2 `shouldMatch` (mem %. "email")
+      role <- mem %. "role" & asString
+      parseField 3 `shouldMatch` role
+      when (role /= "owner") $ do
+        now <- formatTime defaultTimeLocale "%Y-%m-%d" <$> liftIO getCurrentTime
+        take 10 (parseField 4) `shouldMatch` now
+        parseField 5 `shouldMatch` (ownerMember %. "handle")
+      parseField 7 `shouldMatch` "wire"
+      parseField 9 `shouldMatch` "foo"
+      parseField 12 `shouldMatch` (mem %. "num_clients")
+  where
+    unquote :: String -> String
+    unquote ('\'' : x) = x
+    unquote x = x

services/galley/default.nix

@@ -116,7 +116,6 @@
 , utf8-string
 , uuid
 , uuid-types
-, vector
 , wai
 , wai-extra
 , wai-middleware-gunzip
@@ -237,7 +236,6 @@ mkDerivation {
     bytestring-conversion
     call-stack
     cassandra-util
-    cassava
     cereal
     conduit
     containers
@@ -276,7 +274,6 @@ mkDerivation {
     quickcheck-instances
     random
     retry
-    saml2-web-sso
     servant-client
     servant-client-core
     servant-server
@@ -302,7 +299,6 @@ mkDerivation {
     unliftio
     unordered-containers
     uuid
-    vector
     wai
     wai-utilities
     warp

services/galley/galley.cabal

@@ -483,7 +483,6 @@ executable galley-integration
     , bytestring-conversion
     , call-stack
     , cassandra-util
-    , cassava
     , cereal
     , containers
     , cookie
@@ -521,7 +520,6 @@ executable galley-integration
     , quickcheck-instances
     , random
     , retry
-    , saml2-web-sso          >=0.20
     , servant-client
     , servant-client-core
     , servant-server
@@ -547,7 +545,6 @@ executable galley-integration
     , unliftio
     , unordered-containers
     , uuid
-    , vector
     , wai
     , wai-utilities
     , warp