diff --git a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs index 1ad291c91bf..a4e3de01d02 100644 --- a/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/EnterpriseLoginSubsystem/Interpreter.hs @@ -194,7 +194,7 @@ authorizeTeamImpl lusr domain (DomainOwnershipToken token) = do Just DomainLocked -> throw EnterpriseLoginSubsystemOperationForbidden Just same@DomainPreAuthorized -> pure same Just same@DomainNoRegistration -> pure same - Just same@(DomainForBackend url) -> pure same + Just same@(DomainForBackend _url) -> pure same Just (DomainForLocalTeam _oldTid Nothing) -> pure (DomainForLocalTeam tid Nothing) Just (DomainForLocalTeam _oldTid (Just idpid)) -> pure (DomainForLocalTeam tid (Just idpid)) upsert domainReg {settings = Just newSettings} @@ -562,7 +562,10 @@ updateDomainRedirectImpl token domain config = do computeUpdate domainReg updateDomainRegistrationImpl domain update where - computeUpdate reg = case (config, reg.domainRedirect) of + -- TODO: it is more straight-forward for 'computeUpdate' to use the DomainRegistrationRow to + -- compute the update value. maybe the update type should also be adjusted to fit better + -- into 'DomainRegistration'? + computeUpdate (domainRegistrationToRow -> reg) = case (config, reg.domainRedirect) of (DomainRedirectConfigRemove, NoRegistration) -> Just $ DomainRegistrationUpdate PreAuthorized reg.teamInvite (DomainRedirectConfigRemove, Backend _) -> @@ -598,8 +601,11 @@ updateTeamInviteImpl luid domain config = do update <- validateUpdate tid domainReg config updateDomainRegistrationImpl domain update where + -- TODO: it is more straight-forward for 'computeUpdate' to use the DomainRegistrationRow to + -- compute the update value. maybe the update type should also be adjusted to fit better + -- into 'DomainRegistration'? validateUpdate :: TeamId -> DomainRegistration -> TeamInviteConfig -> Sem r DomainRegistrationUpdate - validateUpdate tid domReg conf = do + validateUpdate tid (domainRegistrationToRow -> domReg) conf = do -- TODO: remove this function, validation should happen near declarations of -- DomainRegistration, DomainRegistrationUpdate when (domReg.domainRedirect == Locked) $ diff --git a/libs/wire-subsystems/test/unit/Wire/TeamInvitationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/TeamInvitationSubsystem/InterpreterSpec.hs index 9a72717b134..afcdc6d5ffb 100644 --- a/libs/wire-subsystems/test/unit/Wire/TeamInvitationSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/TeamInvitationSubsystem/InterpreterSpec.hs @@ -139,12 +139,12 @@ spec = do { teamOwner = inviterMember, initialUsers = [inviter] <> maybeToList existingPersonalAccount, constGuardResult = - let domreg = - (def registeredDomain :: DomainRegistration) - { domainRedirect = domRegUpd.domainRedirect, - teamInvite = domRegUpd.teamInvite - } - in Just domreg + -- TODO: this fails, i think because domainRegistrationFromUpdate needs + -- to set the team for, eg., `DomainRegistrationUpdate {domainRedirect = + -- SSO (IdPId {fromIdPId = 46ed514c-a479-588e-7857-c41b2029be79}), + -- teamInvite = Allowed}`, but there is no team id available. do we + -- need to fix the types some more? + either error Just $ domainRegistrationFromUpdate (def registeredDomain) domRegUpd } -- run the test diff --git a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs index f54eaae713e..830d5ff8f49 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs +++ b/libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs @@ -908,11 +908,12 @@ spec = describe "UserSubsystem.Interpreter" do DRS.upsert domreg guardRegisterUserImpl email - expected = case domreg.domainRedirect of - None -> Right () - Locked -> Right () - SSO _ -> Left $ UserSubsystemGuardFailed DomRedirSetToSSO - Backend _ -> Left $ UserSubsystemGuardFailed DomRedirSetToBackend - NoRegistration -> Left $ UserSubsystemGuardFailed DomRedirSetToNoRegistration - PreAuthorized -> Right () + expected = case domreg.settings of + Nothing -> Right () + Just DomainLocked -> Right () + Just DomainPreAuthorized -> Right () + Just DomainNoRegistration -> Left $ UserSubsystemGuardFailed DomRedirSetToNoRegistration + Just (DomainForBackend _) -> Left $ UserSubsystemGuardFailed DomRedirSetToBackend + Just (DomainForLocalTeam _tid Nothing) -> Left $ UserSubsystemGuardFailed TeamInviteRestrictedToOtherTeam + Just (DomainForLocalTeam _tid (Just _idp)) -> Left $ UserSubsystemGuardFailed DomRedirSetToSSO in outcome === expected