diff --git a/integration/test/Test/Teams.hs b/integration/test/Test/Teams.hs index ef6ec0baa83..70f44a3eee2 100644 --- a/integration/test/Test/Teams.hs +++ b/integration/test/Test/Teams.hs @@ -1,3 +1,4 @@ +{-# OPTIONS -Wno-ambiguous-fields #-} -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2024 Wire Swiss GmbH @@ -22,6 +23,7 @@ import qualified API.BrigInternal as I import API.Common import API.Galley (getTeam, getTeamMembers, getTeamMembersCsv, getTeamNotifications) import API.GalleyInternal (setTeamFeatureStatus) +import API.Gundeck import Control.Monad.Codensity (Codensity (runCodensity)) import Control.Monad.Extra (findM) import Control.Monad.Reader (asks) @@ -283,16 +285,28 @@ testUpgradePersonalToTeamAlreadyInATeam = do 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) + (owner, tid, members) <- createTeam OwnDomain 5 + + modifiedMembers <- for + ( zip + ([0, 1, 2] <> repeat 0) + (owner : members) + ) + $ \(n, m) -> do + handle <- randomHandle + putHandle m handle >>= assertSuccess + clients <- + replicateM n + $ addClient m def + >>= getJSON 201 + >>= (%. "id") + >>= asString + for_ (listToMaybe clients) $ \c -> + getNotifications m def {client = Just c} + 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" n memberMap :: Map.Map String Value <- fmap Map.fromList $ for (modifiedMembers) $ \m -> do uid <- m %. "id" & asString @@ -301,7 +315,7 @@ testTeamMemberCsvExport = do bindResponse (getTeamMembersCsv owner tid) $ \resp -> do resp.status `shouldMatchInt` 200 let rows = sort $ tail $ B8.lines $ resp.body - length rows `shouldMatchInt` 10 + length rows `shouldMatchInt` 5 for_ rows $ \row -> do let cols = B8.split ',' row let uid = read $ B8.unpack $ cols !! 11 @@ -309,6 +323,8 @@ testTeamMemberCsvExport = do ownerId <- owner %. "id" & asString let ownerMember = memberMap Map.! ownerId + now <- formatTime defaultTimeLocale "%Y-%m-%d" <$> liftIO getCurrentTime + numClients <- mem %. "num_clients" & asInt let parseField = unquote . read . B8.unpack . (cols !!) @@ -318,12 +334,14 @@ testTeamMemberCsvExport = do 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") + parseField 12 `shouldMatch` show numClients + (if numClients > 0 then shouldNotMatch else shouldMatch) + (parseField 13) + "" where unquote :: String -> String unquote ('\'' : x) = x diff --git a/libs/wire-api/src/Wire/API/Team/Export.hs b/libs/wire-api/src/Wire/API/Team/Export.hs index 61304ad28eb..eb684f34a31 100644 --- a/libs/wire-api/src/Wire/API/Team/Export.hs +++ b/libs/wire-api/src/Wire/API/Team/Export.hs @@ -25,10 +25,14 @@ import Data.ByteString.Conversion (FromByteString (..), ToByteString, toByteStri import Data.Csv (DefaultOrdered (..), FromNamedRecord (..), Parser, ToNamedRecord (..), namedRecord, (.:)) import Data.Handle (Handle) import Data.Id (UserId) -import Data.Json.Util (UTCTimeMillis) +import Data.Json.Util (UTCTimeMillis, utcTimeSchema) import Data.Misc (HttpsUrl) import Data.OpenApi qualified as OpenApi import Data.Schema +import Data.Text qualified as T +import Data.Text.Encoding qualified as T +import Data.Time.Clock +import Data.Time.Format import Data.Vector (fromList) import Imports import Test.QuickCheck @@ -39,6 +43,9 @@ import Wire.API.User.Profile (ManagedBy) import Wire.API.User.RichInfo (RichInfo) import Wire.Arbitrary +timestampFormat :: String +timestampFormat = "%Y-%m-%d" + data TeamExportUser = TeamExportUser { tExportDisplayName :: Name, tExportHandle :: Maybe Handle, @@ -52,7 +59,8 @@ data TeamExportUser = TeamExportUser tExportSCIMExternalId :: Text, tExportSCIMRichInfo :: Maybe RichInfo, tExportUserId :: UserId, - tExportNumDevices :: Int + tExportNumDevices :: Int, + tExportLastActive :: Maybe UTCTime } deriving (Show, Eq, Generic) deriving (Arbitrary) via (GenericUniform TeamExportUser) @@ -75,6 +83,7 @@ instance ToSchema TeamExportUser where <*> tExportSCIMRichInfo .= maybe_ (optField "scim_rich_info" schema) <*> tExportUserId .= field "user_id" schema <*> tExportNumDevices .= field "num_devices" schema + <*> tExportLastActive .= maybe_ (optField "last_active" utcTimeSchema) instance ToNamedRecord TeamExportUser where toNamedRecord row = @@ -91,7 +100,15 @@ instance ToNamedRecord TeamExportUser where ("scim_external_id", secureCsvFieldToByteString (tExportSCIMExternalId row)), ("scim_rich_info", maybe "" (C.toStrict . Aeson.encode) (tExportSCIMRichInfo row)), ("user_id", secureCsvFieldToByteString (tExportUserId row)), - ("num_devices", secureCsvFieldToByteString (tExportNumDevices row)) + ("num_devices", secureCsvFieldToByteString (tExportNumDevices row)), + ( "last_active", + C.pack + ( maybe + "" + (formatTime defaultTimeLocale timestampFormat) + (tExportLastActive row) + ) + ) ] secureCsvFieldToByteString :: forall a. (ToByteString a) => a -> ByteString @@ -113,7 +130,8 @@ instance DefaultOrdered TeamExportUser where "scim_external_id", "scim_rich_info", "user_id", - "num_devices" + "num_devices", + "last_active" ] allowEmpty :: (ByteString -> Parser a) -> ByteString -> Parser (Maybe a) @@ -126,6 +144,11 @@ parseByteString bstr = Left err -> fail err Right thing -> pure thing +parseUTCTime :: ByteString -> Parser UTCTime +parseUTCTime b = do + s <- either (fail . displayException) pure $ T.decodeUtf8' b + parseTimeM False defaultTimeLocale timestampFormat (T.unpack s) + instance FromNamedRecord TeamExportUser where parseNamedRecord nrec = TeamExportUser @@ -148,6 +171,7 @@ instance FromNamedRecord TeamExportUser where ) <*> (nrec .: "user_id" >>= parseByteString) <*> (nrec .: "num_devices" >>= parseByteString) + <*> (nrec .: "last_active" >>= allowEmpty parseUTCTime) quoted :: ByteString -> ByteString quoted bs = case C.uncons bs of diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index 7ea8f4d3fdc..e1f7844e199 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs @@ -159,29 +159,6 @@ runUserSubsystem authInterpreter = interpret $ GetUserActivityTimestamp uid -> getUserActivityTimestampImpl uid GetUserExportData uid -> getUserExportDataImpl uid -getUserExportDataImpl :: (Member UserStore r) => UserId -> Sem r (Maybe TeamExportUser) -getUserExportDataImpl uid = fmap hush . runError @() $ do - su <- UserStore.getUser uid >>= note () - mRichInfo <- UserStore.getRichInfo uid - timestamps <- UserStore.getActivityTimestamps uid - let numClients = length timestamps - pure $ - TeamExportUser - { tExportDisplayName = su.name, - tExportHandle = su.handle, - tExportEmail = su.email, - tExportRole = Nothing, - tExportCreatedOn = Nothing, - tExportInvitedBy = Nothing, - tExportIdpIssuer = userToIdPIssuer su, - tExportManagedBy = fromMaybe ManagedByWire su.managedBy, - tExportSAMLNamedId = fromMaybe "" (samlNamedId su), - tExportSCIMExternalId = fromMaybe "" (scimExtId su), - tExportSCIMRichInfo = fmap RichInfo mRichInfo, - tExportUserId = uid, - tExportNumDevices = numClients - } - scimExtId :: StoredUser -> Maybe Text scimExtId su = do m <- su.managedBy @@ -971,6 +948,7 @@ acceptTeamInvitationImpl luid pw code = do syncUserIndex uid generateUserEvent uid Nothing (teamUpdated uid tid) +-- TODO: remove getUserActivityTimestampImpl :: (Member UserStore r) => UserId -> Sem r (Maybe UTCTime) getUserActivityTimestampImpl uid = do ts <- getActivityTimestamps uid @@ -978,3 +956,30 @@ getUserActivityTimestampImpl uid = do maximum -- make sure the list of timestamps is non-empty) (Nothing : ts) + +getUserExportDataImpl :: (Member UserStore r) => UserId -> Sem r (Maybe TeamExportUser) +getUserExportDataImpl uid = fmap hush . runError @() $ do + su <- UserStore.getUser uid >>= note () + mRichInfo <- UserStore.getRichInfo uid + timestamps <- UserStore.getActivityTimestamps uid + -- Make sure the list of timestamps is non-empty so that 'maximum' is + -- well-defined and returns 'Nothing' when no valid timestamps are present. + let lastActive = maximum (Nothing : timestamps) + let numClients = length timestamps + pure $ + TeamExportUser + { tExportDisplayName = su.name, + tExportHandle = su.handle, + tExportEmail = su.email, + tExportRole = Nothing, + tExportCreatedOn = Nothing, + tExportInvitedBy = Nothing, + tExportIdpIssuer = userToIdPIssuer su, + tExportManagedBy = fromMaybe ManagedByWire su.managedBy, + tExportSAMLNamedId = fromMaybe "" (samlNamedId su), + tExportSCIMExternalId = fromMaybe "" (scimExtId su), + tExportSCIMRichInfo = fmap RichInfo mRichInfo, + tExportUserId = uid, + tExportNumDevices = numClients, + tExportLastActive = lastActive + } diff --git a/services/galley/src/Galley/API/Teams/Export.hs b/services/galley/src/Galley/API/Teams/Export.hs index 29c35240336..273cd18972c 100644 --- a/services/galley/src/Galley/API/Teams/Export.hs +++ b/services/galley/src/Galley/API/Teams/Export.hs @@ -12,7 +12,6 @@ import Data.IORef (atomicModifyIORef, newIORef) import Data.Id import Data.Map qualified as Map import Data.Qualified (Local, tUnqualified) -import Debug.Trace import Galley.Effects import Galley.Effects.BrigAccess import Galley.Effects.SparAccess qualified as Spar @@ -97,6 +96,12 @@ getUserRecord cache member = do tExportCreatedOn = mCreatedOn } +-- | Export team info as a CSV, and stream it to the client. +-- +-- We paginate through the team member list, then spawn a thread for each user +-- (out of a thread pool) in order to fetch information for that user from brig +-- and spar. Inviter IDs are resolved to handles via a brig request, then +-- stored in a cache so that they can be reused by subsequent requests. getTeamMembersCSV :: forall r. ( Member BrigAccess r, @@ -157,7 +162,6 @@ getTeamMembersCSV lusr tid = do pure r pure $ \write flush -> do let go = do - traceM "write chunk" readChan chan >>= \case Nothing -> write "" >> flush Just line -> write (byteString (toStrict line)) >> flush >> go