wire-subsystems: Make mock for UserSubsystem depend on UserStore

libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs

@@ -96,7 +96,6 @@ import Wire.TeamCollaboratorsSubsystem
 import Wire.TeamStore
 import Wire.TeamSubsystem (TeamSubsystem)
 import Wire.TeamSubsystem qualified as TeamSubsystem
-import Wire.TeamSubsystem qualified as TeamSubsytem
 import Wire.UserList
 
 data NoChanges = NoChanges
@@ -162,7 +161,7 @@ ensureConnectedToLocalsOrSameTeam (tUnqualified -> u) uids = do
   icUsers <- getTeamCollaborators uTeams
   -- We collect all the relevant uids from same teams as the origin user
   sameTeamUids <- forM (uTeams `union` icTeams) $ \team ->
-    fmap (view Mem.userId) <$> TeamSubsytem.internalSelectTeamMembers team uids
+    fmap (view Mem.userId) <$> TeamSubsystem.internalSelectTeamMembers team uids
   -- Do not check connections for users that are on the same team
   ensureConnectedToLocals u ((uids \\ join sameTeamUids) \\ icUsers)
   where

libs/wire-subsystems/test/unit/Wire/EnterpriseLoginSubsystem/InterpreterSpec.hs

@@ -68,7 +68,7 @@ runDependencies ::
   Either EnterpriseLoginSubsystemError a
 runDependencies =
   run
-    . userSubsystemTestInterpreter []
+    . runInMemoryUserSubsystemInterpreter mempty
     . (evalState mempty . inMemoryUserKeyStoreInterpreter . raiseUnder)
     . fakeRpc
     . runRandomPure

libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserKeyStore.hs

@@ -19,11 +19,24 @@ module Wire.MockInterpreters.UserKeyStore where
 
 import Data.Id
 import Data.Map qualified as M
+import Data.Map qualified as Map
 import Imports
 import Polysemy
 import Polysemy.State
+import Wire.StoredUser
 import Wire.UserKeyStore
 
+runInMemoryUserKeyStoreIntepreterWithStoredUsers :: [StoredUser] -> InterpreterFor UserKeyStore r
+runInMemoryUserKeyStoreIntepreterWithStoredUsers initialUsers =
+  let emailKeys = Map.fromList $ mapMaybe (\u -> (,u.id) . mkEmailKey <$> u.email) initialUsers
+   in runInMemoryUserKeyStoreIntepreter emailKeys
+
+runInMemoryUserKeyStoreIntepreter :: Map EmailKey UserId -> InterpreterFor UserKeyStore r
+runInMemoryUserKeyStoreIntepreter keys =
+  evalState keys
+    . inMemoryUserKeyStoreInterpreter
+    . raiseUnder
+
 inMemoryUserKeyStoreInterpreter ::
   (Member (State (Map EmailKey UserId)) r) =>
   InterpreterFor UserKeyStore r

libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs

@@ -34,6 +34,12 @@ import Wire.StoredUser
 import Wire.UserStore
 import Wire.UserStore.IndexUser
 
+runInMemoryUserStoreInterpreter :: [StoredUser] -> InterpreterFor UserStore r
+runInMemoryUserStoreInterpreter initialUsers =
+  evalState initialUsers
+    . inMemoryUserStoreInterpreter
+    . raiseUnder
+
 inMemoryUserStoreInterpreter ::
   forall r.
   (Member (State [StoredUser]) r) =>

libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs

@@ -17,35 +17,56 @@
 
 module Wire.MockInterpreters.UserSubsystem where
 
+import Control.Monad.Trans.Maybe (MaybeT (..))
+import Data.Domain
+import Data.LanguageCodes
 import Data.LegalHold
 import Data.Qualified
 import Imports
 import Polysemy
 import Wire.API.User
+import Wire.MockInterpreters.UserKeyStore
+import Wire.MockInterpreters.UserStore
+import Wire.StoredUser
+import Wire.UserKeyStore (UserKeyStore)
+import Wire.UserKeyStore qualified as UserKeyStore
+import Wire.UserStore (UserStore)
+import Wire.UserStore qualified as UserStore
 import Wire.UserSubsystem
 
-userSubsystemTestInterpreter :: [User] -> InterpreterFor UserSubsystem r
-userSubsystemTestInterpreter initialUsers =
+runInMemoryUserSubsystemInterpreter :: [StoredUser] -> InterpreterFor UserSubsystem r
+runInMemoryUserSubsystemInterpreter initialUsers =
+  runInMemoryUserStoreInterpreter initialUsers
+    . runInMemoryUserKeyStoreIntepreterWithStoredUsers initialUsers
+    . inMemoryUserSubsystemInterpreter
+    . raiseUnder
+    . raiseUnder
+
+testDomain :: Domain
+testDomain = Domain "test.example"
+
+testLocale :: Locale
+testLocale = Locale (Language EN) Nothing
+
+inMemoryUserSubsystemInterpreter :: (Member UserStore r, Member UserKeyStore r) => InterpreterFor UserSubsystem r
+inMemoryUserSubsystemInterpreter =
   interpret \case
-    GetAccountsByEmailNoFilter (tUnqualified -> emails) ->
-      pure $
-        filter
-          (\u -> userEmail u `elem` (Just <$> emails))
-          initialUsers
-    GetUserTeam uid -> pure $ do
-      user <- find (\u -> userId u == uid) initialUsers
-      user.userTeam
-    GetSelfProfile uid ->
-      pure . fmap SelfProfile $
-        find (\u -> qUnqualified u.userQualifiedId == tUnqualified uid) initialUsers
+    GetAccountsByEmailNoFilter (tUnqualified -> emails) -> do
+      uids <- catMaybes <$> traverse (UserKeyStore.lookupKey . UserKeyStore.mkEmailKey) emails
+      storedUsers <- UserStore.getUsers uids
+      pure $ mkUserFromStored testDomain testLocale <$> storedUsers
+    GetUserTeam uid -> runMaybeT do
+      user <- MaybeT $ UserStore.getUser uid
+      MaybeT $ pure user.teamId
+    GetSelfProfile uid -> do
+      SelfProfile . mkUserFromStored testDomain testLocale <$$> UserStore.getUser (tUnqualified uid)
     IsBlocked _ -> pure False
     GetUserProfiles _ _ -> error "GetUserProfiles: implement on demand (userSubsystemInterpreter)"
     GetUserProfilesWithErrors _ _ -> error "GetUserProfilesWithErrors: implement on demand (userSubsystemInterpreter)"
     GetLocalUserProfiles luids ->
-      let uids = qUnqualified $ tUntagged luids
-       in pure (toProfile <$> filter (\u -> userId u `elem` uids) initialUsers)
+      toProfile . mkUserFromStored testDomain testLocale <$$> UserStore.getUsers (tUnqualified luids)
     GetAccountsBy (tUnqualified -> GetBy NoPendingInvitations True True uids []) ->
-      pure (filter (\u -> userId u `elem` uids) initialUsers)
+      mkUserFromStored testDomain testLocale <$$> UserStore.getUsers uids
     GetAccountsBy _ -> error "GetAccountsBy: implement on demand (userSubsystemInterpreter)"
     UpdateUserProfile {} -> error "UpdateUserProfile: implement on demand (userSubsystemInterpreter)"
     CheckHandle _ -> error "CheckHandle: implement on demand (userSubsystemInterpreter)"

libs/wire-subsystems/test/unit/Wire/SAMLEmailSubsystem/InterpreterSpec.hs

@@ -24,6 +24,7 @@ import Test.QuickCheck
 import Text.Email.Parser (unsafeEmailAddress)
 import URI.ByteString
 import Wire.API.Locale
+import Wire.API.Password
 import Wire.API.Routes.Internal.Brig (IdpChangedNotification (..))
 import Wire.API.Team.Member
 import Wire.API.Team.Permission (fullPermissions)
@@ -341,6 +342,7 @@ runInterpreters ::
        Email.EmailSubsystem,
        UserStore,
        State [StoredUser],
+       State (Map UserId Password),
        GalleyAPIAccess,
        Logger (Logger.Msg -> Logger.Msg),
        EmailSending,
@@ -351,13 +353,14 @@ runInterpreters ::
   IO ([Mail], [(Level, LByteString)], a)
 runInterpreters users teamMap teamTemplates branding action = do
   lr <- newLogRecorder
-  (mails, (_userState, res)) <-
+  (mails, res) <-
     runM
       . runState @[Mail] [] -- Use runState to capture and return the Mail state
       . recordingEmailSendingInterpreter
       . recordLogs lr
       . miniGalleyAPIAccess teamMap def
-      . runState @[StoredUser] users
+      . evalState @(Map UserId Password) mempty
+      . evalState @[StoredUser] users
       . inMemoryUserStoreInterpreter
       . emailSubsystemInterpreter undefined teamTemplates branding
       . interpretTeamSubsystemToGalleyAPI

libs/wire-subsystems/test/unit/Wire/ScimSubsystem/InterpreterSpec.hs

@@ -42,8 +42,10 @@ import Wire.API.User as User
 import Wire.API.User.Scim
 import Wire.API.UserGroup
 import Wire.BrigAPIAccess (BrigAPIAccess (..))
+import Wire.MockInterpreters
 import Wire.ScimSubsystem
 import Wire.ScimSubsystem.Interpreter
+import Wire.StoredUser
 import Wire.UserGroupSubsystem qualified as UGS
 import Wire.UserGroupSubsystem.Interpreter qualified as UGS
 import Wire.UserGroupSubsystem.InterpreterSpec qualified as UGS
@@ -60,17 +62,17 @@ type AllDependencies =
 runDependencies ::
   forall a.
   (HasCallStack) =>
-  [User] ->
+  [StoredUser] ->
   Map TeamId [TeamMember] ->
   Sem AllDependencies a ->
   Either ScimSubsystemError a
 runDependencies initialUsers initialTeams =
-  either (error . show) id . runDependenciesSafe initialUsers initialTeams
+  either (error . show) Imports.id . runDependenciesSafe initialUsers initialTeams
 
 runDependenciesSafe ::
   forall a.
   (HasCallStack) =>
-  [User] ->
+  [StoredUser] ->
   Map TeamId [TeamMember] ->
   Sem AllDependencies a ->
   Either UGS.UserGroupSubsystemError (Either ScimSubsystemError a)
@@ -88,12 +90,12 @@ runDependenciesSafe initialUsers initialTeams =
     scimBaseUri = Common.URI . fromJust . parseURI $ "http://nowhere.net/scim/v2"
 
     -- Mock BrigAPIAccess interpreter for tests
-    mockBrigAPIAccess :: (Member UGS.UserGroupSubsystem r) => [User] -> InterpreterFor BrigAPIAccess r
+    mockBrigAPIAccess :: (Member UGS.UserGroupSubsystem r) => [StoredUser] -> InterpreterFor BrigAPIAccess r
     mockBrigAPIAccess users = interpret $ \case
       CreateGroupInternal managedBy teamId creatorUserId newGroup -> do
         Right <$> UGS.createGroupInternal managedBy teamId creatorUserId newGroup
       GetAccountsBy getBy -> do
-        pure $ filter (\u -> User.userId u `elem` getBy.getByUserId) users
+        pure . map (mkUserFromStored testDomain testLocale) $ filter (\u -> u.id `elem` getBy.getByUserId) users
       GetGroupInternal tid gid False -> do
         UGS.getGroupInternal tid gid False
       DeleteGroupInternal managedBy teamId groupId ->
@@ -110,8 +112,8 @@ instance Arbitrary Group.Group where
           members = []
         }
 
-mkScimGroupMember :: User -> Group.Member
-mkScimGroupMember (idToText . User.userId -> value) =
+mkScimGroupMember :: StoredUser -> Group.Member
+mkScimGroupMember (idToText . (.id) -> value) =
   let typ = "User"
       ref = "$schema://$host.$domain/scim/vs/Users/$uuid" -- not a real URI, just a string for testing.
    in Group.Member {..}
@@ -123,7 +125,7 @@ spec = UGS.timeoutHook $ describe "ScimSubsystem.Interpreter" $ do
       let newScimGroup =
             newScimGroup_
               { Group.members =
-                  let scimMembers = filter (\u -> u.userManagedBy == ManagedByScim) (UGS.allUsers team)
+                  let scimMembers = filter (\u -> u.managedBy == Just ManagedByScim) (UGS.allUsers team)
                    in mkScimGroupMember <$> scimMembers
               }
           resultOrError = do
@@ -161,18 +163,18 @@ spec = UGS.timeoutHook $ describe "ScimSubsystem.Interpreter" $ do
               scimCreateUserGroup team.tid newScimGroup
 
           want =
-            if all (\u -> u.userManagedBy == ManagedByScim) groupMembers
+            if all (\u -> u.managedBy == Just ManagedByScim) groupMembers
               then isRight
               else isLeft
       unless (want have) do
-        expectationFailure . show $ ((.userManagedBy) <$> UGS.allUsers team)
+        expectationFailure . show $ ((.managedBy) <$> UGS.allUsers team)
 
   describe "scimDeleteUserGroup" $ do
     prop "deletes a SCIM-managed group" $ \(team :: UGS.ArbitraryTeam) (newScimGroup_ :: Group.Group) ->
       let newScimGroup =
             newScimGroup_
               { Group.members =
-                  let scimUsers = filter (\u -> u.userManagedBy == ManagedByScim) (UGS.allUsers team)
+                  let scimUsers = filter (\u -> u.managedBy == Just ManagedByScim) (UGS.allUsers team)
                    in mkScimGroupMember <$> scimUsers
               }
           resultOrError = do
@@ -190,7 +192,7 @@ spec = UGS.timeoutHook $ describe "ScimSubsystem.Interpreter" $ do
 
     it "fails to delete non-SCIM-managed groups" $ do
       team :: UGS.ArbitraryTeam <- generate arbitrary
-      let ugName = either (error . show) id $ userGroupNameFromText "test-group"
+      let ugName = either (error . show) Imports.id $ userGroupNameFromText "test-group"
       let newGroup = NewUserGroup {name = ugName, members = mempty}
       let have =
             runDependenciesSafe (UGS.allUsers team) (UGS.galleyTeam team) $ do