Fixup

wireapp · Feb 5, 2025 · 2f28c05 · 2f28c05
1 parent 9f4fccb
commit 2f28c05
Show file tree

Hide file tree

Showing 3 changed files with 23 additions and 16 deletions.
diff --git 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
@@ -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
@@ -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