[wip] more things added to user subsystem and refactor things to use the

new definitions

libs/wire-subsystems/src/Wire/MiniBackend.hs

@@ -356,8 +356,10 @@ staticUserStoreInterpreter = interpret $ \case
               $ u
       doUpdate u = u
   -- TODO
-  ClaimHandle _ _ _ -> pure False
-  FreeHandle _ _ -> pure ()
+  ClaimHandle {} -> pure False
+  FreeHandle {} -> pure ()
+  LookupHandle {} -> undefined -- TODO(mangoiv): not yet implemented
+  GlimpseHandle {} -> undefined -- TODO(mangoiv): not yet implemented
 
 -- | interprets galley by statically returning the values passed
 miniGalleyAPIAccess ::

libs/wire-subsystems/src/Wire/UserStore.hs

@@ -59,17 +59,20 @@ instance Default UserProfileUpdate where
         handle = Nothing
       }
 
-data CheckHandleResp
-  = CheckHandleInvalid
-  | CheckHandleFound
-  | CheckHandleNotFound
-
 data UserStore m a where
   GetUser :: UserId -> UserStore m (Maybe StoredUser)
   UpdateUser :: UserId -> UserProfileUpdate -> UserStore m ()
   -- | Claim a new handle for an existing 'User'.
   ClaimHandle :: UserId -> Maybe Handle -> Handle -> UserStore m Bool
   -- | Free a 'Handle', making it available to be claimed again.
   FreeHandle :: UserId -> Handle -> UserStore m ()
+  -- | this operation looks up a handle but may not give you stale data
+  --   it is potentially slower and less resilient than 'GlimpseHandle'
+  LookupHandle :: Handle -> UserStore m (Maybe UserId)
+  -- | the interpretation for 'LookupHandle' and 'GlimpseHandle'
+  --   may differ in terms of how consistent they are, if that
+  --   matters for the interpretation, this operation may give you stale data
+  --   but is faster and more resilient
+  GlimpseHandle :: Handle -> UserStore m (Maybe UserId)
 
 makeSem ''UserStore

libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs

@@ -20,6 +20,8 @@ interpretUserStoreCassandra casClient =
       UpdateUser uid update -> embed $ updateUserImpl uid update
       ClaimHandle uid old new -> embed $ claimHandleImpl uid old new
       FreeHandle uid h -> embed $ freeHandleImpl uid h
+      LookupHandle hdl -> embed $ lookupHandleImpl LocalQuorum hdl
+      GlimpseHandle hdl -> embed $ lookupHandleImpl One hdl
 
 getUserImpl :: Member (Embed Client) r => UserId -> Sem r (Maybe StoredUser)
 getUserImpl uid = embed $ do
@@ -38,7 +40,7 @@ updateUserImpl uid update = retry x5 . batch $ do
 claimHandleImpl :: UserId -> Maybe Handle -> Handle -> Client Bool
 claimHandleImpl uid oldHandle newHandle =
   isJust <$> do
-    owner <- lookupHandle newHandle
+    owner <- lookupHandleImpl LocalQuorum newHandle
     case owner of
       Just uid' | uid /= uid' -> pure Nothing
       _ -> do
@@ -56,7 +58,7 @@ claimHandleImpl uid oldHandle newHandle =
 
 freeHandleImpl :: UserId -> Handle -> Client ()
 freeHandleImpl uid h = do
-  mbHandleUid <- lookupHandle h
+  mbHandleUid <- lookupHandleImpl LocalQuorum h
   case mbHandleUid of
     Just handleUid | handleUid == uid -> do
       retry x5 $ write handleDelete (params LocalQuorum (Identity h))
@@ -69,10 +71,10 @@ freeHandleImpl uid h = do
 --
 -- FUTUREWORK: This should ideally be tackled by hiding constructor for 'Handle'
 -- and only allowing it to be parsed.
-lookupHandle :: Handle -> Client (Maybe UserId)
-lookupHandle h = do
+lookupHandleImpl :: Consistency -> Handle -> Client (Maybe UserId)
+lookupHandleImpl consistencyLevel h = do
   (runIdentity =<<)
-    <$> retry x1 (query1 handleSelect (params LocalQuorum (Identity h)))
+    <$> retry x1 (query1 handleSelect (params consistencyLevel (Identity h)))
 
 updateHandle :: UserId -> Handle -> Client ()
 updateHandle u h = retry x5 $ write userHandleUpdate (params LocalQuorum (h, u))

libs/wire-subsystems/src/Wire/UserSubsystem.hs

@@ -2,14 +2,16 @@
 
 module Wire.UserSubsystem where
 
+-- FUTUREWORK(mangoiv): this should probably be renamed such that it doesn't
+-- associate with the name "brig" anymore
+
+import Data.Handle (Handle)
 import Data.Id
 import Data.Qualified
 import Imports
 import Network.Wai.Utilities qualified as Wai
 import Polysemy
 import Wire.API.Error
--- FUTUREWORK(mangoiv): this should probably be renamed such that it doesn't
--- associate with the name "brig" anymore
 import Wire.API.Error.Brig qualified as E
 import Wire.API.Federation.Error
 import Wire.API.User
@@ -48,6 +50,18 @@ data UserSubsystem m a where
   -- FUTUREWORK: it would be better to return errors as `Map Domain FederationError`, but would clients like that?
   GetUserProfilesWithErrors :: Local UserId -> [Qualified UserId] -> UserSubsystem m ([(Qualified UserId, FederationError)], [UserProfile])
   UpdateUserProfile :: Local UserId -> Maybe ConnId -> UserProfileUpdate -> UserSubsystem m ()
+  -- | parse and lookup a handle, return what the operation has found
+  CheckHandle :: Text -> UserSubsystem m CheckHandleResp
+  -- | checks a number of 'Handle's for availability and returns at most 'Word' amount of them
+  CheckHandles :: [Handle] -> Word -> UserSubsystem m [Handle]
+  -- | parses a handle, this may fail so it's effectful
+  ParseHandle :: Text -> UserSubsystem m Handle
+
+-- | the return type of 'CheckHandle'
+data CheckHandleResp
+  = CheckHandleFound
+  | CheckHandleNotFound
+  deriving stock (Eq, Ord, Show)
 
 makeSem ''UserSubsystem
 

libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
+
 module Wire.UserSubsystem.Interpreter
   ( runUserSubsystem,
     UserSubsystemConfig (..),
@@ -8,6 +11,8 @@ where
 import Control.Lens (view)
 import Control.Monad.Trans.Maybe
 import Data.Either.Extra
+import Data.Handle (Handle)
+import Data.Handle qualified as Handle
 import Data.Id
 import Data.Json.Util
 import Data.LegalHold
@@ -80,11 +85,14 @@ interpretUserSubsystem ::
     Typeable fedM
   ) =>
   InterpreterFor UserSubsystem r
-interpretUserSubsystem = interpret $ \case
+interpretUserSubsystem = interpret \case
   GetUserProfiles self others -> getUserProfilesImpl self others
   GetLocalUserProfiles others -> getLocalUserProfilesImpl others
   GetUserProfilesWithErrors self others -> getUserProfilesWithErrorsImpl self others
   UpdateUserProfile self mconn update -> updateUserProfileImpl self mconn update
+  ParseHandle uhandle -> parseHandleImpl uhandle
+  CheckHandle uhandle -> checkHandleImpl uhandle
+  CheckHandles hdls cnt -> checkHandlesImpl hdls cnt
 
 -- | Obtain user profiles for a list of users as they can be seen by
 -- a given user 'self'. If 'self' is an unknown 'UserId', return '[]'.
@@ -336,10 +344,13 @@ mkProfileUpdateEvent uid update =
 --------------------------------------------------------------------------------
 -- Check Handle
 
-checkHandle :: Text -> Sem r CheckHandleResp
-checkHandle uhandle = do
-  xhandle <- validateHandle uhandle
-  owner <- lift . wrapClient $ lookupHandle xhandle
+parseHandleImpl :: (Member (Error UserSubsystemError) r) => Text -> Sem r Handle
+parseHandleImpl = note UserSubsystemInvalidHandle . Handle.parseHandle
+
+checkHandleImpl :: (Member (Error UserSubsystemError) r, Member UserStore r) => Text -> Sem r CheckHandleResp
+checkHandleImpl uhandle = do
+  xhandle :: Handle <- parseHandleImpl uhandle
+  owner <- lookupHandle xhandle
   if
       | isJust owner ->
           -- Handle is taken (=> getHandleInfo will return 200)
@@ -350,16 +361,18 @@ checkHandle uhandle = do
           -- FUTUREWORK: i wonder if this is correct?  isn't this the error for malformed
           -- handles?  shouldn't we throw not-found here?  or should there be a fourth case
           -- 'CheckHandleBlacklisted'?
-          pure CheckHandleInvalid
+          throw UserSubsystemInvalidHandle
       | otherwise ->
           -- Handle is free and can be taken
           pure CheckHandleNotFound
 
 --------------------------------------------------------------------------------
 -- Check Handles
 
-checkHandles :: [Handle] -> Word -> Sem r [Handle]
-checkHandles check num = reverse <$> collectFree [] check num
+-- | checks for handles @check@ to be available and returns
+--   at maximum @num@ of them
+checkHandlesImpl :: _ => [Handle] -> Word -> Sem r [Handle]
+checkHandlesImpl check num = reverse <$> collectFree [] check num
   where
     collectFree free _ 0 = pure free
     collectFree free [] _ = pure free

services/brig/src/Brig/API/Internal.hs

@@ -43,7 +43,12 @@ import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore)
 import Brig.Effects.BlacklistStore (BlacklistStore)
 import Brig.Effects.CodeStore (CodeStore)
 import Brig.Effects.ConnectionStore (ConnectionStore)
-import Brig.Effects.FederationConfigStore (AddFederationRemoteResult (..), AddFederationRemoteTeamResult (..), FederationConfigStore, UpdateFederationResult (..))
+import Brig.Effects.FederationConfigStore
+  ( AddFederationRemoteResult (..),
+    AddFederationRemoteTeamResult (..),
+    FederationConfigStore,
+    UpdateFederationResult (..),
+  )
 import Brig.Effects.FederationConfigStore qualified as E
 import Brig.Effects.PasswordResetStore (PasswordResetStore)
 import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore)
@@ -107,6 +112,7 @@ import Wire.Sem.Concurrency
 import Wire.Sem.Paging.Cassandra (InternalPaging)
 import Wire.UserStore (UserProfileUpdate (..), allowScimUpdate)
 import Wire.UserSubsystem
+import Wire.UserSubsystem qualified as UserSubsystem
 
 servantSitemap ::
   forall r p.
@@ -555,13 +561,13 @@ listActivatedAccounts ::
   Member DeleteQueue r =>
   Either [UserId] [Handle] ->
   Bool ->
-  (AppT r) [UserAccount]
+  AppT r [UserAccount]
 listActivatedAccounts elh includePendingInvitations = do
   Log.debug (Log.msg $ "listActivatedAccounts: " <> show (elh, includePendingInvitations))
   case elh of
     Left us -> byIds us
     Right hs -> do
-      us <- mapM (wrapClient . API.lookupHandle) hs
+      us <- liftSem $ mapM API.lookupHandle hs
       byIds (catMaybes us)
   where
     byIds :: Member DeleteQueue r => [UserId] -> (AppT r) [UserAccount]
@@ -849,16 +855,18 @@ updateHandleH ::
     Member GalleyAPIAccess r,
     Member TinyLog r,
     Member (Input (Local ())) r,
+    Member UserSubsystem r,
     Member (Input UTCTime) r,
     Member (ConnectionStore InternalPaging) r
   ) =>
   UserId ->
   HandleUpdate ->
-  (Handler r) NoContent
+  Handler r NoContent
 updateHandleH uid (HandleUpdate handleUpd) =
   NoContent <$ do
     handle <- validateHandle handleUpd
-    API.changeHandle uid Nothing handle API.AllowSCIMUpdates !>> changeHandleError
+    quid <- qualifyLocal uid
+    lift (liftSem $ UserSubsystem.updateUserProfile quid Nothing def {handle = Just $ allowScimUpdate handle}) !>> changeHandleError
 
 updateUserNameH ::
   Member UserSubsystem r =>
@@ -874,12 +882,11 @@ updateUserNameH uid (NameUpdate nameUpd) =
       Just _ -> lift . liftSem $ updateUserProfile luid Nothing uu
       Nothing -> throwStd (errorToWai @'E.InvalidUser)
 
-checkHandleInternalH :: Handle -> (Handler r) CheckHandleResponse
-checkHandleInternalH (Handle h) =
-  API.checkHandle h >>= \case
-    API.CheckHandleInvalid -> throwE (StdError (errorToWai @'E.InvalidHandle))
-    API.CheckHandleFound -> pure CheckHandleResponseFound
-    API.CheckHandleNotFound -> pure CheckHandleResponseNotFound
+checkHandleInternalH :: Handle -> Handler r CheckHandleResponse
+checkHandleInternalH (Handle h) = lift $ liftSem do
+  API.checkHandle h <&> \case
+    API.CheckHandleFound -> CheckHandleResponseFound
+    API.CheckHandleNotFound -> CheckHandleResponseNotFound
 
 getContactListH :: UserId -> (Handler r) UserIds
 getContactListH uid = lift . wrapClient $ UserIds <$> API.lookupContactList uid

services/brig/src/Brig/API/Public.hs

@@ -70,7 +70,7 @@ import Brig.User.Email
 import Brig.User.Phone
 import Cassandra qualified as C
 import Cassandra qualified as Data
-import Control.Error hiding (bool)
+import Control.Error hiding (bool, note)
 import Control.Lens (view, (.~), (?~), (^.))
 import Control.Monad.Catch (throwM)
 import Control.Monad.Except
@@ -84,7 +84,8 @@ import Data.CommaSeparatedList
 import Data.Default
 import Data.Domain
 import Data.FileEmbed
-import Data.Handle (Handle, parseHandle)
+import Data.Handle (Handle)
+import Data.Handle qualified as Handle
 import Data.Id
 import Data.Id qualified as Id
 import Data.List.NonEmpty (nonEmpty)
@@ -105,6 +106,7 @@ import Imports hiding (head)
 import Network.Socket (PortNumber)
 import Network.Wai.Utilities as Utilities
 import Polysemy
+import Polysemy.Error (note)
 import Polysemy.Input (Input)
 import Polysemy.TinyLog (TinyLog)
 import Servant hiding (Handler, JSON, addHeader, respond)
@@ -165,8 +167,9 @@ import Wire.Sem.Concurrency
 import Wire.Sem.Jwk (Jwk)
 import Wire.Sem.Now (Now)
 import Wire.Sem.Paging.Cassandra (InternalPaging)
-import Wire.UserStore (UserProfileUpdate (..), forbidScimUpdate)
-import Wire.UserSubsystem
+import Wire.UserStore (UserProfileUpdate (..), UserStore, forbidScimUpdate)
+import Wire.UserSubsystem hiding (checkHandle, checkHandles)
+import Wire.UserSubsystem qualified as UserSubsystem
 
 -- User API -----------------------------------------------------------
 
@@ -854,9 +857,9 @@ listUsersByUnqualifiedIdsOrHandles self mUids mHandles = do
        in listUsersByIdsOrHandlesV3 self (Public.ListUsersByHandles qualifiedRangedList)
     (Nothing, Nothing) -> throwStd $ badRequest "at least one ids or handles must be provided"
 
-listUsersByIdsOrHandlesGetIds :: [Handle] -> (Handler r) [Qualified UserId]
+listUsersByIdsOrHandlesGetIds :: [Handle] -> Handler r [Qualified UserId]
 listUsersByIdsOrHandlesGetIds localHandles = do
-  localUsers <- catMaybes <$> traverse (lift . wrapClient . API.lookupHandle) localHandles
+  localUsers <- catMaybes <$> traverse (lift . liftSem . API.lookupHandle) localHandles
   domain <- viewFederationDomain
   pure $ map (`Qualified` domain) localUsers
 
@@ -1013,26 +1016,26 @@ changeSupportedProtocols (tUnqualified -> u) conn (Public.SupportedProtocolUpdat
 
 -- | (zusr is ignored by this handler, ie. checking handles is allowed as long as you have
 -- *any* account.)
-checkHandle :: UserId -> Text -> Handler r ()
+checkHandle :: Member UserSubsystem r => UserId -> Text -> Handler r ()
 checkHandle _uid hndl =
-  API.checkHandle hndl >>= \case
-    API.CheckHandleInvalid -> throwStd (errorToWai @'E.InvalidHandle)
+  lift (liftSem $ UserSubsystem.checkHandle hndl) >>= \case
     API.CheckHandleFound -> pure ()
     API.CheckHandleNotFound -> throwStd (errorToWai @'E.HandleNotFound)
 
 -- | (zusr is ignored by this handler, ie. checking handles is allowed as long as you have
 -- *any* account.)
-checkHandles :: UserId -> Public.CheckHandles -> Handler r [Handle]
+checkHandles :: Member UserSubsystem r => UserId -> Public.CheckHandles -> Handler r [Handle]
 checkHandles _ (Public.CheckHandles hs num) = do
-  let handles = mapMaybe parseHandle (fromRange hs)
-  lift $ wrapHttpClient $ API.checkHandles handles (fromRange num)
+  let handles = mapMaybe Handle.parseHandle (fromRange hs)
+  lift $ liftSem $ API.checkHandles handles (fromRange num)
 
 -- | This endpoint returns UserHandleInfo instead of UserProfile for backwards
 -- compatibility, whereas the corresponding qualified endpoint (implemented by
 -- 'Handle.getHandleInfo') returns UserProfile to reduce traffic between backends
 -- in a federated scenario.
 getHandleInfoUnqualifiedH ::
-  ( Member UserSubsystem r
+  ( Member UserSubsystem r,
+    Member UserStore r
   ) =>
   UserId ->
   Handle ->
@@ -1042,27 +1045,15 @@ getHandleInfoUnqualifiedH self handle = do
   Public.UserHandleInfo . Public.profileQualifiedId
     <$$> Handle.getHandleInfo self (Qualified handle domain)
 
-changeHandle ::
-  ( Member (Embed HttpClientIO) r,
-    Member NotificationSubsystem r,
-    Member GalleyAPIAccess r,
-    Member TinyLog r,
-    Member (Input (Local ())) r,
-    Member (Input UTCTime) r,
-    Member (ConnectionStore InternalPaging) r
-  ) =>
-  UserId ->
-  ConnId ->
-  Public.HandleUpdate ->
-  (Handler r) (Maybe Public.ChangeHandleError)
-changeHandle u conn (Public.HandleUpdate h) = lift . exceptTToMaybe $ do
-  handle <- maybe (throwError Public.ChangeHandleInvalid) pure $ parseHandle h
-  API.changeHandle u (Just conn) handle API.ForbidSCIMUpdates
+changeHandle :: (Member UserSubsystem r) => Local UserId -> ConnId -> Public.HandleUpdate -> Handler r ()
+changeHandle u conn (Public.HandleUpdate h) = lift $ liftSem do
+  handle <- UserSubsystem.parseHandle h
+  UserSubsystem.updateUserProfile u (Just conn) def {handle = Just (forbidScimUpdate handle)}
 
 beginPasswordReset ::
   (Member PasswordResetStore r, Member TinyLog r) =>
   Public.NewPasswordReset ->
-  (Handler r) ()
+  Handler r ()
 beginPasswordReset (Public.NewPasswordReset target) = do
   checkAllowlist target
   (u, pair) <- API.beginPasswordReset target !>> pwResetError