diff --git a/changelog.d/5-internal/WPB-11101-internal-types b/changelog.d/5-internal/WPB-11101-internal-types new file mode 100644 index 00000000000..bf92f52b5ce --- /dev/null +++ b/changelog.d/5-internal/WPB-11101-internal-types @@ -0,0 +1 @@ +Improve abstraction in the invitation store and hide DB interaction-specific internal types from the application code. diff --git a/libs/wire-subsystems/src/Wire/InvitationCodeStore.hs b/libs/wire-subsystems/src/Wire/InvitationStore.hs similarity index 54% rename from libs/wire-subsystems/src/Wire/InvitationCodeStore.hs rename to libs/wire-subsystems/src/Wire/InvitationStore.hs index 78eee5283dc..e691f516bf7 100644 --- a/libs/wire-subsystems/src/Wire/InvitationCodeStore.hs +++ b/libs/wire-subsystems/src/Wire/InvitationStore.hs @@ -18,17 +18,14 @@ {-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-} -module Wire.InvitationCodeStore where +module Wire.InvitationStore where -import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT)) import Data.Id (InvitationId, TeamId, UserId) import Data.Json.Util (UTCTimeMillis) import Data.Range (Range) import Database.CQL.Protocol (Record (..), TupleType, recordInstance) import Imports import Polysemy -import Polysemy.TinyLog (TinyLog) -import System.Logger.Message qualified as Log import URI.ByteString import Util.Timeout import Wire.API.Team.Invitation (Invitation (inviteeEmail)) @@ -36,7 +33,6 @@ import Wire.API.Team.Invitation qualified as Public import Wire.API.Team.Role (Role, defaultRole) import Wire.API.User (EmailAddress, InvitationCode, Name) import Wire.Arbitrary (Arbitrary, GenericUniform (..)) -import Wire.Sem.Logger qualified as Log data StoredInvitation = MkStoredInvitation { teamId :: TeamId, @@ -53,16 +49,6 @@ data StoredInvitation = MkStoredInvitation recordInstance ''StoredInvitation -data StoredInvitationInfo = MkStoredInvitationInfo - { teamId :: TeamId, - invitationId :: InvitationId, - code :: InvitationCode - } - deriving (Show, Eq, Generic) - deriving (Arbitrary) via (GenericUniform StoredInvitationInfo) - -recordInstance ''StoredInvitationInfo - data InsertInvitation = MkInsertInvitation { invitationId :: InvitationId, teamId :: TeamId, @@ -84,45 +70,21 @@ data PaginatedResult a ---------------------------- -data InvitationCodeStore :: Effect where - InsertInvitation :: InsertInvitation -> Timeout -> InvitationCodeStore m StoredInvitation - LookupInvitation :: TeamId -> InvitationId -> InvitationCodeStore m (Maybe StoredInvitation) - LookupInvitationInfo :: InvitationCode -> InvitationCodeStore m (Maybe StoredInvitationInfo) - LookupInvitationCodesByEmail :: EmailAddress -> InvitationCodeStore m [StoredInvitationInfo] +data InvitationStore :: Effect where + InsertInvitation :: InsertInvitation -> Timeout -> InvitationStore m StoredInvitation + LookupInvitation :: TeamId -> InvitationId -> InvitationStore m (Maybe StoredInvitation) + LookupInvitationByCode :: InvitationCode -> InvitationStore m (Maybe StoredInvitation) + LookupInvitationsByEmail :: EmailAddress -> InvitationStore m [StoredInvitation] -- | Range is page size, it defaults to 100 - LookupInvitationsPaginated :: Maybe (Range 1 500 Int32) -> TeamId -> Maybe InvitationId -> InvitationCodeStore m (PaginatedResult [StoredInvitation]) - CountInvitations :: TeamId -> InvitationCodeStore m Int64 - DeleteInvitation :: TeamId -> InvitationId -> InvitationCodeStore m () - DeleteAllTeamInvitations :: TeamId -> InvitationCodeStore m () + LookupInvitationsPaginated :: Maybe (Range 1 500 Int32) -> TeamId -> Maybe InvitationId -> InvitationStore m (PaginatedResult [StoredInvitation]) + CountInvitations :: TeamId -> InvitationStore m Int64 + DeleteInvitation :: TeamId -> InvitationId -> InvitationStore m () + DeleteAllTeamInvitations :: TeamId -> InvitationStore m () -makeSem ''InvitationCodeStore +makeSem ''InvitationStore ---------------------------- -lookupInvitationByEmail :: (Member InvitationCodeStore r, Member TinyLog r) => EmailAddress -> Sem r (Maybe StoredInvitation) -lookupInvitationByEmail email = runMaybeT do - MkStoredInvitationInfo {teamId, invitationId} <- MaybeT $ lookupSingleInvitationCodeByEmail email - MaybeT $ lookupInvitation teamId invitationId - -lookupInvitationByCode :: (Member InvitationCodeStore r) => InvitationCode -> Sem r (Maybe StoredInvitation) -lookupInvitationByCode code = runMaybeT do - info <- MaybeT $ lookupInvitationInfo code - MaybeT $ lookupInvitation info.teamId info.invitationId - -lookupSingleInvitationCodeByEmail :: (Member TinyLog r, Member InvitationCodeStore r) => EmailAddress -> Sem r (Maybe StoredInvitationInfo) -lookupSingleInvitationCodeByEmail email = do - invs <- lookupInvitationCodesByEmail email - case invs of - [] -> pure Nothing - [inv] -> pure $ Just inv - (_ : _ : _) -> do - -- edge case: more than one pending invite from different teams - Log.info $ - Log.msg (Log.val "team_invidation_email: multiple pending invites from different teams for the same email") - . Log.field "email" (show email) - - pure Nothing - invitationFromStored :: Maybe (URIRef Absolute) -> StoredInvitation -> Public.Invitation invitationFromStored maybeUrl MkStoredInvitation {..} = Public.Invitation diff --git a/libs/wire-subsystems/src/Wire/InvitationCodeStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/InvitationStore/Cassandra.hs similarity index 77% rename from libs/wire-subsystems/src/Wire/InvitationCodeStore/Cassandra.hs rename to libs/wire-subsystems/src/Wire/InvitationStore/Cassandra.hs index 37463cfb966..b9fc0173858 100644 --- a/libs/wire-subsystems/src/Wire/InvitationCodeStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/InvitationStore/Cassandra.hs @@ -1,31 +1,33 @@ -module Wire.InvitationCodeStore.Cassandra where +module Wire.InvitationStore.Cassandra + ( interpretInvitationStoreToCassandra, + ) +where import Cassandra +import Control.Monad.Trans.Maybe import Data.Conduit (runConduit, (.|)) import Data.Conduit.List qualified as Conduit import Data.Id import Data.Json.Util (UTCTimeMillis, toUTCTimeMillis) import Data.Range (Range, fromRange) -import Data.Text.Ascii (encodeBase64Url) -import Database.CQL.Protocol (TupleType, asRecord) +import Database.CQL.Protocol (Record (..), TupleType, asRecord) import Imports -import OpenSSL.Random (randBytes) import Polysemy import Polysemy.Embed import UnliftIO.Async (pooledMapConcurrentlyN_) import Util.Timeout import Wire.API.Team.Role (Role) import Wire.API.User -import Wire.InvitationCodeStore +import Wire.InvitationStore -interpretInvitationCodeStoreToCassandra :: (Member (Embed IO) r) => ClientState -> InterpreterFor InvitationCodeStore r -interpretInvitationCodeStoreToCassandra casClient = +interpretInvitationStoreToCassandra :: (Member (Embed IO) r) => ClientState -> InterpreterFor InvitationStore r +interpretInvitationStoreToCassandra casClient = interpret $ runEmbedded (runClient casClient) . \case InsertInvitation newInv timeout -> embed $ insertInvitationImpl newInv timeout LookupInvitation tid iid -> embed $ lookupInvitationImpl tid iid - LookupInvitationCodesByEmail email -> embed $ lookupInvitationCodesByEmailImpl email - LookupInvitationInfo code -> embed $ lookupInvitationInfoImpl code + LookupInvitationsByEmail email -> embed $ lookupInvitationsByEmailImpl email + LookupInvitationByCode code -> embed $ lookupInvitationByCodeImpl code LookupInvitationsPaginated mSize tid miid -> embed $ lookupInvitationsPaginatedImpl mSize tid miid CountInvitations tid -> embed $ countInvitationsImpl tid DeleteInvitation tid invId -> embed $ deleteInvitationImpl tid invId @@ -108,24 +110,41 @@ countInvitationsImpl t = cql :: PrepQuery R (Identity TeamId) (Identity Int64) cql = [sql| SELECT count(*) FROM team_invitation WHERE team = ?|] -lookupInvitationInfoImpl :: InvitationCode -> Client (Maybe StoredInvitationInfo) -lookupInvitationInfoImpl code = - fmap asRecord <$> retry x1 (query1 cql (params LocalQuorum (Identity code))) +lookupInvitationByCodeImpl :: InvitationCode -> Client (Maybe StoredInvitation) +lookupInvitationByCodeImpl code = runMaybeT do + (teamId, invId, _) <- + MaybeT $ + retry x1 (query1 cqlInfo (params LocalQuorum (Identity code))) + MaybeT $ fmap asRecord <$> retry x1 (query1 cqlMain (params LocalQuorum (teamId, invId))) where - cql :: PrepQuery R (Identity InvitationCode) (TupleType StoredInvitationInfo) - cql = + cqlInfo :: PrepQuery R (Identity InvitationCode) (TeamId, InvitationId, InvitationCode) + cqlInfo = [sql| - SELECT team, id, code FROM team_invitation_info WHERE code = ? + SELECT team, id, code FROM team_invitation_info WHERE code = ? + |] + cqlMain :: PrepQuery R (TeamId, InvitationId) (TupleType StoredInvitation) + cqlMain = + [sql| + SELECT team, role, id, created_at, created_by, email, name, code FROM team_invitation WHERE team = ? AND id = ? |] -lookupInvitationCodesByEmailImpl :: EmailAddress -> Client [StoredInvitationInfo] -lookupInvitationCodesByEmailImpl email = map asRecord <$> retry x1 (query cql (params LocalQuorum (Identity email))) +lookupInvitationsByEmailImpl :: EmailAddress -> Client [StoredInvitation] +lookupInvitationsByEmailImpl email = do + infoList <- + retry x1 (query cqlInfo (params LocalQuorum (Identity email))) + fmap catMaybes $ forM infoList $ \(tid, invId, _invCode) -> + fmap asRecord <$> retry x1 (query1 cqlMain (params LocalQuorum (tid, invId))) where - cql :: PrepQuery R (Identity EmailAddress) (TeamId, InvitationId, InvitationCode) - cql = + cqlInfo :: PrepQuery R (Identity EmailAddress) (TeamId, InvitationId, InvitationCode) + cqlInfo = [sql| SELECT team, invitation, code FROM team_invitation_email WHERE email = ? |] + cqlMain :: PrepQuery R (TeamId, InvitationId) (TupleType StoredInvitation) + cqlMain = + [sql| + SELECT team, role, id, created_at, created_by, email, name, code FROM team_invitation WHERE team = ? AND id = ? + |] lookupInvitationImpl :: TeamId -> InvitationId -> Client (Maybe StoredInvitation) lookupInvitationImpl tid iid = @@ -186,8 +205,3 @@ deleteInvitationsImpl teamId = where cqlSelect :: PrepQuery R (Identity TeamId) (Identity InvitationId) cqlSelect = "SELECT id FROM team_invitation WHERE team = ? ORDER BY id ASC" - --- | This function doesn't really belong here, and may want to have return type `Sem (Random : --- ...)` instead of `IO`. Meh. -mkInvitationCode :: IO InvitationCode -mkInvitationCode = InvitationCode . encodeBase64Url <$> randBytes 24 diff --git a/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs index 6095ba6441d..bac8f052635 100644 --- a/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs @@ -27,8 +27,8 @@ import Wire.Arbitrary import Wire.EmailSubsystem import Wire.GalleyAPIAccess hiding (AddTeamMember) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess -import Wire.InvitationCodeStore (InvitationCodeStore, StoredInvitation) -import Wire.InvitationCodeStore qualified as Store +import Wire.InvitationStore (InvitationStore, StoredInvitation) +import Wire.InvitationStore qualified as Store import Wire.Sem.Logger qualified as Log import Wire.Sem.Now (Now) import Wire.Sem.Now qualified as Now @@ -52,7 +52,7 @@ runTeamInvitationSubsystem :: Member GalleyAPIAccess r, Member UserSubsystem r, Member Random r, - Member InvitationCodeStore r, + Member InvitationStore r, Member Now r, Member EmailSubsystem r ) => @@ -69,7 +69,7 @@ inviteUserImpl :: Member UserSubsystem r, Member TinyLog r, Member Random r, - Member InvitationCodeStore r, + Member InvitationStore r, Member (Input TeamInvitationSubsystemConfig) r, Member Now r, Member EmailSubsystem r @@ -106,7 +106,7 @@ inviteUserImpl luid tid request = do createInvitation' :: ( Member GalleyAPIAccess r, Member UserSubsystem r, - Member InvitationCodeStore r, + Member InvitationStore r, Member TinyLog r, Member (Error TeamInvitationSubsystemError) r, Member Random r, diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem.hs b/libs/wire-subsystems/src/Wire/UserSubsystem.hs index 86f4304b064..10357641b71 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem.hs @@ -27,7 +27,7 @@ import Wire.API.User.Search import Wire.Arbitrary import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess -import Wire.InvitationCodeStore +import Wire.InvitationStore import Wire.UserKeyStore (EmailKey, emailKeyOrig) import Wire.UserSearch.Types import Wire.UserSubsystem.Error (UserSubsystemError (..)) diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs index 98e4bd97b6f..f0318d5bff7 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs @@ -55,7 +55,7 @@ import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.IndexedUserStore (IndexedUserStore) import Wire.IndexedUserStore qualified as IndexedUserStore import Wire.IndexedUserStore.Bulk.ElasticSearch (teamSearchVisibilityInbound) -import Wire.InvitationCodeStore +import Wire.InvitationStore import Wire.Sem.Concurrency import Wire.Sem.Metrics import Wire.Sem.Metrics qualified as Metrics @@ -99,7 +99,7 @@ runUserSubsystem :: Member IndexedUserStore r, Member FederationConfigStore r, Member Metrics r, - Member InvitationCodeStore r, + Member InvitationStore r, Member TinyLog r ) => UserSubsystemConfig -> @@ -172,7 +172,7 @@ runUserSubsystem cfg authInterpreter = internalFindTeamInvitationImpl mEmailKey code internalFindTeamInvitationImpl :: - ( Member InvitationCodeStore r, + ( Member InvitationStore r, Member (Error UserSubsystemError) r, Member (Input UserSubsystemConfig) r, Member (GalleyAPIAccess) r, @@ -183,15 +183,11 @@ internalFindTeamInvitationImpl :: Sem r StoredInvitation internalFindTeamInvitationImpl Nothing _ = throw UserSubsystemMissingIdentity internalFindTeamInvitationImpl (Just e) c = - lookupInvitationInfo c >>= \case - Just invitationInfo -> do - inv <- lookupInvitation invitationInfo.teamId invitationInfo.invitationId - case (inv, (.email) <$> inv) of - (Just invite, Just em) - | e == mkEmailKey em -> do - ensureMemberCanJoin invitationInfo.teamId - pure invite - _ -> throw UserSubsystemInvalidInvitationCode + lookupInvitationByCode c >>= \case + Just inv -> do + if e == mkEmailKey (inv.email) + then ensureMemberCanJoin inv.teamId $> inv + else throw UserSubsystemInvalidInvitationCode Nothing -> throw UserSubsystemInvalidInvitationCode where ensureMemberCanJoin tid = do @@ -849,8 +845,7 @@ getAccountsByImpl :: ( Member UserStore r, Member DeleteQueue r, Member (Input UserSubsystemConfig) r, - Member InvitationCodeStore r, - Member TinyLog r + Member InvitationStore r ) => Local GetBy -> Sem r [User] @@ -883,7 +878,7 @@ getAccountsByImpl (tSplit -> (domain, MkGetBy {includePendingInvitations, getByH -- validated one cannot be found. that's probably wrong? split up into -- validEmailIdentity, anyEmailIdentity? Just email -> do - hasInvitation <- isJust <$> lookupInvitationByEmail email + hasInvitation <- isJust . listToMaybe <$> lookupInvitationsByEmail email gcHack hasInvitation (User.userId user) pure hasInvitation Nothing -> error "getExtendedAccountsByImpl: should never happen, user invited via scim always has an email" @@ -916,7 +911,7 @@ acceptTeamInvitationImpl :: Member UserStore r, Member GalleyAPIAccess r, Member (Error UserSubsystemError) r, - Member InvitationCodeStore r, + Member InvitationStore r, Member IndexedUserStore r, Member Metrics r, Member Events r, diff --git a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs index c0d68dadc93..a13271b863a 100644 --- a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs +++ b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs @@ -72,10 +72,10 @@ import Wire.GalleyAPIAccess import Wire.HashPassword (HashPassword) import Wire.IndexedUserStore import Wire.InternalEvent hiding (DeleteUser) -import Wire.InvitationCodeStore +import Wire.InvitationStore import Wire.MockInterpreters import Wire.MockInterpreters.ActivationCodeStore (inMemoryActivationCodeStoreInterpreter) -import Wire.MockInterpreters.InvitationCodeStore (inMemoryInvitationCodeStoreInterpreter) +import Wire.MockInterpreters.InvitationStore (inMemoryInvitationStoreInterpreter) import Wire.PasswordResetCodeStore import Wire.PasswordStore import Wire.Sem.Concurrency @@ -137,10 +137,10 @@ type MiniBackendEffects = UserSubsystem ': MiniBackendLowerEffects type MiniBackendLowerEffects = [ EmailSubsystem, GalleyAPIAccess, - InvitationCodeStore, + InvitationStore, PasswordStore, State (Map (TeamId, InvitationId) StoredInvitation), - State (Map InvitationCode StoredInvitationInfo), + State (Map InvitationCode StoredInvitation), ActivationCodeStore, State (Map EmailKey (Maybe UserId, ActivationCode)), BlockListStore, @@ -178,7 +178,7 @@ data MiniBackend = MkMiniBackend passwordResetCodes :: Map PasswordResetKey (PRQueryData Identity), blockList :: [EmailKey], activationCodes :: Map EmailKey (Maybe UserId, ActivationCode), - invitationInfos :: Map InvitationCode StoredInvitationInfo, + invitationInfos :: Map InvitationCode StoredInvitation, invitations :: Map (TeamId, InvitationId) StoredInvitation } deriving stock (Eq, Show, Generic) @@ -428,20 +428,20 @@ interpretMaybeFederationStackState maybeFederationAPIAccess localBackend teamMem . liftActivationCodeStoreState . inMemoryActivationCodeStoreInterpreter . liftInvitationInfoStoreState - . liftInvitationCodeStoreState + . liftInvitationStoreState . runInMemoryPasswordStoreInterpreter - . inMemoryInvitationCodeStoreInterpreter + . inMemoryInvitationStoreInterpreter . miniGalleyAPIAccess teamMember galleyConfigs . noopEmailSubsystemInterpreter . userSubsystemInterpreter -liftInvitationInfoStoreState :: (Member (State MiniBackend) r) => Sem (State (Map InvitationCode StoredInvitationInfo) : r) a -> Sem r a +liftInvitationInfoStoreState :: (Member (State MiniBackend) r) => Sem (State (Map InvitationCode StoredInvitation) : r) a -> Sem r a liftInvitationInfoStoreState = interpret \case Polysemy.State.Get -> gets (.invitationInfos) Put newAcs -> modify $ \b -> b {invitationInfos = newAcs} -liftInvitationCodeStoreState :: (Member (State MiniBackend) r) => Sem (State (Map (TeamId, InvitationId) StoredInvitation) : r) a -> Sem r a -liftInvitationCodeStoreState = interpret \case +liftInvitationStoreState :: (Member (State MiniBackend) r) => Sem (State (Map (TeamId, InvitationId) StoredInvitation) : r) a -> Sem r a +liftInvitationStoreState = interpret \case Polysemy.State.Get -> gets (.invitations) Put newInvs -> modify $ \b -> b {invitations = newInvs} diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/InvitationCodeStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/InvitationStore.hs similarity index 55% rename from libs/wire-subsystems/test/unit/Wire/MockInterpreters/InvitationCodeStore.hs rename to libs/wire-subsystems/test/unit/Wire/MockInterpreters/InvitationStore.hs index 18f00055865..3de35c3da6a 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/InvitationCodeStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/InvitationStore.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE RecordWildCards #-} - -module Wire.MockInterpreters.InvitationCodeStore where +module Wire.MockInterpreters.InvitationStore where import Data.Id (InvitationId, TeamId) import Data.Map (elems, (!?)) @@ -9,23 +7,21 @@ import Imports import Polysemy import Polysemy.State (State, get, gets) import Wire.API.User (InvitationCode (..)) -import Wire.InvitationCodeStore +import Wire.InvitationStore -inMemoryInvitationCodeStoreInterpreter :: +inMemoryInvitationStoreInterpreter :: forall r. ( Member (State (Map (TeamId, InvitationId) StoredInvitation)) r, - Member (State (Map (InvitationCode) StoredInvitationInfo)) r + Member (State (Map (InvitationCode) StoredInvitation)) r ) => - InterpreterFor InvitationCodeStore r -inMemoryInvitationCodeStoreInterpreter = interpret \case + InterpreterFor InvitationStore r +inMemoryInvitationStoreInterpreter = interpret \case InsertInvitation _a _timeout -> error "InsertInvitation" LookupInvitation tid iid -> gets (!? (tid, iid)) - LookupInvitationInfo iid -> gets (!? iid) - LookupInvitationCodesByEmail em -> - let c MkStoredInvitation {..} - | email == em = Just MkStoredInvitationInfo {..} - | otherwise = Nothing - in mapMaybe c . elems <$> get + LookupInvitationByCode iid -> gets (!? iid) + LookupInvitationsByEmail em -> + let c i = guard (i.email == em) $> i + in mapMaybe c . elems <$> get @(Map (TeamId, InvitationId) _) LookupInvitationsPaginated {} -> error "LookupInvitationsPaginated" CountInvitations tid -> gets (fromIntegral . M.size . M.filterWithKey (\(tid', _) _v -> tid == tid')) DeleteInvitation _tid _invId -> error "DeleteInvitation" diff --git a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs index 721f8479645..c573d4709c5 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs @@ -29,8 +29,8 @@ import Wire.API.Team.Permission import Wire.API.User hiding (DeleteUser) import Wire.API.UserEvent import Wire.AuthenticationSubsystem.Error -import Wire.InvitationCodeStore (StoredInvitation) -import Wire.InvitationCodeStore qualified as InvitationStore +import Wire.InvitationStore (StoredInvitation) +import Wire.InvitationStore qualified as InvitationStore import Wire.MiniBackend import Wire.StoredUser import Wire.UserKeyStore diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index 668e20b9a17..54ff613f5e4 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -102,8 +102,8 @@ library Wire.IndexedUserStore.MigrationStore Wire.IndexedUserStore.MigrationStore.ElasticSearch Wire.InternalEvent - Wire.InvitationCodeStore - Wire.InvitationCodeStore.Cassandra + Wire.InvitationStore + Wire.InvitationStore.Cassandra Wire.NotificationSubsystem Wire.NotificationSubsystem.Interpreter Wire.ParseException @@ -243,7 +243,7 @@ test-suite wire-subsystems-tests Wire.MockInterpreters.GalleyAPIAccess Wire.MockInterpreters.HashPassword Wire.MockInterpreters.IndexedUserStore - Wire.MockInterpreters.InvitationCodeStore + Wire.MockInterpreters.InvitationStore Wire.MockInterpreters.Now Wire.MockInterpreters.PasswordResetCodeStore Wire.MockInterpreters.PasswordStore diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 3d5c3b16fed..d5abf271fc1 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -103,7 +103,7 @@ import Wire.FederationConfigStore import Wire.FederationConfigStore qualified as E import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.IndexedUserStore (IndexedUserStore, getTeamSize) -import Wire.InvitationCodeStore +import Wire.InvitationStore import Wire.NotificationSubsystem import Wire.PasswordResetCodeStore (PasswordResetCodeStore) import Wire.PropertySubsystem @@ -132,7 +132,7 @@ servantSitemap :: Member UserSubsystem r, Member TeamInvitationSubsystem r, Member UserStore r, - Member InvitationCodeStore r, + Member InvitationStore r, Member UserKeyStore r, Member Rpc r, Member TinyLog r, @@ -196,7 +196,7 @@ accountAPI :: Member PropertySubsystem r, Member Events r, Member PasswordResetCodeStore r, - Member InvitationCodeStore r + Member InvitationStore r ) => ServerT BrigIRoutes.AccountAPI (Handler r) accountAPI = @@ -243,7 +243,7 @@ teamsAPI :: Member UserKeyStore r, Member (Concurrency 'Unsafe) r, Member TinyLog r, - Member InvitationCodeStore r, + Member InvitationStore r, Member TeamInvitationSubsystem r, Member UserSubsystem r, Member (Polysemy.Error.Error UserSubsystemError) r, @@ -462,7 +462,7 @@ createUserNoVerify :: Member (UserPendingActivationStore p) r, Member TinyLog r, Member Events r, - Member InvitationCodeStore r, + Member InvitationStore r, Member UserKeyStore r, Member UserSubsystem r, Member (Input (Local ())) r, diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 3d50eea50e1..838d5979403 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -157,7 +157,7 @@ import Wire.FederationConfigStore (FederationConfigStore) import Wire.GalleyAPIAccess (GalleyAPIAccess) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.IndexedUserStore (IndexedUserStore) -import Wire.InvitationCodeStore +import Wire.InvitationStore import Wire.NotificationSubsystem import Wire.PasswordResetCodeStore (PasswordResetCodeStore) import Wire.PasswordStore (PasswordStore, lookupHashedPassword) @@ -283,7 +283,7 @@ servantSitemap :: Member Events r, Member FederationConfigStore r, Member GalleyAPIAccess r, - Member InvitationCodeStore r, + Member InvitationStore r, Member Jwk r, Member JwtTools r, Member NotificationSubsystem r, @@ -731,7 +731,7 @@ upgradePersonalToTeam luid bNewTeam = createUser :: ( Member BlockListStore r, Member GalleyAPIAccess r, - Member InvitationCodeStore r, + Member InvitationStore r, Member (UserPendingActivationStore p) r, Member (Input (Local ())) r, Member TinyLog r, diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 0477c86f754..6d40b450a4c 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -137,8 +137,8 @@ import Wire.Error import Wire.Events (Events) import Wire.Events qualified as Events import Wire.GalleyAPIAccess as GalleyAPIAccess -import Wire.InvitationCodeStore (InvitationCodeStore, StoredInvitation) -import Wire.InvitationCodeStore qualified as InvitationCodeStore +import Wire.InvitationStore (InvitationStore, StoredInvitation) +import Wire.InvitationStore qualified as InvitationStore import Wire.NotificationSubsystem import Wire.PasswordResetCodeStore (PasswordResetCodeStore) import Wire.PasswordStore (PasswordStore, lookupHashedPassword, upsertHashedPassword) @@ -316,7 +316,7 @@ createUser :: Member Events r, Member (Input (Local ())) r, Member PasswordResetCodeStore r, - Member InvitationCodeStore r + Member InvitationStore r ) => NewUser -> ExceptT RegisterError (AppT r) CreateUserResult @@ -456,7 +456,7 @@ createUser new = do . field "team" (toByteString $ inv.teamId) . msg (val "Accepting invitation") UserPendingActivationStore.remove uid - InvitationCodeStore.deleteInvitation inv.teamId inv.invitationId + InvitationStore.deleteInvitation inv.teamId inv.invitationId addUserToTeamSSO :: User -> TeamId -> UserIdentity -> ExceptT RegisterError (AppT r) CreateUserTeam addUserToTeamSSO account tid ident = do diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 4b6af606d58..b2967854fd6 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -57,8 +57,8 @@ import Wire.GundeckAPIAccess import Wire.HashPassword import Wire.IndexedUserStore import Wire.IndexedUserStore.ElasticSearch -import Wire.InvitationCodeStore (InvitationCodeStore) -import Wire.InvitationCodeStore.Cassandra (interpretInvitationCodeStoreToCassandra) +import Wire.InvitationStore (InvitationStore) +import Wire.InvitationStore.Cassandra (interpretInvitationStoreToCassandra) import Wire.NotificationSubsystem import Wire.NotificationSubsystem.Interpreter (defaultNotificationSubsystemConfig, runNotificationSubsystemGundeck) import Wire.ParseException @@ -130,7 +130,7 @@ type BrigLowerLevelEffects = PasswordStore, VerificationCodeStore, ActivationCodeStore, - InvitationCodeStore, + InvitationStore, PropertyStore, SFT, ConnectionStore InternalPaging, @@ -254,7 +254,7 @@ runBrigToIO e (AppT ma) = do . connectionStoreToCassandra . interpretSFT e.httpManager . interpretPropertyStoreCassandra e.casClient - . interpretInvitationCodeStoreToCassandra e.casClient + . interpretInvitationStoreToCassandra e.casClient . interpretActivationCodeStoreToCassandra e.casClient . interpretVerificationCodeStoreCassandra e.casClient . interpretPasswordStore e.casClient diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 0622ce07e7b..e6fcd9f0d43 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -34,7 +34,7 @@ import Brig.App as App import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore) import Brig.Types.Team (TeamSize) import Control.Lens (view, (^.)) -import Control.Monad.Trans.Except (mapExceptT) +import Control.Monad.Trans.Except import Data.ByteString.Conversion (toByteString) import Data.Id import Data.List1 qualified as List1 @@ -55,6 +55,8 @@ import Servant hiding (Handler, JSON, addHeader) import System.Logger.Message as Log import URI.ByteString (Absolute, URIRef, laxURIParserOptions, parseURI) import Util.Logging (logFunction, logTeam) +import Wire.API.Error +import Wire.API.Error.Brig import Wire.API.Routes.Internal.Brig (FoundInvitationCode (FoundInvitationCode)) import Wire.API.Routes.Internal.Galley.TeamsIntra qualified as Team import Wire.API.Routes.Named @@ -74,8 +76,8 @@ import Wire.Events (Events) import Wire.GalleyAPIAccess (GalleyAPIAccess, ShowOrHideInvitationUrl (..)) import Wire.GalleyAPIAccess qualified as GalleyAPIAccess import Wire.IndexedUserStore (IndexedUserStore, getTeamSize) -import Wire.InvitationCodeStore (InvitationCodeStore (..), PaginatedResult (..), StoredInvitation (..)) -import Wire.InvitationCodeStore qualified as Store +import Wire.InvitationStore (InvitationStore (..), PaginatedResult (..), StoredInvitation (..)) +import Wire.InvitationStore qualified as Store import Wire.Sem.Concurrency import Wire.TeamInvitationSubsystem import Wire.UserKeyStore @@ -86,7 +88,7 @@ servantAPI :: ( Member GalleyAPIAccess r, Member TeamInvitationSubsystem r, Member UserSubsystem r, - Member Store.InvitationCodeStore r, + Member Store.InvitationStore r, Member TinyLog r, Member (Input TeamTemplates) r, Member (Input (Local ())) r, @@ -118,7 +120,7 @@ teamSizePublic uid tid = do getTeamSize tid getInvitationCode :: - ( Member Store.InvitationCodeStore r, + ( Member Store.InvitationStore r, Member (Error UserSubsystemError) r ) => TeamId -> @@ -191,7 +193,7 @@ logInvitationRequest context action = deleteInvitation :: ( Member GalleyAPIAccess r, - Member InvitationCodeStore r, + Member InvitationStore r, Member (Error UserSubsystemError) r ) => UserId -> @@ -206,7 +208,7 @@ listInvitations :: forall r. ( Member GalleyAPIAccess r, Member TinyLog r, - Member InvitationCodeStore r, + Member InvitationStore r, Member (Input TeamTemplates) r, Member (Input (Local ())) r, Member UserSubsystem r, @@ -319,7 +321,7 @@ mkInviteUrlPersonalUser ShowInvitationUrl team (InvitationCode c) = do getInvitation :: ( Member GalleyAPIAccess r, - Member InvitationCodeStore r, + Member InvitationStore r, Member TinyLog r, Member (Input TeamTemplates) r, Member (Error UserSubsystemError) r @@ -348,7 +350,7 @@ isPersonalUser uke = do Just account -> account.userStatus == Active && isNothing account.userTeam getInvitationByCode :: - ( Member Store.InvitationCodeStore r, + ( Member Store.InvitationStore r, Member (Error UserSubsystemError) r ) => InvitationCode -> @@ -358,28 +360,32 @@ getInvitationByCode c = do maybe (throw UserSubsystemInvalidInvitationCode) (pure . Store.invitationFromStored Nothing) inv headInvitationByEmail :: - (Member InvitationCodeStore r, Member TinyLog r) => + (Member InvitationStore r, Member TinyLog r) => EmailAddress -> Sem r Public.HeadInvitationByEmailResult headInvitationByEmail email = - Store.lookupInvitationCodesByEmail email >>= \case + Store.lookupInvitationsByEmail email >>= \case [] -> pure Public.InvitationByEmailNotFound [_code] -> pure Public.InvitationByEmail (_ : _ : _) -> do Log.info $ - Log.msg (Log.val "team_invidation_email: multiple pending invites from different teams for the same email") + Log.msg (Log.val "team_invitation_email: multiple pending invites from different teams for the same email") . Log.field "email" (show email) pure Public.InvitationByEmailMoreThanOne --- | FUTUREWORK: This should also respond with status 409 in case of --- @DB.InvitationByEmailMoreThanOne@. Refactor so that 'headInvitationByEmailH' and --- 'getInvitationByEmailH' are almost the same thing. +-- | FUTUREWORK: Refactor so that 'headInvitationByEmail' and +-- 'getInvitationByEmail' are almost the same thing. getInvitationByEmail :: - (Member Store.InvitationCodeStore r, Member TinyLog r) => + (Member Store.InvitationStore r) => EmailAddress -> (Handler r) Public.Invitation getInvitationByEmail email = do - inv <- lift . liftSem $ Store.lookupInvitationByEmail email + inv <- do + invs <- lift . liftSem $ Store.lookupInvitationsByEmail email + case invs of + [] -> pure Nothing + [inv] -> pure . Just $ inv + (_ : _ : _) -> throwStd $ errorToWai @'ConflictingInvitations maybe (throwStd (notFound "Invitation not found")) (pure . Store.invitationFromStored Nothing) inv suspendTeam :: @@ -389,7 +395,7 @@ suspendTeam :: Member UserSubsystem r, Member Events r, Member TinyLog r, - Member InvitationCodeStore r + Member InvitationStore r ) => TeamId -> (Handler r) NoContent