diff --git a/changelog.d/5-internal/user-types-refactoring b/changelog.d/5-internal/user-types-refactoring new file mode 100644 index 00000000000..f3684d7f309 --- /dev/null +++ b/changelog.d/5-internal/user-types-refactoring @@ -0,0 +1 @@ +Remove `UserAccount` and `ExtendedUserAccount` and their fields to the `User` type diff --git a/libs/brig-types/brig-types.cabal b/libs/brig-types/brig-types.cabal index 161a81ce30c..817720e0b65 100644 --- a/libs/brig-types/brig-types.cabal +++ b/libs/brig-types/brig-types.cabal @@ -150,7 +150,6 @@ test-suite brig-types-tests , openapi3 , QuickCheck >=2.9 , tasty - , tasty-hunit , tasty-quickcheck , wire-api diff --git a/libs/brig-types/default.nix b/libs/brig-types/default.nix index 290305e7c13..d427109a406 100644 --- a/libs/brig-types/default.nix +++ b/libs/brig-types/default.nix @@ -14,7 +14,6 @@ , openapi3 , QuickCheck , tasty -, tasty-hunit , tasty-quickcheck , types-common , wire-api @@ -40,7 +39,6 @@ mkDerivation { openapi3 QuickCheck tasty - tasty-hunit tasty-quickcheck wire-api ]; diff --git a/libs/brig-types/src/Brig/Types/Intra.hs b/libs/brig-types/src/Brig/Types/Intra.hs index e224a62419e..6b0a81ca597 100644 --- a/libs/brig-types/src/Brig/Types/Intra.hs +++ b/libs/brig-types/src/Brig/Types/Intra.hs @@ -16,7 +16,7 @@ -- with this program. If not, see . module Brig.Types.Intra - ( UserAccount (..), + ( User (..), NewUserScimInvitation (..), UserSet (..), ) diff --git a/libs/brig-types/test/unit/Test/Brig/Types/User.hs b/libs/brig-types/test/unit/Test/Brig/Types/User.hs index e345eb8e9b0..79a848fcef8 100644 --- a/libs/brig-types/test/unit/Test/Brig/Types/User.hs +++ b/libs/brig-types/test/unit/Test/Brig/Types/User.hs @@ -26,14 +26,12 @@ module Test.Brig.Types.User where import Brig.Types.Connection (UpdateConnectionsInternal (..)) -import Brig.Types.Intra (NewUserScimInvitation (..), UserAccount (..)) +import Brig.Types.Intra import Brig.Types.User (ManagedByUpdate (..), RichInfoUpdate (..)) -import Data.Aeson import Imports import Test.Brig.Roundtrip (testRoundTrip, testRoundTripWithSwagger) import Test.QuickCheck (Arbitrary (arbitrary)) import Test.Tasty -import Test.Tasty.HUnit import Wire.API.Routes.Internal.Brig.EJPD (EJPDRequestBody (..), EJPDResponseBody (..)) import Wire.API.User.Auth.ReAuth @@ -48,22 +46,8 @@ roundtripTests = testRoundTrip @NewUserScimInvitation, testRoundTripWithSwagger @EJPDRequestBody, testRoundTripWithSwagger @EJPDResponseBody, - testRoundTrip @UpdateConnectionsInternal, - testRoundTripWithSwagger @UserAccount, - testGroup "golden tests" $ - [testCaseUserAccount] + testRoundTrip @UpdateConnectionsInternal ] instance Arbitrary ReAuthUser where arbitrary = ReAuthUser <$> arbitrary <*> arbitrary <*> arbitrary - -testCaseUserAccount :: TestTree -testCaseUserAccount = testCase "UserAcccount" $ do - assertEqual "1" (Just json1) (encode <$> decode @UserAccount json1) - assertEqual "2" (Just json2) (encode <$> decode @UserAccount json2) - where - json1 :: LByteString - json1 = "{\"accent_id\":1,\"assets\":[],\"deleted\":true,\"email\":\"foo@example.com\",\"expires_at\":\"1864-05-09T17:20:22.192Z\",\"handle\":\"-ve\",\"id\":\"00000000-0000-0001-0000-000100000000\",\"locale\":\"lu\",\"managed_by\":\"wire\",\"name\":\"bla\",\"picture\":[],\"qualified_id\":{\"domain\":\"4-o60.j7-i\",\"id\":\"00000000-0000-0001-0000-000100000000\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000000000001\"},\"status\":\"suspended\",\"supported_protocols\":[\"proteus\"],\"team\":\"00000000-0000-0001-0000-000100000001\"}" - - json2 :: LByteString - json2 = "{\"accent_id\":0,\"assets\":[{\"key\":\"3-4-00000000-0000-0001-0000-000000000000\",\"size\":\"preview\",\"type\":\"image\"}],\"email\":\"a@b\",\"expires_at\":\"1864-05-10T22:45:44.823Z\",\"handle\":\"b8m\",\"id\":\"00000000-0000-0000-0000-000000000001\",\"locale\":\"tk-KZ\",\"managed_by\":\"wire\",\"name\":\"name2\",\"picture\":[],\"qualified_id\":{\"domain\":\"1-8wq0.b22k1.w5\",\"id\":\"00000000-0000-0000-0000-000000000001\"},\"service\":{\"id\":\"00000000-0000-0001-0000-000000000001\",\"provider\":\"00000001-0000-0001-0000-000100000000\"},\"status\":\"pending-invitation\",\"supported_protocols\":[\"proteus\"],\"team\":\"00000000-0000-0001-0000-000000000001\"}" diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index ec853e7f933..5c6dc34ffd9 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -248,7 +248,7 @@ type AccountAPI = ] "includePendingInvitations" Bool - :> Get '[Servant.JSON] [ExtendedUserAccount] + :> Get '[Servant.JSON] [User] ) :<|> Named "iGetUserContacts" @@ -594,7 +594,7 @@ type TeamInvitations = :> Capture "tid" TeamId :> "invitations" :> Servant.ReqBody '[JSON] NewUserScimInvitation - :> Post '[JSON] UserAccount + :> Post '[JSON] User ) type UserAPI = diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 5d5a42af3b1..6e037a0489a 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -36,6 +36,7 @@ module Wire.API.User -- User (should not be here) User (..), userId, + userDeleted, userEmail, userSSOId, userIssuer, @@ -110,10 +111,6 @@ module Wire.API.User AccountStatusUpdate (..), AccountStatusResp (..), - -- * Account - UserAccount (..), - ExtendedUserAccount (..), - -- * Scim invitations NewUserScimInvitation (..), @@ -558,6 +555,7 @@ data User = User -- the user is activated, and the email/phone contained in it will be guaranteedly -- verified. {#RefActivation} userIdentity :: Maybe UserIdentity, + userEmailUnvalidated :: Maybe EmailAddress, -- | required; non-unique userDisplayName :: Name, -- | text status @@ -566,7 +564,7 @@ data User = User userPict :: Pict, userAssets :: [Asset], userAccentId :: ColourId, - userDeleted :: Bool, + userStatus :: AccountStatus, userLocale :: Locale, -- | Set if the user represents an external service, -- i.e. it is a "bot". @@ -589,6 +587,9 @@ data User = User userId :: User -> UserId userId = qUnqualified . userQualifiedId +userDeleted :: User -> Bool +userDeleted u = userStatus u == Deleted + -- -- FUTUREWORK: -- -- disentangle json serializations for 'User', 'NewUser', 'UserIdentity', 'NewUserOrigin'. instance ToSchema User where @@ -601,8 +602,8 @@ userObjectSchema = .= field "qualified_id" schema <* userId .= optional (field "id" (deprecatedSchema "qualified_id" schema)) - <*> userIdentity - .= maybeUserIdentityObjectSchema + <*> userIdentity .= maybeUserIdentityObjectSchema + <*> userEmailUnvalidated .= maybe_ (optField "email_unvalidated" schema) <*> userDisplayName .= field "name" schema <*> userTextStatus @@ -611,22 +612,17 @@ userObjectSchema = .= (fromMaybe noPict <$> optField "picture" schema) <*> userAssets .= (fromMaybe [] <$> optField "assets" (array schema)) - <*> userAccentId - .= field "accent_id" schema - <*> (fromMaybe False <$> (\u -> if userDeleted u then Just True else Nothing) .= maybe_ (optField "deleted" schema)) - <*> userLocale - .= field "locale" schema - <*> userService - .= maybe_ (optField "service" schema) - <*> userHandle - .= maybe_ (optField "handle" schema) - <*> userExpire - .= maybe_ (optField "expires_at" schema) - <*> userTeam - .= maybe_ (optField "team" schema) + <*> userAccentId .= field "accent_id" schema + <*> userStatus .= field "status" schema + <*> userLocale .= field "locale" schema + <*> userService .= maybe_ (optField "service" schema) + <*> userHandle .= maybe_ (optField "handle" schema) + <*> userExpire .= maybe_ (optField "expires_at" schema) + <*> userTeam .= maybe_ (optField "team" schema) <*> userManagedBy .= (fromMaybe ManagedByWire <$> optField "managed_by" schema) <*> userSupportedProtocols .= supportedProtocolsObjectSchema + <* (fromMaybe False <$> (\u -> if userDeleted u then Just True else Nothing) .= maybe_ (optField "deleted" schema)) userEmail :: User -> Maybe EmailAddress userEmail = emailIdentity <=< userIdentity @@ -1813,43 +1809,6 @@ instance Schema.ToSchema AccountStatusUpdate where ------------------------------------------------------------------------------- -- UserAccount --- | A UserAccount is targeted to be used by our \"backoffice\" and represents --- all the data related to a user in our system, regardless of whether they --- are active or not, their status, etc. -data UserAccount = UserAccount - { accountUser :: !User, - accountStatus :: !AccountStatus - } - deriving (Eq, Ord, Show, Generic) - deriving (Arbitrary) via (GenericUniform UserAccount) - deriving (ToJSON, FromJSON, S.ToSchema) via Schema.Schema UserAccount - -instance Schema.ToSchema UserAccount where - schema = Schema.object "UserAccount" userAccountObjectSchema - -userAccountObjectSchema :: ObjectSchema SwaggerDoc UserAccount -userAccountObjectSchema = - UserAccount - <$> accountUser Schema..= userObjectSchema - <*> accountStatus Schema..= Schema.field "status" Schema.schema - --- | This can be parsed as UserAccount, but it has an extra field `email_unvalidated` from --- brig's cassandra that is needed in spar. so we return this from GET /i/users in brig. -data ExtendedUserAccount = ExtendedUserAccount - { account :: UserAccount, - emailUnvalidated :: Maybe EmailAddress - } - deriving (Eq, Ord, Show, Generic) - deriving (Arbitrary) via (GenericUniform ExtendedUserAccount) - deriving (ToJSON, FromJSON, S.ToSchema) via Schema.Schema ExtendedUserAccount - -instance Schema.ToSchema ExtendedUserAccount where - schema = - Schema.object "ExtendedUserAccount" $ - ExtendedUserAccount - <$> account Schema..= userAccountObjectSchema - <*> emailUnvalidated Schema..= maybe_ (Schema.optField "email_unvalidated" Schema.schema) - ------------------------------------------------------------------------------- -- NewUserScimInvitation diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs index 1d91629c06c..9841fd014e1 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/SelfProfile_user.hs @@ -41,14 +41,14 @@ testObject_SelfProfile_user_1 = { qUnqualified = Id (fromJust (UUID.fromString "00000001-0000-0000-0000-000000000002")), qDomain = Domain {_domainText = "n0-994.m-226.f91.vg9p-mj-j2"} }, - userIdentity = - Just (EmailIdentity (unsafeEmailAddress "some" "example")), + userIdentity = Just (EmailIdentity (unsafeEmailAddress "some" "example")), + userEmailUnvalidated = Nothing, userDisplayName = Name {fromName = "@\1457\2598\66242\US\1104967l+\137302\&6\996495^\162211Mu\t"}, userTextStatus = rightToMaybe $ mkTextStatus "text status", userPict = Pict {fromPict = []}, userAssets = [], userAccentId = ColourId {fromColourId = 1}, - userDeleted = False, + userStatus = Active, userLocale = Locale {lLanguage = Language Data.LanguageCodes.GL, lCountry = Just (Country {fromCountry = PA})}, userService = diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs index a552b90f049..8d45d8da2a2 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/User_user.hs @@ -55,12 +55,13 @@ testObject_User_user_1 = qDomain = Domain {_domainText = "s-f4.s"} }, userIdentity = Nothing, + userEmailUnvalidated = Nothing, userDisplayName = Name {fromName = "\NULuv\996028su\28209lRi"}, userTextStatus = Nothing, userPict = Pict {fromPict = []}, userAssets = [], userAccentId = ColourId {fromColourId = 1}, - userDeleted = True, + userStatus = Deleted, userLocale = Locale {lLanguage = Language Data.LanguageCodes.TN, lCountry = Just (Country {fromCountry = SB})}, userService = Nothing, userHandle = Nothing, @@ -79,6 +80,7 @@ testObject_User_user_2 = qDomain = Domain {_domainText = "k.vbg.p"} }, userIdentity = Just (EmailIdentity (unsafeEmailAddress "some" "example")), + userEmailUnvalidated = Nothing, userDisplayName = Name { fromName = @@ -92,7 +94,7 @@ testObject_User_user_2 = ImageAsset (AssetKeyV3 (Id (fromJust (UUID.fromString "5cd81cc4-c643-4e9c-849c-c596a88c27fd"))) AssetExpiring) (Just AssetComplete) ], userAccentId = ColourId {fromColourId = -2}, - userDeleted = True, + userStatus = Deleted, userLocale = Locale {lLanguage = Language Data.LanguageCodes.DA, lCountry = Just (Country {fromCountry = TN})}, userService = Just @@ -117,13 +119,14 @@ testObject_User_user_3 = qDomain = Domain {_domainText = "dt.n"} }, userIdentity = Just (EmailIdentity (unsafeEmailAddress "some" "example")), + userEmailUnvalidated = Nothing, userDisplayName = Name {fromName = ",r\EMXEg0$\98187\RS\SI'uS\ETX/\1009222`\228V.J{\fgE(\rK!\SOp8s9gXO\21810Xj\STX\RS\DC2"}, userTextStatus = Nothing, userPict = Pict {fromPict = []}, userAssets = [], userAccentId = ColourId {fromColourId = -2}, - userDeleted = True, + userStatus = Deleted, userLocale = Locale {lLanguage = Language Data.LanguageCodes.TG, lCountry = Just (Country {fromCountry = UA})}, userService = Just @@ -149,6 +152,7 @@ testObject_User_user_4 = }, userIdentity = Just (SSOIdentity (UserScimExternalId "") (Just (unsafeEmailAddress "some" "example"))), + userEmailUnvalidated = Nothing, userDisplayName = Name { fromName = @@ -158,7 +162,7 @@ testObject_User_user_4 = userPict = Pict {fromPict = []}, userAssets = [], userAccentId = ColourId {fromColourId = 0}, - userDeleted = False, + userStatus = Active, userLocale = Locale {lLanguage = Language Data.LanguageCodes.BI, lCountry = Just (Country {fromCountry = MQ})}, userService = Just @@ -185,6 +189,7 @@ testObject_User_user_5 = }, userIdentity = Just (EmailIdentity (unsafeEmailAddress "some" "example")), + userEmailUnvalidated = Nothing, userDisplayName = Name { fromName = @@ -194,7 +199,7 @@ testObject_User_user_5 = userPict = Pict {fromPict = []}, userAssets = [], userAccentId = ColourId {fromColourId = 0}, - userDeleted = False, + userStatus = Active, userLocale = Locale {lLanguage = Language Data.LanguageCodes.BI, lCountry = Just (Country {fromCountry = MQ})}, userService = Just diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/UserEvent.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/UserEvent.hs index 5d99e783a5c..9c8fa6666f5 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/UserEvent.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/UserEvent.hs @@ -225,12 +225,13 @@ alice = qDomain = Domain {_domainText = "foo.example.com"} }, userIdentity = Nothing, + userEmailUnvalidated = Nothing, userDisplayName = Name "alice", userTextStatus = rightToMaybe $ mkTextStatus "text status", userPict = Pict {fromPict = []}, userAssets = [], userAccentId = ColourId {fromColourId = 1}, - userDeleted = True, + userStatus = Deleted, userLocale = Locale { lLanguage = Language L.TN, @@ -253,12 +254,13 @@ bob = qDomain = Domain {_domainText = "baz.example.com"} }, userIdentity = Nothing, + userEmailUnvalidated = Nothing, userDisplayName = Name "bob", userTextStatus = rightToMaybe $ mkTextStatus "text status", userPict = Pict {fromPict = []}, userAssets = [], userAccentId = ColourId {fromColourId = 2}, - userDeleted = False, + userStatus = Active, userLocale = Locale { lLanguage = Language L.CA, diff --git a/libs/wire-api/test/golden/testObject_SelfProfile_user_1.json b/libs/wire-api/test/golden/testObject_SelfProfile_user_1.json index fb9fd970c7f..a3a2b2be525 100644 --- a/libs/wire-api/test/golden/testObject_SelfProfile_user_1.json +++ b/libs/wire-api/test/golden/testObject_SelfProfile_user_1.json @@ -17,6 +17,7 @@ "id": "00000000-0000-0001-0000-000000000000", "provider": "00000000-0000-0001-0000-000000000001" }, + "status": "active", "supported_protocols": [ "proteus" ], diff --git a/libs/wire-api/test/golden/testObject_UserEvent_1.json b/libs/wire-api/test/golden/testObject_UserEvent_1.json index bfe90d9970a..53d801cd5b5 100644 --- a/libs/wire-api/test/golden/testObject_UserEvent_1.json +++ b/libs/wire-api/test/golden/testObject_UserEvent_1.json @@ -13,6 +13,7 @@ "domain": "foo.example.com", "id": "539d9183-32a5-4fc4-ba5c-4634454e7585" }, + "status": "deleted", "supported_protocols": [ "proteus" ], diff --git a/libs/wire-api/test/golden/testObject_UserEvent_2.json b/libs/wire-api/test/golden/testObject_UserEvent_2.json index e630fcc9701..1909dc0bc38 100644 --- a/libs/wire-api/test/golden/testObject_UserEvent_2.json +++ b/libs/wire-api/test/golden/testObject_UserEvent_2.json @@ -13,6 +13,7 @@ "domain": "foo.example.com", "id": "539d9183-32a5-4fc4-ba5c-4634454e7585" }, + "status": "deleted", "supported_protocols": [ "proteus" ], diff --git a/libs/wire-api/test/golden/testObject_User_user_1.json b/libs/wire-api/test/golden/testObject_User_user_1.json index b3fbc638960..147a90f2c7d 100644 --- a/libs/wire-api/test/golden/testObject_User_user_1.json +++ b/libs/wire-api/test/golden/testObject_User_user_1.json @@ -11,6 +11,7 @@ "domain": "s-f4.s", "id": "00000002-0000-0001-0000-000200000002" }, + "status": "deleted", "supported_protocols": [ "proteus" ] diff --git a/libs/wire-api/test/golden/testObject_User_user_2.json b/libs/wire-api/test/golden/testObject_User_user_2.json index 4d70aed9563..67d0f8f93e6 100644 --- a/libs/wire-api/test/golden/testObject_User_user_2.json +++ b/libs/wire-api/test/golden/testObject_User_user_2.json @@ -32,6 +32,7 @@ "id": "00000000-0000-0000-0000-000000000001", "provider": "00000000-0000-0000-0000-000100000000" }, + "status": "deleted", "supported_protocols": [], "text_status": "text status" } diff --git a/libs/wire-api/test/golden/testObject_User_user_3.json b/libs/wire-api/test/golden/testObject_User_user_3.json index 4c3c8b75cde..e5f00227e8d 100644 --- a/libs/wire-api/test/golden/testObject_User_user_3.json +++ b/libs/wire-api/test/golden/testObject_User_user_3.json @@ -18,6 +18,7 @@ "id": "00000001-0000-0001-0000-000100000000", "provider": "00000001-0000-0000-0000-000100000000" }, + "status": "deleted", "supported_protocols": [ "proteus" ], diff --git a/libs/wire-api/test/golden/testObject_User_user_4.json b/libs/wire-api/test/golden/testObject_User_user_4.json index 2ac47461051..0b17893cf11 100644 --- a/libs/wire-api/test/golden/testObject_User_user_4.json +++ b/libs/wire-api/test/golden/testObject_User_user_4.json @@ -20,6 +20,7 @@ "sso_id": { "scim_external_id": "" }, + "status": "active", "supported_protocols": [ "proteus" ], diff --git a/libs/wire-api/test/golden/testObject_User_user_5.json b/libs/wire-api/test/golden/testObject_User_user_5.json index 4fe7299ab5b..c3d9ce3cae4 100644 --- a/libs/wire-api/test/golden/testObject_User_user_5.json +++ b/libs/wire-api/test/golden/testObject_User_user_5.json @@ -17,6 +17,7 @@ "id": "00000000-0000-0001-0000-000100000000", "provider": "00000000-0000-0000-0000-000000000000" }, + "status": "active", "supported_protocols": [ "proteus" ], diff --git a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs index fc13fb05a01..183d1130c6e 100644 --- a/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Interpreter.hs @@ -164,12 +164,12 @@ lookupActiveUserByUserKey :: lookupActiveUserByUserKey target = do localUnit <- input let ltarget = qualifyAs localUnit [emailKeyOrig target] - mUser <- User.getExtendedAccountsByEmailNoFilter ltarget + mUser <- User.getAccountsByEmailNoFilter ltarget case mUser of [user] -> do pure $ - if user.account.accountStatus == Active - then Just user.account.accountUser + if user.userStatus == Active + then Just user else Nothing _ -> pure Nothing diff --git a/libs/wire-subsystems/src/Wire/StoredUser.hs b/libs/wire-subsystems/src/Wire/StoredUser.hs index f18502ad591..7d8420740af 100644 --- a/libs/wire-subsystems/src/Wire/StoredUser.hs +++ b/libs/wire-subsystems/src/Wire/StoredUser.hs @@ -73,19 +73,19 @@ hasPendingInvitation u = u.status == Just PendingInvitation mkUserFromStored :: Domain -> Locale -> StoredUser -> User mkUserFromStored domain defaultLocale storedUser = - let deleted = Just Deleted == storedUser.status - expiration = if storedUser.status == Just Ephemeral then storedUser.expires else Nothing + let expiration = if storedUser.status == Just Ephemeral then storedUser.expires else Nothing loc = toLocale defaultLocale (storedUser.language, storedUser.country) svc = newServiceRef <$> storedUser.serviceId <*> storedUser.providerId in User { userQualifiedId = (Qualified storedUser.id domain), userIdentity = storedUser.identity, + userEmailUnvalidated = storedUser.emailUnvalidated, userDisplayName = storedUser.name, userTextStatus = storedUser.textStatus, userPict = (fromMaybe noPict storedUser.pict), userAssets = (fromMaybe [] storedUser.assets), userAccentId = storedUser.accentId, - userDeleted = deleted, + userStatus = fromMaybe Active storedUser.status, userLocale = loc, userService = svc, userHandle = storedUser.handle, @@ -97,16 +97,6 @@ mkUserFromStored domain defaultLocale storedUser = Just ps -> if S.null ps then defSupportedProtocols else ps } -mkAccountFromStored :: Domain -> Locale -> StoredUser -> UserAccount -mkAccountFromStored domain defaultLocale storedUser = - UserAccount - (mkUserFromStored domain defaultLocale storedUser) - (fromMaybe Active storedUser.status) - -mkExtendedAccountFromStored :: Domain -> Locale -> StoredUser -> ExtendedUserAccount -mkExtendedAccountFromStored domain defaultLocale storedUser = - ExtendedUserAccount (mkAccountFromStored domain defaultLocale storedUser) storedUser.emailUnvalidated - toLocale :: Locale -> (Maybe Language, Maybe Country) -> Locale toLocale _ (Just l, c) = Locale l c toLocale l _ = l diff --git a/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs index 336e73d5f9f..6095ba6441d 100644 --- a/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs @@ -131,8 +131,8 @@ createInvitation' tid mExpectedInvId inviteeRole mbInviterUid inviterEmail invRe mEmailOwner <- getLocalUserAccountByUserKey uke isPersonalUserMigration <- case mEmailOwner of Nothing -> pure False - Just account -> - if (account.accountStatus == Active && isNothing account.accountUser.userTeam) + Just user -> + if (user.userStatus == Active && isNothing user.userTeam) then pure True else throw TeamInvitationEmailTaken @@ -181,9 +181,7 @@ isPersonalUser uke = do pure $ case mAccount of -- this can e.g. happen if the key is claimed but the account is not yet created Nothing -> False - Just account -> - account.accountStatus == Active - && isNothing account.accountUser.userTeam + Just user -> user.userStatus == Active && isNothing user.userTeam -- | brig used to not store the role, so for migration we allow this to be empty and fill in the -- default here. diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem.hs b/libs/wire-subsystems/src/Wire/UserSubsystem.hs index 5ba2119a103..86f4304b064 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem.hs @@ -99,13 +99,13 @@ data UserSubsystem m a where -- | Sometimes we don't have any identity of a requesting user, and local profiles are public. GetLocalUserProfiles :: Local [UserId] -> UserSubsystem m [UserProfile] -- | Get the union of all user accounts matching the `GetBy` argument *and* having a non-empty UserIdentity. - GetExtendedAccountsBy :: Local GetBy -> UserSubsystem m [ExtendedUserAccount] + GetAccountsBy :: Local GetBy -> UserSubsystem m [User] -- | Get user accounts matching the `[EmailAddress]` argument (accounts with missing -- identity and accounts with status /= active included). - GetExtendedAccountsByEmailNoFilter :: Local [EmailAddress] -> UserSubsystem m [ExtendedUserAccount] + GetAccountsByEmailNoFilter :: Local [EmailAddress] -> UserSubsystem m [User] -- | Get user account by local user id (accounts with missing identity and accounts with -- status /= active included). - GetAccountNoFilter :: Local UserId -> UserSubsystem m (Maybe UserAccount) + GetAccountNoFilter :: Local UserId -> UserSubsystem m (Maybe User) -- | Get `SelfProfile` (it contains things not present in `UserProfile`). GetSelfProfile :: Local UserId -> UserSubsystem m (Maybe SelfProfile) -- | Simple updates (as opposed to, eg., handle, where we need to manage locks). Empty fields are ignored (not deleted). @@ -152,10 +152,6 @@ data CheckHandleResp makeSem ''UserSubsystem --- | given a lookup criteria record ('GetBy'), return the union of the user accounts fulfilling that criteria -getAccountsBy :: (Member UserSubsystem r) => Local GetBy -> Sem r [UserAccount] -getAccountsBy getby = (.account) <$$> getExtendedAccountsBy getby - getUserProfile :: (Member UserSubsystem r) => Local UserId -> Qualified UserId -> Sem r (Maybe UserProfile) getUserProfile luid targetUser = listToMaybe <$> getUserProfiles luid [targetUser] @@ -171,7 +167,7 @@ getLocalAccountBy :: (Member UserSubsystem r) => HavePendingInvitations -> Local UserId -> - Sem r (Maybe UserAccount) + Sem r (Maybe User) getLocalAccountBy includePendingInvitations uid = listToMaybe <$> getAccountsBy @@ -182,9 +178,9 @@ getLocalAccountBy includePendingInvitations uid = } ) -getLocalUserAccountByUserKey :: (Member UserSubsystem r) => Local EmailKey -> Sem r (Maybe UserAccount) +getLocalUserAccountByUserKey :: (Member UserSubsystem r) => Local EmailKey -> Sem r (Maybe User) getLocalUserAccountByUserKey q@(tUnqualified -> ek) = - listToMaybe . fmap (.account) <$> getExtendedAccountsByEmailNoFilter (qualifyAs q [emailKeyOrig ek]) + listToMaybe <$> getAccountsByEmailNoFilter (qualifyAs q [emailKeyOrig ek]) ------------------------------------------ -- FUTUREWORK: Pending functions for a team subsystem diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index c0cfd1e02d2..98e4bd97b6f 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs @@ -114,12 +114,12 @@ runUserSubsystem cfg authInterpreter = GetLocalUserProfiles others -> runInputConst cfg $ getLocalUserProfilesImpl others - GetExtendedAccountsBy getBy -> + GetAccountsBy getBy -> runInputConst cfg $ - getExtendedAccountsByImpl getBy - GetExtendedAccountsByEmailNoFilter emails -> + getAccountsByImpl getBy + GetAccountsByEmailNoFilter emails -> runInputConst cfg $ - getExtendedAccountsByEmailNoFilterImpl emails + getAccountsByEmailNoFilterImpl emails GetAccountNoFilter luid -> runInputConst cfg $ getAccountNoFilterImpl luid @@ -820,31 +820,31 @@ getAccountNoFilterImpl :: Member (Input UserSubsystemConfig) r ) => Local UserId -> - Sem r (Maybe UserAccount) + Sem r (Maybe User) getAccountNoFilterImpl (tSplit -> (domain, uid)) = do cfg <- input muser <- getUser uid - pure $ (mkAccountFromStored domain cfg.defaultLocale) <$> muser + pure $ (mkUserFromStored domain cfg.defaultLocale) <$> muser -getExtendedAccountsByEmailNoFilterImpl :: +getAccountsByEmailNoFilterImpl :: forall r. ( Member UserStore r, Member UserKeyStore r, Member (Input UserSubsystemConfig) r ) => Local [EmailAddress] -> - Sem r [ExtendedUserAccount] -getExtendedAccountsByEmailNoFilterImpl (tSplit -> (domain, emails)) = do + Sem r [User] +getAccountsByEmailNoFilterImpl (tSplit -> (domain, emails)) = do config <- input nubOrd <$> flip foldMap emails \ek -> do mactiveUid <- lookupKey (mkEmailKey ek) getUsers (nubOrd . catMaybes $ [mactiveUid]) - <&> map (mkExtendedAccountFromStored domain config.defaultLocale) + <&> map (mkUserFromStored domain config.defaultLocale) -------------------------------------------------------------------------------- -- getting user accounts by different criteria -getExtendedAccountsByImpl :: +getAccountsByImpl :: forall r. ( Member UserStore r, Member DeleteQueue r, @@ -853,16 +853,16 @@ getExtendedAccountsByImpl :: Member TinyLog r ) => Local GetBy -> - Sem r [ExtendedUserAccount] -getExtendedAccountsByImpl (tSplit -> (domain, MkGetBy {includePendingInvitations, getByHandle, getByUserId})) = do + Sem r [User] +getAccountsByImpl (tSplit -> (domain, MkGetBy {includePendingInvitations, getByHandle, getByUserId})) = do storedToExtAcc <- do config <- input - pure $ mkExtendedAccountFromStored domain config.defaultLocale + pure $ mkUserFromStored domain config.defaultLocale handleUserIds :: [UserId] <- wither lookupHandle getByHandle - accsByIds :: [ExtendedUserAccount] <- + accsByIds :: [User] <- getUsers (nubOrd $ handleUserIds <> getByUserId) <&> map storedToExtAcc filterM want (nubOrd $ accsByIds) @@ -871,11 +871,11 @@ getExtendedAccountsByImpl (tSplit -> (domain, MkGetBy {includePendingInvitations -- . users without identity -- . pending users without matching invitation (those are garbage-collected) -- . TODO: deleted users? - want :: ExtendedUserAccount -> Sem r Bool - want ExtendedUserAccount {account} = - case account.accountUser.userIdentity of + want :: User -> Sem r Bool + want user = + case user.userIdentity of Nothing -> pure False - Just ident -> case account.accountStatus of + Just ident -> case user.userStatus of PendingInvitation -> case includePendingInvitations of WithPendingInvitations -> case emailIdentity ident of @@ -884,7 +884,7 @@ getExtendedAccountsByImpl (tSplit -> (domain, MkGetBy {includePendingInvitations -- validEmailIdentity, anyEmailIdentity? Just email -> do hasInvitation <- isJust <$> lookupInvitationByEmail email - gcHack hasInvitation (User.userId account.accountUser) + gcHack hasInvitation (User.userId user) pure hasInvitation Nothing -> error "getExtendedAccountsByImpl: should never happen, user invited via scim always has an email" NoPendingInvitations -> pure False diff --git a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs index 4a7572ec306..f553aa595dc 100644 --- a/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs @@ -53,7 +53,7 @@ type AllEffects = State (Map EmailAddress [SentMail]) ] -runAllEffects :: Domain -> [ExtendedUserAccount] -> Maybe [Text] -> Sem AllEffects a -> Either AuthenticationSubsystemError a +runAllEffects :: Domain -> [User] -> Maybe [Text] -> Sem AllEffects a -> Either AuthenticationSubsystemError a runAllEffects localDomain preexistingUsers mAllowedEmailDomains = run . evalState mempty @@ -77,11 +77,16 @@ spec = describe "AuthenticationSubsystem.Interpreter" do describe "password reset" do prop "password reset should work with the email being used as password reset key" $ \email userNoEmail (cookiesWithTTL :: [(Cookie (), Maybe TTL)]) mPreviousPassword newPassword -> - let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + let user = + userNoEmail + { userIdentity = Just $ EmailIdentity email, + userEmailUnvalidated = Nothing, + userStatus = Active + } uid = User.userId user localDomain = userNoEmail.userQualifiedId.qDomain Right (newPasswordHash, cookiesAfterReset) = - runAllEffects localDomain [ExtendedUserAccount (UserAccount user Active) Nothing] Nothing $ do + runAllEffects localDomain [user] Nothing $ do forM_ mPreviousPassword (hashPassword >=> upsertHashedPassword uid) mapM_ (uncurry (insertCookie uid)) cookiesWithTTL @@ -96,11 +101,16 @@ spec = describe "AuthenticationSubsystem.Interpreter" do prop "password reset should work with the returned password reset key" $ \email userNoEmail (cookiesWithTTL :: [(Cookie (), Maybe TTL)]) mPreviousPassword newPassword -> - let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + let user = + userNoEmail + { userIdentity = Just $ EmailIdentity email, + userEmailUnvalidated = Nothing, + userStatus = Active + } uid = User.userId user localDomain = userNoEmail.userQualifiedId.qDomain Right (newPasswordHash, cookiesAfterReset) = - runAllEffects localDomain [ExtendedUserAccount (UserAccount user Active) Nothing] Nothing $ do + runAllEffects localDomain [user] Nothing $ do forM_ mPreviousPassword (hashPassword >=> upsertHashedPassword uid) mapM_ (uncurry (insertCookie uid)) cookiesWithTTL @@ -124,23 +134,32 @@ spec = describe "AuthenticationSubsystem.Interpreter" do prop "reset code is generated when email is in allow list" $ \email userNoEmail -> - let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + let user = + userNoEmail + { userIdentity = Just $ EmailIdentity email, + userEmailUnvalidated = Nothing, + userStatus = Active + } localDomain = userNoEmail.userQualifiedId.qDomain createPasswordResetCodeResult = - runAllEffects localDomain [ExtendedUserAccount (UserAccount user Active) Nothing] (Just [decodeUtf8 $ domainPart email]) $ + runAllEffects localDomain [user] (Just [decodeUtf8 $ domainPart email]) $ createPasswordResetCode (mkEmailKey email) in counterexample ("expected Right, got: " <> show createPasswordResetCodeResult) $ isRight createPasswordResetCodeResult prop "reset code is not generated for when user's status is not Active" $ - \email userNoEmail status -> - let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + \email userNoEmail -> + let user = + userNoEmail + { userIdentity = Just $ EmailIdentity email, + userEmailUnvalidated = Nothing + } localDomain = userNoEmail.userQualifiedId.qDomain createPasswordResetCodeResult = - runAllEffects localDomain [ExtendedUserAccount (UserAccount user status) Nothing] Nothing $ + runAllEffects localDomain [user] Nothing $ createPasswordResetCode (mkEmailKey email) <* expectNoEmailSent - in status /= Active ==> + in userStatus user /= Active ==> createPasswordResetCodeResult === Right () prop "reset code is not generated for when there is no user for the email" $ @@ -153,11 +172,16 @@ spec = describe "AuthenticationSubsystem.Interpreter" do prop "reset code is only generated once" $ \email userNoEmail newPassword -> - let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + let user = + userNoEmail + { userIdentity = Just $ EmailIdentity email, + userEmailUnvalidated = Nothing, + userStatus = Active + } uid = User.userId user localDomain = userNoEmail.userQualifiedId.qDomain Right (newPasswordHash, mCaughtException) = - runAllEffects localDomain [ExtendedUserAccount (UserAccount user Active) Nothing] Nothing $ do + runAllEffects localDomain [user] Nothing $ do createPasswordResetCode (mkEmailKey email) (_, code) <- expect1ResetPasswordEmail email @@ -172,11 +196,16 @@ spec = describe "AuthenticationSubsystem.Interpreter" do prop "reset code is not accepted after expiry" $ \email userNoEmail oldPassword newPassword -> - let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + let user = + userNoEmail + { userIdentity = Just $ EmailIdentity email, + userEmailUnvalidated = Nothing, + userStatus = Active + } uid = User.userId user localDomain = userNoEmail.userQualifiedId.qDomain Right (passwordInDB, resetPasswordResult) = - runAllEffects localDomain [ExtendedUserAccount (UserAccount user Active) Nothing] Nothing $ do + runAllEffects localDomain [user] Nothing $ do upsertHashedPassword uid =<< hashPassword oldPassword createPasswordResetCode (mkEmailKey email) (_, code) <- expect1ResetPasswordEmail email @@ -190,11 +219,16 @@ spec = describe "AuthenticationSubsystem.Interpreter" do prop "password reset is not allowed with arbitrary codes when no other codes exist" $ \email userNoEmail resetCode oldPassword newPassword -> - let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + let user = + userNoEmail + { userIdentity = Just $ EmailIdentity email, + userEmailUnvalidated = Nothing, + userStatus = Active + } uid = User.userId user localDomain = userNoEmail.userQualifiedId.qDomain Right (passwordInDB, resetPasswordResult) = - runAllEffects localDomain [ExtendedUserAccount (UserAccount user Active) Nothing] Nothing $ do + runAllEffects localDomain [user] Nothing $ do upsertHashedPassword uid =<< hashPassword oldPassword mCaughtExc <- catchExpectedError $ resetPassword (PasswordResetEmailIdentity email) resetCode newPassword (,mCaughtExc) <$> lookupHashedPassword uid @@ -203,11 +237,16 @@ spec = describe "AuthenticationSubsystem.Interpreter" do prop "password reset doesn't work if email is wrong" $ \email wrongEmail userNoEmail resetCode oldPassword newPassword -> - let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + let user = + userNoEmail + { userIdentity = Just $ EmailIdentity email, + userEmailUnvalidated = Nothing, + userStatus = Active + } uid = User.userId user localDomain = userNoEmail.userQualifiedId.qDomain Right (passwordInDB, resetPasswordResult) = - runAllEffects localDomain [ExtendedUserAccount (UserAccount user Active) Nothing] Nothing $ do + runAllEffects localDomain [user] Nothing $ do hashAndUpsertPassword uid oldPassword mCaughtExc <- catchExpectedError $ resetPassword (PasswordResetEmailIdentity wrongEmail) resetCode newPassword (,mCaughtExc) <$> lookupHashedPassword uid @@ -217,11 +256,16 @@ spec = describe "AuthenticationSubsystem.Interpreter" do prop "only 3 wrong password reset attempts are allowed" $ \email userNoEmail arbitraryResetCode oldPassword newPassword (Upto4 wrongResetAttempts) -> - let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + let user = + userNoEmail + { userIdentity = Just $ EmailIdentity email, + userEmailUnvalidated = Nothing, + userStatus = Active + } uid = User.userId user localDomain = userNoEmail.userQualifiedId.qDomain Right (passwordHashInDB, correctResetCode, wrongResetErrors, resetPassworedWithCorectCodeResult) = - runAllEffects localDomain [ExtendedUserAccount (UserAccount user Active) Nothing] Nothing $ do + runAllEffects localDomain [user] Nothing $ do upsertHashedPassword uid =<< hashPassword oldPassword createPasswordResetCode (mkEmailKey email) (_, generatedResetCode) <- expect1ResetPasswordEmail email @@ -249,11 +293,16 @@ spec = describe "AuthenticationSubsystem.Interpreter" do describe "internalLookupPasswordResetCode" do prop "should find password reset code by email" $ \email userNoEmail newPassword -> - let user = userNoEmail {userIdentity = Just $ EmailIdentity email} + let user = + userNoEmail + { userIdentity = Just $ EmailIdentity email, + userEmailUnvalidated = Nothing, + userStatus = Active + } uid = User.userId user localDomain = userNoEmail.userQualifiedId.qDomain Right passwordHashInDB = - runAllEffects localDomain [ExtendedUserAccount (UserAccount user Active) Nothing] Nothing $ do + runAllEffects localDomain [user] Nothing $ do void $ createPasswordResetCode (mkEmailKey email) mLookupRes <- internalLookupPasswordResetCode (mkEmailKey email) for_ mLookupRes $ \(_, code) -> resetPassword (PasswordResetEmailIdentity email) code newPassword diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs index 45dc93a379a..839ced4e5ad 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs @@ -7,12 +7,12 @@ import Wire.API.User import Wire.UserSubsystem -- HINT: This is used to test AuthenticationSubsystem, not to test itself! -userSubsystemTestInterpreter :: [ExtendedUserAccount] -> InterpreterFor UserSubsystem r +userSubsystemTestInterpreter :: [User] -> InterpreterFor UserSubsystem r userSubsystemTestInterpreter initialUsers = interpret \case - GetExtendedAccountsByEmailNoFilter (tUnqualified -> emails) -> + GetAccountsByEmailNoFilter (tUnqualified -> emails) -> pure $ filter - (\u -> userEmail u.account.accountUser `elem` (Just <$> emails)) + (\u -> userEmail u `elem` (Just <$> emails)) initialUsers _ -> error $ "userSubsystemTestInterpreter: implement on demand" diff --git a/libs/wire-subsystems/test/unit/Wire/UserStoreSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserStoreSpec.hs index b1cbf972f98..5f9192c469b 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserStoreSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserStoreSpec.hs @@ -20,7 +20,7 @@ spec = do prop "user deleted" $ \domain defaultLocale storedUser -> let user = mkUserFromStored domain defaultLocale storedUser - in user.userDeleted === (storedUser.status == Just Deleted) + in userDeleted user === (storedUser.status == Just Deleted) prop "user expires" $ \domain defaultLocale storedUser -> let user = mkUserFromStored domain defaultLocale storedUser diff --git a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs index fbefec47a3f..721f8479645 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs @@ -347,7 +347,7 @@ spec = describe "UserSubsystem.Interpreter" do result = runNoFederationStack localBackend Nothing config $ getAccountsBy getBy - in result === [mkAccountFromStored localDomain locale alice] + in result === [mkUserFromStored localDomain locale alice] prop "GetBy handle when pending fails if not explicitly allowed" $ \(PendingNotEmptyIdentityStoredUser alice') handl email teamId invitationInfo localDomain visibility locale -> let config = UserSubsystemConfig visibility locale True 100 @@ -418,7 +418,7 @@ spec = describe "UserSubsystem.Interpreter" do result = runNoFederationStack localBackend Nothing config $ getAccountsBy getBy - in result === [mkAccountFromStored localDomain locale alice] + in result === [mkUserFromStored localDomain locale alice] prop "GetBy email does not filter by pending, missing identity or expired invitations" $ \(alice' :: StoredUser) email localDomain visibility locale -> @@ -431,8 +431,8 @@ spec = describe "UserSubsystem.Interpreter" do } result = runNoFederationStack localBackend Nothing config $ - getExtendedAccountsByEmailNoFilter (toLocalUnsafe localDomain [email]) - in result === [mkExtendedAccountFromStored localDomain locale alice] + getAccountsByEmailNoFilter (toLocalUnsafe localDomain [email]) + in result === [mkUserFromStored localDomain locale alice] prop "GetBy userId does not return missing identity users, pending invitation off" $ \(NotPendingEmptyIdentityStoredUser alice) localDomain visibility locale -> @@ -491,7 +491,7 @@ spec = describe "UserSubsystem.Interpreter" do result = runNoFederationStack localBackend Nothing config $ getAccountsBy getBy - in result === [mkAccountFromStored localDomain locale alice] + in result === [mkUserFromStored localDomain locale alice] prop "GetBy pending user by id fails if there is no valid invitation" $ \(PendingNotEmptyIdentityStoredUser alice') (email :: EmailAddress) teamId localDomain visibility locale -> @@ -546,7 +546,7 @@ spec = describe "UserSubsystem.Interpreter" do result = runNoFederationStack localBackend Nothing config $ getAccountsBy getBy - in result === [mkAccountFromStored localDomain locale alice] + in result === [mkUserFromStored localDomain locale alice] prop "GetBy pending user by handle fails if there is no valid invitation" $ \(PendingNotEmptyIdentityStoredUser alice') (email :: EmailAddress) handl teamId localDomain visibility locale -> @@ -786,7 +786,7 @@ spec = describe "UserSubsystem.Interpreter" do runAllErrorsUnsafe . interpretNoFederationStack localBackend Nothing def config $ getLocalUserAccountByUserKey (toLocalUnsafe localDomain userKey) - in retrievedUser === Just (mkAccountFromStored localDomain config.defaultLocale storedUser) + in retrievedUser === Just (mkUserFromStored localDomain config.defaultLocale storedUser) prop "doesn't get users if they are not indexed by the UserKeyStore" $ \(config :: UserSubsystemConfig) (localDomain :: Domain) (storedUserNoEmail :: StoredUser) (email :: EmailAddress) -> diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 08cac151d6d..ce9cd717a7e 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -192,7 +192,9 @@ addClientWithReAuthPolicy :: NewClient -> ExceptT ClientError (AppT r) Client addClientWithReAuthPolicy policy luid@(tUnqualified -> u) con new = do - usr <- (lift . liftSem $ User.getAccountNoFilter luid) >>= maybe (throwE (ClientUserNotFound u)) (pure . (.accountUser)) + usr <- + (lift . liftSem $ User.getAccountNoFilter luid) + >>= maybe (throwE (ClientUserNotFound u)) pure verifyCode (newClientVerificationCode new) luid maxPermClients <- fromMaybe Opt.defUserMaxPermClients <$> asks (.settings.userMaxPermClients) let caps :: Maybe ClientCapabilityList diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 33f79d6ec34..3d5c3b16fed 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -473,14 +473,13 @@ createUserNoVerify :: createUserNoVerify uData = lift . runExceptT $ do result <- API.createUser uData let acc = createdAccount result - let usr = accountUser acc - let uid = userId usr + let uid = userId acc let eac = createdEmailActivation result for_ eac $ \adata -> let key = ActivateKey $ activationKey adata code = activationCode adata in API.activate key code (Just uid) !>> activationErrorToRegisterError - pure . SelfProfile $ usr + pure . SelfProfile $ acc createUserNoVerifySpar :: ( Member GalleyAPIAccess r, @@ -495,14 +494,13 @@ createUserNoVerifySpar uData = lift . runExceptT $ do result <- API.createUserSpar uData let acc = createdAccount result - let usr = accountUser acc - let uid = userId usr + let uid = userId acc let eac = createdEmailActivation result for_ eac $ \adata -> let key = ActivateKey $ activationKey adata code = activationCode adata in API.activate key code (Just uid) !>> CreateUserSparRegistrationError . activationErrorToRegisterError - pure . SelfProfile $ usr + pure . SelfProfile $ acc deleteUserNoAuthH :: ( Member (Embed HttpClientIO) r, @@ -570,7 +568,7 @@ listActivatedAccountsH :: Maybe (CommaSeparatedList Handle) -> Maybe (CommaSeparatedList EmailAddress) -> Maybe Bool -> - Handler r [ExtendedUserAccount] + Handler r [User] listActivatedAccountsH (maybe [] fromCommaSeparatedList -> uids) (maybe [] fromCommaSeparatedList -> handles) @@ -580,9 +578,9 @@ listActivatedAccountsH throwStd (notFound "no user keys") lift $ liftSem do loc <- input - byEmails <- getExtendedAccountsByEmailNoFilter $ loc $> emails + byEmails <- getAccountsByEmailNoFilter $ loc $> emails others <- - getExtendedAccountsBy $ + getAccountsBy $ loc $> def { includePendingInvitations = include, diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index fc460854766..98f151e3763 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -51,7 +51,7 @@ import Brig.Provider.API import Brig.Team.API qualified as Team import Brig.Team.Email qualified as Team import Brig.Types.Activation (ActivationPair) -import Brig.Types.Intra (UserAccount (UserAccount, accountUser)) +import Brig.Types.Intra import Brig.User.API.Handle qualified as Handle import Brig.User.Auth.Cookie qualified as Auth import Cassandra qualified as C @@ -659,7 +659,7 @@ getRichInfo lself user = do -- other user let fetch luid = ifNothing (errorToWai @'E.UserNotFound) - =<< lift (liftSem $ (.accountUser) <$$> User.getLocalAccountBy NoPendingInvitations luid) + =<< lift (liftSem $ User.getLocalAccountBy NoPendingInvitations luid) selfUser <- fetch lself otherUser <- fetch luser case (Public.userTeam selfUser, Public.userTeam otherUser) of @@ -754,39 +754,38 @@ createUser (Public.NewUserPublic new) = lift . runExceptT $ do let epair = (,) <$> (activationKey <$> eac) <*> (activationCode <$> eac) let newUserLabel = Public.newUserLabel new let newUserTeam = Public.newUserTeam new - let usr = accountUser acc let context = let invitationCode = case Public.newUserTeam new of (Just (Public.NewTeamMember code)) -> Just code _ -> Nothing in ( logFunction "Brig.API.Public.createUser" - . logUser (Public.userId usr) - . maybe id logHandle (Public.userHandle usr) - . maybe id logTeam (Public.userTeam usr) - . maybe id logEmail (Public.userEmail usr) + . logUser (Public.userId acc) + . maybe id logHandle (Public.userHandle acc) + . maybe id logTeam (Public.userTeam acc) + . maybe id logEmail (Public.userEmail acc) . maybe id logInvitationCode invitationCode ) lift . Log.info $ context . Log.msg @Text "Sucessfully created user" - let Public.User {userLocale, userDisplayName} = usr - userEmail = Public.userEmail usr - userId = Public.userId usr + let Public.User {userLocale, userDisplayName} = acc + userEmail = Public.userEmail acc + userId = Public.userId acc lift $ do for_ (liftM2 (,) userEmail epair) $ \(e, p) -> sendActivationEmail e userDisplayName p (Just userLocale) newUserTeam for_ (liftM3 (,,) userEmail (createdUserTeam result) newUserTeam) $ \(e, ct, ut) -> sendWelcomeEmail e ct ut (Just userLocale) cok <- - Auth.toWebCookie =<< case acc of - UserAccount _ Public.Ephemeral -> + Auth.toWebCookie =<< case userStatus acc of + Public.Ephemeral -> lift . wrapHttpClient $ Auth.newCookie @ZAuth.User userId Nothing Public.SessionCookie newUserLabel - UserAccount _ _ -> + _ -> lift . wrapHttpClient $ Auth.newCookie @ZAuth.User userId Nothing Public.PersistentCookie newUserLabel - -- pure $ CreateUserResponse cok userId (Public.SelfProfile usr) - pure $ Public.RegisterSuccess cok (Public.SelfProfile usr) + -- pure $ CreateUserResponse cok userId (Public.SelfProfile acc) + pure $ Public.RegisterSuccess cok (Public.SelfProfile acc) where sendActivationEmail :: (Member EmailSubsystem r) => Public.EmailAddress -> Public.Name -> ActivationPair -> Maybe Public.Locale -> Maybe Public.NewTeamUser -> (AppT r) () sendActivationEmail email name (key, code) locale mTeamUser @@ -1348,11 +1347,11 @@ sendVerificationCode req = do (scopeFromAction action) (Retries 3) timeout - (Just $ toUUID $ Public.userId $ accountUser account) - sendMail email code.codeValue (Just $ Public.userLocale $ accountUser account) action + (Just $ toUUID $ Public.userId $ account) + sendMail email code.codeValue (Just (Public.userLocale account)) action _ -> pure () where - getAccount :: Public.EmailAddress -> (Handler r) (Maybe UserAccount) + getAccount :: Public.EmailAddress -> (Handler r) (Maybe User) getAccount email = lift . liftSem $ do mbUserId <- lookupKey $ mkEmailKey email mbLUserId <- qualifyLocal' `traverse` mbUserId @@ -1365,9 +1364,9 @@ sendVerificationCode req = do Public.Login -> sendLoginVerificationMail email value mbLocale Public.DeleteTeam -> sendTeamDeletionVerificationMail email value mbLocale - getFeatureStatus :: Maybe UserAccount -> (Handler r) Bool + getFeatureStatus :: Maybe User -> (Handler r) Bool getFeatureStatus mbAccount = do - mbStatusEnabled <- lift $ liftSem $ GalleyAPIAccess.getVerificationCodeEnabled `traverse` (Public.userTeam <$> accountUser =<< mbAccount) + mbStatusEnabled <- lift $ liftSem $ GalleyAPIAccess.getVerificationCodeEnabled `traverse` (Public.userTeam =<< mbAccount) pure $ fromMaybe False mbStatusEnabled getSystemSettings :: (Handler r) SystemSettingsPublic diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs index 97d15e8c06b..d83e258932e 100644 --- a/services/brig/src/Brig/API/Types.hs +++ b/services/brig/src/Brig/API/Types.hs @@ -50,7 +50,7 @@ import Wire.UserKeyStore data CreateUserResult = CreateUserResult { -- | The newly created user account. - createdAccount :: !UserAccount, + createdAccount :: !User, -- | Activation data for the registered email address, if any. createdEmailActivation :: !(Maybe Activation), -- | Info of a team just created/joined diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 7719f808ac0..0477c86f754 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -205,7 +205,7 @@ createUserSpar new = do account <- lift $ do (account, pw) <- wrapClient $ newAccount new' Nothing (Just tid) handle' - let uid = userId (accountUser account) + let uid = userId account -- FUTUREWORK: make this transactional if possible wrapClient $ Data.insertAccount account Nothing pw False @@ -214,7 +214,7 @@ createUserSpar new = do Nothing -> pure () -- Nothing to do liftSem $ GalleyAPIAccess.createSelfConv uid liftSem $ User.internalUpdateSearchIndex uid - liftSem $ Events.generateUserEvent uid Nothing (UserCreated (accountUser account)) + liftSem $ Events.generateUserEvent uid Nothing (UserCreated account) pure account @@ -222,7 +222,7 @@ createUserSpar new = do userTeam <- withExceptT CreateUserSparRegistrationError $ addUserToTeamSSO account tid (SSOIdentity ident Nothing) (newUserSparRole new) -- Set up feature flags - luid <- lift $ ensureLocal (userQualifiedId (accountUser account)) + luid <- lift $ ensureLocal (userQualifiedId account) lift $ initAccountFeatureConfig (tUnqualified luid) -- Set handle @@ -235,9 +235,9 @@ createUserSpar new = do updateHandle' luid (Just h) = liftSem $ User.updateHandle luid Nothing UpdateOriginScim (fromHandle h) - addUserToTeamSSO :: UserAccount -> TeamId -> UserIdentity -> Role -> ExceptT RegisterError (AppT r) CreateUserTeam + addUserToTeamSSO :: User -> TeamId -> UserIdentity -> Role -> ExceptT RegisterError (AppT r) CreateUserTeam addUserToTeamSSO account tid ident role = do - let uid = userId (accountUser account) + let uid = userId account added <- lift $ liftSem $ GalleyAPIAccess.addTeamMember uid tid Nothing role unless added $ throwE RegisterErrorTooManyTeamMembers @@ -350,9 +350,8 @@ createUser new = do Nothing ) Just existingAccount -> - let existingUser = existingAccount.accountUser - mbSSOid = - case (teamInvitation, email, existingUser.userManagedBy, userSSOId existingUser) of + let mbSSOid = + case (teamInvitation, email, existingAccount.userManagedBy, userSSOId existingAccount) of -- isJust teamInvitation And ManagedByScim implies that the -- user invitation has been generated by SCIM and there is no IdP (Just _, _, ManagedByScim, ssoId@(Just (UserScimExternalId _))) -> @@ -362,28 +361,28 @@ createUser new = do Just $ UserScimExternalId (fromEmail em) _ -> newUserSSOId new in ( new - { newUserManagedBy = Just existingUser.userManagedBy, + { newUserManagedBy = Just existingAccount.userManagedBy, newUserIdentity = newIdentity email mbSSOid }, - existingUser.userHandle + existingAccount.userHandle ) -- Create account account <- lift $ do (account, pw) <- wrapClient $ newAccount new' mbInv tid mbHandle - let uid = userId (accountUser account) + let uid = userId account liftSem $ do Log.debug $ field "user" (toByteString uid) . field "action" (val "User.createUser") Log.info $ field "user" (toByteString uid) . msg (val "Creating user") wrapClient $ Data.insertAccount account Nothing pw False liftSem $ GalleyAPIAccess.createSelfConv uid - liftSem $ Events.generateUserEvent uid Nothing (UserCreated (accountUser account)) + liftSem $ Events.generateUserEvent uid Nothing (UserCreated account) pure account - let uid = qUnqualified account.accountUser.userQualifiedId + let uid = qUnqualified account.userQualifiedId createUserTeam <- do activatedTeam <- lift $ do @@ -430,13 +429,13 @@ createUser new = do pure email acceptInvitationToTeam :: - UserAccount -> + User -> StoredInvitation -> EmailKey -> UserIdentity -> ExceptT RegisterError (AppT r) () acceptInvitationToTeam account inv uk ident = do - let uid = userId (accountUser account) + let uid = userId account ok <- lift $ liftSem $ claimKey uk uid unless ok $ throwE RegisterErrorUserKeyExists @@ -459,9 +458,9 @@ createUser new = do UserPendingActivationStore.remove uid InvitationCodeStore.deleteInvitation inv.teamId inv.invitationId - addUserToTeamSSO :: UserAccount -> TeamId -> UserIdentity -> ExceptT RegisterError (AppT r) CreateUserTeam + addUserToTeamSSO :: User -> TeamId -> UserIdentity -> ExceptT RegisterError (AppT r) CreateUserTeam addUserToTeamSSO account tid ident = do - let uid = userId (accountUser account) + let uid = userId account added <- lift $ liftSem $ GalleyAPIAccess.addTeamMember uid tid Nothing defaultRole unless added $ throwE RegisterErrorTooManyTeamMembers @@ -510,12 +509,12 @@ createUserInviteViaScim :: Member TinyLog r ) => NewUserScimInvitation -> - ExceptT HttpError (AppT r) UserAccount + ExceptT HttpError (AppT r) User createUserInviteViaScim (NewUserScimInvitation tid uid extId loc name email _) = do let emKey = mkEmailKey email verifyUniquenessAndCheckBlacklist emKey !>> identityErrorToBrigError account <- lift . wrapClient $ newAccountInviteViaScim uid extId tid loc name email - lift . liftSem . Log.debug $ field "user" (toByteString . userId . accountUser $ account) . field "action" (val "User.createUserInviteViaScim") + lift . liftSem . Log.debug $ field "user" (toByteString . userId $ account) . field "action" (val "User.createUserInviteViaScim") -- add the expiry table entry first! (if brig creates an account, and then crashes before -- creating the expiry table entry, gc will miss user data.) @@ -760,12 +759,12 @@ onActivated :: ActivationEvent -> AppT r (UserId, Maybe UserIdentity, Bool) onActivated (AccountActivated account) = liftSem $ do - let uid = userId (accountUser account) + let uid = userId account Log.debug $ field "user" (toByteString uid) . field "action" (val "User.onActivated") Log.info $ field "user" (toByteString uid) . msg (val "User activated") User.internalUpdateSearchIndex uid - Events.generateUserEvent uid Nothing $ UserActivated (accountUser account) - pure (uid, userIdentity (accountUser account), True) + Events.generateUserEvent uid Nothing $ UserActivated account + pure (uid, userIdentity account, True) onActivated (EmailActivated uid email) = do liftSem $ User.internalUpdateSearchIndex uid liftSem $ Events.generateUserEvent uid Nothing (emailUpdated uid email) @@ -895,22 +894,22 @@ deleteSelfUser luid@(tUnqualified -> uid) pwd = do account <- lift . liftSem $ User.getAccountNoFilter luid case account of Nothing -> throwE DeleteUserInvalid - Just a -> case accountStatus a of + Just a -> case userStatus a of Deleted -> pure Nothing Suspended -> ensureNotOwner a >> go a Active -> ensureNotOwner a >> go a Ephemeral -> go a PendingInvitation -> go a where - ensureNotOwner :: UserAccount -> ExceptT DeleteUserError (AppT r) () + ensureNotOwner :: User -> ExceptT DeleteUserError (AppT r) () ensureNotOwner acc = do - case userTeam $ accountUser acc of + case userTeam acc of Nothing -> pure () Just tid -> do isOwner <- lift $ liftSem $ GalleyAPIAccess.memberIsTeamOwner tid uid when isOwner $ throwE DeleteUserOwnerDeletingSelf go a = maybe (byIdentity a) (byPassword a) pwd - byIdentity a = case emailIdentity =<< userIdentity (accountUser a) of + byIdentity a = case emailIdentity =<< userIdentity a of Just email -> sendCode a email Nothing -> case pwd of Just _ -> throwE DeleteUserMissingPassword @@ -937,8 +936,8 @@ deleteSelfUser luid@(tUnqualified -> uid) pwd = do . msg (val "Sending verification code for account deletion") let k = VerificationCode.codeKey c let v = VerificationCode.codeValue c - let l = userLocale (accountUser a) - let n = userDisplayName (accountUser a) + let l = userLocale a + let n = userDisplayName a lift (liftSem $ sendAccountDeletionEmail target n k v l) `onException` lift (liftSem $ deleteCode k VerificationCode.AccountDeletion) pure $! Just $! VerificationCode.codeTTL c @@ -995,7 +994,6 @@ ensureAccountDeleted luid@(tUnqualified -> uid) = do Just acc -> do probs <- liftSem $ getPropertyKeys uid - let accIsDeleted = accountStatus acc == Deleted clients <- wrapClient $ Data.lookupClients uid localUid <- qualifyLocal uid @@ -1003,7 +1001,7 @@ ensureAccountDeleted luid@(tUnqualified -> uid) = do cookies <- wrapClient $ Auth.listCookies uid [] if notNull probs - || not accIsDeleted + || not (userDeleted acc) || notNull clients || conCount > 0 || notNull cookies @@ -1024,7 +1022,7 @@ ensureAccountDeleted luid@(tUnqualified -> uid) = do -- -- FUTUREWORK(mangoiv): this uses 'UserStore', hence it must be moved to 'UserSubsystem' -- as an effet operation --- FUTUREWORK: this does not need the whole UserAccount structure, only the User. +-- FUTUREWORK: this does not need the whole User structure, only the User. deleteAccount :: ( Member (Embed HttpClientIO) r, Member NotificationSubsystem r, @@ -1035,9 +1033,9 @@ deleteAccount :: Member UserSubsystem r, Member Events r ) => - UserAccount -> + User -> Sem r () -deleteAccount (accountUser -> user) = do +deleteAccount user = do let uid = userId user Log.info $ field "user" (toByteString uid) . msg (val "Deleting account") do @@ -1124,7 +1122,7 @@ getLegalHoldStatus :: AppT r (Maybe UserLegalHoldStatus) getLegalHoldStatus uid = liftSem $ - traverse (getLegalHoldStatus' . accountUser) + traverse getLegalHoldStatus' =<< User.getLocalAccountBy NoPendingInvitations uid getLegalHoldStatus' :: diff --git a/services/brig/src/Brig/Data/Activation.hs b/services/brig/src/Brig/Data/Activation.hs index 25745846b69..a7f94e58205 100644 --- a/services/brig/src/Brig/Data/Activation.hs +++ b/services/brig/src/Brig/Data/Activation.hs @@ -79,7 +79,7 @@ activationErrorToRegisterError = \case InvalidActivationPhone _ -> RegisterErrorInvalidPhone data ActivationEvent - = AccountActivated !UserAccount + = AccountActivated !User | EmailActivated !UserId !EmailAddress deriving (Show) @@ -106,19 +106,18 @@ activateKey k c u = wrapClientE (verifyCode k c) >>= pickUser >>= activate activate (key, uid) = do luid <- qualifyLocal uid a <- lift (liftSem $ User.getAccountNoFilter luid) >>= maybe (throwE invalidUser) pure - unless (accountStatus a == Active) $ -- this is never 'PendingActivation' in the flow this function is used in. + unless (userStatus a == Active) $ -- this is never 'PendingActivation' in the flow this function is used in. throwE invalidCode - case userIdentity (accountUser a) of + case userIdentity a of Nothing -> do claim key uid let ident = EmailIdentity (emailKeyOrig key) wrapClientE (activateUser uid ident) - let a' = a {accountUser = (accountUser a) {userIdentity = Just ident}} + let a' = a {userIdentity = Just ident} pure . Just $ AccountActivated a' Just _ -> do - let usr = accountUser a - profileNeedsUpdate = Just (emailKeyOrig key) /= userEmail usr - oldKey :: Maybe EmailKey = mkEmailKey <$> userEmail usr + let profileNeedsUpdate = Just (emailKeyOrig key) /= userEmail a + oldKey :: Maybe EmailKey = mkEmailKey <$> userEmail a in handleExistingIdentity uid profileNeedsUpdate oldKey key handleExistingIdentity :: diff --git a/services/brig/src/Brig/Data/User.hs b/services/brig/src/Brig/Data/User.hs index fec86b7a4e6..4e3013a19bd 100644 --- a/services/brig/src/Brig/Data/User.hs +++ b/services/brig/src/Brig/Data/User.hs @@ -112,7 +112,13 @@ data ReAuthError -- Condition (2.) is essential for maintaining handle uniqueness. It is guaranteed by the -- fact that we're setting getting @mbHandle@ from table @"user"@, and when/if it was added -- there, it was claimed properly. -newAccount :: (MonadClient m, MonadReader Env m) => NewUser -> Maybe InvitationId -> Maybe TeamId -> Maybe Handle -> m (UserAccount, Maybe Password) +newAccount :: + (MonadClient m, MonadReader Env m) => + NewUser -> + Maybe InvitationId -> + Maybe TeamId -> + Maybe Handle -> + m (User, Maybe Password) newAccount u inv tid mbHandle = do defLoc <- defaultUserLocale <$> asks (.settings) domain <- viewFederationDomain @@ -132,7 +138,7 @@ newAccount u inv tid mbHandle = do now <- liftIO =<< asks (.currentTime) pure . Just . toUTCTimeMillis $ addUTCTime (fromIntegral ttl) now _ -> pure Nothing - pure (UserAccount (user uid domain (locale defLoc) expiry) status, passwd) + pure (user uid domain (locale defLoc) expiry, passwd) where ident = newUserIdentity u pass = newUserPassword u @@ -147,32 +153,31 @@ newAccount u inv tid mbHandle = do locale defLoc = fromMaybe defLoc (newUserLocale u) managedBy = fromMaybe defaultManagedBy (newUserManagedBy u) prots = fromMaybe defSupportedProtocols (newUserSupportedProtocols u) - user uid domain l e = User (Qualified uid domain) ident name Nothing pict assets colour False l Nothing mbHandle e tid managedBy prots + user uid domain l e = User (Qualified uid domain) ident Nothing name Nothing pict assets colour status l Nothing mbHandle e tid managedBy prots -newAccountInviteViaScim :: (MonadReader Env m) => UserId -> Text -> TeamId -> Maybe Locale -> Name -> EmailAddress -> m UserAccount +newAccountInviteViaScim :: (MonadReader Env m) => UserId -> Text -> TeamId -> Maybe Locale -> Name -> EmailAddress -> m User newAccountInviteViaScim uid externalId tid locale name email = do defLoc <- defaultUserLocale <$> asks (.settings) let loc = fromMaybe defLoc locale domain <- viewFederationDomain - pure (UserAccount (user domain loc) PendingInvitation) - where - user domain loc = - User - (Qualified uid domain) - (Just $ SSOIdentity (UserScimExternalId externalId) (Just email)) - name - Nothing - (Pict []) - [] - defaultAccentId - False - loc - Nothing - Nothing - Nothing - (Just tid) - ManagedByScim - defSupportedProtocols + pure $ + User + (Qualified uid domain) + (Just $ SSOIdentity (UserScimExternalId externalId) (Just email)) + Nothing + name + Nothing + (Pict []) + [] + defaultAccentId + PendingInvitation + loc + Nothing + Nothing + Nothing + (Just tid) + ManagedByScim + defSupportedProtocols -- | Mandatory password authentication. authenticate :: forall r. (Member PasswordStore r) => UserId -> PlainTextPassword6 -> ExceptT AuthError (AppT r) () @@ -234,7 +239,7 @@ isSamlUser usr = do insertAccount :: (MonadClient m) => - UserAccount -> + User -> -- | If a bot: conversation and team -- (if a team conversation) Maybe (ConvId, Maybe TeamId) -> @@ -242,7 +247,7 @@ insertAccount :: -- | Whether the user is activated Bool -> m () -insertAccount (UserAccount u status) mbConv password activated = retry x5 . batch $ do +insertAccount u mbConv password activated = retry x5 . batch $ do setType BatchLogged setConsistency LocalQuorum let Locale l c = userLocale u @@ -258,7 +263,7 @@ insertAccount (UserAccount u status) mbConv password activated = retry x5 . batc userAccentId u, password, activated, - status, + userStatus u, userExpire u, l, c, @@ -598,7 +603,7 @@ toUsers domain defLocale havePendingInvitations = fmap mk . filter fp textStatus, pict, email, - _emailUnvalidated, + emailUnvalidated, ssoid, accent, assets, @@ -615,19 +620,19 @@ toUsers domain defLocale havePendingInvitations = fmap mk . filter fp prots ) = let ident = toIdentity activated email ssoid - deleted = Just Deleted == status expiration = if status == Just Ephemeral then expires else Nothing loc = toLocaleWithDefault defLocale (lan, con) svc = newServiceRef <$> sid <*> pid in User (Qualified uid domain) ident + emailUnvalidated name textStatus (fromMaybe noPict pict) (fromMaybe [] assets) accent - deleted + (fromMaybe Active status) loc svc handle diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 8630afafef4..dea4ba451c5 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -713,12 +713,12 @@ addBot zuid zcon cid add = do let colour = fromMaybe defaultAccentId (Ext.rsNewBotColour rs) let pict = Pict [] -- Legacy let sref = newServiceRef sid pid - let usr = User (Qualified (botUserId bid) domain) Nothing name Nothing pict assets colour False locale (Just sref) Nothing Nothing Nothing ManagedByWire defSupportedProtocols + let usr = User (Qualified (botUserId bid) domain) Nothing Nothing name Nothing pict assets colour Active locale (Just sref) Nothing Nothing Nothing ManagedByWire defSupportedProtocols let newClt = (newClient PermanentClientType (Ext.rsNewBotLastPrekey rs)) { newClientPrekeys = Ext.rsNewBotPrekeys rs } - lift $ wrapClient $ User.insertAccount (UserAccount usr Active) (Just (cid, cnvTeam cnv)) Nothing True + lift $ wrapClient $ User.insertAccount usr (Just (cid, cnvTeam cnv)) Nothing True maxPermClients <- fromMaybe Opt.defUserMaxPermClients <$> asks (.settings.userMaxPermClients) (clt, _, _) <- do _ <- do diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 8b13deab2ef..0622ce07e7b 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -144,7 +144,7 @@ createInvitationViaScim :: ) => TeamId -> NewUserScimInvitation -> - (Handler r) UserAccount + Handler r User createInvitationViaScim tid newUser@(NewUserScimInvitation _tid _uid@(Id (Id -> invId)) _eid loc name email role) = do env <- ask let inviteeRole = role @@ -345,9 +345,7 @@ isPersonalUser uke = do pure $ case mAccount of -- this can e.g. happen if the key is claimed but the account is not yet created Nothing -> False - Just account -> - account.accountStatus == Active - && isNothing account.accountUser.userTeam + Just account -> account.userStatus == Active && isNothing account.userTeam getInvitationByCode :: ( Member Store.InvitationCodeStore r, diff --git a/services/brig/src/Brig/User/Auth.hs b/services/brig/src/Brig/User/Auth.hs index 7ef94976f13..39c5b1ef139 100644 --- a/services/brig/src/Brig/User/Auth.hs +++ b/services/brig/src/Brig/User/Auth.hs @@ -135,7 +135,7 @@ verifyCode mbCode action luid = do mbFeatureEnabled <- liftSem $ GalleyAPIAccess.getVerificationCodeEnabled `traverse` mbTeamId pure $ fromMaybe ((def @(Feature Public.SndFactorPasswordChallengeConfig)).status == Public.FeatureStatusEnabled) mbFeatureEnabled account <- lift . liftSem $ User.getAccountNoFilter luid - let isSsoUser = maybe False (Data.isSamlUser . ((.accountUser))) account + let isSsoUser = maybe False Data.isSamlUser account when (featureEnabled && not isSsoUser) $ do case (mbCode, mbEmail) of (Just code, Just email) -> do @@ -151,7 +151,10 @@ verifyCode mbCode action luid = do ExceptT e (AppT r) (Maybe EmailAddress, Maybe TeamId) getEmailAndTeamId u = do mbAccount <- lift . liftSem $ User.getAccountNoFilter u - pure (userEmail <$> accountUser =<< mbAccount, userTeam <$> accountUser =<< mbAccount) + pure + ( userEmail =<< mbAccount, + userTeam =<< mbAccount + ) loginFailedWith :: (MonadClient m, MonadReader Env m) => LoginError -> UserId -> ExceptT LoginError m () loginFailedWith e uid = decrRetryLimit uid >> throwE e @@ -226,7 +229,7 @@ revokeAccess luid@(tUnqualified -> u) pw cc ll = do lift . liftSem $ Log.debug $ field "user" (toByteString u) . field "action" (val "User.revokeAccess") isSaml <- lift . liftSem $ do account <- User.getAccountNoFilter luid - pure $ maybe False (Data.isSamlUser . ((.accountUser))) account + pure $ maybe False Data.isSamlUser account unless isSaml $ Data.authenticate u pw lift $ wrapHttpClient $ revokeCookies u cc ll @@ -319,10 +322,10 @@ isPendingActivation ident = case ident of lusr <- qualifyLocal' usr maybe False (checkAccount k) <$> User.getAccountNoFilter lusr - checkAccount :: EmailKey -> UserAccount -> Bool + checkAccount :: EmailKey -> User -> Bool checkAccount k a = - let i = userIdentity (accountUser a) - statusAdmitsPending = case accountStatus a of + let i = userIdentity a + statusAdmitsPending = case userStatus a of Active -> True Suspended -> False Deleted -> False diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 4d5db18a72d..9c1afb6f703 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -993,7 +993,7 @@ testGetByIdentity brig = do const 200 === statusCode const (Just [uid]) === getUids where - getUids r = fmap (userId . accountUser) <$> responseJsonMaybe r + getUids r = fmap userId <$> responseJsonMaybe r testPasswordSet :: Brig -> Http () testPasswordSet brig = do diff --git a/services/galley/src/Galley/API/LegalHold/Conflicts.hs b/services/galley/src/Galley/API/LegalHold/Conflicts.hs index 4a4f8e27968..1503e390fe4 100644 --- a/services/galley/src/Galley/API/LegalHold/Conflicts.hs +++ b/services/galley/src/Galley/API/LegalHold/Conflicts.hs @@ -128,7 +128,7 @@ guardLegalholdPolicyConflictsUid self (Map.keys . userClients -> otherUids) = do checkAnyConsentMissing :: Sem r Bool checkAnyConsentMissing = do - users :: [User] <- accountUser <$$> getUsers (self : otherUids) + users <- getUsers (self : otherUids) -- NB: `users` can't be empty! let checkUserConsentMissing :: User -> Sem r Bool checkUserConsentMissing user = diff --git a/services/galley/src/Galley/API/MLS/Migration.hs b/services/galley/src/Galley/API/MLS/Migration.hs index 4cb5c35d8a6..2ecf68ed54f 100644 --- a/services/galley/src/Galley/API/MLS/Migration.hs +++ b/services/galley/src/Galley/API/MLS/Migration.hs @@ -65,8 +65,7 @@ checkMigrationCriteria now conv ws localUsersMigrated = ApAll $ do localProfiles <- - map accountUser - <$> getUsers (map lmId conv.mcLocalMembers) + getUsers (map lmId conv.mcLocalMembers) pure $ all (containsMLS . userSupportedProtocols) localProfiles remoteUsersMigrated = ApAll $ do diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index f6105cc46f1..a8e7953feb3 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -57,7 +57,6 @@ module Galley.API.Teams ) where -import Brig.Types.Intra (accountUser) import Brig.Types.Team (TeamSize (..)) import Cassandra (PageWithState (pwsResults), pwsHasMore) import Cassandra qualified as C @@ -583,7 +582,7 @@ getTeamMembersCSV lusr tid = do let inviterIds :: [UserId] inviterIds = nub $ mapMaybe (fmap fst . view invitation) members - userList :: [User] <- accountUser <$$> E.getUsers inviterIds + userList <- E.getUsers inviterIds let userMap :: M.Map UserId Handle.Handle userMap = M.fromList (mapMaybe extract userList) diff --git a/services/galley/src/Galley/API/Teams/Notifications.hs b/services/galley/src/Galley/API/Teams/Notifications.hs index f3e31f9ec33..38e562dacda 100644 --- a/services/galley/src/Galley/API/Teams/Notifications.hs +++ b/services/galley/src/Galley/API/Teams/Notifications.hs @@ -65,7 +65,7 @@ getTeamNotifications :: Range 1 10000 Int32 -> Sem r QueuedNotificationList getTeamNotifications zusr since size = do - tid <- (noteS @'TeamNotFound =<<) $ (userTeam . accountUser =<<) <$> Intra.getUser zusr + tid <- (noteS @'TeamNotFound =<<) $ (userTeam =<<) <$> Intra.getUser zusr page <- E.getTeamNotifications tid since size pure $ queuedNotificationList diff --git a/services/galley/src/Galley/Effects/BrigAccess.hs b/services/galley/src/Galley/Effects/BrigAccess.hs index 2e14a25c104..de7fc43bd5b 100644 --- a/services/galley/src/Galley/Effects/BrigAccess.hs +++ b/services/galley/src/Galley/Effects/BrigAccess.hs @@ -73,7 +73,6 @@ import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti qualified as Multi import Wire.API.Team.Feature import Wire.API.Team.Size -import Wire.API.User import Wire.API.User.Auth.ReAuth import Wire.API.User.Client import Wire.API.User.Client.Prekey @@ -99,7 +98,7 @@ data BrigAccess m a where PutConnectionInternal :: UpdateConnectionsInternal -> BrigAccess m Status ReauthUser :: UserId -> ReAuthUser -> BrigAccess m (Either AuthenticationError ()) LookupActivatedUsers :: [UserId] -> BrigAccess m [User] - GetUsers :: [UserId] -> BrigAccess m [UserAccount] + GetUsers :: [UserId] -> BrigAccess m [User] DeleteUser :: UserId -> BrigAccess m () GetContactList :: UserId -> BrigAccess m [UserId] GetRichInfoMultiUser :: [UserId] -> BrigAccess m [(UserId, RichInfo)] @@ -130,7 +129,7 @@ data BrigAccess m a where makeSem ''BrigAccess -getUser :: (Member BrigAccess r) => UserId -> Sem r (Maybe UserAccount) +getUser :: (Member BrigAccess r) => UserId -> Sem r (Maybe User) getUser = fmap listToMaybe . getUsers . pure addLegalHoldClientToUser :: diff --git a/services/galley/src/Galley/Intra/User.hs b/services/galley/src/Galley/Intra/User.hs index 4221e42dbec..8d6c620fd66 100644 --- a/services/galley/src/Galley/Intra/User.hs +++ b/services/galley/src/Galley/Intra/User.hs @@ -37,7 +37,6 @@ where import Bilge hiding (getHeader, host, options, port, statusCode) import Bilge.RPC -import Brig.Types.Intra qualified as Brig import Control.Error hiding (bool, isRight) import Control.Lens (view) import Control.Monad.Catch @@ -198,7 +197,7 @@ chunkify doChunk keys = mconcat <$> (doChunk `mapM` chunks keys) chunks uids = case splitAt maxSize uids of (h, t) -> h : chunks t -- | Calls 'Brig.API.listActivatedAccountsH'. -getUsers :: [UserId] -> App [Brig.UserAccount] +getUsers :: [UserId] -> App [User] getUsers = chunkify $ \uids -> do resp <- call Brig $ diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 1a31fae869e..6fe7bcbd9bd 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -2400,8 +2400,7 @@ getUsersBy keyName = chunkify $ \keys -> do . queryItem keyName users . expect2xx ) - let accounts = fromJust $ responseJsonMaybe @[UserAccount] res - pure $ fmap accountUser accounts + pure $ fromJust $ responseJsonMaybe @[User] res getUsersByHandle :: [Handle.Handle] -> TestM [User] getUsersByHandle = getUsersBy "handles" diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 6ac9a07efae..3d9eca78560 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -77,7 +77,7 @@ import Spar.Orphans () import Spar.Scim hiding (handle) import Spar.Sem.AReqIDStore (AReqIDStore) import Spar.Sem.AssIDStore (AssIDStore) -import Spar.Sem.BrigAccess (BrigAccess) +import Spar.Sem.BrigAccess (BrigAccess, getAccount) import qualified Spar.Sem.BrigAccess as BrigAccess import Spar.Sem.DefaultSsoCode (DefaultSsoCode) import qualified Spar.Sem.DefaultSsoCode as DefaultSsoCode @@ -434,7 +434,7 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co assertEmptyOrPurge teamId page = do forM_ (Cas.result page) $ \(uref, uid) -> do mAccount <- BrigAccess.getAccount NoPendingInvitations uid - let mUserTeam = userTeam . accountUser . account =<< mAccount + let mUserTeam = userTeam =<< mAccount when (mUserTeam == Just teamId) $ do if purge then do @@ -466,7 +466,7 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co idpDoesAuthSelf :: IdP -> UserId -> Sem r Bool idpDoesAuthSelf idp uid = do let idpIssuer = idp ^. SAML.idpMetadata . SAML.edIssuer - mUserIssuer <- (>>= userIssuer) <$> Brig.getBrigUser NoPendingInvitations uid + mUserIssuer <- (>>= userIssuer) <$> getAccount NoPendingInvitations uid pure $ mUserIssuer == Just idpIssuer -- | This handler only does the json parsing, and leaves all authorization checks and diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 6bd4d9ea1b1..562776433b4 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -75,7 +75,7 @@ import qualified Spar.Intra.BrigApp as Intra import Spar.Options import Spar.Orphans () import Spar.Sem.AReqIDStore (AReqIDStore) -import Spar.Sem.BrigAccess (BrigAccess) +import Spar.Sem.BrigAccess (BrigAccess, getAccount) import qualified Spar.Sem.BrigAccess as BrigAccess import Spar.Sem.GalleyAccess (GalleyAccess) import qualified Spar.Sem.GalleyAccess as GalleyAccess @@ -141,7 +141,7 @@ getUserByUrefUnsafe :: SAML.UserRef -> Sem r (Maybe User) getUserByUrefUnsafe uref = do - maybe (pure Nothing) (Intra.getBrigUser Intra.WithPendingInvitations) =<< SAMLUserStore.get uref + maybe (pure Nothing) (getAccount Intra.WithPendingInvitations) =<< SAMLUserStore.get uref -- FUTUREWORK: Remove and reinstatate getUser, in AuthID refactoring PR getUserIdByScimExternalId :: diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 31333cf34f1..a059b0232a6 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -144,7 +144,7 @@ createBrigUserNoSAML extId email uid teamid uname locale role = do . json newUser if statusCode resp `elem` [200, 201] - then userId . accountUser <$> parseResponse @UserAccount "brig" resp + then userId <$> parseResponse @User "brig" resp else rethrow "brig" resp updateEmail :: (HasCallStack, MonadSparToBrig m) => UserId -> EmailAddress -> m () @@ -162,7 +162,7 @@ updateEmail buid email = do _ -> rethrow "brig" resp -- | Get a user; returns 'Nothing' if the user was not found or has been deleted. -getBrigUserAccount :: (HasCallStack, MonadSparToBrig m) => HavePendingInvitations -> UserId -> m (Maybe ExtendedUserAccount) +getBrigUserAccount :: (HasCallStack, MonadSparToBrig m) => HavePendingInvitations -> UserId -> m (Maybe User) getBrigUserAccount havePending buid = do resp :: ResponseLBS <- call $ @@ -180,10 +180,10 @@ getBrigUserAccount havePending buid = do case statusCode resp of 200 -> - parseResponse @[ExtendedUserAccount] "brig" resp >>= \case + parseResponse @[User] "brig" resp >>= \case [account] -> pure $ - if userDeleted account.account.accountUser + if userDeleted account then Nothing else Just account _ -> pure Nothing @@ -194,7 +194,7 @@ getBrigUserAccount havePending buid = do -- -- TODO: currently this is not used, but it might be useful later when/if -- @hscim@ stops doing checks during user creation. -getBrigUserByHandle :: (HasCallStack, MonadSparToBrig m) => Handle -> m (Maybe UserAccount) +getBrigUserByHandle :: (HasCallStack, MonadSparToBrig m) => Handle -> m (Maybe User) getBrigUserByHandle handle = do resp :: ResponseLBS <- call $ @@ -203,11 +203,11 @@ getBrigUserByHandle handle = do . queryItem "handles" (toByteString' handle) . queryItem "includePendingInvitations" "true" case statusCode resp of - 200 -> listToMaybe <$> parseResponse @[UserAccount] "brig" resp + 200 -> listToMaybe <$> parseResponse @[User] "brig" resp 404 -> pure Nothing _ -> rethrow "brig" resp -getBrigUserByEmail :: (HasCallStack, MonadSparToBrig m) => EmailAddress -> m (Maybe UserAccount) +getBrigUserByEmail :: (HasCallStack, MonadSparToBrig m) => EmailAddress -> m (Maybe User) getBrigUserByEmail email = do resp :: ResponseLBS <- call $ @@ -217,8 +217,8 @@ getBrigUserByEmail email = do . queryItem "includePendingInvitations" "true" case statusCode resp of 200 -> do - macc <- listToMaybe <$> parseResponse @[UserAccount] "brig" resp - case userEmail . accountUser =<< macc of + macc <- listToMaybe <$> parseResponse @[User] "brig" resp + case userEmail =<< macc of Just email' | email' == email -> pure macc _ -> pure Nothing 404 -> pure Nothing diff --git a/services/spar/src/Spar/Intra/BrigApp.hs b/services/spar/src/Spar/Intra/BrigApp.hs index ec8ed68ed78..f394ed12cbb 100644 --- a/services/spar/src/Spar/Intra/BrigApp.hs +++ b/services/spar/src/Spar/Intra/BrigApp.hs @@ -27,7 +27,6 @@ module Spar.Intra.BrigApp veidFromUserSSOId, mkUserName, HavePendingInvitations (..), - getBrigUser, getBrigUserTeam, getZUsrCheckPerm, authorizeScimTokenManagement, @@ -123,13 +122,10 @@ mkUserName Nothing = ---------------------------------------------------------------------- -getBrigUser :: (HasCallStack, Member BrigAccess r) => HavePendingInvitations -> UserId -> Sem r (Maybe User) -getBrigUser ifpend = ((accountUser . account) <$$>) . BrigAccess.getAccount ifpend - -- | Check that an id maps to an user on brig that is 'Active' (or optionally -- 'PendingInvitation') and has a team id. getBrigUserTeam :: (HasCallStack, Member BrigAccess r) => HavePendingInvitations -> UserId -> Sem r (Maybe TeamId) -getBrigUserTeam ifpend = fmap (userTeam =<<) . getBrigUser ifpend +getBrigUserTeam ifpend = fmap (userTeam =<<) . BrigAccess.getAccount ifpend -- | Pull team id for z-user from brig. Check permission in galley. Return team id. Fail if -- permission check fails or the user is not in status 'Active'. diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index b7985a3c3cf..019c20902a4 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -80,7 +80,7 @@ import Spar.Options import Spar.Scim.Auth () import Spar.Scim.Types import qualified Spar.Scim.Types as ST -import Spar.Sem.BrigAccess (BrigAccess) +import Spar.Sem.BrigAccess (BrigAccess, getAccount) import qualified Spar.Sem.BrigAccess as BrigAccess import Spar.Sem.GalleyAccess as GalleyAccess import Spar.Sem.IdPConfigStore (IdPConfigStore) @@ -799,7 +799,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = -- thing that could happen is that foreign users cleanup partially -- deleted users. void . lift $ BrigAccess.deleteUser uid - Just acc@(accountUser . account -> brigUser) -> do + Just brigUser -> do if userTeam brigUser == Just stiTeam then do -- This deletion needs data from the non-deleted User in brig. So, @@ -808,7 +808,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = -- that have been deleted in brig. Deleting scim-managed users in brig -- (via the TM app) is blocked, though, so there is no legal way to enter -- that situation. - deleteUserInSpar acc + deleteUserInSpar brigUser void . lift $ BrigAccess.deleteUser uid else do -- if we find the user in another team, we pretend it wasn't even there, to @@ -821,12 +821,12 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = Member ScimExternalIdStore r, Member ScimUserTimesStore r ) => - ExtendedUserAccount -> + User -> Scim.ScimHandler (Sem r) () deleteUserInSpar account = do mIdpConfig <- mapM (lift . IdPConfigStore.getConfig) stiIdP - case Brig.veidFromBrigUser account.account.accountUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) account.emailUnvalidated of + case Brig.veidFromBrigUser account ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) account.userEmailUnvalidated of Left _ -> pure () Right veid -> lift $ do for_ (justThere veid.validScimIdAuthInfo) (SAMLUserStore.delete uid) @@ -923,7 +923,7 @@ assertHandleUnused' msg hndl = assertHandleNotUsedElsewhere :: (Member BrigAccess r) => UserId -> Handle -> Scim.ScimHandler (Sem r) () assertHandleNotUsedElsewhere uid hndl = do - musr <- lift $ Brig.getBrigUser Brig.WithPendingInvitations uid + musr <- lift $ getAccount Brig.WithPendingInvitations uid unless ((userHandle =<< musr) == Just hndl) $ assertHandleUnused' "userName already in use by another wire user" hndl @@ -939,21 +939,21 @@ synthesizeStoredUser :: Member GalleyAccess r, Member ScimUserTimesStore r ) => - ExtendedUserAccount -> + User -> ST.ValidScimId -> Scim.ScimHandler (Sem r) (Scim.StoredUser ST.SparTag) synthesizeStoredUser acc veid = logScim ( logFunction "Spar.Scim.User.synthesizeStoredUser" - . logUser (userId acc.account.accountUser) - . maybe id logHandle acc.account.accountUser.userHandle - . maybe id logTeam acc.account.accountUser.userTeam + . logUser (userId acc) + . maybe id logHandle acc.userHandle + . maybe id logTeam acc.userTeam . maybe id logEmail (justHere $ ST.validScimIdAuthInfo veid) ) logScimUserId $ do - let uid = userId acc.account.accountUser - accStatus = acc.account.accountStatus + let uid = userId acc + accStatus = acc.userStatus let readState :: Sem r (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI, Role) readState = @@ -977,17 +977,17 @@ synthesizeStoredUser acc veid = now <- toUTCTimeMillis <$> lift Now.get let (createdAt, lastUpdatedAt) = fromMaybe (now, now) accessTimes - handle <- lift $ Brig.giveDefaultHandle acc.account.accountUser + handle <- lift $ Brig.giveDefaultHandle acc let emails = maybeToList $ - acc.emailUnvalidated <|> (emailIdentity =<< userIdentity acc.account.accountUser) <|> justHere veid.validScimIdAuthInfo + acc.userEmailUnvalidated <|> (emailIdentity =<< userIdentity acc) <|> justHere veid.validScimIdAuthInfo storedUser <- synthesizeStoredUser' uid veid - (userDisplayName acc.account.accountUser) + acc.userDisplayName emails handle richInfo @@ -995,15 +995,15 @@ synthesizeStoredUser acc veid = createdAt lastUpdatedAt baseuri - (userLocale acc.account.accountUser) + acc.userLocale (Just role) - lift $ writeState accessTimes (userManagedBy acc.account.accountUser) richInfo storedUser + lift $ writeState accessTimes acc.userManagedBy richInfo storedUser pure storedUser where getRole :: Sem r Role getRole = do let tmRoleOrDefault m = fromMaybe defaultRole $ m >>= \member -> member ^. Member.permissions . to Member.permissionsRole - maybe (pure defaultRole) (\tid -> tmRoleOrDefault <$> GalleyAccess.getTeamMember tid (userId acc.account.accountUser)) (userTeam acc.account.accountUser) + maybe (pure defaultRole) (\tid -> tmRoleOrDefault <$> GalleyAccess.getTeamMember tid (userId acc)) (userTeam acc) synthesizeStoredUser' :: (MonadError Scim.ScimError m) => @@ -1075,15 +1075,15 @@ getUserById :: UserId -> MaybeT (Scim.ScimHandler (Sem r)) (Scim.StoredUser ST.SparTag) getUserById midp stiTeam uid = do - acc@(accountUser . account -> brigUser) <- MaybeT . lift $ BrigAccess.getAccount Brig.WithPendingInvitations uid + brigUser <- MaybeT . lift $ BrigAccess.getAccount Brig.WithPendingInvitations uid let mbveid = Brig.veidFromBrigUser brigUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> midp) - acc.emailUnvalidated + brigUser.userEmailUnvalidated case mbveid of Right veid | userTeam brigUser == Just stiTeam -> lift $ do - storedUser :: Scim.StoredUser ST.SparTag <- synthesizeStoredUser acc veid + storedUser :: Scim.StoredUser ST.SparTag <- synthesizeStoredUser brigUser veid -- if we get a user from brig that hasn't been touched by scim yet, we call this -- function to move it under scim control. assertExternalIdNotUsedElsewhere stiTeam veid uid @@ -1123,7 +1123,7 @@ scimFindUserByHandle :: scimFindUserByHandle mIdpConfig stiTeam hndl = do handle <- MaybeT . pure . parseHandle . Text.toLower $ hndl brigUser <- MaybeT . lift . BrigAccess.getByHandle $ handle - getUserById mIdpConfig stiTeam . userId . accountUser $ brigUser + getUserById mIdpConfig stiTeam . userId $ brigUser -- | Construct a 'ValidScimId'. If it is an 'Email', find the non-SAML SCIM user in spar; if -- that fails, find the user by email in brig. If it is a 'UserRef', find the SAML user. @@ -1155,12 +1155,12 @@ scimFindUserByExternalId mIdpConfig stiTeam eid = do -- there are a few ways to find a user. this should all be redundant, especially the where -- we lookup a user from brig by email, throw it away and only keep the uid, and then use -- the uid to lookup the account again. but cassandra, and also reasons. - mViaEmail :: Maybe UserId <- join <$> (for (justHere veid.validScimIdAuthInfo) ((userId . accountUser <$$>) . BrigAccess.getByEmail)) + mViaEmail :: Maybe UserId <- join <$> (for (justHere veid.validScimIdAuthInfo) ((userId <$$>) . BrigAccess.getByEmail)) mViaUref :: Maybe UserId <- join <$> (for (justThere veid.validScimIdAuthInfo) SAMLUserStore.get) pure $ mViaEmail <|> mViaUref Just uid -> pure uid acc <- MaybeT . lift . BrigAccess.getAccount Brig.WithPendingInvitations $ uid - getUserById mIdpConfig stiTeam (userId acc.account.accountUser) + getUserById mIdpConfig stiTeam (userId acc) logFilter :: Filter -> (Msg -> Msg) logFilter (FilterAttrCompare attr op val) = diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 46d208d1b10..a9f3b69fe5a 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -55,18 +55,16 @@ import qualified SAML2.WebSSO as SAML import Web.Cookie import Wire.API.Locale import Wire.API.Team.Role -import Wire.API.User (AccountStatus (..), DeleteUserResult, ExtendedUserAccount, VerificationAction) -import Wire.API.User.Identity -import Wire.API.User.Profile +import Wire.API.User import Wire.API.User.RichInfo as RichInfo data BrigAccess m a where CreateSAML :: SAML.UserRef -> UserId -> TeamId -> Name -> ManagedBy -> Maybe Handle -> Maybe RichInfo -> Maybe Locale -> Role -> BrigAccess m UserId CreateNoSAML :: Text -> EmailAddress -> UserId -> TeamId -> Name -> Maybe Locale -> Role -> BrigAccess m UserId UpdateEmail :: UserId -> EmailAddress -> BrigAccess m () - GetAccount :: HavePendingInvitations -> UserId -> BrigAccess m (Maybe ExtendedUserAccount) - GetByHandle :: Handle -> BrigAccess m (Maybe UserAccount) - GetByEmail :: EmailAddress -> BrigAccess m (Maybe UserAccount) + GetAccount :: HavePendingInvitations -> UserId -> BrigAccess m (Maybe User) + GetByHandle :: Handle -> BrigAccess m (Maybe User) + GetByEmail :: EmailAddress -> BrigAccess m (Maybe User) SetName :: UserId -> Name -> BrigAccess m () SetHandle :: UserId -> Handle {- not 'HandleUpdate'! -} -> BrigAccess m () SetManagedBy :: UserId -> ManagedBy -> BrigAccess m () diff --git a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs index 822a4ee99bf..c97ad084a90 100644 --- a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs +++ b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs @@ -25,6 +25,7 @@ import Data.Id (Id (Id), UserId) import qualified Data.UUID as UUID import Imports hiding (head) import qualified Spar.Intra.BrigApp as Intra +import Spar.Sem.BrigAccess (getAccount) import qualified Spar.Sem.BrigAccess as BrigAccess import Test.QuickCheck import Util @@ -45,9 +46,9 @@ spec = do r <- runSpar $ BrigAccess.deleteUser uid liftIO $ r `shouldBe` NoUser - describe "getBrigUser" $ do + describe "getAccount" $ do it "return Nothing if n/a" $ do - musr <- runSpar $ Intra.getBrigUser Intra.WithPendingInvitations (Id . fromJust $ UUID.fromText "29546d9e-ed5b-11ea-8228-c324b1ea1030") + musr <- runSpar $ getAccount Intra.WithPendingInvitations (Id . fromJust $ UUID.fromText "29546d9e-ed5b-11ea-8228-c324b1ea1030") liftIO $ musr `shouldSatisfy` isNothing it "return Just if /a" $ do @@ -60,5 +61,5 @@ spec = do scimUserId <$> createUser tok scimUser uid <- setup - musr <- runSpar $ Intra.getBrigUser Intra.WithPendingInvitations uid + musr <- runSpar $ getAccount Intra.WithPendingInvitations uid liftIO $ musr `shouldSatisfy` isJust diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index f055bc467f5..71a8eaee3fe 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -353,7 +353,7 @@ assertBrigCassandra :: ManagedBy -> TestSpar () assertBrigCassandra uid uref usr (valemail, emailValidated) managedBy = do - runSpar (BrigAccess.getAccount NoPendingInvitations uid) >>= \(Just (account -> acc)) -> liftIO $ do + runSpar (BrigAccess.getAccount NoPendingInvitations uid) >>= \(Just acc) -> liftIO $ do let handle = fromRight errmsg . parseHandleEither $ Scim.User.userName usr where errmsg = error . show . Scim.User.userName $ usr @@ -366,14 +366,12 @@ assertBrigCassandra uid uref usr (valemail, emailValidated) managedBy = do _ -> Nothing - accountStatus acc `shouldBe` Active - userId (accountUser acc) `shouldBe` uid - userHandle (accountUser acc) `shouldBe` Just handle - userDisplayName (accountUser acc) `shouldBe` name - userManagedBy (accountUser acc) `shouldBe` managedBy - - userIdentity (accountUser acc) - `shouldBe` Just (SSOIdentity (UserSSOId uref) email) + userStatus acc `shouldBe` Active + userId acc `shouldBe` uid + userHandle acc `shouldBe` Just handle + userDisplayName acc `shouldBe` name + userManagedBy acc `shouldBe` managedBy + userIdentity acc `shouldBe` Just (SSOIdentity (UserSSOId uref) email) specSuspend :: SpecWith TestEnv specSuspend = do @@ -651,12 +649,11 @@ testCreateUserNoIdP = do do aFewTimes (runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations userid) isJust >>= maybe (pure ()) (error "pending user in brig is visible, even though it should not be") - brigUserAccount <- + brigUser <- aFewTimes (runSpar $ BrigAccess.getAccount Intra.WithPendingInvitations userid) isJust >>= maybe (error "could not find user in brig") pure - let brigUser = brigUserAccount.account.accountUser brigUser `userShouldMatch` WrappedScimStoredUser scimStoredUser - liftIO $ accountStatus brigUserAccount.account `shouldBe` PendingInvitation + liftIO $ brigUser.userStatus `shouldBe` PendingInvitation liftIO $ userEmail brigUser `shouldBe` Just email liftIO $ userManagedBy brigUser `shouldBe` ManagedByScim -- Previous to the change that allowed the external ID to be different from the email, `userSSOId brigUser` was `Nothing`. @@ -699,10 +696,10 @@ testCreateUserNoIdP = do brigUser <- aFewTimes (runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations userid) isJust >>= maybe (error "could not find user in brig") pure - liftIO $ accountStatus brigUser.account `shouldBe` Active - liftIO $ userManagedBy (accountUser brigUser.account) `shouldBe` ManagedByScim - liftIO $ userHandle (accountUser brigUser.account) `shouldBe` Just handle - liftIO $ userSSOId (accountUser brigUser.account) `shouldBe` Just (UserScimExternalId (fromEmail email)) + liftIO $ brigUser.userStatus `shouldBe` Active + liftIO $ userManagedBy brigUser `shouldBe` ManagedByScim + liftIO $ userHandle brigUser `shouldBe` Just handle + liftIO $ userSSOId brigUser `shouldBe` Just (UserScimExternalId (fromEmail email)) susr <- getUser tok userid let usr = Scim.value . Scim.thing $ susr liftIO $ Scim.User.active usr `shouldNotBe` Just (Scim.ScimBool False) @@ -1230,7 +1227,7 @@ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do -- auto-provision user via saml memberWithSSO <- do uid <- loginSsoUserFirstTime idp privCreds - Just usr <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid + Just usr <- runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations uid handle <- nextHandle runSpar $ BrigAccess.setHandle uid handle pure usr @@ -1243,7 +1240,7 @@ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do liftIO $ userManagedBy memberWithSSO `shouldBe` ManagedByWire users <- listUsers tok (Just (filterBy "externalId" externalId)) liftIO $ (scimUserId <$> users) `shouldContain` [memberIdWithSSO] - Just brigUser' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations memberIdWithSSO + Just brigUser' <- runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations memberIdWithSSO liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim where veidToText :: (MonadError String m) => ValidScimId -> m Text @@ -1265,7 +1262,7 @@ testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSO = do users' <- listUsers tok (Just (filterBy "externalId" emailInvited)) liftIO $ (scimUserId <$> users') `shouldContain` [memberIdInvited] - Just brigUserInvited' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations memberIdInvited + Just brigUserInvited' <- runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations memberIdInvited liftIO $ userManagedBy brigUserInvited' `shouldBe` ManagedByScim testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSOViaUserId :: TestSpar () @@ -1278,7 +1275,7 @@ testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSOViaUserId = do let memberIdInvited = userId memberInvited _ <- getUser tok memberIdInvited - Just brigUserInvited' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations memberIdInvited + Just brigUserInvited' <- runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations memberIdInvited liftIO $ userManagedBy brigUserInvited' `shouldBe` ManagedByScim testFindProvisionedUserNoIdP :: TestSpar () @@ -1299,7 +1296,7 @@ testFindNonProvisionedUserNoIdP findBy = do uid <- userId <$> call (inviteAndRegisterUser (env ^. teBrig) owner teamid email) handle <- nextHandle runSpar $ BrigAccess.setHandle uid handle - Just brigUser <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid + Just brigUser <- runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations uid do -- inspect brig user @@ -1313,7 +1310,7 @@ testFindNonProvisionedUserNoIdP findBy = do do liftIO $ users `shouldBe` [uid] - Just brigUser' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid + Just brigUser' <- runSpar $ BrigAccess.getAccount Intra.NoPendingInvitations uid liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim liftIO $ brigUser' `shouldBe` scimifyBrigUserHack brigUser email @@ -1328,7 +1325,7 @@ testListNoDeletedUsers = do -- Delete the user _ <- deleteUser tok userid -- Make sure it is deleted in brig before pulling via SCIM (which would recreate it!) - Nothing <- aFewTimes (runSpar (Intra.getBrigUser Intra.WithPendingInvitations userid)) isNothing + Nothing <- aFewTimes (runSpar (BrigAccess.getAccount Intra.WithPendingInvitations userid)) isNothing -- Get all users users <- listUsers tok (Just (filterForStoredUser storedUser)) -- Check that the user is absent @@ -1400,7 +1397,7 @@ testGetUser = do shouldBeManagedBy :: (HasCallStack) => UserId -> ManagedBy -> TestSpar () shouldBeManagedBy uid flag = do - managedBy <- maybe (error "user not found") userManagedBy <$> runSpar (Intra.getBrigUser Intra.WithPendingInvitations uid) + managedBy <- maybe (error "user not found") userManagedBy <$> runSpar (BrigAccess.getAccount Intra.WithPendingInvitations uid) liftIO $ managedBy `shouldBe` flag -- | This is (roughly) the behavior on develop as well as on the branch where this test was @@ -1459,12 +1456,12 @@ testGetUserWithNoHandle = do uid <- loginSsoUserFirstTime idp privcreds tok <- registerScimToken tid (Just (idp ^. SAML.idpId)) - mhandle :: Maybe Handle <- maybe (error "user not found") userHandle <$> runSpar (Intra.getBrigUser Intra.WithPendingInvitations uid) + mhandle :: Maybe Handle <- maybe (error "user not found") userHandle <$> runSpar (BrigAccess.getAccount Intra.WithPendingInvitations uid) liftIO $ mhandle `shouldSatisfy` isNothing storedUser <- getUser tok uid liftIO $ (Scim.User.displayName . Scim.value . Scim.thing) storedUser `shouldSatisfy` isJust - mhandle' :: Maybe Handle <- aFewTimes (maybe (error "user not found") userHandle <$> runSpar (Intra.getBrigUser Intra.WithPendingInvitations uid)) isJust + mhandle' :: Maybe Handle <- aFewTimes (maybe (error "user not found") userHandle <$> runSpar (BrigAccess.getAccount Intra.WithPendingInvitations uid)) isJust liftIO $ mhandle' `shouldSatisfy` isJust liftIO $ (fromHandle <$> mhandle') `shouldBe` (Just . Scim.User.userName . Scim.value . Scim.thing $ storedUser) @@ -1847,7 +1844,7 @@ testBrigSideIsUpdated = do validScimUser <- runSpar . runScimErrorUnsafe $ validateScimUser' "testBrigSideIsUpdated" (Just idp) 999999 user' - brigUser <- maybe (error "no brig user") pure =<< runSpar (Intra.getBrigUser Intra.WithPendingInvitations userid) + brigUser <- maybe (error "no brig user") pure =<< runSpar (BrigAccess.getAccount Intra.WithPendingInvitations userid) let scimUserWithDefLocale = validScimUser {Spar.Types.locale = Spar.Types.locale validScimUser <|> Just (Locale (Language EN) Nothing)} brigUser `userShouldMatch` scimUserWithDefLocale @@ -2138,7 +2135,7 @@ specDeleteUser = do storedUser <- createUser tok user let uid :: UserId = scimUserId storedUser uref :: SAML.UserRef <- do - mUsr <- runSpar $ Intra.getBrigUser Intra.WithPendingInvitations uid + mUsr <- runSpar $ BrigAccess.getAccount Intra.WithPendingInvitations uid let err = error . ("brig user without UserRef: " <>) . show case (\usr -> Intra.veidFromBrigUser usr Nothing Nothing) <$> mUsr of bad@(Just (Right veid)) -> runValidScimIdEither pure (const $ err bad) veid @@ -2147,7 +2144,7 @@ specDeleteUser = do deleteUser_ (Just tok) (Just uid) spar !!! const 204 === statusCode brigUser :: Maybe User <- - aFewTimes (runSpar $ Intra.getBrigUser Intra.WithPendingInvitations uid) isNothing + aFewTimes (runSpar $ BrigAccess.getAccount Intra.WithPendingInvitations uid) isNothing samlUser :: Maybe UserId <- aFewTimes (getUserIdViaRef' uref) isNothing scimUser <- diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 7f6ae09b7a9..74aacb800cb 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -180,6 +180,7 @@ import Spar.Error (SparError) import qualified Spar.Intra.BrigApp as Intra import Spar.Options import Spar.Run +import Spar.Sem.BrigAccess (getAccount) import qualified Spar.Sem.IdPConfigStore as IdPConfigStore import qualified Spar.Sem.SAMLUserStore as SAMLUserStore import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore @@ -1186,7 +1187,7 @@ getSsoidViaSelf uid = maybe (error "not found") pure =<< getSsoidViaSelf' uid getSsoidViaSelf' :: (HasCallStack) => UserId -> TestSpar (Maybe UserSSOId) getSsoidViaSelf' uid = do - musr <- aFewTimes (runSpar $ Intra.getBrigUser Intra.NoPendingInvitations uid) isJust + musr <- aFewTimes (runSpar $ getAccount Intra.NoPendingInvitations uid) isJust pure $ ssoIdentity =<< (userIdentity =<< musr) getUserIdViaRef :: (HasCallStack) => UserRef -> TestSpar UserId diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index 5c51ed624de..9d759d600ac 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -35,7 +35,7 @@ spec = describe "deleteScimUser" $ do r <- interpretWithBrigAccessMock (mockBrig (withActiveUser acc) AccountDeleted) - (deleteUserAndAssertDeletionInSpar acc.account tokenInfo) + (deleteUserAndAssertDeletionInSpar acc tokenInfo) r `shouldBe` Right () it "is idempotent" $ do tokenInfo <- generate arbitrary @@ -43,7 +43,7 @@ spec = describe "deleteScimUser" $ do r <- interpretWithBrigAccessMock (mockBrig (withActiveUser acc) AccountAlreadyDeleted) - (deleteUserAndAssertDeletionInSpar acc.account tokenInfo) + (deleteUserAndAssertDeletionInSpar acc tokenInfo) r `shouldBe` Right () it "works if there never was an account" $ do uid <- generate arbitrary @@ -75,13 +75,13 @@ deleteUserAndAssertDeletionInSpar :: ] r ) => - UserAccount -> + User -> ScimTokenInfo -> Sem r (Either ScimError ()) deleteUserAndAssertDeletionInSpar acc tokenInfo = do let tid = stiTeam tokenInfo - email = (fromJust . emailIdentity . fromJust . userIdentity . accountUser) acc - uid = (userId . accountUser) acc + email = (fromJust . emailIdentity . fromJust . userIdentity) acc + uid = userId acc ScimExternalIdStore.insert tid (fromEmail email) uid r <- runExceptT $ deleteScimUser tokenInfo uid lr <- ScimExternalIdStore.lookup tid (fromEmail email) @@ -120,7 +120,7 @@ ignoringState f = fmap snd . f mockBrig :: forall (r :: EffectRow) a. (Member (Embed IO) r) => - (UserId -> Maybe ExtendedUserAccount) -> + (UserId -> Maybe User) -> DeleteUserResult -> Sem (BrigAccess ': r) a -> Sem r a @@ -131,30 +131,24 @@ mockBrig lookup_user delete_response = interpret $ \case liftIO $ expectationFailure $ "Unexpected effect (call to brig)" error "Throw error here to avoid implementation of all cases." -withActiveUser :: ExtendedUserAccount -> UserId -> Maybe ExtendedUserAccount +withActiveUser :: User -> UserId -> Maybe User withActiveUser acc uid = - if uid == (userId . accountUser) acc.account + if uid == userId acc then Just acc else Nothing -someActiveUser :: ScimTokenInfo -> IO ExtendedUserAccount +someActiveUser :: ScimTokenInfo -> IO User someActiveUser tokenInfo = do user <- generate arbitrary pure $ - ExtendedUserAccount - { account = - UserAccount - { accountStatus = Active, - accountUser = - user - { userDisplayName = Name "Some User", - userAccentId = defaultAccentId, - userPict = noPict, - userAssets = [], - userHandle = parseHandle "some-handle", - userIdentity = (Just . EmailIdentity . fromJust . emailAddressText) "someone@wire.com", - userTeam = Just $ stiTeam tokenInfo - } - }, - emailUnvalidated = Nothing + user + { userDisplayName = Name "Some User", + userEmailUnvalidated = Nothing, + userAccentId = defaultAccentId, + userStatus = Active, + userPict = noPict, + userAssets = [], + userHandle = parseHandle "some-handle", + userIdentity = (Just . EmailIdentity . fromJust . emailAddressText) "someone@wire.com", + userTeam = Just $ stiTeam tokenInfo } diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 036a2d9d16f..3e915b2a69e 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -207,13 +207,13 @@ suspendUser uid = NoContent <$ Intra.putUserStatus Suspended uid unsuspendUser :: UserId -> Handler NoContent unsuspendUser uid = NoContent <$ Intra.putUserStatus Active uid -usersByEmail :: EmailAddress -> Handler [UserAccount] +usersByEmail :: EmailAddress -> Handler [User] usersByEmail = Intra.getUserProfilesByIdentity -usersByIds :: [UserId] -> Handler [UserAccount] +usersByIds :: [UserId] -> Handler [User] usersByIds = Intra.getUserProfiles . Left -usersByHandles :: [Handle] -> Handler [UserAccount] +usersByHandles :: [Handle] -> Handler [User] usersByHandles = Intra.getUserProfiles . Right ejpdInfoByHandles :: Maybe Bool -> [Handle] -> Handler EJPD.EJPDResponseBody @@ -242,7 +242,7 @@ deleteUser :: UserId -> EmailAddress -> Handler NoContent deleteUser uid email = do usrs <- Intra.getUserProfilesByIdentity email case usrs of - [accountUser -> u] -> + [u] -> if userId u == uid then do info $ userMsg uid . msg (val "Deleting account") @@ -258,7 +258,7 @@ setTeamStatusH status tid = NoContent <$ Intra.setStatusBindingTeam tid status deleteTeam :: TeamId -> Maybe Bool -> Maybe EmailAddress -> Handler NoContent deleteTeam givenTid (fromMaybe False -> False) (Just email) = do acc <- Intra.getUserProfilesByIdentity email >>= handleNoUser . listToMaybe - userTid <- (Intra.getUserBindingTeam . userId . accountUser $ acc) >>= handleNoTeam + userTid <- (Intra.getUserBindingTeam . userId $ acc) >>= handleNoTeam when (givenTid /= userTid) $ throwE bindingTeamMismatch tInfo <- Intra.getTeamInfo givenTid @@ -294,7 +294,7 @@ deleteFromBlacklist email = do getTeamInfoByMemberEmail :: EmailAddress -> Handler TeamInfo getTeamInfoByMemberEmail e = do acc <- Intra.getUserProfilesByIdentity e >>= handleUser . listToMaybe - tid <- (Intra.getUserBindingTeam . userId . accountUser $ acc) >>= handleTeam + tid <- (Intra.getUserBindingTeam . userId $ acc) >>= handleTeam Intra.getTeamInfo tid where handleUser = ifNothing (mkError status404 "no-user" "No such user with that email") @@ -427,7 +427,7 @@ getUserData uid mMaxConvs mMaxNotifs = do consentLog <- (Intra.getUserConsentLog uid <&> toJSON @ConsentLog) `catchE` (pure . String . T.pack . show) - let em = userEmail $ accountUser account + let em = userEmail account marketo <- do let noEmail = MarketoResult $ KeyMap.singleton "results" emptyArray maybe diff --git a/tools/stern/src/Stern/API/Routes.hs b/tools/stern/src/Stern/API/Routes.hs index 3c78d30ebe5..777bd118c5d 100644 --- a/tools/stern/src/Stern/API/Routes.hs +++ b/tools/stern/src/Stern/API/Routes.hs @@ -85,7 +85,7 @@ type SternAPI = :> "users" :> "by-email" :> QueryParam' [Required, Strict, Description "Email address"] "email" EmailAddress - :> Get '[JSON] [UserAccount] + :> Get '[JSON] [User] ) :<|> Named "get-users-by-ids" @@ -93,7 +93,7 @@ type SternAPI = :> "users" :> "by-ids" :> QueryParam' [Required, Strict, Description "List of IDs of the users, separated by comma"] "ids" [UserId] - :> Get '[JSON] [UserAccount] + :> Get '[JSON] [User] ) :<|> Named "get-users-by-handles" @@ -101,7 +101,7 @@ type SternAPI = :> "users" :> "by-handles" :> QueryParam' [Required, Strict, Description "List of Handles of the users, without '@', separated by comma"] "handles" [Handle] - :> Get '[JSON] [UserAccount] + :> Get '[JSON] [User] ) :<|> Named "get-user-connections" diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index 6b9f0d0890a..f72649bba90 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -205,13 +205,13 @@ getUsersConnections uids = do info $ msg ("Response" ++ show r) parseResponse (mkError status502 "bad-upstream") r -getUserProfiles :: Either [UserId] [Handle] -> Handler [UserAccount] +getUserProfiles :: Either [UserId] [Handle] -> Handler [User] getUserProfiles uidsOrHandles = do info $ msg "Getting user accounts" b <- asks (.brig) concat <$> mapM (doRequest b) (prepareQS uidsOrHandles) where - doRequest :: Request -> (Request -> Request) -> Handler [UserAccount] + doRequest :: Request -> (Request -> Request) -> Handler [User] doRequest b qry = do r <- catchRpcErrors $ @@ -232,7 +232,7 @@ getUserProfiles uidsOrHandles = do fmap (BS.intercalate "," . map toByteString') . chunksOf 50 -getUserProfilesByIdentity :: EmailAddress -> Handler [UserAccount] +getUserProfilesByIdentity :: EmailAddress -> Handler [User] getUserProfilesByIdentity email = do info $ msg "Getting user accounts by identity" b <- asks (.brig) diff --git a/tools/stern/test/integration/API.hs b/tools/stern/test/integration/API.hs index 1cd947747b8..0e8b84cb5f1 100644 --- a/tools/stern/test/integration/API.hs +++ b/tools/stern/test/integration/API.hs @@ -182,7 +182,7 @@ testDeleteUser = do (uid, email) <- randomEmailUser do [ua] <- getUsersByIds [uid] - liftIO $ ua.accountStatus @?= Active + liftIO $ ua.userStatus @?= Active deleteUser uid (Left email) do uas <- getUsersByIds [uid] @@ -215,7 +215,7 @@ testDeleteTeam :: TestM () testDeleteTeam = do (uid, tid, _) <- createTeamWithNMembers 10 [ua] <- getUsersByIds [uid] - let email = fromMaybe (error "user has no email") $ emailIdentity =<< ua.accountUser.userIdentity + let email = fromMaybe (error "user has no email") $ emailIdentity =<< ua.userIdentity do info <- getTeamInfo tid liftIO $ info.tiData.tdStatus @?= Team.Active @@ -245,7 +245,7 @@ testGetTeamInfoByMemberEmail :: TestM () testGetTeamInfoByMemberEmail = do (_, tid, member : _) <- createTeamWithNMembers 10 [ua] <- getUsersByIds [member] - let email = fromMaybe (error "user has no email") $ emailIdentity =<< ua.accountUser.userIdentity + let email = fromMaybe (error "user has no email") $ emailIdentity =<< ua.userIdentity info <- getTeamInfoByMemberEmail email liftIO $ (info.tiData.tdTeam ^. teamId) @?= tid @@ -399,13 +399,13 @@ testGetUsersByHandles = do h <- randomHandle void $ setHandle uid h [ua] <- getUsersByHandles h - liftIO $ userId ua.accountUser @?= uid + liftIO $ userId ua @?= uid testGetUsersByEmail :: TestM () testGetUsersByEmail = do (uid, email) <- randomEmailUser [ua] <- getUsersByEmail email - liftIO $ userId ua.accountUser @?= uid + liftIO $ userId ua @?= uid testUnsuspendUser :: TestM () testUnsuspendUser = do @@ -413,18 +413,18 @@ testUnsuspendUser = do void $ postSupendUser uid do [ua] <- getUsersByIds [uid] - liftIO $ ua.accountStatus @?= Suspended + liftIO $ ua.userStatus @?= Suspended void $ postUnsuspendUser uid do [ua] <- getUsersByIds [uid] - liftIO $ ua.accountStatus @?= Active + liftIO $ ua.userStatus @?= Active testSuspendUser :: TestM () testSuspendUser = do uid <- randomUser void $ postSupendUser uid [ua] <- getUsersByIds [uid] - liftIO $ ua.accountStatus @?= Suspended + liftIO $ ua.userStatus @?= Suspended testGetStatus :: TestM () testGetStatus = do @@ -439,7 +439,7 @@ testGetUsersByIds = do uas <- getUsersByIds [uid1, uid2] liftIO $ do length uas @?= 2 - Set.fromList (userId . (.accountUser) <$> uas) @?= Set.fromList [uid1, uid2] + Set.fromList (userId <$> uas) @?= Set.fromList [uid1, uid2] testGetTeamInfo :: TestM () testGetTeamInfo = do @@ -460,14 +460,14 @@ testRevokeIdentity = do do [ua] <- getUsersByEmail email liftIO $ do - ua.accountStatus @?= Active - isJust ua.accountUser.userIdentity @?= True + ua.userStatus @?= Active + isJust ua.userIdentity @?= True void $ revokeIdentity (Left email) do [ua] <- getUsersByEmail email liftIO $ do - ua.accountStatus @?= Active - isJust ua.accountUser.userIdentity @?= False + ua.userStatus @?= Active + isJust ua.userIdentity @?= False testPutEmail :: TestM () testPutEmail = do @@ -494,13 +494,13 @@ getConnections uid = do r <- get (s . paths ["users", toByteString' uid, "connections"] . expect2xx) pure $ responseJsonUnsafe r -getUsersByHandles :: Text -> TestM [UserAccount] +getUsersByHandles :: Text -> TestM [User] getUsersByHandles h = do stern <- view tsStern r <- get (stern . paths ["users", "by-handles"] . queryItem "handles" (cs h) . expect2xx) pure $ responseJsonUnsafe r -getUsersByEmail :: EmailAddress -> TestM [UserAccount] +getUsersByEmail :: EmailAddress -> TestM [User] getUsersByEmail email = do stern <- view tsStern r <- get (stern . paths ["users", "by-email"] . queryItem "email" (toByteString' email) . expect2xx) @@ -521,7 +521,7 @@ getStatus = do stern <- view tsStern get (stern . paths ["i", "status"] . expect2xx) -getUsersByIds :: [UserId] -> TestM [UserAccount] +getUsersByIds :: [UserId] -> TestM [User] getUsersByIds uids = do stern <- view tsStern r <- get (stern . paths ["users", "by-ids"] . queryItem "ids" (toByteString' uids) . expect2xx)