From 214b72ac7c784cbc955fe1a744ebe6d90c58f443 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 12 Dec 2025 14:58:25 +0100 Subject: [PATCH 01/18] Add stubs to EmailSubsystem --- libs/wire-subsystems/src/Wire/EmailSubsystem.hs | 3 +++ .../src/Wire/EmailSubsystem/Interpreter.hs | 10 ++++++++++ 2 files changed, 13 insertions(+) diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs index 837ed89a1d..9946a1bf5e 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs @@ -27,6 +27,7 @@ import Wire.API.Locale import Wire.API.User import Wire.API.User.Activation (ActivationCode, ActivationKey) import Wire.API.User.Client (Client (..)) +import Wire.API.User.IdentityProvider (IdP) data EmailSubsystem m a where SendPasswordResetMail :: EmailAddress -> PasswordResetPair -> Maybe Locale -> EmailSubsystem m () @@ -43,5 +44,7 @@ data EmailSubsystem m a where SendTeamInvitationMail :: EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> EmailSubsystem m Text -- | send invitation to an email address associated with a personal user account. SendTeamInvitationMailPersonalUser :: EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> EmailSubsystem m Text + SendSAMLIdPCreated :: EmailAddress -> IdP -> EmailSubsystem m () + SendSAMLIdPUpdated :: EmailSubsystem m () makeSem ''EmailSubsystem diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs index 58206ef46d..cb85e30470 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs @@ -38,6 +38,7 @@ import Wire.API.Locale import Wire.API.User import Wire.API.User.Activation import Wire.API.User.Client (Client (..)) +import Wire.API.User.IdentityProvider (IdP) import Wire.API.User.Password import Wire.EmailSending (EmailSending, sendMail) import Wire.EmailSubsystem @@ -57,6 +58,15 @@ emailSubsystemInterpreter userTpls teamTpls branding = interpret \case SendAccountDeletionEmail email name key code locale -> sendAccountDeletionEmailImpl userTpls branding email name key code locale SendTeamInvitationMail email tid from code loc -> sendTeamInvitationMailImpl teamTpls branding email tid from code loc SendTeamInvitationMailPersonalUser email tid from code loc -> sendTeamInvitationMailPersonalUserImpl teamTpls branding email tid from code loc + SendSAMLIdPCreated email idp -> sendSAMLIdPCreatedImpl email idp + SendSAMLIdPUpdated -> sendSAMLIdPUpdatedImpl + +-- TODO: Move these functions down in this file. +sendSAMLIdPUpdatedImpl :: Sem r () +sendSAMLIdPUpdatedImpl = todo + +sendSAMLIdPCreatedImpl :: EmailAddress -> IdP -> Sem r () +sendSAMLIdPCreatedImpl = todo ------------------------------------------------------------------------------- -- Verification Email for From 25fea4ac6dc0a0bd61159840ef1505417f3eaa01 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 12 Dec 2025 14:59:37 +0100 Subject: [PATCH 02/18] Add fetching email addresses by UserId to UserStore --- libs/wire-subsystems/src/Wire/UserStore.hs | 1 + libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs | 9 +++++++++ .../test/unit/Wire/MockInterpreters/UserStore.hs | 1 + 3 files changed, 11 insertions(+) diff --git a/libs/wire-subsystems/src/Wire/UserStore.hs b/libs/wire-subsystems/src/Wire/UserStore.hs index 55485bfb93..8ec6e0754e 100644 --- a/libs/wire-subsystems/src/Wire/UserStore.hs +++ b/libs/wire-subsystems/src/Wire/UserStore.hs @@ -97,6 +97,7 @@ data UserStore m a where GetUserAuthenticationInfo :: UserId -> UserStore m (Maybe (Maybe Password, AccountStatus)) DeleteEmail :: UserId -> UserStore m () SetUserSearchable :: UserId -> SetSearchable -> UserStore m () + GetEmails :: [UserId] -> UserStore m [EmailAddress] makeSem ''UserStore diff --git a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs index ec2c6a85b9..dcdeef1b94 100644 --- a/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs @@ -62,6 +62,15 @@ interpretUserStoreCassandra casClient = GetUserAuthenticationInfo uid -> getUserAuthenticationInfoImpl uid DeleteEmail uid -> deleteEmailImpl uid SetUserSearchable uid searchable -> setUserSearchableImpl uid searchable + GetEmails uids -> getEmailsImpl uids + +getEmailsImpl :: [UserId] -> Client [EmailAddress] +getEmailsImpl uids = + map runIdentity + <$> retry x1 (query selectEmailAddresses (params LocalQuorum (Identity uids))) + where + selectEmailAddresses :: PrepQuery R (Identity [UserId]) (Identity EmailAddress) + selectEmailAddresses = "SELECT email FROM user WHERE id IN ?" createUserImpl :: NewStoredUser -> Maybe (ConvId, Maybe TeamId) -> Client () createUserImpl new mbConv = retry x5 . batch $ do diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs index 391e8305d1..823f5dc183 100644 --- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs +++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs @@ -114,6 +114,7 @@ inMemoryUserStoreInterpreter = interpret $ \case if u.id == uid then u {Wire.StoredUser.searchable = Just searchable} :: StoredUser else u + GetEmails uids -> gets $ mapMaybe (.email) . filter (\user -> user.id `elem` uids) storedUserToIndexUser :: StoredUser -> IndexUser storedUserToIndexUser storedUser = From 6c142072cba5506bc3eda42447f39889cc8882d9 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 12 Dec 2025 15:00:10 +0100 Subject: [PATCH 03/18] Add SAMLEmailSubsystem (mostly stub) --- .../src/Wire/SAMLEmailSubsystem.hs | 11 ++++++ .../Wire/SAMLEmailSubsystem/Interpreter.hs | 37 +++++++++++++++++++ libs/wire-subsystems/wire-subsystems.cabal | 2 + 3 files changed, 50 insertions(+) create mode 100644 libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs create mode 100644 libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs diff --git a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs new file mode 100644 index 0000000000..c837cf20eb --- /dev/null +++ b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Wire.SAMLEmailSubsystem where + +import Polysemy +import Wire.API.User.IdentityProvider (IdP) + +data SAMLEmailSubsystem m a where + SendSAMLIdPCreated :: IdP -> SAMLEmailSubsystem m () + +makeSem ''SAMLEmailSubsystem diff --git a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs new file mode 100644 index 0000000000..017a253d57 --- /dev/null +++ b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs @@ -0,0 +1,37 @@ +module Wire.SAMLEmailSubsystem.Interpreter + ( samlEmailSubsystemInterpreter, + ) +where + +import Control.Lens ((^.), (^..)) +import Imports +import Polysemy +import SAML2.WebSSO.Types +import Wire.API.Team.Member +import Wire.API.User.IdentityProvider (IdP, team) +import Wire.EmailSubsystem qualified as Email +import Wire.SAMLEmailSubsystem +import Wire.TeamSubsystem +import Wire.UserStore + +samlEmailSubsystemInterpreter :: + ( Member TeamSubsystem r, + Member UserStore r, + Member Email.EmailSubsystem r + ) => + InterpreterFor SAMLEmailSubsystem r +samlEmailSubsystemInterpreter = interpret \case + SendSAMLIdPCreated idp -> sendSAMLIdPCreatedImpl idp + +sendSAMLIdPCreatedImpl :: + ( Member TeamSubsystem r, + Member UserStore r, + Member Email.EmailSubsystem r + ) => + IdP -> + Sem r () +sendSAMLIdPCreatedImpl idp = do + admins <- internalGetTeamAdmins (idp ^. idpExtraInfo . team) + let adminUids = admins ^.. teamMembers . traverse . userId + emails <- getEmails adminUids + mapM_ (flip Email.sendSAMLIdPCreated idp) emails diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal index ff58ed1943..625e224220 100644 --- a/libs/wire-subsystems/wire-subsystems.cabal +++ b/libs/wire-subsystems/wire-subsystems.cabal @@ -299,6 +299,8 @@ library Wire.RateLimit Wire.RateLimit.Interpreter Wire.Rpc + Wire.SAMLEmailSubsystem + Wire.SAMLEmailSubsystem.Interpreter Wire.ScimSubsystem Wire.ScimSubsystem.Error Wire.ScimSubsystem.Interpreter From 9bc37915301384eea0721483bc2abb4641147741 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 12 Dec 2025 16:52:51 +0100 Subject: [PATCH 04/18] Add Servant endpoint to brig --- libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs | 13 +++++++++++++ services/brig/src/Brig/API/Internal.hs | 8 +++++++- services/brig/src/Brig/CanonicalInterpreter.hs | 6 +++++- 3 files changed, 25 insertions(+), 2 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index c14a2a2eb3..f27005a844 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -42,6 +42,7 @@ module Wire.API.Routes.Internal.Brig module Wire.API.Routes.Internal.Brig.EJPD, FoundInvitationCode (..), EnterpriseLoginApi, + SAMLIdPAPI, ) where @@ -95,6 +96,7 @@ import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso import Wire.API.User.Client +import Wire.API.User.IdentityProvider (IdP) import Wire.API.User.RichInfo import Wire.API.UserGroup import Wire.API.UserGroup.Pagination @@ -696,8 +698,19 @@ type API = :<|> FederationRemotesAPI :<|> ProviderAPI :<|> EnterpriseLoginApi + :<|> SAMLIdPAPI ) +type SAMLIdPAPI = + Named + "send-idp-created-email" + ( Summary "Send an email about the new IdP to all team admins and owners" + :> "idp" + :> "send-idp-created-email" + :> ReqBody '[Servant.JSON] IdP + :> Post '[Servant.JSON] () + ) + type IStatusAPI = Named "get-status" diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index fc0d6a62e9..ba8afde978 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -123,6 +123,7 @@ import Wire.PasswordResetCodeStore (PasswordResetCodeStore) import Wire.PropertySubsystem import Wire.RateLimit import Wire.Rpc +import Wire.SAMLEmailSubsystem (SAMLEmailSubsystem, sendSAMLIdPCreated) import Wire.Sem.Concurrency import Wire.Sem.Now (Now) import Wire.Sem.Random (Random) @@ -180,7 +181,8 @@ servantSitemap :: Member (Input AuthenticationSubsystemConfig) r, Member Now r, Member CryptoSign r, - Member Random r + Member Random r, + Member SAMLEmailSubsystem r ) => ServerT BrigIRoutes.API (Handler r) servantSitemap = @@ -198,6 +200,7 @@ servantSitemap = :<|> federationRemotesAPI :<|> Provider.internalProviderAPI :<|> enterpriseLoginApi + :<|> samlIdPApi istatusAPI :: forall r. ServerT BrigIRoutes.IStatusAPI (Handler r) istatusAPI = Named @"get-status" (pure NoContent) @@ -515,6 +518,9 @@ enterpriseLoginApi = :<|> Named @"domain-registration-delete" (fmap (const NoContent) . lift . liftSem . deleteDomain) :<|> Named @"domain-registration-get" getDomainRegistrationH +samlIdPApi :: (Member SAMLEmailSubsystem r) => ServerT SAMLIdPAPI (Handler r) +samlIdPApi = Named @"send-idp-created-email" (lift . liftSem . sendSAMLIdPCreated) + --------------------------------------------------------------------------- -- Handlers diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 13bef0bfbc..e7b24a5909 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -109,6 +109,8 @@ import Wire.PropertySubsystem.Interpreter import Wire.RateLimit import Wire.RateLimit.Interpreter import Wire.Rpc +import Wire.SAMLEmailSubsystem +import Wire.SAMLEmailSubsystem.Interpreter import Wire.Sem.Concurrency import Wire.Sem.Concurrency.IO import Wire.Sem.Delay @@ -163,7 +165,8 @@ type BrigCanonicalEffects = -- | These effects have interpreters which don't depend on each other type BrigLowerLevelEffects = - '[ TeamSubsystem, + '[ SAMLEmailSubsystem, + TeamSubsystem, TeamCollaboratorsStore, AppStore, EmailSubsystem, @@ -393,6 +396,7 @@ runBrigToIO e (AppT ma) = do . interpretAppStoreToPostgres . interpretTeamCollaboratorsStoreToPostgres . interpretTeamSubsystemToGalleyAPI + . samlEmailSubsystemInterpreter . interpretTeamCollaboratorsSubsystem . userSubsystemInterpreter . interpretUserGroupSubsystem From 18fc323dfc8d03a5e459851f2b668370dcc6c15c Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 12 Dec 2025 17:06:55 +0100 Subject: [PATCH 05/18] Add client for the endpoint to spar --- services/spar/src/Spar/Intra/Brig.hs | 8 ++++++++ services/spar/src/Spar/Sem/BrigAccess.hs | 2 ++ services/spar/src/Spar/Sem/BrigAccess/Http.hs | 1 + 3 files changed, 11 insertions(+) diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index fee2e54616..53ff94c079 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -43,6 +43,7 @@ module Spar.Intra.Brig setStatus, getDefaultUserLocale, checkAdminGetTeamId, + sendSAMLIdPCreatedEmail, ) where @@ -68,6 +69,7 @@ import Wire.API.Team.Role (Role) import Wire.API.User import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso +import Wire.API.User.IdentityProvider (IdP) import Wire.API.User.RichInfo as RichInfo import Wire.UserSubsystem (HavePendingInvitations (..)) @@ -453,3 +455,9 @@ checkAdminGetTeamId uid = do case statusCode resp of 200 -> parseResponse @TeamId "brig" resp _ -> rethrow "brig" resp + +sendSAMLIdPCreatedEmail :: (HasCallStack, MonadSparToBrig m) => IdP -> m () +sendSAMLIdPCreatedEmail idp = do + resp <- call $ method POST . path "/i/idp/send-idp-created-email" . json idp + unless (statusCode resp == 200) $ + rethrow "brig" resp diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 8530786359..b4343201ed 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -57,6 +57,7 @@ import Web.Cookie import Wire.API.Locale import Wire.API.Team.Role import Wire.API.User +import Wire.API.User.IdentityProvider (IdP) import Wire.API.User.RichInfo as RichInfo data BrigAccess m a where @@ -82,5 +83,6 @@ data BrigAccess m a where SetStatus :: UserId -> AccountStatus -> BrigAccess m () GetDefaultUserLocale :: BrigAccess m Locale CheckAdminGetTeamId :: UserId -> BrigAccess m TeamId + SendSAMLIdPCreatedEmail :: IdP -> BrigAccess m () makeSem ''BrigAccess diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index b3623597d3..69d4a27bf0 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -65,3 +65,4 @@ brigAccessToHttp mgr req = SetStatus itlu a -> Intra.setStatus itlu a GetDefaultUserLocale -> Intra.getDefaultUserLocale CheckAdminGetTeamId itlu -> Intra.checkAdminGetTeamId itlu + SendSAMLIdPCreatedEmail idp -> Intra.sendSAMLIdPCreatedEmail idp From 3f083915a7eb5c12554796e71c16e99835fe2928 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 15 Dec 2025 08:40:06 +0100 Subject: [PATCH 06/18] Send EMail when IdP is created --- services/spar/src/Spar/API.hs | 1 + services/spar/src/Spar/Sem/BrigAccess.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index f5f9de0d1e..6f355f0a5b 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -653,6 +653,7 @@ idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmet IdPConfigStore.insertConfig idp forM_ mReplaces $ \replaces -> IdPConfigStore.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId)) + BrigAccess.sendSAMLIdPCreatedEmail idp pure idp where -- Ensure that the domain is not in use by an existing IDP diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index b4343201ed..5707316252 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -41,6 +41,7 @@ module Spar.Sem.BrigAccess setStatus, getDefaultUserLocale, checkAdminGetTeamId, + sendSAMLIdPCreatedEmail, ) where From 2a8ef66f8313ef3c0f773c5865819d0ab5c604c6 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 15 Dec 2025 10:06:50 +0100 Subject: [PATCH 07/18] Add more endpoints --- .../src/Wire/API/Routes/Internal/Brig.hs | 31 +++++++++++---- .../src/Wire/EmailSubsystem.hs | 5 ++- .../src/Wire/EmailSubsystem/Interpreter.hs | 12 ++++-- .../src/Wire/SAMLEmailSubsystem.hs | 2 + .../Wire/SAMLEmailSubsystem/Interpreter.hs | 39 ++++++++++++++++++- services/brig/src/Brig/API/Internal.hs | 7 +++- services/spar/src/Spar/Intra/Brig.hs | 14 +++++++ services/spar/src/Spar/Sem/BrigAccess.hs | 4 ++ services/spar/src/Spar/Sem/BrigAccess/Http.hs | 2 + 9 files changed, 98 insertions(+), 18 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index f27005a844..cd3756e6f8 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -702,14 +702,29 @@ type API = ) type SAMLIdPAPI = - Named - "send-idp-created-email" - ( Summary "Send an email about the new IdP to all team admins and owners" - :> "idp" - :> "send-idp-created-email" - :> ReqBody '[Servant.JSON] IdP - :> Post '[Servant.JSON] () - ) + "idp" + :> ( Named + "send-idp-created-email" + ( Summary "Send an email about the new IdP to all team admins and owners" + :> "send-idp-created-email" + :> ReqBody '[Servant.JSON] IdP + :> Post '[Servant.JSON] () + ) + :<|> Named + "send-idp-deleted-email" + ( Summary "Send an email about the deleted IdP to all team admins and owners" + :> "send-idp-deleted-email" + :> ReqBody '[Servant.JSON] IdP + :> Post '[Servant.JSON] () + ) + :<|> Named + "send-idp-updated-email" + ( Summary "Send an email about the IdP update to all team admins and owners" + :> "send-idp-updated-email" + :> ReqBody '[Servant.JSON] (IdP, IdP) + :> Post '[Servant.JSON] () + ) + ) type IStatusAPI = Named diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs index 9946a1bf5e..44ff7541cd 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem.hs @@ -44,7 +44,8 @@ data EmailSubsystem m a where SendTeamInvitationMail :: EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> EmailSubsystem m Text -- | send invitation to an email address associated with a personal user account. SendTeamInvitationMailPersonalUser :: EmailAddress -> TeamId -> EmailAddress -> InvitationCode -> Maybe Locale -> EmailSubsystem m Text - SendSAMLIdPCreated :: EmailAddress -> IdP -> EmailSubsystem m () - SendSAMLIdPUpdated :: EmailSubsystem m () + SendSAMLIdPCreated :: IdP -> EmailAddress -> EmailSubsystem m () + SendSAMLIdPDeleted :: IdP -> EmailAddress -> EmailSubsystem m () + SendSAMLIdPUpdated :: IdP -> IdP -> EmailAddress -> EmailSubsystem m () makeSem ''EmailSubsystem diff --git a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs index cb85e30470..1ded704fd8 100644 --- a/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/EmailSubsystem/Interpreter.hs @@ -58,16 +58,20 @@ emailSubsystemInterpreter userTpls teamTpls branding = interpret \case SendAccountDeletionEmail email name key code locale -> sendAccountDeletionEmailImpl userTpls branding email name key code locale SendTeamInvitationMail email tid from code loc -> sendTeamInvitationMailImpl teamTpls branding email tid from code loc SendTeamInvitationMailPersonalUser email tid from code loc -> sendTeamInvitationMailPersonalUserImpl teamTpls branding email tid from code loc - SendSAMLIdPCreated email idp -> sendSAMLIdPCreatedImpl email idp - SendSAMLIdPUpdated -> sendSAMLIdPUpdatedImpl + SendSAMLIdPCreated idp email -> sendSAMLIdPCreatedImpl idp email + SendSAMLIdPDeleted idp email -> sendSAMLIdPDeletedImpl idp email + SendSAMLIdPUpdated old new email -> sendSAMLIdPUpdatedImpl old new email -- TODO: Move these functions down in this file. -sendSAMLIdPUpdatedImpl :: Sem r () +sendSAMLIdPUpdatedImpl :: IdP -> IdP -> EmailAddress -> Sem r () sendSAMLIdPUpdatedImpl = todo -sendSAMLIdPCreatedImpl :: EmailAddress -> IdP -> Sem r () +sendSAMLIdPCreatedImpl :: IdP -> EmailAddress -> Sem r () sendSAMLIdPCreatedImpl = todo +sendSAMLIdPDeletedImpl :: IdP -> EmailAddress -> Sem r () +sendSAMLIdPDeletedImpl = todo + ------------------------------------------------------------------------------- -- Verification Email for -- - Login diff --git a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs index c837cf20eb..edcd7a1cf2 100644 --- a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs @@ -7,5 +7,7 @@ import Wire.API.User.IdentityProvider (IdP) data SAMLEmailSubsystem m a where SendSAMLIdPCreated :: IdP -> SAMLEmailSubsystem m () + SendSAMLIdPDeleted :: IdP -> SAMLEmailSubsystem m () + SendSAMLIdPUpdated :: IdP -> IdP -> SAMLEmailSubsystem m () makeSem ''SAMLEmailSubsystem diff --git a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs index 017a253d57..f78c7e3816 100644 --- a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs @@ -7,6 +7,7 @@ import Control.Lens ((^.), (^..)) import Imports import Polysemy import SAML2.WebSSO.Types +import Text.Email.Parser import Wire.API.Team.Member import Wire.API.User.IdentityProvider (IdP, team) import Wire.EmailSubsystem qualified as Email @@ -22,6 +23,8 @@ samlEmailSubsystemInterpreter :: InterpreterFor SAMLEmailSubsystem r samlEmailSubsystemInterpreter = interpret \case SendSAMLIdPCreated idp -> sendSAMLIdPCreatedImpl idp + SendSAMLIdPDeleted idp -> sendSAMLIdPDeletedImpl idp + SendSAMLIdPUpdated old new -> sendSAMLIdPUpdatedImpl old new sendSAMLIdPCreatedImpl :: ( Member TeamSubsystem r, @@ -31,7 +34,39 @@ sendSAMLIdPCreatedImpl :: IdP -> Sem r () sendSAMLIdPCreatedImpl idp = do + emails <- getEmailAddresses idp + mapM_ (Email.sendSAMLIdPCreated idp) emails + +sendSAMLIdPDeletedImpl :: + ( Member TeamSubsystem r, + Member UserStore r, + Member Email.EmailSubsystem r + ) => + IdP -> + Sem r () +sendSAMLIdPDeletedImpl idp = do + emails <- getEmailAddresses idp + mapM_ (Email.sendSAMLIdPDeleted idp) emails + +sendSAMLIdPUpdatedImpl :: + ( Member TeamSubsystem r, + Member UserStore r, + Member Email.EmailSubsystem r + ) => + IdP -> + IdP -> + Sem r () +sendSAMLIdPUpdatedImpl old new = do + emails <- getEmailAddresses old + mapM_ (Email.sendSAMLIdPUpdated old new) emails + +getEmailAddresses :: + ( Member TeamSubsystem r, + Member UserStore r + ) => + IdP -> + Sem r [EmailAddress] +getEmailAddresses idp = do admins <- internalGetTeamAdmins (idp ^. idpExtraInfo . team) let adminUids = admins ^.. teamMembers . traverse . userId - emails <- getEmails adminUids - mapM_ (flip Email.sendSAMLIdPCreated idp) emails + getEmails adminUids diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index ba8afde978..ce54455db6 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -123,7 +123,7 @@ import Wire.PasswordResetCodeStore (PasswordResetCodeStore) import Wire.PropertySubsystem import Wire.RateLimit import Wire.Rpc -import Wire.SAMLEmailSubsystem (SAMLEmailSubsystem, sendSAMLIdPCreated) +import Wire.SAMLEmailSubsystem (SAMLEmailSubsystem, sendSAMLIdPCreated, sendSAMLIdPDeleted, sendSAMLIdPUpdated) import Wire.Sem.Concurrency import Wire.Sem.Now (Now) import Wire.Sem.Random (Random) @@ -519,7 +519,10 @@ enterpriseLoginApi = :<|> Named @"domain-registration-get" getDomainRegistrationH samlIdPApi :: (Member SAMLEmailSubsystem r) => ServerT SAMLIdPAPI (Handler r) -samlIdPApi = Named @"send-idp-created-email" (lift . liftSem . sendSAMLIdPCreated) +samlIdPApi = + Named @"send-idp-created-email" (lift . liftSem . sendSAMLIdPCreated) + :<|> Named @"send-idp-deleted-email" (lift . liftSem . sendSAMLIdPDeleted) + :<|> Named @"send-idp-updated-email" (lift . liftSem . uncurry sendSAMLIdPUpdated) --------------------------------------------------------------------------- -- Handlers diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 53ff94c079..3146e979f5 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -44,6 +44,8 @@ module Spar.Intra.Brig getDefaultUserLocale, checkAdminGetTeamId, sendSAMLIdPCreatedEmail, + sendSAMLIdPDeletedEmail, + sendSAMLIdPUpdatedEmail, ) where @@ -461,3 +463,15 @@ sendSAMLIdPCreatedEmail idp = do resp <- call $ method POST . path "/i/idp/send-idp-created-email" . json idp unless (statusCode resp == 200) $ rethrow "brig" resp + +sendSAMLIdPDeletedEmail :: (HasCallStack, MonadSparToBrig m) => IdP -> m () +sendSAMLIdPDeletedEmail idp = do + resp <- call $ method POST . path "/i/idp/send-idp-deleted-email" . json idp + unless (statusCode resp == 200) $ + rethrow "brig" resp + +sendSAMLIdPUpdatedEmail :: (HasCallStack, MonadSparToBrig m) => IdP -> IdP -> m () +sendSAMLIdPUpdatedEmail old new = do + resp <- call $ method POST . path "/i/idp/send-idp-updated-email" . json (old, new) + unless (statusCode resp == 200) $ + rethrow "brig" resp diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 5707316252..753b35b0f7 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -42,6 +42,8 @@ module Spar.Sem.BrigAccess getDefaultUserLocale, checkAdminGetTeamId, sendSAMLIdPCreatedEmail, + sendSAMLIdPDeletedEmail, + sendSAMLIdPUpdatedEmail, ) where @@ -85,5 +87,7 @@ data BrigAccess m a where GetDefaultUserLocale :: BrigAccess m Locale CheckAdminGetTeamId :: UserId -> BrigAccess m TeamId SendSAMLIdPCreatedEmail :: IdP -> BrigAccess m () + SendSAMLIdPDeletedEmail :: IdP -> BrigAccess m () + SendSAMLIdPUpdatedEmail :: IdP -> IdP -> BrigAccess m () makeSem ''BrigAccess diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 69d4a27bf0..247177b5c5 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -66,3 +66,5 @@ brigAccessToHttp mgr req = GetDefaultUserLocale -> Intra.getDefaultUserLocale CheckAdminGetTeamId itlu -> Intra.checkAdminGetTeamId itlu SendSAMLIdPCreatedEmail idp -> Intra.sendSAMLIdPCreatedEmail idp + SendSAMLIdPDeletedEmail idp -> Intra.sendSAMLIdPDeletedEmail idp + SendSAMLIdPUpdatedEmail old new -> Intra.sendSAMLIdPUpdatedEmail old new From 873328081c816975a2259fc7c00891be172aec32 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 15 Dec 2025 10:36:15 +0100 Subject: [PATCH 08/18] Trigger IdP update and deletion mails --- services/spar/src/Spar/API.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 6f355f0a5b..6d595fe219 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -573,6 +573,7 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co do IdPConfigStore.deleteConfig idp IdPRawMetadataStore.delete idpid + BrigAccess.sendSAMLIdPDeletedEmail idp pure NoContent where assertEmptyOrPurge :: TeamId -> Cas.Page (SAML.UserRef, UserId) -> Sem r () @@ -816,7 +817,7 @@ idpUpdateXML :: Maybe (Range 1 32 Text) -> Sem r IdP idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML" (Just . show . (^. SAML.idpId)) $ do - (teamid, idp) <- validateIdPUpdate zusr idpmeta idpid + (teamid, idp, previousIdP) <- validateIdPUpdate zusr idpmeta idpid GalleyAccess.assertSSOEnabled teamid guardMultiIngressDuplicateDomain teamid mDomain idpid IdPRawMetadataStore.store (idp ^. SAML.idpId) raw @@ -834,6 +835,7 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML WireIdPAPIV1 -> Nothing WireIdPAPIV2 -> Just teamid forM_ (idp'' ^. SAML.idpExtraInfo . oldIssuers) (flip IdPConfigStore.deleteIssuer mbteamid) + BrigAccess.sendSAMLIdPUpdatedEmail previousIdP idp'' pure idp'' where -- Ensure that the domain is not in use by an existing IDP @@ -872,7 +874,7 @@ validateIdPUpdate :: Maybe UserId -> SAML.IdPMetadata -> SAML.IdPId -> - m (TeamId, IdP) + m (TeamId, IdP, IdP) validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (Just . show . (_2 %~ (^. SAML.idpId))) $ do previousIdP <- IdPConfigStore.getConfig _idpId (_, teamId) <- authorizeIdP zusr previousIdP @@ -905,7 +907,7 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (J let requri = _idpMetadata ^. SAML.edRequestURI enforceHttps requri - pure (teamId, SAML.IdPConfig {..}) + pure (teamId, SAML.IdPConfig {..}, previousIdP) where -- If the new issuer was previously used, it has to be removed from the list of old issuers, -- to prevent it from getting deleted in a later step From 613df9710c68ada8684b90db7460ebcf0f1803be Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 15 Dec 2025 16:49:34 +0100 Subject: [PATCH 09/18] Add ToSchema instance for IdP --- libs/saml2-web-sso/saml2-web-sso.cabal | 1 + .../saml2-web-sso/src/SAML2/WebSSO/Orphans.hs | 13 ++-- libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs | 62 +++++++++++++------ .../src/Wire/API/Routes/Internal/Brig.hs | 43 ++++++++++++- 4 files changed, 92 insertions(+), 27 deletions(-) diff --git a/libs/saml2-web-sso/saml2-web-sso.cabal b/libs/saml2-web-sso/saml2-web-sso.cabal index da09daed9e..ce29601401 100644 --- a/libs/saml2-web-sso/saml2-web-sso.cabal +++ b/libs/saml2-web-sso/saml2-web-sso.cabal @@ -121,6 +121,7 @@ library , memory >=0.14.18 , mtl >=2.2.2 , network-uri >=2.6.1.0 + , openapi3 , pretty-show >=1.9.5 , process >=1.6.5.0 , QuickCheck >=2.13.2 diff --git a/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs b/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs index 63de870073..23c7cdd90f 100644 --- a/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs +++ b/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs @@ -11,10 +11,10 @@ import Data.Aeson import Data.ByteString import Data.ByteString.Builder import Data.Schema as Schema -import Data.String.Conversions import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text +import Data.Text.Lazy qualified as TL import Data.X509 as X509 import Data.Yaml.Aeson qualified as A import SAML2.Util (normURI, parseURI', renderURI) @@ -37,11 +37,14 @@ instance ToHttpApiData URI where instance FromHttpApiData URI where parseUrlPiece = either (Left . Text.pack) pure . parseURI' <=< parseUrlPiece -instance FromJSON X509.SignedCertificate where - parseJSON = withText "KeyInfo element" $ either fail pure . parseKeyInfo False . cs +instance Schema.ToSchema SignedCertificate where + schema = serialize Schema..= Schema.parsedText "SignedCertificate" parse + where + parse :: Text.Text -> Either String SignedCertificate + parse = parseKeyInfo False . TL.fromStrict -instance ToJSON X509.SignedCertificate where - toJSON = String . cs . renderKeyInfo + serialize :: SignedCertificate -> Text.Text + serialize = TL.toStrict . renderKeyInfo -- This can unfortunately not live in wire-api, because wire-api depends on -- saml2-web-sso. diff --git a/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs b/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs index 21c5732287..cada2f039c 100644 --- a/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs +++ b/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs @@ -171,10 +171,12 @@ import Data.List qualified as L import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as NL import Data.Maybe +import Data.OpenApi qualified as S import Data.Schema qualified as Schema import Data.String.Conversions (ST, cs) import Data.Text (Text) import Data.Text qualified as ST +import Data.Text.Encoding qualified as T import Data.Time (NominalDiffTime, UTCTime (..), addUTCTime, defaultTimeLocale, formatTime, parseTimeM) import Data.UUID as UUID import Data.X509 qualified as X509 @@ -230,14 +232,15 @@ data UserRef = UserRef {_uidTenant :: Issuer, _uidSubject :: NameID} -- | More correctly, an 'Issuer' is a 'NameID', but we only support 'URI'. newtype Issuer = Issuer {_fromIssuer :: URI} deriving (Eq, Ord, Show, Generic) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema.Schema Issuer -instance FromJSON Issuer where - parseJSON = withText "Issuer" $ \uri -> case parseURI' uri of - Right i -> pure $ Issuer i - Left msg -> fail $ "Issuer: " <> show msg - -instance ToJSON Issuer where - toJSON = toJSON . renderURI . _fromIssuer +instance Schema.ToSchema Issuer where + schema = + Issuer + <$> _fromIssuer Schema..= uriSchema + where + uriSchema :: Schema.ValueSchema Schema.NamedSwaggerDoc URI + uriSchema = renderURI Schema..= Schema.parsedText "URI" parseURI' ---------------------------------------------------------------------- -- meta [4/2.3.2] @@ -307,11 +310,33 @@ data IdPMetadata = IdPMetadata _edCertAuthnResponse :: NonEmpty X509.SignedCertificate } deriving (Eq, Show, Generic) + deriving (FromJSON, ToJSON, S.ToSchema) via (Schema.Schema IdPMetadata) + +instance Schema.ToSchema IdPMetadata where + schema = + Schema.object "IdPMetadata" $ + IdPMetadata + <$> (_edIssuer Schema..= Schema.field "issuer" Schema.schema) + <*> (_edRequestURI Schema..= Schema.field "requestURI" Schema.schema) + <*> (_edCertAuthnResponse Schema..= Schema.field "certAuthnResponse" Schema.schema) ---------------------------------------------------------------------- -- idp info -newtype IdPId = IdPId {fromIdPId :: UUID} deriving (Eq, Show, Generic, Ord) +newtype IdPId = IdPId {fromIdPId :: UUID} + deriving (Eq, Show, Generic, Ord) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema.Schema IdPId + +instance Schema.ToSchema IdPId where + schema = + IdPId + <$> fromIdPId Schema..= idpIdSchema + where + idpIdSchema :: Schema.ValueSchema Schema.NamedSwaggerDoc UUID + idpIdSchema = UUID.toText Schema..= Schema.parsedText "URI" parseUUID + + parseUUID :: Text -> Either String UUID + parseUUID = maybe (Left "Cannot parse UUID") Right . UUID.fromText type IdPConfig_ = IdPConfig () @@ -321,6 +346,15 @@ data IdPConfig extra = IdPConfig _idpExtraInfo :: extra } deriving (Eq, Show, Generic) + deriving (FromJSON, ToJSON, S.ToSchema) via (Schema.Schema (IdPConfig extra)) + +instance (Schema.ToSchema extra) => Schema.ToSchema (IdPConfig extra) where + schema = + Schema.object "IdPConfig" $ + IdPConfig + <$> (_idpId Schema..= Schema.field "id" Schema.schema) + <*> (_idpMetadata Schema..= Schema.field "metadata" Schema.schema) + <*> (_idpExtraInfo Schema..= Schema.field "extraInfo" Schema.schema) ---------------------------------------------------------------------- -- request, response @@ -721,18 +755,6 @@ makePrisms ''Statement makePrisms ''UnqualifiedNameID -deriveJSON deriveJSONOptions ''IdPMetadata - -deriveJSON deriveJSONOptions ''IdPConfig - -instance FromJSON IdPId where - parseJSON value = ((maybe unerror (pure . IdPId) . UUID.fromText) <=< parseJSON) value - where - unerror = fail ("could not parse config: " <> (show value)) - -instance ToJSON IdPId where - toJSON = toJSON . UUID.toText . fromIdPId - idPIdToST :: IdPId -> ST idPIdToST = UUID.toText . fromIdPId diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index cd3756e6f8..b86336974d 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -46,7 +48,7 @@ module Wire.API.Routes.Internal.Brig ) where -import Control.Lens ((.~), (?~)) +import Control.Lens (makePrisms, (.~), (?~), _1) import Data.Aeson (FromJSON, ToJSON, Value (Null)) import Data.Code qualified as Code import Data.CommaSeparatedList @@ -96,7 +98,8 @@ import Wire.API.User.Auth.LegalHold import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso import Wire.API.User.Client -import Wire.API.User.IdentityProvider (IdP) +import Wire.API.User.IdentityProvider +import Wire.API.User.Orphans () import Wire.API.User.RichInfo import Wire.API.UserGroup import Wire.API.UserGroup.Pagination @@ -1016,3 +1019,39 @@ runBrigInternalClient httpMgr (Endpoint brigHost brigPort) (BrigInternalClient a let baseUrl = Servant.BaseUrl Servant.Http (Text.unpack brigHost) (fromIntegral brigPort) "" clientEnv = Servant.mkClientEnv httpMgr baseUrl Servant.runClientM action clientEnv + +data IdpChangedNotification = IdPCreated IdP | IdPDeleted IdP | IdPUpdated IdP IdP + deriving (Eq, Show, Generic) + deriving (FromJSON, ToJSON, S.ToSchema) via (Schema IdpChangedNotification) + +data IdpChangedNotificationTag = IdPCreatedTag | IdPDeletedTag | IdPUpdatedTag + deriving (Eq, Enum, Bounded) + +makePrisms ''IdpChangedNotification + +instance Data.Schema.ToSchema IdpChangedNotification where + schema = + object "IdpChangedNotification" $ + fromTagged + <$> toTagged + .= bind + (fst .= field "tag" tagSchema) + (snd .= fieldOver _1 "value" untaggedSchema) + where + toTagged :: IdpChangedNotification -> (IdpChangedNotificationTag, IdpChangedNotification) + toTagged d@(IdPCreated _) = (IdPCreatedTag, d) + toTagged d@(IdPDeleted _) = (IdPDeletedTag, d) + toTagged d@(IdPUpdated _ _) = (IdPUpdatedTag, d) + + fromTagged :: (IdpChangedNotificationTag, IdpChangedNotification) -> IdpChangedNotification + fromTagged = snd + + untaggedSchema = dispatch $ \case + IdPCreatedTag -> tag _IdPCreated (Data.Schema.unnamed schema) + IdPDeletedTag -> tag _IdPDeleted (Data.Schema.unnamed schema) + IdPUpdatedTag -> tag _IdPUpdated (Data.Schema.unnamed schema) + + tagSchema :: ValueSchema NamedSwaggerDoc IdpChangedNotificationTag + tagSchema = + enum @Text "Detail Tag" $ + mconcat [element "created" IdPCreatedTag, element "deleted" IdPDeletedTag, element "updated" IdPUpdatedTag] From ebd2901ac4c79340cdff6106daaa28f5ad20c5db Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 16 Dec 2025 09:14:06 +0100 Subject: [PATCH 10/18] Add golden test for IdPConfig --- .../golden/Test/Wire/API/Golden/Manual.hs | 7 +++ .../golden/Test/Wire/API/Golden/Manual/IdP.hs | 53 +++++++++++++++++++ .../test/golden/testObject_IdP_1.json | 22 ++++++++ .../test/golden/testObject_IdP_2.json | 18 +++++++ libs/wire-api/wire-api.cabal | 1 + 5 files changed, 101 insertions(+) create mode 100644 libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/IdP.hs create mode 100644 libs/wire-api/test/golden/testObject_IdP_1.json create mode 100644 libs/wire-api/test/golden/testObject_IdP_2.json diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs index f62e490ed2..0a5d29a7c6 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs @@ -41,6 +41,7 @@ import Test.Wire.API.Golden.Manual.FederationRestriction import Test.Wire.API.Golden.Manual.FederationStatus import Test.Wire.API.Golden.Manual.GetPaginatedConversationIds import Test.Wire.API.Golden.Manual.GroupId +import Test.Wire.API.Golden.Manual.IdP import Test.Wire.API.Golden.Manual.InvitationUserView import Test.Wire.API.Golden.Manual.ListConversations import Test.Wire.API.Golden.Manual.ListUsersById @@ -429,5 +430,11 @@ tests = (testObject_DomainRedirectConfig_2, "testObject_DomainRedirectConfig_2.json"), (testObject_DomainRedirectConfig_4, "testObject_DomainRedirectConfig_4.json") ] + ], + testGroup + "IdP" + $ testObjects + [ (testObject_IdP_1, "testObject_IdP_1.json"), + (testObject_IdP_2, "testObject_IdP_2.json") ] ] diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/IdP.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/IdP.hs new file mode 100644 index 0000000000..6e0400d3a5 --- /dev/null +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/IdP.hs @@ -0,0 +1,53 @@ +module Test.Wire.API.Golden.Manual.IdP where + +import Data.Id +import Data.List.NonEmpty +import Data.UUID +import Imports +import SAML2.WebSSO.Types +import Text.XML.DSig +import URI.ByteString +import Wire.API.Routes.Version +import Wire.API.User.IdentityProvider + +testObject_IdP_1 :: IdP +testObject_IdP_1 = + IdPConfig + { _idpId = IdPId {fromIdPId = (fromJust . Data.UUID.fromString) "614c0bb0-1b33-98b6-8600-a1b290bbe1d7"}, + _idpMetadata = + IdPMetadata + { _edIssuer = Issuer {_fromIssuer = URI {uriScheme = Scheme {schemeBS = "https"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "liisa.kaisa"}, authorityPort = Nothing}), uriPath = "/", uriQuery = Query {queryPairs = []}, uriFragment = Nothing}}, + _edRequestURI = URI {uriScheme = Scheme {schemeBS = "https"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "johanna.leks"}, authorityPort = Nothing}), uriPath = "/aytamah", uriQuery = Query {queryPairs = []}, uriFragment = Nothing}, + _edCertAuthnResponse = either error id (parseKeyInfo False "MIIDBTCCAe2gAwIBAgIQev76BWqjWZxChmKkGqoAfDANBgkqhkiG9w0BAQsFADAtMSswKQYDVQQDEyJhY2NvdW50cy5hY2Nlc3Njb250cm9sLndpbmRvd3MubmV0MB4XDTE4MDIxODAwMDAwMFoXDTIwMDIxOTAwMDAwMFowLTErMCkGA1UEAxMiYWNjb3VudHMuYWNjZXNzY29udHJvbC53aW5kb3dzLm5ldDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMgmGiRfLh6Fdi99XI2VA3XKHStWNRLEy5Aw/gxFxchnh2kPdk/bejFOs2swcx7yUWqxujjCNRsLBcWfaKUlTnrkY7i9x9noZlMrijgJy/Lk+HH5HX24PQCDf+twjnHHxZ9G6/8VLM2e5ZBeZm+t7M3vhuumEHG3UwloLF6cUeuPdW+exnOB1U1fHBIFOG8ns4SSIoq6zw5rdt0CSI6+l7b1DEjVvPLtJF+zyjlJ1Qp7NgBvAwdiPiRMU4l8IRVbuSVKoKYJoyJ4L3eXsjczoBSTJ6VjV2mygz96DC70MY3avccFrk7tCEC6ZlMRBfY1XPLyldT7tsR3EuzjecSa1M8CAwEAAaMhMB8wHQYDVR0OBBYEFIks1srixjpSLXeiR8zES5cTY6fBMA0GCSqGSIb3DQEBCwUAA4IBAQCKthfK4C31DMuDyQZVS3F7+4Evld3hjiwqu2uGDK+qFZas/D/eDunxsFpiwqC01RIMFFN8yvmMjHphLHiBHWxcBTS+tm7AhmAvWMdxO5lzJLS+UWAyPF5ICROe8Mu9iNJiO5JlCo0Wpui9RbB1C81Xhax1gWHK245ESL6k7YWvyMYWrGqr1NuQcNS0B/AIT1Nsj1WY7efMJQOmnMHkPUTWryVZlthijYyd7P2Gz6rY5a81DAFqhDNJl2pGIAE6HWtSzeUEh3jCsHEkoglKfm4VrGJEuXcALmfCMbdfTvtu4rlsaP2hQad+MG/KJFlenoTK34EMHeBPDCpqNDz8UVNk") :| [] + }, + _idpExtraInfo = + WireIdP + { _team = (either error id . parseIdFromText) "fc5f3bf8-c296-69e7-27fd-70d483740fe4", + _apiVersion = Nothing, + _oldIssuers = [Issuer {_fromIssuer = URI {uriScheme = Scheme {schemeBS = "https"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "hele.johanna"}, authorityPort = Nothing}), uriPath = "/", uriQuery = Query {queryPairs = []}, uriFragment = Nothing}}, Issuer {_fromIssuer = URI {uriScheme = Scheme {schemeBS = "https"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "ulli.jannis"}, authorityPort = Nothing}), uriPath = "/", uriQuery = Query {queryPairs = []}, uriFragment = Nothing}}, Issuer {_fromIssuer = URI {uriScheme = Scheme {schemeBS = "https"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "reet.loviise"}, authorityPort = Nothing}), uriPath = "/", uriQuery = Query {queryPairs = []}, uriFragment = Nothing}}], + _replacedBy = Just (IdPId {fromIdPId = (fromJust . Data.UUID.fromString) "fc5f3bf8-c296-69e7-27fd-70d483740fe4"}), + _handle = IdPHandle {unIdPHandle = "614c0bb0-1b33-98b6-8600-a1b290bbe1d7"}, + _domain = Just "wire.com" + } + } + +testObject_IdP_2 :: IdP +testObject_IdP_2 = + IdPConfig + { _idpId = IdPId {fromIdPId = (fromJust . Data.UUID.fromString) "614c0bb0-1b33-98b6-8600-a1b290bbe1d7"}, + _idpMetadata = + IdPMetadata + { _edIssuer = Issuer {_fromIssuer = URI {uriScheme = Scheme {schemeBS = "https"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "liisa.kaisa"}, authorityPort = Nothing}), uriPath = "/", uriQuery = Query {queryPairs = []}, uriFragment = Nothing}}, + _edRequestURI = URI {uriScheme = Scheme {schemeBS = "https"}, uriAuthority = Just (Authority {authorityUserInfo = Nothing, authorityHost = Host {hostBS = "johanna.leks"}, authorityPort = Nothing}), uriPath = "/aytamah", uriQuery = Query {queryPairs = []}, uriFragment = Nothing}, + _edCertAuthnResponse = either error id (parseKeyInfo False "MIIDBTCCAe2gAwIBAgIQev76BWqjWZxChmKkGqoAfDANBgkqhkiG9w0BAQsFADAtMSswKQYDVQQDEyJhY2NvdW50cy5hY2Nlc3Njb250cm9sLndpbmRvd3MubmV0MB4XDTE4MDIxODAwMDAwMFoXDTIwMDIxOTAwMDAwMFowLTErMCkGA1UEAxMiYWNjb3VudHMuYWNjZXNzY29udHJvbC53aW5kb3dzLm5ldDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMgmGiRfLh6Fdi99XI2VA3XKHStWNRLEy5Aw/gxFxchnh2kPdk/bejFOs2swcx7yUWqxujjCNRsLBcWfaKUlTnrkY7i9x9noZlMrijgJy/Lk+HH5HX24PQCDf+twjnHHxZ9G6/8VLM2e5ZBeZm+t7M3vhuumEHG3UwloLF6cUeuPdW+exnOB1U1fHBIFOG8ns4SSIoq6zw5rdt0CSI6+l7b1DEjVvPLtJF+zyjlJ1Qp7NgBvAwdiPiRMU4l8IRVbuSVKoKYJoyJ4L3eXsjczoBSTJ6VjV2mygz96DC70MY3avccFrk7tCEC6ZlMRBfY1XPLyldT7tsR3EuzjecSa1M8CAwEAAaMhMB8wHQYDVR0OBBYEFIks1srixjpSLXeiR8zES5cTY6fBMA0GCSqGSIb3DQEBCwUAA4IBAQCKthfK4C31DMuDyQZVS3F7+4Evld3hjiwqu2uGDK+qFZas/D/eDunxsFpiwqC01RIMFFN8yvmMjHphLHiBHWxcBTS+tm7AhmAvWMdxO5lzJLS+UWAyPF5ICROe8Mu9iNJiO5JlCo0Wpui9RbB1C81Xhax1gWHK245ESL6k7YWvyMYWrGqr1NuQcNS0B/AIT1Nsj1WY7efMJQOmnMHkPUTWryVZlthijYyd7P2Gz6rY5a81DAFqhDNJl2pGIAE6HWtSzeUEh3jCsHEkoglKfm4VrGJEuXcALmfCMbdfTvtu4rlsaP2hQad+MG/KJFlenoTK34EMHeBPDCpqNDz8UVNk") :| [] + }, + _idpExtraInfo = + WireIdP + { _team = (either error id . parseIdFromText) "fc5f3bf8-c296-69e7-27fd-70d483740fe4", + _apiVersion = Just WireIdPAPIV2, + _oldIssuers = [], + _replacedBy = Nothing, + _handle = IdPHandle {unIdPHandle = "614c0bb0-1b33-98b6-8600-a1b290bbe1d7"}, + _domain = Nothing + } + } diff --git a/libs/wire-api/test/golden/testObject_IdP_1.json b/libs/wire-api/test/golden/testObject_IdP_1.json new file mode 100644 index 0000000000..6d5614ceb2 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_IdP_1.json @@ -0,0 +1,22 @@ +{ + "extraInfo": { + "apiVersion": null, + "domain": "wire.com", + "handle": "614c0bb0-1b33-98b6-8600-a1b290bbe1d7", + "oldIssuers": [ + "https://hele.johanna/", + "https://ulli.jannis/", + "https://reet.loviise/" + ], + "replacedBy": "fc5f3bf8-c296-69e7-27fd-70d483740fe4", + "team": "fc5f3bf8-c296-69e7-27fd-70d483740fe4" + }, + "id": "614c0bb0-1b33-98b6-8600-a1b290bbe1d7", + "metadata": { + "certAuthnResponse": [ + "MIIDBTCCAe2gAwIBAgIQev76BWqjWZxChmKkGqoAfDANBgkqhkiG9w0BAQsFADAtMSswKQYDVQQDEyJhY2NvdW50cy5hY2Nlc3Njb250cm9sLndpbmRvd3MubmV0MB4XDTE4MDIxODAwMDAwMFoXDTIwMDIxOTAwMDAwMFowLTErMCkGA1UEAxMiYWNjb3VudHMuYWNjZXNzY29udHJvbC53aW5kb3dzLm5ldDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMgmGiRfLh6Fdi99XI2VA3XKHStWNRLEy5Aw/gxFxchnh2kPdk/bejFOs2swcx7yUWqxujjCNRsLBcWfaKUlTnrkY7i9x9noZlMrijgJy/Lk+HH5HX24PQCDf+twjnHHxZ9G6/8VLM2e5ZBeZm+t7M3vhuumEHG3UwloLF6cUeuPdW+exnOB1U1fHBIFOG8ns4SSIoq6zw5rdt0CSI6+l7b1DEjVvPLtJF+zyjlJ1Qp7NgBvAwdiPiRMU4l8IRVbuSVKoKYJoyJ4L3eXsjczoBSTJ6VjV2mygz96DC70MY3avccFrk7tCEC6ZlMRBfY1XPLyldT7tsR3EuzjecSa1M8CAwEAAaMhMB8wHQYDVR0OBBYEFIks1srixjpSLXeiR8zES5cTY6fBMA0GCSqGSIb3DQEBCwUAA4IBAQCKthfK4C31DMuDyQZVS3F7+4Evld3hjiwqu2uGDK+qFZas/D/eDunxsFpiwqC01RIMFFN8yvmMjHphLHiBHWxcBTS+tm7AhmAvWMdxO5lzJLS+UWAyPF5ICROe8Mu9iNJiO5JlCo0Wpui9RbB1C81Xhax1gWHK245ESL6k7YWvyMYWrGqr1NuQcNS0B/AIT1Nsj1WY7efMJQOmnMHkPUTWryVZlthijYyd7P2Gz6rY5a81DAFqhDNJl2pGIAE6HWtSzeUEh3jCsHEkoglKfm4VrGJEuXcALmfCMbdfTvtu4rlsaP2hQad+MG/KJFlenoTK34EMHeBPDCpqNDz8UVNk" + ], + "issuer": "https://liisa.kaisa/", + "requestURI": "https://johanna.leks/aytamah" + } +} diff --git a/libs/wire-api/test/golden/testObject_IdP_2.json b/libs/wire-api/test/golden/testObject_IdP_2.json new file mode 100644 index 0000000000..e6ae1cacd0 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_IdP_2.json @@ -0,0 +1,18 @@ +{ + "extraInfo": { + "apiVersion": "WireIdPAPIV2", + "domain": null, + "handle": "614c0bb0-1b33-98b6-8600-a1b290bbe1d7", + "oldIssuers": [], + "replacedBy": null, + "team": "fc5f3bf8-c296-69e7-27fd-70d483740fe4" + }, + "id": "614c0bb0-1b33-98b6-8600-a1b290bbe1d7", + "metadata": { + "certAuthnResponse": [ + "MIIDBTCCAe2gAwIBAgIQev76BWqjWZxChmKkGqoAfDANBgkqhkiG9w0BAQsFADAtMSswKQYDVQQDEyJhY2NvdW50cy5hY2Nlc3Njb250cm9sLndpbmRvd3MubmV0MB4XDTE4MDIxODAwMDAwMFoXDTIwMDIxOTAwMDAwMFowLTErMCkGA1UEAxMiYWNjb3VudHMuYWNjZXNzY29udHJvbC53aW5kb3dzLm5ldDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMgmGiRfLh6Fdi99XI2VA3XKHStWNRLEy5Aw/gxFxchnh2kPdk/bejFOs2swcx7yUWqxujjCNRsLBcWfaKUlTnrkY7i9x9noZlMrijgJy/Lk+HH5HX24PQCDf+twjnHHxZ9G6/8VLM2e5ZBeZm+t7M3vhuumEHG3UwloLF6cUeuPdW+exnOB1U1fHBIFOG8ns4SSIoq6zw5rdt0CSI6+l7b1DEjVvPLtJF+zyjlJ1Qp7NgBvAwdiPiRMU4l8IRVbuSVKoKYJoyJ4L3eXsjczoBSTJ6VjV2mygz96DC70MY3avccFrk7tCEC6ZlMRBfY1XPLyldT7tsR3EuzjecSa1M8CAwEAAaMhMB8wHQYDVR0OBBYEFIks1srixjpSLXeiR8zES5cTY6fBMA0GCSqGSIb3DQEBCwUAA4IBAQCKthfK4C31DMuDyQZVS3F7+4Evld3hjiwqu2uGDK+qFZas/D/eDunxsFpiwqC01RIMFFN8yvmMjHphLHiBHWxcBTS+tm7AhmAvWMdxO5lzJLS+UWAyPF5ICROe8Mu9iNJiO5JlCo0Wpui9RbB1C81Xhax1gWHK245ESL6k7YWvyMYWrGqr1NuQcNS0B/AIT1Nsj1WY7efMJQOmnMHkPUTWryVZlthijYyd7P2Gz6rY5a81DAFqhDNJl2pGIAE6HWtSzeUEh3jCsHEkoglKfm4VrGJEuXcALmfCMbdfTvtu4rlsaP2hQad+MG/KJFlenoTK34EMHeBPDCpqNDz8UVNk" + ], + "issuer": "https://liisa.kaisa/", + "requestURI": "https://johanna.leks/aytamah" + } +} diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 80c4e21136..0d0a166660 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -631,6 +631,7 @@ test-suite wire-api-golden-tests Test.Wire.API.Golden.Manual.FederationStatus Test.Wire.API.Golden.Manual.GetPaginatedConversationIds Test.Wire.API.Golden.Manual.GroupId + Test.Wire.API.Golden.Manual.IdP Test.Wire.API.Golden.Manual.InvitationUserView Test.Wire.API.Golden.Manual.ListConversations Test.Wire.API.Golden.Manual.ListUsersById From 23d362bc0b0a8e7a6cbee8b4fd98ee51525f0002 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 16 Dec 2025 11:05:42 +0100 Subject: [PATCH 11/18] Add ToSchema instances for IdP (and dependencies) --- .../saml2-web-sso/src/SAML2/WebSSO/Orphans.hs | 15 ++++++++++ libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs | 4 +-- .../test/Test/SAML2/WebSSO/RoundtripSpec.hs | 1 + .../src/Wire/API/Routes/Internal/Brig.hs | 22 ++++++++++---- .../src/Wire/API/User/IdentityProvider.hs | 30 +++++++++++++++---- libs/wire-api/src/Wire/API/User/Orphans.hs | 12 -------- 6 files changed, 58 insertions(+), 26 deletions(-) diff --git a/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs b/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs index 23c7cdd90f..a19e16c111 100644 --- a/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs +++ b/libs/saml2-web-sso/src/SAML2/WebSSO/Orphans.hs @@ -46,6 +46,10 @@ instance Schema.ToSchema SignedCertificate where serialize :: SignedCertificate -> Text.Text serialize = TL.toStrict . renderKeyInfo +deriving via (Schema.Schema SignedCertificate) instance FromJSON SignedCertificate + +deriving via (Schema.Schema SignedCertificate) instance ToJSON SignedCertificate + -- This can unfortunately not live in wire-api, because wire-api depends on -- saml2-web-sso. instance ToSchema URI where @@ -72,3 +76,14 @@ instance ToSchema Level where deriving instance Enum Level deriving instance Bounded Level + +-- | Used in tests to have no @extra@ in @IdPConfig extra@ +instance Schema.ToSchema () where + schema = Schema.named "unit" $ Schema.null_ + +-- | Used in tests to have JSON as @extra@ in @IdPConfig extra@ +instance Schema.ToSchema A.Value where + schema = + Schema.named (Text.pack "Value") $ + id + Schema..= Schema.jsonValue diff --git a/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs b/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs index cada2f039c..93039ca76d 100644 --- a/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs +++ b/libs/saml2-web-sso/src/SAML2/WebSSO/Types.hs @@ -161,7 +161,6 @@ module SAML2.WebSSO.Types where import Control.Lens -import Control.Monad ((<=<)) import Control.Monad.Except import Data.Aeson import Data.Aeson.TH @@ -176,7 +175,6 @@ import Data.Schema qualified as Schema import Data.String.Conversions (ST, cs) import Data.Text (Text) import Data.Text qualified as ST -import Data.Text.Encoding qualified as T import Data.Time (NominalDiffTime, UTCTime (..), addUTCTime, defaultTimeLocale, formatTime, parseTimeM) import Data.UUID as UUID import Data.X509 qualified as X509 @@ -318,7 +316,7 @@ instance Schema.ToSchema IdPMetadata where IdPMetadata <$> (_edIssuer Schema..= Schema.field "issuer" Schema.schema) <*> (_edRequestURI Schema..= Schema.field "requestURI" Schema.schema) - <*> (_edCertAuthnResponse Schema..= Schema.field "certAuthnResponse" Schema.schema) + <*> (_edCertAuthnResponse Schema..= Schema.field "certAuthnResponse" (Schema.nonEmptyArray Schema.schema)) ---------------------------------------------------------------------- -- idp info diff --git a/libs/saml2-web-sso/test/Test/SAML2/WebSSO/RoundtripSpec.hs b/libs/saml2-web-sso/test/Test/SAML2/WebSSO/RoundtripSpec.hs index a9aba12569..dce765a26a 100644 --- a/libs/saml2-web-sso/test/Test/SAML2/WebSSO/RoundtripSpec.hs +++ b/libs/saml2-web-sso/test/Test/SAML2/WebSSO/RoundtripSpec.hs @@ -32,6 +32,7 @@ import Hedgehog import Hedgehog.Gen as Gen import SAML2.Core qualified as HS import SAML2.WebSSO +import SAML2.WebSSO.Orphans () import SAML2.WebSSO.Test.Arbitrary import SAML2.WebSSO.Test.Util import Servant diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index b86336974d..e5e86dce64 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -1020,13 +1020,12 @@ runBrigInternalClient httpMgr (Endpoint brigHost brigPort) (BrigInternalClient a clientEnv = Servant.mkClientEnv httpMgr baseUrl Servant.runClientM action clientEnv -data IdpChangedNotification = IdPCreated IdP | IdPDeleted IdP | IdPUpdated IdP IdP - deriving (Eq, Show, Generic) - deriving (FromJSON, ToJSON, S.ToSchema) via (Schema IdpChangedNotification) - data IdpChangedNotificationTag = IdPCreatedTag | IdPDeletedTag | IdPUpdatedTag deriving (Eq, Enum, Bounded) +data IdpChangedNotification = IdPCreated IdP | IdPDeleted IdP | IdPUpdated IdP IdP + deriving (Eq, Show, Generic) + makePrisms ''IdpChangedNotification instance Data.Schema.ToSchema IdpChangedNotification where @@ -1049,9 +1048,22 @@ instance Data.Schema.ToSchema IdpChangedNotification where untaggedSchema = dispatch $ \case IdPCreatedTag -> tag _IdPCreated (Data.Schema.unnamed schema) IdPDeletedTag -> tag _IdPDeleted (Data.Schema.unnamed schema) - IdPUpdatedTag -> tag _IdPUpdated (Data.Schema.unnamed schema) + IdPUpdatedTag -> tag _IdPUpdated (Data.Schema.unnamed updatedSchema) tagSchema :: ValueSchema NamedSwaggerDoc IdpChangedNotificationTag tagSchema = enum @Text "Detail Tag" $ mconcat [element "created" IdPCreatedTag, element "deleted" IdPDeletedTag, element "updated" IdPUpdatedTag] + + updatedSchema :: ValueSchema NamedSwaggerDoc (IdP, IdP) + updatedSchema = + object "IdPUpdated" $ + (,) + <$> fst .= field "old" schema + <*> snd .= field "new" schema + +deriving via (Schema IdpChangedNotification) instance FromJSON IdpChangedNotification + +deriving via (Schema IdpChangedNotification) instance ToJSON IdpChangedNotification + +deriving via (Schema IdpChangedNotification) instance S.ToSchema IdpChangedNotification diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index b6ffbd7129..395e194f1e 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -50,6 +50,7 @@ import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap import Data.Id (TeamId) import Data.OpenApi import Data.Proxy (Proxy (Proxy)) +import Data.Schema qualified as Schema import Data.Text.Encoding import Data.Text.Encoding.Error import Data.Text.Lazy qualified as LT @@ -70,7 +71,7 @@ type IdP = IdPConfig WireIdP -- | Unique human-readable IdP name. newtype IdPHandle = IdPHandle {unIdPHandle :: Text} - deriving (Eq, Ord, Show, FromJSON, ToJSON, ToSchema, Arbitrary, Generic) + deriving (Eq, Ord, Show, FromJSON, ToJSON, ToSchema, Schema.ToSchema, Arbitrary, Generic) data WireIdP = WireIdP { _team :: TeamId, @@ -89,6 +90,19 @@ data WireIdP = WireIdP deriving (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform WireIdP) +instance Schema.ToSchema WireIdP where + schema = + Schema.object + "WireIdP" + ( WireIdP + <$> _team Schema..= Schema.field "team" Schema.schema + <*> _apiVersion Schema..= Schema.maybe_ (Schema.optField "apiVersion" Schema.schema) + <*> _oldIssuers Schema..= Schema.field "oldIssuers" (Schema.array Schema.schema) + <*> _replacedBy Schema..= Schema.maybe_ (Schema.optField "replacedBy" Schema.schema) + <*> _handle Schema..= Schema.field "handle" Schema.schema + <*> _domain Schema..= Schema.maybe_ (Schema.optField "domain" Schema.schema) + ) + data WireIdPAPIVersion = -- | initial API WireIdPAPIV1 @@ -96,6 +110,15 @@ data WireIdPAPIVersion WireIdPAPIV2 deriving stock (Eq, Show, Enum, Bounded, Generic) deriving (Arbitrary) via (GenericUniform WireIdPAPIVersion) + deriving (FromJSON, ToJSON, ToSchema) via (Schema.Schema WireIdPAPIVersion) + +instance Schema.ToSchema WireIdPAPIVersion where + schema = + Schema.enum @Text "WireIdPAPIVersion" $ + mconcat + [ Schema.element "v1" WireIdPAPIV1, + Schema.element "v2" WireIdPAPIV2 + ] -- | (Internal issue for making v2 the default: -- https://wearezeta.atlassian.net/browse/SQSERVICES-781. BEWARE: We probably shouldn't ever @@ -106,8 +129,6 @@ defWireIdPAPIVersion = WireIdPAPIV1 makeLenses ''WireIdP -deriveJSON deriveJSONOptions ''WireIdPAPIVersion - -- Changing the encoder since we've dropped the field prefixes deriveJSON (defaultOptsDropChar '_') ''WireIdP @@ -208,9 +229,6 @@ idPMetadataToInfo = instance ToSchema IdPList where declareNamedSchema = genericDeclareNamedSchema $ fromAesonOptions $ defaultOptsDropChar '_' -instance ToSchema WireIdPAPIVersion where - declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions - instance ToSchema WireIdP where -- We don't want to use `samlSchemaOptions`, as it pulls from saml2-web-sso json options which -- as a `dropWhile not . isUpper` modifier. All we need is to drop the underscore prefix and diff --git a/libs/wire-api/src/Wire/API/User/Orphans.hs b/libs/wire-api/src/Wire/API/User/Orphans.hs index 794d4d3643..c3d44c7084 100644 --- a/libs/wire-api/src/Wire/API/User/Orphans.hs +++ b/libs/wire-api/src/Wire/API/User/Orphans.hs @@ -118,15 +118,6 @@ instance O.ToSchema Void where instance (HasOpenApi route) => HasOpenApi (SM.MultipartForm SM.Mem resp :> route) where toOpenApi _proxy = toOpenApi (Proxy @route) -instance O.ToSchema SAML.IdPId where - declareNamedSchema _ = declareNamedSchema (Proxy @UUID) - -instance (O.ToSchema a) => O.ToSchema (SAML.IdPConfig a) where - declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions - -instance O.ToSchema SAML.Issuer where - declareNamedSchema _ = declareNamedSchema (Proxy @String) - instance O.ToSchema URI where declareNamedSchema _ = declareNamedSchema (Proxy @String) @@ -136,9 +127,6 @@ instance O.ToParamSchema URI where instance O.ToSchema X509.SignedCertificate where declareNamedSchema _ = declareNamedSchema (Proxy @String) -instance O.ToSchema SAML.IdPMetadata where - declareNamedSchema = genericDeclareNamedSchema samlSchemaOptions - instance S.ToSchema Currency.Alpha where schema = S.enum @Text "Currency.Alpha" cases & S.doc' . O.schema %~ swaggerTweaks where From 471c2547073fa3666eb2011e57c461f14838a4c3 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 16 Dec 2025 15:03:21 +0100 Subject: [PATCH 12/18] Switch to one endpoint for all notifications --- .../src/Wire/API/Routes/Internal/Brig.hs | 65 ++++++++----------- .../src/Wire/SAMLEmailSubsystem.hs | 5 +- .../Wire/SAMLEmailSubsystem/Interpreter.hs | 50 ++++++-------- services/brig/src/Brig/API/Internal.hs | 7 +- services/spar/src/Spar/API.hs | 7 +- services/spar/src/Spar/Intra/Brig.hs | 24 ++----- services/spar/src/Spar/Sem/BrigAccess.hs | 10 +-- services/spar/src/Spar/Sem/BrigAccess/Http.hs | 4 +- 8 files changed, 62 insertions(+), 110 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index e5e86dce64..8933fee193 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -45,6 +45,7 @@ module Wire.API.Routes.Internal.Brig FoundInvitationCode (..), EnterpriseLoginApi, SAMLIdPAPI, + IdpChangedNotification (..), ) where @@ -707,26 +708,12 @@ type API = type SAMLIdPAPI = "idp" :> ( Named - "send-idp-created-email" - ( Summary "Send an email about the new IdP to all team admins and owners" - :> "send-idp-created-email" - :> ReqBody '[Servant.JSON] IdP + "send-idp-changed-email" + ( Summary "Send an email about IdP creation, deletion or update to all team admins and owners" + :> "send-idp-changed-email" + :> ReqBody '[Servant.JSON] IdpChangedNotification :> Post '[Servant.JSON] () ) - :<|> Named - "send-idp-deleted-email" - ( Summary "Send an email about the deleted IdP to all team admins and owners" - :> "send-idp-deleted-email" - :> ReqBody '[Servant.JSON] IdP - :> Post '[Servant.JSON] () - ) - :<|> Named - "send-idp-updated-email" - ( Summary "Send an email about the IdP update to all team admins and owners" - :> "send-idp-updated-email" - :> ReqBody '[Servant.JSON] (IdP, IdP) - :> Post '[Servant.JSON] () - ) ) type IStatusAPI = @@ -999,27 +986,6 @@ instance S.ToSchema GetRichInfoMultiResponse where S.NamedSchema (Just $ "GetRichInfoMultiResponse") $ mempty & S.description ?~ "List of pairs of UserId and RichInfo" -swaggerDoc :: OpenApi -swaggerDoc = brigSwaggerDoc - -brigSwaggerDoc :: OpenApi -brigSwaggerDoc = - ( toOpenApi (Proxy @API) - & info . title .~ "Wire-Server internal brig API" - ) - -newtype BrigInternalClient a = BrigInternalClient (Servant.ClientM a) - deriving newtype (Functor, Applicative, Monad, Servant.RunClient) - -brigInternalClient :: forall (name :: Symbol) endpoint. (HasEndpoint API endpoint name, Servant.HasClient BrigInternalClient endpoint) => Servant.Client BrigInternalClient endpoint -brigInternalClient = namedClient @API @name @BrigInternalClient - -runBrigInternalClient :: HTTP.Manager -> Endpoint -> BrigInternalClient a -> IO (Either Servant.ClientError a) -runBrigInternalClient httpMgr (Endpoint brigHost brigPort) (BrigInternalClient action) = do - let baseUrl = Servant.BaseUrl Servant.Http (Text.unpack brigHost) (fromIntegral brigPort) "" - clientEnv = Servant.mkClientEnv httpMgr baseUrl - Servant.runClientM action clientEnv - data IdpChangedNotificationTag = IdPCreatedTag | IdPDeletedTag | IdPUpdatedTag deriving (Eq, Enum, Bounded) @@ -1067,3 +1033,24 @@ deriving via (Schema IdpChangedNotification) instance FromJSON IdpChangedNotific deriving via (Schema IdpChangedNotification) instance ToJSON IdpChangedNotification deriving via (Schema IdpChangedNotification) instance S.ToSchema IdpChangedNotification + +swaggerDoc :: OpenApi +swaggerDoc = brigSwaggerDoc + +brigSwaggerDoc :: OpenApi +brigSwaggerDoc = + ( toOpenApi (Proxy @API) + & info . title .~ "Wire-Server internal brig API" + ) + +newtype BrigInternalClient a = BrigInternalClient (Servant.ClientM a) + deriving newtype (Functor, Applicative, Monad, Servant.RunClient) + +brigInternalClient :: forall (name :: Symbol) endpoint. (HasEndpoint API endpoint name, Servant.HasClient BrigInternalClient endpoint) => Servant.Client BrigInternalClient endpoint +brigInternalClient = namedClient @API @name @BrigInternalClient + +runBrigInternalClient :: HTTP.Manager -> Endpoint -> BrigInternalClient a -> IO (Either Servant.ClientError a) +runBrigInternalClient httpMgr (Endpoint brigHost brigPort) (BrigInternalClient action) = do + let baseUrl = Servant.BaseUrl Servant.Http (Text.unpack brigHost) (fromIntegral brigPort) "" + clientEnv = Servant.mkClientEnv httpMgr baseUrl + Servant.runClientM action clientEnv diff --git a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs index edcd7a1cf2..aa7fc477da 100644 --- a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs @@ -3,11 +3,10 @@ module Wire.SAMLEmailSubsystem where import Polysemy +import Wire.API.Routes.Internal.Brig (IdpChangedNotification) import Wire.API.User.IdentityProvider (IdP) data SAMLEmailSubsystem m a where - SendSAMLIdPCreated :: IdP -> SAMLEmailSubsystem m () - SendSAMLIdPDeleted :: IdP -> SAMLEmailSubsystem m () - SendSAMLIdPUpdated :: IdP -> IdP -> SAMLEmailSubsystem m () + SendSAMLIdPChanged :: IdpChangedNotification -> SAMLEmailSubsystem m () makeSem ''SAMLEmailSubsystem diff --git a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs index f78c7e3816..5885481d6b 100644 --- a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem/Interpreter.hs @@ -8,8 +8,9 @@ import Imports import Polysemy import SAML2.WebSSO.Types import Text.Email.Parser +import Wire.API.Routes.Internal.Brig import Wire.API.Team.Member -import Wire.API.User.IdentityProvider (IdP, team) +import Wire.API.User.IdentityProvider import Wire.EmailSubsystem qualified as Email import Wire.SAMLEmailSubsystem import Wire.TeamSubsystem @@ -22,43 +23,30 @@ samlEmailSubsystemInterpreter :: ) => InterpreterFor SAMLEmailSubsystem r samlEmailSubsystemInterpreter = interpret \case - SendSAMLIdPCreated idp -> sendSAMLIdPCreatedImpl idp - SendSAMLIdPDeleted idp -> sendSAMLIdPDeletedImpl idp - SendSAMLIdPUpdated old new -> sendSAMLIdPUpdatedImpl old new + SendSAMLIdPChanged idp -> sendSAMLIdPChangedImpl idp -sendSAMLIdPCreatedImpl :: +sendSAMLIdPChangedImpl :: ( Member TeamSubsystem r, Member UserStore r, Member Email.EmailSubsystem r ) => - IdP -> - Sem r () -sendSAMLIdPCreatedImpl idp = do - emails <- getEmailAddresses idp - mapM_ (Email.sendSAMLIdPCreated idp) emails - -sendSAMLIdPDeletedImpl :: - ( Member TeamSubsystem r, - Member UserStore r, - Member Email.EmailSubsystem r - ) => - IdP -> + IdpChangedNotification -> Sem r () -sendSAMLIdPDeletedImpl idp = do - emails <- getEmailAddresses idp - mapM_ (Email.sendSAMLIdPDeleted idp) emails +sendSAMLIdPChangedImpl notif = do + emails <- getEmailAddresses origIdP + mapM_ delegate emails + where + delegate :: (Member Email.EmailSubsystem r) => EmailAddress -> Sem r () + delegate email = case notif of + IdPCreated idp -> Email.sendSAMLIdPCreated idp email + IdPDeleted idp -> Email.sendSAMLIdPDeleted idp email + IdPUpdated old new -> Email.sendSAMLIdPUpdated old new email -sendSAMLIdPUpdatedImpl :: - ( Member TeamSubsystem r, - Member UserStore r, - Member Email.EmailSubsystem r - ) => - IdP -> - IdP -> - Sem r () -sendSAMLIdPUpdatedImpl old new = do - emails <- getEmailAddresses old - mapM_ (Email.sendSAMLIdPUpdated old new) emails + origIdP :: IdP + origIdP = case notif of + IdPCreated idp -> idp + IdPDeleted idp -> idp + IdPUpdated old _new -> old getEmailAddresses :: ( Member TeamSubsystem r, diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index ce54455db6..b0de336638 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -123,7 +123,7 @@ import Wire.PasswordResetCodeStore (PasswordResetCodeStore) import Wire.PropertySubsystem import Wire.RateLimit import Wire.Rpc -import Wire.SAMLEmailSubsystem (SAMLEmailSubsystem, sendSAMLIdPCreated, sendSAMLIdPDeleted, sendSAMLIdPUpdated) +import Wire.SAMLEmailSubsystem (SAMLEmailSubsystem, sendSAMLIdPChanged) import Wire.Sem.Concurrency import Wire.Sem.Now (Now) import Wire.Sem.Random (Random) @@ -519,10 +519,7 @@ enterpriseLoginApi = :<|> Named @"domain-registration-get" getDomainRegistrationH samlIdPApi :: (Member SAMLEmailSubsystem r) => ServerT SAMLIdPAPI (Handler r) -samlIdPApi = - Named @"send-idp-created-email" (lift . liftSem . sendSAMLIdPCreated) - :<|> Named @"send-idp-deleted-email" (lift . liftSem . sendSAMLIdPDeleted) - :<|> Named @"send-idp-updated-email" (lift . liftSem . uncurry sendSAMLIdPUpdated) +samlIdPApi = Named @"send-idp-changed-email" (lift . liftSem . sendSAMLIdPChanged) --------------------------------------------------------------------------- -- Handlers diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 6d595fe219..e1c4b075ff 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -108,6 +108,7 @@ import Spar.Sem.VerdictFormatStore (VerdictFormatStore) import qualified Spar.Sem.VerdictFormatStore as VerdictFormatStore import System.Logger (Msg) import qualified URI.ByteString as URI +import Wire.API.Routes.Internal.Brig (IdpChangedNotification (IdPCreated, IdPDeleted, IdPUpdated)) import Wire.API.Routes.Internal.Spar import Wire.API.Routes.Named import Wire.API.Routes.Public (ZHostValue) @@ -573,7 +574,7 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co do IdPConfigStore.deleteConfig idp IdPRawMetadataStore.delete idpid - BrigAccess.sendSAMLIdPDeletedEmail idp + BrigAccess.sendSAMLIdPChangedEmail $ IdPDeleted idp pure NoContent where assertEmptyOrPurge :: TeamId -> Cas.Page (SAML.UserRef, UserId) -> Sem r () @@ -654,7 +655,7 @@ idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmet IdPConfigStore.insertConfig idp forM_ mReplaces $ \replaces -> IdPConfigStore.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId)) - BrigAccess.sendSAMLIdPCreatedEmail idp + BrigAccess.sendSAMLIdPChangedEmail $ IdPCreated idp pure idp where -- Ensure that the domain is not in use by an existing IDP @@ -835,7 +836,7 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML WireIdPAPIV1 -> Nothing WireIdPAPIV2 -> Just teamid forM_ (idp'' ^. SAML.idpExtraInfo . oldIssuers) (flip IdPConfigStore.deleteIssuer mbteamid) - BrigAccess.sendSAMLIdPUpdatedEmail previousIdP idp'' + BrigAccess.sendSAMLIdPChangedEmail $ IdPUpdated previousIdP idp'' pure idp'' where -- Ensure that the domain is not in use by an existing IDP diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 3146e979f5..1f52cc05cd 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -43,9 +43,7 @@ module Spar.Intra.Brig setStatus, getDefaultUserLocale, checkAdminGetTeamId, - sendSAMLIdPCreatedEmail, - sendSAMLIdPDeletedEmail, - sendSAMLIdPUpdatedEmail, + sendSAMLIdPChangedEmail, ) where @@ -67,11 +65,11 @@ import Spar.Error import qualified System.Logger.Class as Log import Web.Cookie import Wire.API.Locale +import Wire.API.Routes.Internal.Brig (IdpChangedNotification) import Wire.API.Team.Role (Role) import Wire.API.User import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso -import Wire.API.User.IdentityProvider (IdP) import Wire.API.User.RichInfo as RichInfo import Wire.UserSubsystem (HavePendingInvitations (..)) @@ -458,20 +456,8 @@ checkAdminGetTeamId uid = do 200 -> parseResponse @TeamId "brig" resp _ -> rethrow "brig" resp -sendSAMLIdPCreatedEmail :: (HasCallStack, MonadSparToBrig m) => IdP -> m () -sendSAMLIdPCreatedEmail idp = do - resp <- call $ method POST . path "/i/idp/send-idp-created-email" . json idp - unless (statusCode resp == 200) $ - rethrow "brig" resp - -sendSAMLIdPDeletedEmail :: (HasCallStack, MonadSparToBrig m) => IdP -> m () -sendSAMLIdPDeletedEmail idp = do - resp <- call $ method POST . path "/i/idp/send-idp-deleted-email" . json idp - unless (statusCode resp == 200) $ - rethrow "brig" resp - -sendSAMLIdPUpdatedEmail :: (HasCallStack, MonadSparToBrig m) => IdP -> IdP -> m () -sendSAMLIdPUpdatedEmail old new = do - resp <- call $ method POST . path "/i/idp/send-idp-updated-email" . json (old, new) +sendSAMLIdPChangedEmail :: (HasCallStack, MonadSparToBrig m) => IdpChangedNotification -> m () +sendSAMLIdPChangedEmail notif = do + resp <- call $ method POST . path "/i/idp/send-idp-changed-email" . json notif unless (statusCode resp == 200) $ rethrow "brig" resp diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 753b35b0f7..1d82622eec 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -41,9 +41,7 @@ module Spar.Sem.BrigAccess setStatus, getDefaultUserLocale, checkAdminGetTeamId, - sendSAMLIdPCreatedEmail, - sendSAMLIdPDeletedEmail, - sendSAMLIdPUpdatedEmail, + sendSAMLIdPChangedEmail, ) where @@ -58,9 +56,9 @@ import Polysemy import qualified SAML2.WebSSO as SAML import Web.Cookie import Wire.API.Locale +import Wire.API.Routes.Internal.Brig (IdpChangedNotification) import Wire.API.Team.Role import Wire.API.User -import Wire.API.User.IdentityProvider (IdP) import Wire.API.User.RichInfo as RichInfo data BrigAccess m a where @@ -86,8 +84,6 @@ data BrigAccess m a where SetStatus :: UserId -> AccountStatus -> BrigAccess m () GetDefaultUserLocale :: BrigAccess m Locale CheckAdminGetTeamId :: UserId -> BrigAccess m TeamId - SendSAMLIdPCreatedEmail :: IdP -> BrigAccess m () - SendSAMLIdPDeletedEmail :: IdP -> BrigAccess m () - SendSAMLIdPUpdatedEmail :: IdP -> IdP -> BrigAccess m () + SendSAMLIdPChangedEmail :: IdpChangedNotification -> BrigAccess m () makeSem ''BrigAccess diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 247177b5c5..b2f8adaaf6 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -65,6 +65,4 @@ brigAccessToHttp mgr req = SetStatus itlu a -> Intra.setStatus itlu a GetDefaultUserLocale -> Intra.getDefaultUserLocale CheckAdminGetTeamId itlu -> Intra.checkAdminGetTeamId itlu - SendSAMLIdPCreatedEmail idp -> Intra.sendSAMLIdPCreatedEmail idp - SendSAMLIdPDeletedEmail idp -> Intra.sendSAMLIdPDeletedEmail idp - SendSAMLIdPUpdatedEmail old new -> Intra.sendSAMLIdPUpdatedEmail old new + SendSAMLIdPChangedEmail notif -> Intra.sendSAMLIdPChangedEmail notif From 5721f3661ace6002b15ef13d65fc2922d0446539 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 17 Dec 2025 15:32:14 +0100 Subject: [PATCH 13/18] Add missing cabal/nix dependency --- libs/saml2-web-sso/default.nix | 2 ++ 1 file changed, 2 insertions(+) diff --git a/libs/saml2-web-sso/default.nix b/libs/saml2-web-sso/default.nix index e4d714b714..d09f6565fc 100644 --- a/libs/saml2-web-sso/default.nix +++ b/libs/saml2-web-sso/default.nix @@ -48,6 +48,7 @@ , memory , mtl , network-uri +, openapi3 , pretty-show , process , QuickCheck @@ -127,6 +128,7 @@ mkDerivation { memory mtl network-uri + openapi3 pretty-show process QuickCheck From 2ef11e6257222b2152b1f6001301508606077fa5 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 17 Dec 2025 17:36:37 +0100 Subject: [PATCH 14/18] Add display certs as representing strings Will be used for logging. --- libs/extended/default.nix | 12 +++++ libs/extended/extended.cabal | 9 ++++ libs/extended/src/Data/X509/Extended.hs | 53 +++++++++++++++++++ .../test/Test/Data/X509/ExtendedSpec.hs | 36 +++++++++++++ libs/extended/test/data/sven-test.pem | 3 ++ libs/extended/test/data/test-cert.pem | 4 ++ 6 files changed, 117 insertions(+) create mode 100644 libs/extended/src/Data/X509/Extended.hs create mode 100644 libs/extended/test/Test/Data/X509/ExtendedSpec.hs create mode 100644 libs/extended/test/data/sven-test.pem create mode 100644 libs/extended/test/data/test-cert.pem diff --git a/libs/extended/default.nix b/libs/extended/default.nix index 4090a02a77..3ec398e8d1 100644 --- a/libs/extended/default.nix +++ b/libs/extended/default.nix @@ -5,11 +5,15 @@ { mkDerivation , aeson , amqp +, asn1-types , base , bytestring , cassandra-util , containers +, crypton , crypton-connection +, crypton-pem +, crypton-x509 , crypton-x509-store , data-default , errors @@ -24,6 +28,7 @@ , http-types , imports , lib +, memory , metrics-wai , monad-control , prometheus-client @@ -52,11 +57,14 @@ mkDerivation { libraryHaskellDepends = [ aeson amqp + asn1-types base bytestring cassandra-util containers + crypton crypton-connection + crypton-x509 crypton-x509-store data-default errors @@ -67,6 +75,7 @@ mkDerivation { http-client-tls http-types imports + memory metrics-wai monad-control prometheus-client @@ -89,6 +98,9 @@ mkDerivation { testHaskellDepends = [ aeson base + bytestring + crypton-pem + crypton-x509 hspec imports string-conversions diff --git a/libs/extended/extended.cabal b/libs/extended/extended.cabal index 3828324caa..980338c38a 100644 --- a/libs/extended/extended.cabal +++ b/libs/extended/extended.cabal @@ -28,6 +28,7 @@ library -- cabal-fmt: expand src exposed-modules: Data.Time.Clock.DiffTime + Data.X509.Extended Hasql.Pool.Extended Network.AMQP.Extended Network.RabbitMqAdmin @@ -88,11 +89,14 @@ library build-depends: aeson , amqp + , asn1-types , base , bytestring , cassandra-util , containers + , crypton , crypton-connection + , crypton-x509 , crypton-x509-store , data-default , errors @@ -103,6 +107,7 @@ library , http-client-tls , http-types , imports + , memory , metrics-wai , monad-control , prometheus-client @@ -129,6 +134,7 @@ test-suite extended-tests main-is: Spec.hs other-modules: Paths_extended + Test.Data.X509.ExtendedSpec Test.System.Logger.ExtendedSpec hs-source-dirs: test @@ -186,6 +192,9 @@ test-suite extended-tests build-depends: aeson , base + , bytestring + , crypton-pem + , crypton-x509 , extended , hspec , imports diff --git a/libs/extended/src/Data/X509/Extended.hs b/libs/extended/src/Data/X509/Extended.hs new file mode 100644 index 0000000000..33209a8375 --- /dev/null +++ b/libs/extended/src/Data/X509/Extended.hs @@ -0,0 +1,53 @@ +module Data.X509.Extended (certToString) where + +import Crypto.Hash +import Data.ASN1.OID +import Data.ASN1.Types +import Data.ByteArray.Encoding qualified as BAE +import Data.Map qualified as Map +import Data.Text qualified as T +import Data.Text.Encoding qualified as T +import Data.X509 +import Imports + +certToString :: SignedCertificate -> String +certToString signedCert = + let cert = getCertificate signedCert + issuer = dnToString $ certIssuerDN cert + subject = dnToString $ certSubjectDN cert + der = encodeSignedObject signedCert + fingerprint :: ByteString = BAE.convertToBase BAE.Base16 (hash der :: Digest SHA256) + -- Split into pairs and join with ':' + fingerprintStr = + let hex = (T.decodeUtf8 fingerprint) + pairs = T.unpack <$> T.chunksOf 2 hex + in map toUpper (intercalate ":" pairs) + in mconcat . intersperse "; " $ + [ "Issuer: " <> issuer, + "Subject: " <> subject, + "SHA256 Fingerprint: " <> fingerprintStr + ] + +dnToString :: DistinguishedName -> String +dnToString (getDistinguishedElements -> es) = + let a :: [String] = mapMaybe distinguishedElementString es + in mconcat $ intersperse "," a + where + distinguishedElementString :: (OID, ASN1CharacterString) -> Maybe String + distinguishedElementString (oid, aSN1CharacterString) = do + (_element, desc) <- Map.lookup oid dnElementMap + val <- asn1CharacterToString aSN1CharacterString + pure $ desc <> "=" <> val + + dnElementMap :: Map OID (DnElement, String) + dnElementMap = + Map.fromList + [ (mkEntry DnCommonName "CN"), + (mkEntry DnCountry "Country"), + (mkEntry DnOrganization "O"), + (mkEntry DnOrganizationUnit "OU"), + (mkEntry DnEmailAddress "Email Address") + ] + where + mkEntry :: DnElement -> String -> (OID, (DnElement, String)) + mkEntry e s = (getObjectID e, (e, s)) diff --git a/libs/extended/test/Test/Data/X509/ExtendedSpec.hs b/libs/extended/test/Test/Data/X509/ExtendedSpec.hs new file mode 100644 index 0000000000..6f4ec0fb05 --- /dev/null +++ b/libs/extended/test/Test/Data/X509/ExtendedSpec.hs @@ -0,0 +1,36 @@ +module Test.Data.X509.ExtendedSpec where + +import Data.ByteString qualified as BS +import Data.PEM +import Data.String.Conversions +import Data.X509 +import Data.X509.Extended +import Imports +import Test.Hspec + +spec :: Spec +spec = + describe "Data.X509.Extended" $ do + describe "certToString" $ do + it "should render a representing string of a certificate from stars' Keyloak" $ do + let pemFilePath = "test/data/" <> "sven-test.pem" + expected = "Issuer: CN=sven-test; Subject: CN=sven-test; SHA256 Fingerprint: 84:73:C5:D1:5A:36:7B:E7:00:3F:C5:1B:F6:84:90:5B:21:77:DA:22:FC:3D:8B:94:A2:97:0D:C1:8F:26:F7:6B" + checkDecodingWithPEMFile pemFilePath expected + + it "should render a representing string of a certificate from unit test data (saml2-web-sso)" $ do + let pemFilePath = "test/data/" <> "test-cert.pem" + expected = "Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA256 Fingerprint: A5:0B:76:1A:A3:11:8E:78:CF:2C:75:95:6B:6A:59:D1:85:4E:EA:DE:20:7C:C4:AF:48:B7:7F:A7:90:48:33:DB" + checkDecodingWithPEMFile pemFilePath expected + +checkDecodingWithPEMFile :: FilePath -> String -> IO () +checkDecodingWithPEMFile pemFilePath expected = do + -- sanity check if the file even exists + exists <- doesFileExist pemFilePath + exists `shouldBe` True + + file <- BS.readFile pemFilePath + let decoded :: SignedCertificate = either error id $ do + pemBS <- pemContent . fromMaybe (error "Empty PEM list") . listToMaybe <$> pemParseBS file + decodeSignedCertificate pemBS + + certToString decoded `shouldBe` expected diff --git a/libs/extended/test/data/sven-test.pem b/libs/extended/test/data/sven-test.pem new file mode 100644 index 0000000000..cabff31960 --- /dev/null +++ b/libs/extended/test/data/sven-test.pem @@ -0,0 +1,3 @@ +-----BEGIN CERTIFICATE----- +MIICoTCCAYkCBgGaxY9gbjANBgkqhkiG9w0BAQsFADAUMRIwEAYDVQQDDAlzdmVuLXRlc3QwHhcNMjUxMTI3MTM0MzE5WhcNMzUxMTI3MTM0NDU5WjAUMRIwEAYDVQQDDAlzdmVuLXRlc3QwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCVkM30EqGkdEIjF6ZDzS7mEMtsHmEXXT6bzkrOddzz8fKmle2tb6Rn7uI/pkfbTdMXKlaPQohDSed5907xn3v8TAHc/FA9lf3Mo+o7pl/aQlEHm9RedNnm1DRiuH/zZx60e6ctVFqYu4sTwJxGnM81ojrrQRXU+u4FEnAh0p1aUvXG+3iCz0NHRErYxzYLvnLSziQg70yO1qlxy/K+M04gNKe7ZGxeZbu56ysllWUhrysvGg4/rp3iu4OTb8N5U+iH0ZSDcrUUeOJP2sSNRVYr4cgkcLDI+npr8WmqfqWgc+yRQ9iPAuNYi+nE9aB4ZXf7SyAGs5gmJtT6Cm4hoUa5AgMBAAEwDQYJKoZIhvcNAQELBQADggEBAGfKx/PeiFgLStaPlN+9n7+hW/iy50qhLDtEPuXA3m1XnBLO8sB7ebyJVL1QvO33A3MQdJi1E8R1uQd7ompuQ0+62vAe/bX/EZEzbwMHyM26F+r18BJKf3Dla6ot1CKnVIJuocc9qbuhkeTaeCkFF1HyvnlN/i/oMa+KwK0OP6GRkFG/m53biq9p+jbdKK2/fVvDklt5Vma6sp6KG1HhFJQMaeL/hGGelzS84qL7H9+eSBu5krCZBLfx4L88poDiY3JudM0tS6Kzj8IFDNspXRxHy8sacWn/8ulMVXGEQhw3+u5jN/yCxkxogFg7bE9uR5JhbkZ4J7X6J9uEaU/Sobo= +-----END CERTIFICATE----- diff --git a/libs/extended/test/data/test-cert.pem b/libs/extended/test/data/test-cert.pem new file mode 100644 index 0000000000..ff32fa8028 --- /dev/null +++ b/libs/extended/test/data/test-cert.pem @@ -0,0 +1,4 @@ +-----BEGIN CERTIFICATE----- +MIIDBTCCAe2gAwIBAgIQev76BWqjWZxChmKkGqoAfDANBgkqhkiG9w0BAQsFADAtMSswKQYDVQQDEyJhY2NvdW50cy5hY2Nlc3Njb250cm9sLndpbmRvd3MubmV0MB4XDTE4MDIxODAwMDAwMFoXDTIwMDIxOTAwMDAwMFowLTErMCkGA1UEAxMiYWNjb3VudHMuYWNjZXNzY29udHJvbC53aW5kb3dzLm5ldDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMgmGiRfLh6Fdi99XI2VA3XKHStWNRLEy5Aw/gxFxchnh2kPdk/bejFOs2swcx7yUWqxujjCNRsLBcWfaKUlTnrkY7i9x9noZlMrijgJy/Lk+HH5HX24PQCDf+twjnHHxZ9G6/8VLM2e5ZBeZm+t7M3vhuumEHG3UwloLF6cUeuPdW+exnOB1U1fHBIFOG8ns4SSIoq6zw5rdt0CSI6+l7b1DEjVvPLtJF+zyjlJ1Qp7NgBvAwdiPiRMU4l8IRVbuSVKoKYJoyJ4L3eXsjczoBSTJ6VjV2mygz96DC70MY3avccFrk7tCEC6ZlMRBfY1XPLyldT7tsR3EuzjecSa1M8CAwEAAaMhMB8wHQYDVR0OBBYEFIks1srixjpSLXeiR8zES5cTY6fBMA0GCSqGSIb3DQEBCwUAA4IBAQCKthfK4C31DMuDyQZVS3F7+4Evld3hjiwqu2uGDK+qFZas/D/eDunxsFpiwqC01RIMFFN8yvmMjHphLHiBHWxcBTS+tm7AhmAvWMdxO5lzJLS+UWAyPF5ICROe8Mu9iNJiO5JlCo0Wpui9RbB1C81Xhax1gWHK245ESL6k7YWvyMYWrGqr1NuQcNS0B/AIT1Nsj1WY7efMJQOmnMHkPUTWryVZlthijYyd7P2Gz6rY5a81DAFqhDNJl2pGIAE6HWtSzeUEh3jCsHEkoglKfm4VrGJEuXcALmfCMbdfTvtu4rlsaP2hQad+MG/KJFlenoTK34EMHeBPDCpqNDz8UVNk +-----END CERTIFICATE----- + From cf6c4278c7a12ff3e21be040af37fe3d63f58697 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 17 Dec 2025 17:53:05 +0100 Subject: [PATCH 15/18] Log details of created IdP --- services/spar/default.nix | 2 ++ services/spar/src/Spar/API.hs | 14 ++++++++++++++ 2 files changed, 16 insertions(+) diff --git a/services/spar/default.nix b/services/spar/default.nix index 4b4b7bf58b..6e2a8094a5 100644 --- a/services/spar/default.nix +++ b/services/spar/default.nix @@ -37,6 +37,7 @@ , lens , lens-aeson , lib +, memory , metrics-wai , MonadRandom , mtl @@ -108,6 +109,7 @@ mkDerivation { http-types imports lens + memory metrics-wai mtl network-uri diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index e1c4b075ff..6103cd8245 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -62,6 +62,8 @@ import Data.Text.Encoding.Error import qualified Data.Text.Lazy as T import Data.Text.Lazy.Encoding import Data.Time +import qualified Data.UUID as UUID +import Data.X509.Extended import Imports import Network.Wai (Request, requestHeaders) import Network.Wai.Utilities.Request @@ -107,6 +109,7 @@ import qualified Spar.Sem.ScimUserTimesStore as ScimUserTimesStore import Spar.Sem.VerdictFormatStore (VerdictFormatStore) import qualified Spar.Sem.VerdictFormatStore as VerdictFormatStore import System.Logger (Msg) +import qualified System.Logger as Log import qualified URI.ByteString as URI import Wire.API.Routes.Internal.Brig (IdpChangedNotification (IdPCreated, IdPDeleted, IdPUpdated)) import Wire.API.Routes.Internal.Spar @@ -214,6 +217,7 @@ apiSSO opts = apiIDP :: ( Member Random r, Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member ScimTokenStore r, @@ -628,6 +632,7 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co -- (internal) https://wearezeta.atlassian.net/wiki/spaces/PAD/pages/1107001440/2024-03-27+scim+user+provisioning+and+saml2+sso+associating+scim+peers+and+saml2+idps idpCreate :: ( Member Random r, + Member (Logger (Msg -> Msg)) r, Member (Logger String) r, Member GalleyAccess r, Member BrigAccess r, @@ -656,6 +661,14 @@ idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmet forM_ mReplaces $ \replaces -> IdPConfigStore.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId)) BrigAccess.sendSAMLIdPChangedEmail $ IdPCreated idp + Logger.info $ + Log.msg ("IdP created" :: String) + . Log.field "team" (idToText tid) + . Log.field "idpId" (idp ^. SAML.idpId . to SAML.fromIdPId . to UUID.toString) + . Log.field "issuer" (idp ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer . to URI.serializeURIRef') + . Log.field "replaces" (maybe "None" (UUID.toString . SAML.fromIdPId) mReplaces) + . Log.field "domain" (idp ^. SAML.idpExtraInfo . domain . to (fromMaybe "None")) + . Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList)) pure idp where -- Ensure that the domain is not in use by an existing IDP @@ -681,6 +694,7 @@ filterMultiIngressZHost _ _ = Nothing idpCreateV7 :: ( Member Random r, Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member ScimTokenStore r, From 350a104a97d4b21837f8016efe445ddce5a3e4d3 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 17 Dec 2025 18:12:18 +0100 Subject: [PATCH 16/18] Log details of deleted IdPs --- services/spar/default.nix | 2 -- services/spar/src/Spar/API.hs | 22 ++++++++++++++-------- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/services/spar/default.nix b/services/spar/default.nix index 6e2a8094a5..4b4b7bf58b 100644 --- a/services/spar/default.nix +++ b/services/spar/default.nix @@ -37,7 +37,6 @@ , lens , lens-aeson , lib -, memory , metrics-wai , MonadRandom , mtl @@ -109,7 +108,6 @@ mkDerivation { http-types imports lens - memory metrics-wai mtl network-uri diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 6103cd8245..b9458cc745 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -548,6 +548,7 @@ idpDelete :: forall r. ( Member Random r, Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member ScimTokenStore r, @@ -579,6 +580,7 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co IdPConfigStore.deleteConfig idp IdPRawMetadataStore.delete idpid BrigAccess.sendSAMLIdPChangedEmail $ IdPDeleted idp + logIdPAction "IdP deleted" idp Nothing pure NoContent where assertEmptyOrPurge :: TeamId -> Cas.Page (SAML.UserRef, UserId) -> Sem r () @@ -661,14 +663,7 @@ idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmet forM_ mReplaces $ \replaces -> IdPConfigStore.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId)) BrigAccess.sendSAMLIdPChangedEmail $ IdPCreated idp - Logger.info $ - Log.msg ("IdP created" :: String) - . Log.field "team" (idToText tid) - . Log.field "idpId" (idp ^. SAML.idpId . to SAML.fromIdPId . to UUID.toString) - . Log.field "issuer" (idp ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer . to URI.serializeURIRef') - . Log.field "replaces" (maybe "None" (UUID.toString . SAML.fromIdPId) mReplaces) - . Log.field "domain" (idp ^. SAML.idpExtraInfo . domain . to (fromMaybe "None")) - . Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList)) + logIdPAction "IdP created" idp mReplaces pure idp where -- Ensure that the domain is not in use by an existing IDP @@ -686,6 +681,17 @@ idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmet when (zHost `elem` domains) $ throwSparSem SparIdPDomainInUse +logIdPAction :: (Member (Logger (Msg -> Msg)) r) => String -> IdP -> Maybe SAML.IdPId -> Sem r () +logIdPAction msg idp mReplaces = + Logger.info $ + Log.msg (msg) + . Log.field "team" (idp ^. SAML.idpExtraInfo . team . to idToText) + . Log.field "idpId" (idp ^. SAML.idpId . to SAML.fromIdPId . to UUID.toString) + . Log.field "issuer" (idp ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer . to URI.serializeURIRef') + . Log.field "replaces" (maybe "None" (UUID.toString . SAML.fromIdPId) mReplaces) + . Log.field "domain" (idp ^. SAML.idpExtraInfo . domain . to (fromMaybe "None")) + . Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList)) + -- | Only return a ZHost when multi-ingress is configured and the host value is a configured domain filterMultiIngressZHost :: Either SAML.MultiIngressDomainConfig (Map Domain SAML.MultiIngressDomainConfig) -> Maybe ZHostValue -> Maybe ZHostValue filterMultiIngressZHost (Right domainMap) (Just zHost) | (Domain zHost) `Map.member` domainMap = Just zHost From 9f8f39a2127f34b15aa63e80ab469380c1347650 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 2 Jan 2026 17:44:20 +0100 Subject: [PATCH 17/18] Log ceritificate differences on IdP update --- services/spar/src/Spar/API.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index b9458cc745..3c1f31a048 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -803,6 +803,7 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces idpDomain idHandle = wit -- 'IdPMetadataInfo' directly where convenient. idpUpdate :: ( Member Random r, + Member (Logger (Msg -> Msg)) r, Member (Logger String) r, Member GalleyAccess r, Member BrigAccess r, @@ -823,6 +824,7 @@ idpUpdate samlConfig zusr uncheckedMbHost (IdPMetadataValue raw xml) = idpUpdateXML :: ( Member Random r, + Member (Logger (Msg -> Msg)) r, Member (Logger String) r, Member GalleyAccess r, Member BrigAccess r, @@ -857,6 +859,15 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML WireIdPAPIV2 -> Just teamid forM_ (idp'' ^. SAML.idpExtraInfo . oldIssuers) (flip IdPConfigStore.deleteIssuer mbteamid) BrigAccess.sendSAMLIdPChangedEmail $ IdPUpdated previousIdP idp'' + let (removedCerts, newCerts) = compareNonEmpty (previousIdP ^. SAML.idpMetadata . SAML.edCertAuthnResponse) (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse) + Logger.info $ + Log.msg ("IdP updated" :: String) + . Log.field "team" (idp ^. SAML.idpExtraInfo . team . to idToText) + . Log.field "idpId" (idp ^. SAML.idpId . to SAML.fromIdPId . to UUID.toString) + . Log.field "issuer" (idp ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer . to URI.serializeURIRef') + . Log.field "domain" (idp ^. SAML.idpExtraInfo . domain . to (fromMaybe "None")) + . Log.field "new-certificates" ((intercalate ";; " . map certToString . toList) removedCerts) + . Log.field "removed-certificates" ((intercalate ";; " . map certToString . toList) newCerts) pure idp'' where -- Ensure that the domain is not in use by an existing IDP @@ -878,6 +889,14 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML when otherIdpsOnSameDomain $ throwSparSem SparIdPDomainInUse + compareNonEmpty :: (Eq a) => NonEmpty a -> NonEmpty a -> ([a], [a]) + compareNonEmpty xs ys = + let l = nub . toList $ xs + r = nub . toList $ ys + onlyL = l \\ r + onlyR = r \\ l + in (onlyL, onlyR) + -- | Check that: idp id is valid; calling user is admin in that idp's home team; team id in -- new metainfo doesn't change; new issuer (if changed) is not in use anywhere else (except as -- an earlier IdP under the same ID); request uri is https. Keep track of old issuer in extra From ead8b75a927c79d16e93b865397361aaf7981b6a Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Jan 2026 16:06:52 +0100 Subject: [PATCH 18/18] Cleanup --- libs/wire-api/src/Wire/API/User/IdentityProvider.hs | 2 -- libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/IdP.hs | 1 - libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs | 1 - 3 files changed, 4 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index 395e194f1e..1b15d5bd3f 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -59,10 +59,8 @@ import Network.HTTP.Media ((//)) import SAML2.WebSSO (IdPConfig) import SAML2.WebSSO qualified as SAML import SAML2.WebSSO.Test.Arbitrary () -import SAML2.WebSSO.Types.TH (deriveJSONOptions) import Servant.API as Servant hiding (MkLink, URI (..)) import Wire.API.Routes.Public (ZHostValue) -import Wire.API.User.Orphans (samlSchemaOptions) import Wire.API.Util.Aeson (defaultOptsDropChar) import Wire.Arbitrary (Arbitrary, GenericUniform (GenericUniform)) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/IdP.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/IdP.hs index 6e0400d3a5..564a09586d 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/IdP.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/IdP.hs @@ -7,7 +7,6 @@ import Imports import SAML2.WebSSO.Types import Text.XML.DSig import URI.ByteString -import Wire.API.Routes.Version import Wire.API.User.IdentityProvider testObject_IdP_1 :: IdP diff --git a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs index aa7fc477da..7204b12ccf 100644 --- a/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/SAMLEmailSubsystem.hs @@ -4,7 +4,6 @@ module Wire.SAMLEmailSubsystem where import Polysemy import Wire.API.Routes.Internal.Brig (IdpChangedNotification) -import Wire.API.User.IdentityProvider (IdP) data SAMLEmailSubsystem m a where SendSAMLIdPChanged :: IdpChangedNotification -> SAMLEmailSubsystem m ()