From 156d959f3b4473148d325cf9b613c7cd4b036d1b Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Jan 2026 17:19:42 +0100 Subject: [PATCH 01/38] Log SAML IdP changes Log all changes to SAML IdPs that are triggered via the IdP REST API in Spar. --- 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 ++ services/spar/src/Spar/API.hs | 51 ++++++++++++++++-- 7 files changed, 165 insertions(+), 3 deletions(-) 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 4090a02a779..3ec398e8d14 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 3828324caa2..980338c38a7 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 00000000000..31f5738dc1d --- /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 dess :: [String] = mapMaybe distinguishedElementString es + in mconcat $ intersperse "," dess + 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 00000000000..46a0914c834 --- /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 representative 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 representative 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 00000000000..cabff319600 --- /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 00000000000..ff32fa80286 --- /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----- + diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index f5f9de0d1e9..81a55666b89 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.Spar import Wire.API.Routes.Named @@ -213,6 +216,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, @@ -543,6 +547,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, @@ -573,6 +578,7 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co do IdPConfigStore.deleteConfig idp IdPRawMetadataStore.delete idpid + logIdPAction "IdP deleted" idp Nothing pure NoContent where assertEmptyOrPurge :: TeamId -> Cas.Page (SAML.UserRef, UserId) -> Sem r () @@ -626,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, @@ -653,6 +660,7 @@ idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmet IdPConfigStore.insertConfig idp forM_ mReplaces $ \replaces -> IdPConfigStore.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId)) + logIdPAction "IdP created" idp mReplaces pure idp where -- Ensure that the domain is not in use by an existing IDP @@ -670,6 +678,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 @@ -678,6 +697,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, @@ -780,6 +800,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, @@ -800,6 +821,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, @@ -815,7 +837,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 @@ -833,6 +855,7 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML WireIdPAPIV1 -> Nothing WireIdPAPIV2 -> Just teamid forM_ (idp'' ^. SAML.idpExtraInfo . oldIssuers) (flip IdPConfigStore.deleteIssuer mbteamid) + logIdPUpdate idp'' previousIdP pure idp'' where -- Ensure that the domain is not in use by an existing IDP @@ -854,6 +877,28 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML when otherIdpsOnSameDomain $ throwSparSem SparIdPDomainInUse + logIdPUpdate idp previousIdP = + let (removedCerts, newCerts) = + compareNonEmpty + (previousIdP ^. SAML.idpMetadata . SAML.edCertAuthnResponse) + (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse) + in 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) + + 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 @@ -871,7 +916,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 @@ -904,7 +949,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 7b21ddd061776d836ce9731a0e71c35bd92b444d Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Jan 2026 18:23:15 +0100 Subject: [PATCH 02/38] Unify log functions --- services/spar/src/Spar/API.hs | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 81a55666b89..0344e7524c3 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -578,7 +578,10 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co do IdPConfigStore.deleteConfig idp IdPRawMetadataStore.delete idpid - logIdPAction "IdP deleted" idp Nothing + logIdPAction + "IdP deleted" + idp + (Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList))) pure NoContent where assertEmptyOrPurge :: TeamId -> Cas.Page (SAML.UserRef, UserId) -> Sem r () @@ -660,7 +663,12 @@ idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmet IdPConfigStore.insertConfig idp forM_ mReplaces $ \replaces -> IdPConfigStore.setReplacedBy (Replaced replaces) (Replacing (idp ^. SAML.idpId)) - logIdPAction "IdP created" idp mReplaces + logIdPAction + "IdP created" + idp + ( Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList)) + . Log.field "replaces" (maybe "None" (UUID.toString . SAML.fromIdPId) mReplaces) + ) pure idp where -- Ensure that the domain is not in use by an existing IDP @@ -678,16 +686,15 @@ 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 = +logIdPAction :: (Member (Logger (Msg -> Msg)) r) => String -> IdP -> (Msg -> Msg) -> Sem r () +logIdPAction msg idp additionalFields = 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)) + . additionalFields -- | 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 @@ -882,14 +889,12 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML compareNonEmpty (previousIdP ^. SAML.idpMetadata . SAML.edCertAuthnResponse) (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse) - in 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) + in logIdPAction + "IdP updated" + idp + ( Log.field "new-certificates" ((intercalate ";; " . map certToString . toList) removedCerts) + . Log.field "removed-certificates" ((intercalate ";; " . map certToString . toList) newCerts) + ) compareNonEmpty :: (Eq a) => NonEmpty a -> NonEmpty a -> ([a], [a]) compareNonEmpty xs ys = From c5495097d93851f98dedc744c890be27f0d7adaf Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Jan 2026 18:31:57 +0100 Subject: [PATCH 03/38] Use shorter SHA1 fingerprint --- libs/extended/src/Data/X509/Extended.hs | 4 ++-- libs/extended/test/Test/Data/X509/ExtendedSpec.hs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/libs/extended/src/Data/X509/Extended.hs b/libs/extended/src/Data/X509/Extended.hs index 31f5738dc1d..964c2ee3028 100644 --- a/libs/extended/src/Data/X509/Extended.hs +++ b/libs/extended/src/Data/X509/Extended.hs @@ -16,7 +16,7 @@ certToString signedCert = issuer = dnToString $ certIssuerDN cert subject = dnToString $ certSubjectDN cert der = encodeSignedObject signedCert - fingerprint :: ByteString = BAE.convertToBase BAE.Base16 (hash der :: Digest SHA256) + fingerprint :: ByteString = BAE.convertToBase BAE.Base16 (hash der :: Digest SHA1) -- Split into pairs and join with ':' fingerprintStr = let hex = (T.decodeUtf8 fingerprint) @@ -25,7 +25,7 @@ certToString signedCert = in mconcat . intersperse "; " $ [ "Issuer: " <> issuer, "Subject: " <> subject, - "SHA256 Fingerprint: " <> fingerprintStr + "SHA1 Fingerprint: " <> fingerprintStr ] dnToString :: DistinguishedName -> String diff --git a/libs/extended/test/Test/Data/X509/ExtendedSpec.hs b/libs/extended/test/Test/Data/X509/ExtendedSpec.hs index 46a0914c834..a5af755839e 100644 --- a/libs/extended/test/Test/Data/X509/ExtendedSpec.hs +++ b/libs/extended/test/Test/Data/X509/ExtendedSpec.hs @@ -14,12 +14,12 @@ spec = describe "certToString" $ do it "should render a representative 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" + expected = "Issuer: CN=sven-test; Subject: CN=sven-test; SHA1 Fingerprint: F4:A2:73:D7:B7:2E:EA:66:E1:CB:81:E9:58:BC:1A:E9:CF:3C:95:C4" checkDecodingWithPEMFile pemFilePath expected it "should render a representative 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" + expected = "Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" checkDecodingWithPEMFile pemFilePath expected checkDecodingWithPEMFile :: FilePath -> String -> IO () From 3198f47d6b11f21488f22a4a8855a2c97a23c4cd Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Jan 2026 19:02:03 +0100 Subject: [PATCH 04/38] Add changelog --- changelog.d/2-features/log-saml-idp-changes | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/2-features/log-saml-idp-changes diff --git a/changelog.d/2-features/log-saml-idp-changes b/changelog.d/2-features/log-saml-idp-changes new file mode 100644 index 00000000000..130a4281a1d --- /dev/null +++ b/changelog.d/2-features/log-saml-idp-changes @@ -0,0 +1 @@ +Log changes to IdP configurations made via the IdP REST API to syslog. From a921f8aea1d5c07f26be307620e3165e96469d4b Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Jan 2026 19:21:18 +0100 Subject: [PATCH 05/38] Log the initiating user as well I.e. "Wo did it?" --- libs/wire-api/src/Wire/API/Routes/Public/Spar.hs | 4 ++-- services/spar/src/Spar/API.hs | 16 +++++++++++----- 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs index 642b9dc5225..5390149a7c5 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Spar.hs @@ -135,8 +135,8 @@ type APIIDP = Named "idp-get" (ZOptUser :> IdpGet) :<|> Named "idp-get-raw" (ZOptUser :> IdpGetRaw) :<|> Named "idp-get-all" (ZOptUser :> IdpGetAll) - :<|> Named "idp-create@v7" (Until 'V8 :> AuthProtect "TeamAdmin" :> IdpCreate) -- (change is semantic, see handler) - :<|> Named "idp-create" (From 'V8 :> AuthProtect "TeamAdmin" :> ZHostOpt :> IdpCreate) + :<|> Named "idp-create@v7" (Until 'V8 :> AuthProtect "TeamAdmin" :> ZOptUser :> IdpCreate) -- (change is semantic, see handler) + :<|> Named "idp-create" (From 'V8 :> AuthProtect "TeamAdmin" :> ZOptUser :> ZHostOpt :> IdpCreate) :<|> Named "idp-update" (ZOptUser :> ZHostOpt :> IdpUpdate) :<|> Named "idp-delete" (ZOptUser :> IdpDelete) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 0344e7524c3..dc9f9f3316d 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -581,6 +581,7 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co logIdPAction "IdP deleted" idp + mbzusr (Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList))) pure NoContent where @@ -646,13 +647,14 @@ idpCreate :: ) => SAML.Config -> TeamId -> + Maybe UserId -> Maybe ZHostValue -> IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Maybe (Range 1 32 Text) -> Sem r IdP -idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmeta) mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) mHandle = withDebugLog "idpCreateXML" (Just . show . (^. SAML.idpId)) $ do +idpCreate samlConfig tid zUser uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmeta) mReplaces (fromMaybe defWireIdPAPIVersion -> apiversion) mHandle = withDebugLog "idpCreateXML" (Just . show . (^. SAML.idpId)) $ do let mbHost = filterMultiIngressZHost (samlConfig._cfgDomainConfigs) uncheckedMbHost GalleyAccess.assertSSOEnabled tid guardMultiIngressDuplicateDomain tid mbHost @@ -666,6 +668,7 @@ idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmet logIdPAction "IdP created" idp + zUser ( Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList)) . Log.field "replaces" (maybe "None" (UUID.toString . SAML.fromIdPId) mReplaces) ) @@ -686,14 +689,15 @@ idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmet when (zHost `elem` domains) $ throwSparSem SparIdPDomainInUse -logIdPAction :: (Member (Logger (Msg -> Msg)) r) => String -> IdP -> (Msg -> Msg) -> Sem r () -logIdPAction msg idp additionalFields = +logIdPAction :: (Member (Logger (Msg -> Msg)) r) => String -> IdP -> Maybe UserId -> (Msg -> Msg) -> Sem r () +logIdPAction msg idp zUser additionalFields = 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 "domain" (idp ^. SAML.idpExtraInfo . domain . to (fromMaybe "None")) + . Log.field "user" (fromMaybe "None" (idToText <$> zUser)) . additionalFields -- | Only return a ZHost when multi-ingress is configured and the host value is a configured domain @@ -714,14 +718,15 @@ idpCreateV7 :: ) => SAML.Config -> TeamId -> + Maybe UserId -> IdPMetadataInfo -> Maybe SAML.IdPId -> Maybe WireIdPAPIVersion -> Maybe (Range 1 32 Text) -> Sem r IdP -idpCreateV7 samlConfig tid idpmeta mReplaces mApiversion mHandle = do +idpCreateV7 samlConfig tid zUser idpmeta mReplaces mApiversion mHandle = do assertNoScimOrNoIdP - idpCreate samlConfig tid Nothing idpmeta mReplaces mApiversion mHandle + idpCreate samlConfig tid zUser Nothing idpmeta mReplaces mApiversion mHandle where -- In teams with a scim access token, only one IdP is allowed. The reason is that scim user -- data contains no information about the idp issuer, only the user name, so no valid saml @@ -892,6 +897,7 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML in logIdPAction "IdP updated" idp + zusr ( Log.field "new-certificates" ((intercalate ";; " . map certToString . toList) removedCerts) . Log.field "removed-certificates" ((intercalate ";; " . map certToString . toList) newCerts) ) From 1ad659e8ced101f669f25dcc222edcf0d36f829a Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 7 Jan 2026 16:12:59 +0100 Subject: [PATCH 06/38] Use better function --- services/spar/src/Spar/API.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index dc9f9f3316d..68fc7c02c75 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -697,7 +697,7 @@ logIdPAction msg idp zUser additionalFields = . 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 "user" (fromMaybe "None" (idToText <$> zUser)) + . Log.field "user" (maybe "None" idToText zUser) . additionalFields -- | Only return a ZHost when multi-ingress is configured and the host value is a configured domain From 08acaaa81fbead5a08f28e75d93921f76e709748 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 7 Jan 2026 17:58:34 +0100 Subject: [PATCH 07/38] Unify logging effects One is enough - The more general one. --- services/spar/src/Spar/API.hs | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 68fc7c02c75..e3e0a61cf95 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -243,7 +243,7 @@ apiINTERNAL :: Member (Error SparError) r, Member SAMLUserStore r, Member ScimUserTimesStore r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member Random r, Member GalleyAccess r, Member BrigAccess r @@ -476,7 +476,7 @@ authContext e = authHandler e :. EmptyContext idpGet :: ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -509,7 +509,7 @@ idpGetRaw zusr idpid = do idpGetAll :: ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -523,7 +523,7 @@ idpGetAll zusr = withDebugLog "idpGetAll" (const Nothing) $ do idpGetAllByTeamId :: ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -637,7 +637,6 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co idpCreate :: ( Member Random r, Member (Logger (Msg -> Msg)) r, - Member (Logger String) r, Member GalleyAccess r, Member BrigAccess r, Member ScimTokenStore r, @@ -707,7 +706,6 @@ filterMultiIngressZHost _ _ = Nothing idpCreateV7 :: ( Member Random r, - Member (Logger String) r, Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, @@ -768,7 +766,7 @@ validateNewIdP :: forall m r. (HasCallStack, m ~ Sem r) => ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member IdPConfigStore r, Member (Error SparError) r ) => @@ -792,8 +790,8 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces idpDomain idHandle = wit mbIdp <- case apiversion of WireIdPAPIV1 -> IdPConfigStore.getIdPByIssuerV1Maybe (_idpMetadata ^. SAML.edIssuer) WireIdPAPIV2 -> IdPConfigStore.getIdPByIssuerV2Maybe (_idpMetadata ^. SAML.edIssuer) teamId - Logger.log Logger.Debug $ show (apiversion, _idpMetadata, teamId, mReplaces) - Logger.log Logger.Debug $ show (_idpId, oldIssuersList, mbIdp) + Logger.log Logger.Debug . Log.msg $ show (apiversion, _idpMetadata, teamId, mReplaces) + Logger.log Logger.Debug . Log.msg $ show (_idpId, oldIssuersList, mbIdp) let failWithIdPClash :: m () failWithIdPClash = throwSparSem . SparNewIdPAlreadyInUse $ case apiversion of @@ -918,7 +916,7 @@ validateIdPUpdate :: forall m r. (HasCallStack, m ~ Sem r) => ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -975,12 +973,12 @@ validateIdPUpdate zusr _idpMetadata _idpId = withDebugLog "validateIdPUpdate" (J . URI.serializeURIRef uri = _idpMetadata ^. SAML.edIssuer . SAML.fromIssuer -withDebugLog :: (Member (Logger String) r) => String -> (a -> Maybe String) -> Sem r a -> Sem r a +withDebugLog :: (Member (Logger (Msg -> Msg)) r) => String -> (a -> Maybe String) -> Sem r a -> Sem r a withDebugLog msg showval action = do - Logger.log Logger.Debug $ "entering " ++ msg + Logger.log Logger.Debug . Log.msg $ "entering " ++ msg val <- action let mshowedval = showval val - Logger.log Logger.Debug $ "leaving " ++ msg ++ mconcat [": " ++ fromJust mshowedval | isJust mshowedval] + Logger.log Logger.Debug . Log.msg $ "leaving " ++ msg ++ mconcat [": " ++ fromJust mshowedval | isJust mshowedval] pure val authorizeIdP :: From 3d01710ccd2c0f31fa3d5df09a1a8e4369b257bc Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Thu, 8 Jan 2026 09:07:45 +0100 Subject: [PATCH 08/38] Add lenses for IdPMetadataInfo Useful to tweak test data. --- libs/wire-api/src/Wire/API/User/IdentityProvider.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index b6ffbd71299..8d591ad7986 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -164,9 +164,14 @@ deriveJSON (defaultOptsDropChar '_') ''IdPList -- implement @{"uri": , "cert": }@. check both the certificate we get -- from the server against the pinned one and the metadata url in the metadata against the one -- we fetched the xml from, but it's unclear what the benefit would be.) -data IdPMetadataInfo = IdPMetadataValue Text SAML.IdPMetadata +data IdPMetadataInfo = IdPMetadataValue + { _rawIdpMetadataText :: Text, + _idpMetadataRecord :: SAML.IdPMetadata + } deriving (Eq, Show, Generic) +makeLenses ''IdPMetadataInfo + -- | We want to store the raw xml text from the registration request in the database for -- trouble shooting, but @SAML.XML@ only gives us access to the xml tree, not the raw text. -- 'RawXML' helps with that. From b254aa91496bbbaf207943453c9dc62040d4547a Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 11:38:43 +0100 Subject: [PATCH 09/38] Implement paging effects in in-memory SAMLUserStore --- services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs index 131ae266814..7c4f314ea23 100644 --- a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs +++ b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs @@ -23,7 +23,9 @@ module Spar.Sem.SAMLUserStore.Mem ) where +import Cassandra (Page (..), emptyPage) import Control.Lens (view) +import qualified Data.Bifunctor import Data.Id import qualified Data.Map as M import Imports @@ -49,8 +51,14 @@ samlUserStoreToMem = (runState @(Map UserRefOrd UserId) mempty .) $ Delete _uid ur -> modify $ M.delete $ UserRefOrd ur -- 'GetAllByIssuerPaginated' and 'NextPage' are workarounds, please also see docs at -- 'Spar.Sem.SAMLUserStore.Cassandra.getAllSAMLUsersByIssuerPaginated' - GetAllByIssuerPaginated _is -> error "not implemented as this has a dependency to Cassandra" - NextPage _ -> error "not implemented as this has a dependency to Cassandra" + -- + -- This mock only returns on `Page` for all results. + GetAllByIssuerPaginated is -> gets $ \userMap -> + let entries = + Data.Bifunctor.first unUserRefOrd + <$> M.assocs (M.filterWithKey (\ref _ -> eqIssuer is ref) userMap) + in emptyPage {result = entries} + NextPage _ -> pure emptyPage where eqIssuer :: SAML.Issuer -> UserRefOrd -> Bool eqIssuer is = (== is) . view uidTenant . unUserRefOrd From 3c5b2f5dfb8d10428b4d7a35da033ff0fcaf81a0 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 7 Jan 2026 18:30:29 +0100 Subject: [PATCH 10/38] WIP: IdPSpec --- services/spar/spar.cabal | 1 + services/spar/src/Spar/API.hs | 9 +- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 239 +++++++++++++++++++ 3 files changed, 248 insertions(+), 1 deletion(-) create mode 100644 services/spar/test/Test/Spar/Saml/IdPSpec.hs diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 6d26c0d0f07..b6175253cbf 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -562,6 +562,7 @@ test-suite spec Test.Spar.DataSpec Test.Spar.Intra.BrigSpec Test.Spar.Roundtrip.ByteString + Test.Spar.Saml.IdPSpec Test.Spar.Scim.UserSpec Test.Spar.ScimSpec Test.Spar.Sem.DefaultSsoCodeSpec diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index e3e0a61cf95..78564059a87 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -42,6 +42,14 @@ module Spar.API IdpGetAll, IdpCreate, IdpDelete, + + -- * published to enable testing + + -- FUTUREWORK: This module should be split into two: Servant handler + -- subtilities and the functions that do the actual work. + idpCreate, + idpCreateV7, + idpDelete, ) where @@ -546,7 +554,6 @@ idpGetAllByTeamId tid = do idpDelete :: forall r. ( Member Random r, - Member (Logger String) r, Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs new file mode 100644 index 00000000000..8e555018fd3 --- /dev/null +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -0,0 +1,239 @@ +module Test.Spar.Saml.IdPSpec where + +import Arbitrary () +import Control.Lens ((.~), (^.)) +import Data.Domain +import Data.Id (parseIdFromText) +import qualified Data.Map as Map +import Data.Range +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL +import Imports +import Polysemy +import qualified Polysemy.Error +import Polysemy.TinyLog +import SAML2.WebSSO +import qualified SAML2.WebSSO as SAML +import Spar.API (idpCreate, idpCreateV7, idpDelete) +import Spar.Error +import Spar.Sem.BrigAccess +import Spar.Sem.GalleyAccess +import Spar.Sem.IdPConfigStore +import Spar.Sem.IdPConfigStore.Mem +import Spar.Sem.IdPRawMetadataStore +import Spar.Sem.IdPRawMetadataStore.Mem +import Spar.Sem.SAMLUserStore +import Spar.Sem.SAMLUserStore.Mem +import Spar.Sem.ScimTokenStore +import Spar.Sem.ScimTokenStore.Mem +import System.Logger (Msg) +import System.Logger.Class (Level (..)) +import Test.Hspec +import Test.QuickCheck +import URI.ByteString (parseURI, strictURIParserOptions) +import URI.ByteString.QQ (uri) +import Wire.API.User (User (..)) +import Wire.API.User.IdentityProvider (IdPMetadataInfo, WireIdPAPIVersion (..), idpMetadataRecord) +import Wire.Sem.Logger.TinyLog (LogRecorder (..), newLogRecorder, recordLogs) +import Wire.Sem.Random +import Wire.Sem.Random.Null + +spec :: Spec +spec = describe "SAML IdP change logging" $ do + describe "idp-create" $ do + it "should log IdP creation" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" + zUser = Just <$> either error id $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" + samlConfig = + Config + { -- The log level only matters for log output, not production. + -- Thus, we could put anything here, it just needs to be a valid + -- value. + _cfgLogLevel = Trace, + _cfgSPHost = "localhost", + _cfgSPPort = 8081, + _cfgDomainConfigs = + Left + MultiIngressDomainConfig + { _cfgSPAppURI = [uri|https://example-sp.com/landing|], + _cfgSPSsoURI = [uri|https://example-sp.com/sso|], + _cfgContacts = [fallbackContact] + } + } + host = Just "backend.example.com" + idpHandle = Just $ unsafeRange "some-idp" + apiVersion = Just WireIdPAPIV2 + issuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://accounts.accesscontrol.windows.net/auth" + idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + expectedLogLine = + ( Info, + "IdP created, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" + ) + + (logs, _res) <- interpretWithLoggingMock Nothing (idpCreate samlConfig tid zUser host idPMetadataInfo' Nothing apiVersion idpHandle) + logs `shouldContain` [expectedLogLine] + + (logsV7, _res) <- interpretWithLoggingMock Nothing (idpCreateV7 samlConfig tid zUser idPMetadataInfo' Nothing apiVersion idpHandle) + logsV7 `shouldContain` [expectedLogLine] + + it "should log IdP creation with domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" + zUser = Just <$> either error id $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" + samlConfig = + Config + { -- The log level only matters for log output, not production. + -- Thus, we could put anything here, it just needs to be a valid + -- value. + _cfgLogLevel = Trace, + _cfgSPHost = "localhost", + _cfgSPPort = 8081, + _cfgDomainConfigs = + Right $ + Map.fromList + [ ( miDomain, + MultiIngressDomainConfig + { _cfgSPAppURI = [uri|https://example-sp.com/landing|], + _cfgSPSsoURI = [uri|https://example-sp.com/sso|], + _cfgContacts = [fallbackContact] + } + ) + ] + } + domainAsText = "backend.example.com" + miDomain = either (error . show) id $ mkDomain domainAsText + host = Just domainAsText + idpHandle = Just $ unsafeRange "some-idp" + apiVersion = Just WireIdPAPIV2 + issuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://accounts.accesscontrol.windows.net/auth" + idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + expectedLogLine :: LByteString -> LogLine + expectedLogLine domainPart = + ( Info, + "IdP created, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" <> domainPart <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" + ) + expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ domainAsText + expectedLogLineWithoutDomain = expectedLogLine "None" + + (logs, _res) <- interpretWithLoggingMock Nothing (idpCreate samlConfig tid zUser host idPMetadataInfo' Nothing apiVersion idpHandle) + logs `shouldContain` [expectedLogLineWithDomain] + + -- >=V7 does not bother with multi-ingress domains for IdPs as it can + -- only have one IdP per team anyways. + (logsV7, _res) <- interpretWithLoggingMock Nothing (idpCreateV7 samlConfig tid zUser idPMetadataInfo' Nothing apiVersion idpHandle) + logsV7 `shouldContain` [expectedLogLineWithoutDomain] + describe "idp-delete" $ do + it "should log IdP deletion" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" + zUser = Just <$> either error id $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" + host = Just "backend.example.com" + idpHandle = Just $ unsafeRange "some-idp" + apiVersion = Just WireIdPAPIV2 + issuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://accounts.accesscontrol.windows.net/auth" + idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + samlConfig = + Config + { -- The log level only matters for log output, not production. + -- Thus, we could put anything here, it just needs to be a valid + -- value. + _cfgLogLevel = Trace, + _cfgSPHost = "localhost", + _cfgSPPort = 8081, + _cfgDomainConfigs = + Left + MultiIngressDomainConfig + { _cfgSPAppURI = [uri|https://example-sp.com/landing|], + _cfgSPSsoURI = [uri|https://example-sp.com/sso|], + _cfgContacts = [fallbackContact] + } + } + expectedLogLine = + ( Info, + "IdP deleted, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate samlConfig tid zUser host idPMetadataInfo' Nothing apiVersion idpHandle + idpDelete zUser (idp ^. idpId) Nothing + logs `shouldContain` [expectedLogLine] + +type LogLine = (Level, LByteString) + +interpretWithLoggingMock :: + Maybe User -> + Sem (Effs) a -> + IO ([LogLine], a) +interpretWithLoggingMock mbAccount action = do + lr <- newLogRecorder + a <- + runFinal + . embedToFinal @IO + . Polysemy.Error.errorToIOFinal + . recordLogs lr + . ignoringState idpRawMetadataStoreToMem + . ignoringState idPToMem + . ignoringState scimTokenStoreToMem + . brigAccessMock mbAccount + . galleyAccessMock + . ignoringState samlUserStoreToMem + . randomToNull + $ action + logs <- readIORef lr.recordedLogs + -- TODO: Better error handling + pure (logs, either (error . show) id a) + +-- TODO: Is this general enough to extract it and provide it for other tests? +galleyAccessMock :: Sem (GalleyAccess ': r) a -> Sem r a +galleyAccessMock = interpret $ \case + GetTeamMembers _teamId -> undefined + GetTeamMember _teamId _userId -> undefined + AssertHasPermission _teamId _perm _userId -> pure () + AssertSSOEnabled _teamId -> pure () + IsEmailValidationEnabledTeam _teamId -> undefined + UpdateTeamMember _userId _teamId _role -> undefined + +-- TODO: Is this general enough to extract it and provide it for other tests? +brigAccessMock :: Maybe User -> Sem (BrigAccess ': r) a -> Sem r a +brigAccessMock mbAccount = interpret $ \case + CreateSAML _userRef _userId _teamId _name _managedBy _mHandle _mRichInfo _mLocale _role -> undefined + CreateNoSAML _txt _email _userId _teamId _name _mLocale _role -> undefined + UpdateEmail _userId _email _activation -> undefined + GetAccount _havePendingInvitations _userId -> pure mbAccount + GetByHandle _handle -> undefined + GetByEmail _email -> undefined + SetName _userId _name -> undefined + SetHandle _userId _handle -> undefined + SetManagedBy _userId _managedBy -> undefined + SetSSOId _userId _ssoId -> undefined + SetRichInfo _userId _richInfo -> undefined + SetLocale _userId _mLocale -> undefined + GetRichInfo _userId -> undefined + CheckHandleAvailable _handle -> undefined + DeleteUser _userId -> undefined + EnsureReAuthorised _mUserId _mPassword _mCode _mAction -> undefined + SsoLogin _userId -> undefined + GetStatus _userId -> undefined + GetStatusMaybe _userId -> undefined + SetStatus _userId _status -> undefined + GetDefaultUserLocale -> undefined + CheckAdminGetTeamId _userId -> undefined + +ignoringState :: (Functor f) => (a -> f (c, b)) -> a -> f b +ignoringState f = fmap snd . f + +type Effs = + '[ Random, + SAMLUserStore, + GalleyAccess, + BrigAccess, + ScimTokenStore, + IdPConfigStore, + IdPRawMetadataStore, + Logger (Msg -> Msg), + Polysemy.Error.Error SparError, + Embed IO, + Final IO + ] From e36184c38d8c7b321a987bdbe5c037d58878f8aa Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 13:36:20 +0100 Subject: [PATCH 11/38] WIP: Update test --- services/spar/spar.cabal | 1 + services/spar/src/Spar/API.hs | 7 +- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 95 ++++++++++++++++++- .../spar/test/resources/okta-keyinfo-1.xml | 21 ++++ 4 files changed, 118 insertions(+), 6 deletions(-) create mode 100644 services/spar/test/resources/okta-keyinfo-1.xml diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index b6175253cbf..f4252f1c4f2 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -634,6 +634,7 @@ test-suite spec , bytestring-conversion , containers , cookie + , filepath , hscim , hspec , imports diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 78564059a87..9b3b67616c2 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -50,6 +50,7 @@ module Spar.API idpCreate, idpCreateV7, idpDelete, + idpUpdate, ) where @@ -818,7 +819,6 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces idpDomain idHandle = wit idpUpdate :: ( Member Random r, Member (Logger (Msg -> Msg)) r, - Member (Logger String) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -839,7 +839,6 @@ 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, Member IdPConfigStore r, @@ -903,8 +902,8 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML "IdP updated" idp zusr - ( Log.field "new-certificates" ((intercalate ";; " . map certToString . toList) removedCerts) - . Log.field "removed-certificates" ((intercalate ";; " . map certToString . toList) newCerts) + ( Log.field "new-certificates" ((intercalate ";; " . map certToString . toList) newCerts) + . Log.field "removed-certificates" ((intercalate ";; " . map certToString . toList) removedCerts) ) compareNonEmpty :: (Eq a) => NonEmpty a -> NonEmpty a -> ([a], [a]) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 8e555018fd3..16d1e6dab78 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -4,17 +4,19 @@ import Arbitrary () import Control.Lens ((.~), (^.)) import Data.Domain import Data.Id (parseIdFromText) +import qualified Data.List.NonEmpty as NonEmptyL import qualified Data.Map as Map import Data.Range import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL +import qualified Data.Text.Lazy.IO as TL import Imports import Polysemy import qualified Polysemy.Error import Polysemy.TinyLog import SAML2.WebSSO import qualified SAML2.WebSSO as SAML -import Spar.API (idpCreate, idpCreateV7, idpDelete) +import Spar.API (idpCreate, idpCreateV7, idpDelete, idpUpdate) import Spar.Error import Spar.Sem.BrigAccess import Spar.Sem.GalleyAccess @@ -26,14 +28,16 @@ import Spar.Sem.SAMLUserStore import Spar.Sem.SAMLUserStore.Mem import Spar.Sem.ScimTokenStore import Spar.Sem.ScimTokenStore.Mem +import System.FilePath import System.Logger (Msg) import System.Logger.Class (Level (..)) import Test.Hspec import Test.QuickCheck +import qualified Text.XML.DSig as DSig import URI.ByteString (parseURI, strictURIParserOptions) import URI.ByteString.QQ (uri) import Wire.API.User (User (..)) -import Wire.API.User.IdentityProvider (IdPMetadataInfo, WireIdPAPIVersion (..), idpMetadataRecord) +import Wire.API.User.IdentityProvider (IdPMetadataInfo (..), WireIdPAPIVersion (..), idpMetadataRecord) import Wire.Sem.Logger.TinyLog (LogRecorder (..), newLogRecorder, recordLogs) import Wire.Sem.Random import Wire.Sem.Random.Null @@ -160,6 +164,87 @@ spec = describe "SAML IdP change logging" $ do idpDelete zUser (idp ^. idpId) Nothing logs `shouldContain` [expectedLogLine] + describe "idp-update" $ do + it "should log IdP update" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" + zUser = Just <$> either error id $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" + host = Just "backend.example.com" + idpHandle = Just $ unsafeRange "some-idp" + apiVersion = Just WireIdPAPIV2 + issuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://accounts.accesscontrol.windows.net/auth" + idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + samlConfig = + Config + { -- The log level only matters for log output, not production. + -- Thus, we could put anything here, it just needs to be a valid + -- value. + _cfgLogLevel = Trace, + _cfgSPHost = "localhost", + _cfgSPPort = 8081, + _cfgDomainConfigs = + Left + MultiIngressDomainConfig + { _cfgSPAppURI = [uri|https://example-sp.com/landing|], + _cfgSPSsoURI = [uri|https://example-sp.com/sso|], + _cfgContacts = [fallbackContact] + } + } + expectedLogLine = (Info, "IdP updated, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=, removed-certificates=\n") + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate samlConfig tid zUser host idPMetadataInfo' Nothing apiVersion idpHandle + idpUpdate samlConfig zUser host idPMetadataInfo' (idp ^. idpId) Nothing + logs `shouldContain` [expectedLogLine] + + it "should log IdP update (changed cert)" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + newKeyInfo <- readSampleIO "okta-keyinfo-1.xml" + let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" + zUser = Just <$> either error id $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" + host = Just "backend.example.com" + idpHandle = Just $ unsafeRange "some-idp" + apiVersion = Just WireIdPAPIV2 + issuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://accounts.accesscontrol.windows.net/auth" + newIssuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://new.idp.example.com/auth" + newRequestURI = either (error . show) id . parseURI strictURIParserOptions . fromString $ "https://new.idp.example.com/login" + idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + newCert = either (error . show) id $ DSig.parseKeyInfo False newKeyInfo + newIdPMetadata :: IdPMetadata = + IdPMetadata + { _edIssuer = newIssuer, + _edRequestURI = newRequestURI, + _edCertAuthnResponse = NonEmptyL.singleton newCert + } + idPMetadataInfo'' = IdPMetadataValue ((TL.toStrict . encode) newIdPMetadata) newIdPMetadata + samlConfig = + Config + { -- The log level only matters for log output, not production. + -- Thus, we could put anything here, it just needs to be a valid + -- value. + _cfgLogLevel = Trace, + _cfgSPHost = "localhost", + _cfgSPPort = 8081, + _cfgDomainConfigs = + Left + MultiIngressDomainConfig + { _cfgSPAppURI = [uri|https://example-sp.com/landing|], + _cfgSPSsoURI = [uri|https://example-sp.com/sso|], + _cfgContacts = [fallbackContact] + } + } + expectedLogLine = + ( Info, + "IdP updated, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://new.idp.example.com/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34, removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate samlConfig tid zUser host idPMetadataInfo' Nothing apiVersion idpHandle + idpUpdate samlConfig zUser host idPMetadataInfo'' (idp ^. idpId) Nothing + logs `shouldContain` [expectedLogLine] + type LogLine = (Level, LByteString) interpretWithLoggingMock :: @@ -237,3 +322,9 @@ type Effs = Embed IO, Final IO ] + +readSampleIO :: (MonadIO m) => FilePath -> m TL.Text +readSampleIO fpath = + liftIO $ + TL.readFile $ + "test/resources" fpath diff --git a/services/spar/test/resources/okta-keyinfo-1.xml b/services/spar/test/resources/okta-keyinfo-1.xml new file mode 100644 index 00000000000..5eacdb59013 --- /dev/null +++ b/services/spar/test/resources/okta-keyinfo-1.xml @@ -0,0 +1,21 @@ + + +MIIDpDCCAoygAwIBAgIGAWSx7x1HMA0GCSqGSIb3DQEBCwUAMIGSMQswCQYDVQQGEwJVUzETMBEG +A1UECAwKQ2FsaWZvcm5pYTEWMBQGA1UEBwwNU2FuIEZyYW5jaXNjbzENMAsGA1UECgwET2t0YTEU +MBIGA1UECwwLU1NPUHJvdmlkZXIxEzARBgNVBAMMCmRldi01MDA1MDgxHDAaBgkqhkiG9w0BCQEW +DWluZm9Ab2t0YS5jb20wHhcNMTgwNzE5MDk0NTM1WhcNMjgwNzE5MDk0NjM0WjCBkjELMAkGA1UE +BhMCVVMxEzARBgNVBAgMCkNhbGlmb3JuaWExFjAUBgNVBAcMDVNhbiBGcmFuY2lzY28xDTALBgNV +BAoMBE9rdGExFDASBgNVBAsMC1NTT1Byb3ZpZGVyMRMwEQYDVQQDDApkZXYtNTAwNTA4MRwwGgYJ +KoZIhvcNAQkBFg1pbmZvQG9rdGEuY29tMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA +hUaQm/3dgPws1A5IjFK9ZQpj170vIqENuDG0tapAzkvk6+9vyhduGckHTeZF3k5MMlW9iix2Eg0q +a1oS/Wrq/aBf7+BH6y1MJlQnaKQ3hPL+OFvYzbnrN8k2uC2LivP7Y90dXwtN3P63rA4QSyDPYEMv +dKSubUKX/HNsUg4I2PwHmpfWBNgoMkqe0bxQILBv+84L62IYSd6k77XXnCFb/usHpG/gY6sJsTQ2 +aFl9FuJ51uf67AOj8RzPXstgtUaXbdJI0kAqKIb3j9Zv3mpPCy/GHnyB3PMalvtc1uaz1ZnwO2el +iqhwB6/8W6CPutFo1Bhq1glQIX+1OD7906iORwIDAQABMA0GCSqGSIb3DQEBCwUAA4IBAQB0h6vK +AywJwH3g0RnocOpBvT42QW57TZ3Wzm9gbg6dQL0rB+NHDx2V0VIh51E3YHL1os9W09MreM7I74D/ +fX27r1Q3+qAsL1v3CN8WIVh9eYitBCtF7DwZmL2UXTia+GWPrabO14qAztFmTXfqNuCZej7gJd/K +2r0KBiZtZ6o58WBREW2F70a6nN6Nk1yjzBkDTJMMf8OMXHphTaalMBXojN9W6HEDpGBE0qY7c70P +qvfUEzd8wHWcDxo6+3jajajelk0V4rg7Cqxccr+WwjYtENEuQypNG2mbI52iPZked0QWKy0WzhSM +w5wjJ+QDG31vJInAB2769C2KmhPDyNhU + + From 611c678f5d1fc936d51417ba6c4762d3ba8e1785 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 16:42:06 +0100 Subject: [PATCH 12/38] Reduce duplication in test setups --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 315 ++++++++----------- 1 file changed, 124 insertions(+), 191 deletions(-) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 16d1e6dab78..f711aae74f5 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -43,207 +43,140 @@ import Wire.Sem.Random import Wire.Sem.Random.Null spec :: Spec -spec = describe "SAML IdP change logging" $ do - describe "idp-create" $ do - it "should log IdP creation" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" - zUser = Just <$> either error id $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" - samlConfig = - Config - { -- The log level only matters for log output, not production. - -- Thus, we could put anything here, it just needs to be a valid - -- value. - _cfgLogLevel = Trace, - _cfgSPHost = "localhost", - _cfgSPPort = 8081, - _cfgDomainConfigs = - Left - MultiIngressDomainConfig - { _cfgSPAppURI = [uri|https://example-sp.com/landing|], - _cfgSPSsoURI = [uri|https://example-sp.com/sso|], - _cfgContacts = [fallbackContact] - } - } - host = Just "backend.example.com" - idpHandle = Just $ unsafeRange "some-idp" - apiVersion = Just WireIdPAPIV2 - issuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://accounts.accesscontrol.windows.net/auth" - idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer - expectedLogLine = - ( Info, - "IdP created, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" - ) +spec = + let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" + zUser = Just <$> either error id $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" + singleIngressSamlConfig = + Config + { -- The log level only matters for log output, not production. + -- Thus, we could put anything here, it just needs to be a valid + -- value. + _cfgLogLevel = Trace, + _cfgSPHost = "localhost", + _cfgSPPort = 8081, + _cfgDomainConfigs = + Left + MultiIngressDomainConfig + { _cfgSPAppURI = [uri|https://example-sp.com/landing|], + _cfgSPSsoURI = [uri|https://example-sp.com/sso|], + _cfgContacts = [fallbackContact] + } + } + miDomain = either (error . show) id $ mkDomain miHostAsText + multiIngressSamlConfig = + Config + { -- The log level only matters for log output, not production. + -- Thus, we could put anything here, it just needs to be a valid + -- value. + _cfgLogLevel = Trace, + _cfgSPHost = "localhost", + _cfgSPPort = 8081, + _cfgDomainConfigs = + Right $ + Map.fromList + [ ( miDomain, + MultiIngressDomainConfig + { _cfgSPAppURI = [uri|https://example-sp.com/landing|], + _cfgSPSsoURI = [uri|https://example-sp.com/sso|], + _cfgContacts = [fallbackContact] + } + ) + ] + } + idpHandle = Just $ unsafeRange "some-idp" + apiVersionV2 = Just WireIdPAPIV2 + host = Just "backend.example.com" + miHostAsText = "backend-2.example.com" + miHost = Just miHostAsText + issuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://accounts.accesscontrol.windows.net/auth" + in describe "SAML IdP change logging" $ do + describe "idp-create" $ do + it "should log IdP creation" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + expectedLogLine = + ( Info, + "IdP created, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" + ) - (logs, _res) <- interpretWithLoggingMock Nothing (idpCreate samlConfig tid zUser host idPMetadataInfo' Nothing apiVersion idpHandle) - logs `shouldContain` [expectedLogLine] + forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do + (logs, _res) <- interpretWithLoggingMock Nothing (idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logs `shouldContain` [expectedLogLine] - (logsV7, _res) <- interpretWithLoggingMock Nothing (idpCreateV7 samlConfig tid zUser idPMetadataInfo' Nothing apiVersion idpHandle) - logsV7 `shouldContain` [expectedLogLine] + (logsV7, _res) <- interpretWithLoggingMock Nothing (idpCreateV7 singleIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logsV7 `shouldContain` [expectedLogLine] - it "should log IdP creation with domain for multi-ingress" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" - zUser = Just <$> either error id $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" - samlConfig = - Config - { -- The log level only matters for log output, not production. - -- Thus, we could put anything here, it just needs to be a valid - -- value. - _cfgLogLevel = Trace, - _cfgSPHost = "localhost", - _cfgSPPort = 8081, - _cfgDomainConfigs = - Right $ - Map.fromList - [ ( miDomain, - MultiIngressDomainConfig - { _cfgSPAppURI = [uri|https://example-sp.com/landing|], - _cfgSPSsoURI = [uri|https://example-sp.com/sso|], - _cfgContacts = [fallbackContact] - } - ) - ] - } - domainAsText = "backend.example.com" - miDomain = either (error . show) id $ mkDomain domainAsText - host = Just domainAsText - idpHandle = Just $ unsafeRange "some-idp" - apiVersion = Just WireIdPAPIV2 - issuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://accounts.accesscontrol.windows.net/auth" - idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer - expectedLogLine :: LByteString -> LogLine - expectedLogLine domainPart = - ( Info, - "IdP created, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" <> domainPart <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" - ) - expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ domainAsText - expectedLogLineWithoutDomain = expectedLogLine "None" + it "should log IdP creation with domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + expectedLogLine :: LByteString -> LogLine + expectedLogLine domainPart = + ( Info, + "IdP created, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" <> domainPart <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" + ) + expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ miHostAsText + expectedLogLineWithoutDomain = expectedLogLine "None" - (logs, _res) <- interpretWithLoggingMock Nothing (idpCreate samlConfig tid zUser host idPMetadataInfo' Nothing apiVersion idpHandle) - logs `shouldContain` [expectedLogLineWithDomain] + forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do + (logs, _res) <- interpretWithLoggingMock Nothing (idpCreate multiIngressSamlConfig tid zUser miHost idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logs `shouldContain` [expectedLogLineWithDomain] - -- >=V7 does not bother with multi-ingress domains for IdPs as it can - -- only have one IdP per team anyways. - (logsV7, _res) <- interpretWithLoggingMock Nothing (idpCreateV7 samlConfig tid zUser idPMetadataInfo' Nothing apiVersion idpHandle) - logsV7 `shouldContain` [expectedLogLineWithoutDomain] - describe "idp-delete" $ do - it "should log IdP deletion" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - user :: User <- generate arbitrary - let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" - zUser = Just <$> either error id $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" - host = Just "backend.example.com" - idpHandle = Just $ unsafeRange "some-idp" - apiVersion = Just WireIdPAPIV2 - issuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://accounts.accesscontrol.windows.net/auth" - idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer - samlConfig = - Config - { -- The log level only matters for log output, not production. - -- Thus, we could put anything here, it just needs to be a valid - -- value. - _cfgLogLevel = Trace, - _cfgSPHost = "localhost", - _cfgSPPort = 8081, - _cfgDomainConfigs = - Left - MultiIngressDomainConfig - { _cfgSPAppURI = [uri|https://example-sp.com/landing|], - _cfgSPSsoURI = [uri|https://example-sp.com/sso|], - _cfgContacts = [fallbackContact] - } - } - expectedLogLine = - ( Info, - "IdP deleted, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" - ) + -- >=V7 does not bother with multi-ingress domains for IdPs as it can + -- only have one IdP per team anyways. + (logsV7, _res) <- interpretWithLoggingMock Nothing (idpCreateV7 multiIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logsV7 `shouldContain` [expectedLogLineWithoutDomain] - (logs, _res) <- interpretWithLoggingMock (Just user) $ do - idp <- idpCreate samlConfig tid zUser host idPMetadataInfo' Nothing apiVersion idpHandle - idpDelete zUser (idp ^. idpId) Nothing - logs `shouldContain` [expectedLogLine] + describe "idp-delete" $ do + it "should log IdP deletion" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + expectedLogLine = + ( Info, + "IdP deleted, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + ) - describe "idp-update" $ do - it "should log IdP update" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - user :: User <- generate arbitrary - let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" - zUser = Just <$> either error id $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" - host = Just "backend.example.com" - idpHandle = Just $ unsafeRange "some-idp" - apiVersion = Just WireIdPAPIV2 - issuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://accounts.accesscontrol.windows.net/auth" - idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer - samlConfig = - Config - { -- The log level only matters for log output, not production. - -- Thus, we could put anything here, it just needs to be a valid - -- value. - _cfgLogLevel = Trace, - _cfgSPHost = "localhost", - _cfgSPPort = 8081, - _cfgDomainConfigs = - Left - MultiIngressDomainConfig - { _cfgSPAppURI = [uri|https://example-sp.com/landing|], - _cfgSPSsoURI = [uri|https://example-sp.com/sso|], - _cfgContacts = [fallbackContact] - } - } - expectedLogLine = (Info, "IdP updated, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=, removed-certificates=\n") + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpDelete zUser (idp ^. idpId) Nothing + logs `shouldContain` [expectedLogLine] - (logs, _res) <- interpretWithLoggingMock (Just user) $ do - idp <- idpCreate samlConfig tid zUser host idPMetadataInfo' Nothing apiVersion idpHandle - idpUpdate samlConfig zUser host idPMetadataInfo' (idp ^. idpId) Nothing - logs `shouldContain` [expectedLogLine] + describe "idp-update" $ do + it "should log IdP update" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + expectedLogLine = (Info, "IdP updated, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=, removed-certificates=\n") - it "should log IdP update (changed cert)" $ do - idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - user :: User <- generate arbitrary - newKeyInfo <- readSampleIO "okta-keyinfo-1.xml" - let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" - zUser = Just <$> either error id $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" - host = Just "backend.example.com" - idpHandle = Just $ unsafeRange "some-idp" - apiVersion = Just WireIdPAPIV2 - issuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://accounts.accesscontrol.windows.net/auth" - newIssuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://new.idp.example.com/auth" - newRequestURI = either (error . show) id . parseURI strictURIParserOptions . fromString $ "https://new.idp.example.com/login" - idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer - newCert = either (error . show) id $ DSig.parseKeyInfo False newKeyInfo - newIdPMetadata :: IdPMetadata = - IdPMetadata - { _edIssuer = newIssuer, - _edRequestURI = newRequestURI, - _edCertAuthnResponse = NonEmptyL.singleton newCert - } - idPMetadataInfo'' = IdPMetadataValue ((TL.toStrict . encode) newIdPMetadata) newIdPMetadata - samlConfig = - Config - { -- The log level only matters for log output, not production. - -- Thus, we could put anything here, it just needs to be a valid - -- value. - _cfgLogLevel = Trace, - _cfgSPHost = "localhost", - _cfgSPPort = 8081, - _cfgDomainConfigs = - Left - MultiIngressDomainConfig - { _cfgSPAppURI = [uri|https://example-sp.com/landing|], - _cfgSPSsoURI = [uri|https://example-sp.com/sso|], - _cfgContacts = [fallbackContact] - } - } - expectedLogLine = - ( Info, - "IdP updated, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://new.idp.example.com/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34, removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" - ) + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo' (idp ^. idpId) Nothing + logs `shouldContain` [expectedLogLine] - (logs, _res) <- interpretWithLoggingMock (Just user) $ do - idp <- idpCreate samlConfig tid zUser host idPMetadataInfo' Nothing apiVersion idpHandle - idpUpdate samlConfig zUser host idPMetadataInfo'' (idp ^. idpId) Nothing - logs `shouldContain` [expectedLogLine] + it "should log IdP update (changed cert)" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + newKeyInfo <- readSampleIO "okta-keyinfo-1.xml" + let newIssuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://new.idp.example.com/auth" + newRequestURI = either (error . show) id . parseURI strictURIParserOptions . fromString $ "https://new.idp.example.com/login" + idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + newCert = either (error . show) id $ DSig.parseKeyInfo False newKeyInfo + newIdPMetadata :: IdPMetadata = + IdPMetadata + { _edIssuer = newIssuer, + _edRequestURI = newRequestURI, + _edCertAuthnResponse = NonEmptyL.singleton newCert + } + idPMetadataInfo'' = IdPMetadataValue ((TL.toStrict . encode) newIdPMetadata) newIdPMetadata + expectedLogLine = + ( Info, + "IdP updated, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://new.idp.example.com/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34, removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo'' (idp ^. idpId) Nothing + logs `shouldContain` [expectedLogLine] type LogLine = (Level, LByteString) From 06bb67479db9960a4b1def13435dc95c5b329b5f Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 17:32:26 +0100 Subject: [PATCH 13/38] Formatting --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index f711aae74f5..b39a5b46104 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -100,10 +100,16 @@ spec = ) forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do - (logs, _res) <- interpretWithLoggingMock Nothing (idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + (logs, _res) <- + interpretWithLoggingMock + Nothing + (idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing (Just apiVersion) idpHandle) logs `shouldContain` [expectedLogLine] - (logsV7, _res) <- interpretWithLoggingMock Nothing (idpCreateV7 singleIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + (logsV7, _res) <- + interpretWithLoggingMock + Nothing + (idpCreateV7 singleIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) logsV7 `shouldContain` [expectedLogLine] it "should log IdP creation with domain for multi-ingress" $ do @@ -118,12 +124,18 @@ spec = expectedLogLineWithoutDomain = expectedLogLine "None" forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do - (logs, _res) <- interpretWithLoggingMock Nothing (idpCreate multiIngressSamlConfig tid zUser miHost idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + (logs, _res) <- + interpretWithLoggingMock + Nothing + (idpCreate multiIngressSamlConfig tid zUser miHost idPMetadataInfo' Nothing (Just apiVersion) idpHandle) logs `shouldContain` [expectedLogLineWithDomain] -- >=V7 does not bother with multi-ingress domains for IdPs as it can -- only have one IdP per team anyways. - (logsV7, _res) <- interpretWithLoggingMock Nothing (idpCreateV7 multiIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + (logsV7, _res) <- + interpretWithLoggingMock + Nothing + (idpCreateV7 multiIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) logsV7 `shouldContain` [expectedLogLineWithoutDomain] describe "idp-delete" $ do From 3bce7c40da0d395acea4845582528504c852ea65 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 17:34:33 +0100 Subject: [PATCH 14/38] Simplify --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index b39a5b46104..70362dea0e6 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -45,7 +45,7 @@ import Wire.Sem.Random.Null spec :: Spec spec = let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" - zUser = Just <$> either error id $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" + zUser = either error Just $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" singleIngressSamlConfig = Config { -- The log level only matters for log output, not production. From 05fccec49da0e541c02b960f360101bc29f7d7ce Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 17:36:35 +0100 Subject: [PATCH 15/38] Cleanup --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 70362dea0e6..230bd3cd77d 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -62,7 +62,10 @@ spec = _cfgContacts = [fallbackContact] } } + host = Just "backend.example.com" + miHostAsText = "backend-2.example.com" miDomain = either (error . show) id $ mkDomain miHostAsText + miHost = Just miHostAsText multiIngressSamlConfig = Config { -- The log level only matters for log output, not production. @@ -85,10 +88,11 @@ spec = } idpHandle = Just $ unsafeRange "some-idp" apiVersionV2 = Just WireIdPAPIV2 - host = Just "backend.example.com" - miHostAsText = "backend-2.example.com" - miHost = Just miHostAsText - issuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://accounts.accesscontrol.windows.net/auth" + issuer = + either (error . show) Issuer + . parseURI strictURIParserOptions + . fromString + $ "https://accounts.accesscontrol.windows.net/auth" in describe "SAML IdP change logging" $ do describe "idp-create" $ do it "should log IdP creation" $ do From f3bc5f0110b1c261059bc507c7ffd78c36f6ee39 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 17:38:42 +0100 Subject: [PATCH 16/38] Reduce duplication --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 24 +++++++------------- 1 file changed, 8 insertions(+), 16 deletions(-) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 230bd3cd77d..4d731387ded 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -46,6 +46,12 @@ spec :: Spec spec = let tid = either error id $ parseIdFromText "6861026d-cdee-3da5-22fc-6612bb1360b8" zUser = either error Just $ parseIdFromText "59128ccc-d38a-1d23-67d9-4f529ee7ca9f" + anyMultiIngressDomainCfg = + MultiIngressDomainConfig + { _cfgSPAppURI = [uri|https://example-sp.com/landing|], + _cfgSPSsoURI = [uri|https://example-sp.com/sso|], + _cfgContacts = [fallbackContact] + } singleIngressSamlConfig = Config { -- The log level only matters for log output, not production. @@ -54,13 +60,7 @@ spec = _cfgLogLevel = Trace, _cfgSPHost = "localhost", _cfgSPPort = 8081, - _cfgDomainConfigs = - Left - MultiIngressDomainConfig - { _cfgSPAppURI = [uri|https://example-sp.com/landing|], - _cfgSPSsoURI = [uri|https://example-sp.com/sso|], - _cfgContacts = [fallbackContact] - } + _cfgDomainConfigs = Left anyMultiIngressDomainCfg } host = Just "backend.example.com" miHostAsText = "backend-2.example.com" @@ -76,15 +76,7 @@ spec = _cfgSPPort = 8081, _cfgDomainConfigs = Right $ - Map.fromList - [ ( miDomain, - MultiIngressDomainConfig - { _cfgSPAppURI = [uri|https://example-sp.com/landing|], - _cfgSPSsoURI = [uri|https://example-sp.com/sso|], - _cfgContacts = [fallbackContact] - } - ) - ] + Map.fromList [(miDomain, anyMultiIngressDomainCfg)] } idpHandle = Just $ unsafeRange "some-idp" apiVersionV2 = Just WireIdPAPIV2 From 1eabce69497ae445b896df3d0771f6ec442dd6ad Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 18:01:20 +0100 Subject: [PATCH 17/38] Add multi-ingress deletion test --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 4d731387ded..e167b788512 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -149,6 +149,20 @@ spec = idpDelete zUser (idp ^. idpId) Nothing logs `shouldContain` [expectedLogLine] + it "should log IdP deletion with domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + expectedLogLine = + ( Info, + "IdP deleted, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate multiIngressSamlConfig tid zUser miHost idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpDelete zUser (idp ^. idpId) Nothing + logs `shouldContain` [expectedLogLine] + describe "idp-update" $ do it "should log IdP update" $ do idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary From e9b1c1ce3a9627cfd7b9f10c71b3ae7cf904c092 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 18:02:57 +0100 Subject: [PATCH 18/38] Formatting --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index e167b788512..d0a240295d6 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -114,7 +114,9 @@ spec = expectedLogLine :: LByteString -> LogLine expectedLogLine domainPart = ( Info, - "IdP created, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" <> domainPart <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" + "IdP created, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" + <> domainPart + <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" ) expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ miHostAsText expectedLogLineWithoutDomain = expectedLogLine "None" @@ -149,13 +151,15 @@ spec = idpDelete zUser (idp ^. idpId) Nothing logs `shouldContain` [expectedLogLine] - it "should log IdP deletion with domain for multi-ingress" $ do + it "should log IdP deletion with domain for multi-ingress" $ do idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary user :: User <- generate arbitrary let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer expectedLogLine = ( Info, - "IdP deleted, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + "IdP deleted, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText + <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -168,7 +172,10 @@ spec = idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary user :: User <- generate arbitrary let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer - expectedLogLine = (Info, "IdP updated, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=, removed-certificates=\n") + expectedLogLine = + ( Info, + "IdP updated, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=, removed-certificates=\n" + ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle From d81b938604baa1f6e352efc8458d30332bb23de2 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 18:05:48 +0100 Subject: [PATCH 19/38] Add multi-ingress update test --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index d0a240295d6..2539f7bccf8 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -182,6 +182,22 @@ spec = idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo' (idp ^. idpId) Nothing logs `shouldContain` [expectedLogLine] + it "should log IdP update with domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + expectedLogLine = + ( Info, + "IdP updated, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText + <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=, removed-certificates=\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate multiIngressSamlConfig tid zUser miHost idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate multiIngressSamlConfig zUser miHost idPMetadataInfo' (idp ^. idpId) Nothing + logs `shouldContain` [expectedLogLine] + it "should log IdP update (changed cert)" $ do idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary user :: User <- generate arbitrary From f715a7f7d3f22dd3cb7e523dddfd02a183f64a4b Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 18:12:39 +0100 Subject: [PATCH 20/38] Use tid constant --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 30 ++++++++++++++------ 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 2539f7bccf8..4e215e9a245 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -3,7 +3,7 @@ module Test.Spar.Saml.IdPSpec where import Arbitrary () import Control.Lens ((.~), (^.)) import Data.Domain -import Data.Id (parseIdFromText) +import Data.Id (idToText, parseIdFromText) import qualified Data.List.NonEmpty as NonEmptyL import qualified Data.Map as Map import Data.Range @@ -92,7 +92,9 @@ spec = let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer expectedLogLine = ( Info, - "IdP created, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" + "IdP created, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" ) forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do @@ -114,7 +116,9 @@ spec = expectedLogLine :: LByteString -> LogLine expectedLogLine domainPart = ( Info, - "IdP created, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" + "IdP created, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" <> domainPart <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" ) @@ -143,7 +147,9 @@ spec = let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer expectedLogLine = ( Info, - "IdP deleted, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + "IdP deleted, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -157,7 +163,9 @@ spec = let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer expectedLogLine = ( Info, - "IdP deleted, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" + "IdP deleted, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" ) @@ -174,7 +182,9 @@ spec = let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer expectedLogLine = ( Info, - "IdP updated, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=, removed-certificates=\n" + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=, removed-certificates=\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -188,7 +198,9 @@ spec = let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer expectedLogLine = ( Info, - "IdP updated, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=, removed-certificates=\n" ) @@ -215,7 +227,9 @@ spec = idPMetadataInfo'' = IdPMetadataValue ((TL.toStrict . encode) newIdPMetadata) newIdPMetadata expectedLogLine = ( Info, - "IdP updated, team=6861026d-cdee-3da5-22fc-6612bb1360b8, idpId=00000000-0000-0000-0000-000000000000, issuer=https://new.idp.example.com/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34, removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://new.idp.example.com/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34, removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do From f0b553ef0adcef09a5f207a7948187469d7fef20 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 18:16:06 +0100 Subject: [PATCH 21/38] use zUser constant --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 28 +++++++++++++++----- 1 file changed, 21 insertions(+), 7 deletions(-) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 4e215e9a245..a0be36c3779 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -94,7 +94,9 @@ spec = ( Info, "IdP created, team=" <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" ) forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do @@ -120,7 +122,9 @@ spec = <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" <> domainPart - <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" + <> ", user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" ) expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ miHostAsText expectedLogLineWithoutDomain = expectedLogLine "None" @@ -149,7 +153,9 @@ spec = ( Info, "IdP deleted, team=" <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -167,7 +173,9 @@ spec = <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText - <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + <> ", user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -184,7 +192,9 @@ spec = ( Info, "IdP updated, team=" <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=, removed-certificates=\n" + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", new-certificates=, removed-certificates=\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -202,7 +212,9 @@ spec = <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText - <> ", user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=, removed-certificates=\n" + <> ", user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", new-certificates=, removed-certificates=\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -229,7 +241,9 @@ spec = ( Info, "IdP updated, team=" <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://new.idp.example.com/auth, domain=None, user=59128ccc-d38a-1d23-67d9-4f529ee7ca9f, new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34, removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://new.idp.example.com/auth, domain=None, user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34, removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do From a35ff18469e5232e188392d1d4be416d58f0445a Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 18:34:45 +0100 Subject: [PATCH 22/38] Use issuer constant --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 30 ++++++++++++++------ 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index a0be36c3779..bc27dea87af 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -80,11 +80,12 @@ spec = } idpHandle = Just $ unsafeRange "some-idp" apiVersionV2 = Just WireIdPAPIV2 + issuerString = "https://accounts.accesscontrol.windows.net/auth" issuer = either (error . show) Issuer . parseURI strictURIParserOptions . fromString - $ "https://accounts.accesscontrol.windows.net/auth" + $ issuerString in describe "SAML IdP change logging" $ do describe "idp-create" $ do it "should log IdP creation" $ do @@ -94,7 +95,9 @@ spec = ( Info, "IdP created, team=" <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=" + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" ) @@ -120,7 +123,9 @@ spec = ( Info, "IdP created, team=" <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=" <> domainPart <> ", user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser @@ -153,7 +158,9 @@ spec = ( Info, "IdP deleted, team=" <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=" + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" ) @@ -171,7 +178,9 @@ spec = ( Info, "IdP deleted, team=" <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=" <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText <> ", user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser @@ -192,7 +201,9 @@ spec = ( Info, "IdP updated, team=" <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=None, user=" + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser <> ", new-certificates=, removed-certificates=\n" ) @@ -210,7 +221,9 @@ spec = ( Info, "IdP updated, team=" <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://accounts.accesscontrol.windows.net/auth, domain=" + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=" <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText <> ", user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser @@ -243,7 +256,8 @@ spec = <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://new.idp.example.com/auth, domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34, removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + <> ", new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34" + <> ", removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do From 73b616780b7135de115b7cc3d57f565020b88826 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 18:37:57 +0100 Subject: [PATCH 23/38] Delete Won't-Do Todos --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index bc27dea87af..10cdc5066d9 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -287,10 +287,8 @@ interpretWithLoggingMock mbAccount action = do . randomToNull $ action logs <- readIORef lr.recordedLogs - -- TODO: Better error handling pure (logs, either (error . show) id a) --- TODO: Is this general enough to extract it and provide it for other tests? galleyAccessMock :: Sem (GalleyAccess ': r) a -> Sem r a galleyAccessMock = interpret $ \case GetTeamMembers _teamId -> undefined @@ -300,7 +298,6 @@ galleyAccessMock = interpret $ \case IsEmailValidationEnabledTeam _teamId -> undefined UpdateTeamMember _userId _teamId _role -> undefined --- TODO: Is this general enough to extract it and provide it for other tests? brigAccessMock :: Maybe User -> Sem (BrigAccess ': r) a -> Sem r a brigAccessMock mbAccount = interpret $ \case CreateSAML _userRef _userId _teamId _name _managedBy _mHandle _mRichInfo _mLocale _role -> undefined From 469a11bfb36fbb35e863473a696f1ed7e0f25b34 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 19:03:09 +0100 Subject: [PATCH 24/38] Log IdP endpoint --- services/spar/src/Spar/API.hs | 5 +- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 50 ++++++++++++++++---- 2 files changed, 46 insertions(+), 9 deletions(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 9b3b67616c2..e4643a2673d 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -590,7 +590,9 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co "IdP deleted" idp mbzusr - (Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList))) + ( Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList)) + . Log.field "idp-endpoint" (idp ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') + ) pure NoContent where assertEmptyOrPurge :: TeamId -> Cas.Page (SAML.UserRef, UserId) -> Sem r () @@ -678,6 +680,7 @@ idpCreate samlConfig tid zUser uncheckedMbHost (IdPMetadataValue rawIdpMetadata zUser ( Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList)) . Log.field "replaces" (maybe "None" (UUID.toString . SAML.fromIdPId) mReplaces) + . Log.field "idp-endpoint" (idp ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') ) pure idp where diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 10cdc5066d9..0d88fdf08ba 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -86,11 +86,21 @@ spec = . parseURI strictURIParserOptions . fromString $ issuerString + idpEndpointString = "https://idp-endpoint.example.com" + idpEndpoint = + either (error . show) id + . parseURI strictURIParserOptions + . fromString + $ idpEndpointString in describe "SAML IdP change logging" $ do describe "idp-create" $ do it "should log IdP creation" $ do idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + let idPMetadataInfo' = + idPMetadataInfo + & idpMetadataRecord . SAML.edIssuer .~ issuer + & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + expectedLogLine = ( Info, "IdP created, team=" @@ -99,7 +109,10 @@ spec = <> fromString issuerString <> ", domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> "\n" ) forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do @@ -117,7 +130,11 @@ spec = it "should log IdP creation with domain for multi-ingress" $ do idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary - let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + let idPMetadataInfo' = + idPMetadataInfo + & idpMetadataRecord . SAML.edIssuer .~ issuer + & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + expectedLogLine :: LByteString -> LogLine expectedLogLine domainPart = ( Info, @@ -129,7 +146,10 @@ spec = <> domainPart <> ", user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None\n" + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> "\n" ) expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ miHostAsText expectedLogLineWithoutDomain = expectedLogLine "None" @@ -153,7 +173,11 @@ spec = it "should log IdP deletion" $ do idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary user :: User <- generate arbitrary - let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + let idPMetadataInfo' = + idPMetadataInfo + & idpMetadataRecord . SAML.edIssuer .~ issuer + & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + expectedLogLine = ( Info, "IdP deleted, team=" @@ -162,7 +186,10 @@ spec = <> fromString issuerString <> ", domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> "\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -173,7 +200,11 @@ spec = it "should log IdP deletion with domain for multi-ingress" $ do idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary user :: User <- generate arbitrary - let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + let idPMetadataInfo' = + idPMetadataInfo + & idpMetadataRecord . SAML.edIssuer .~ issuer + & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + expectedLogLine = ( Info, "IdP deleted, team=" @@ -184,7 +215,10 @@ spec = <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText <> ", user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> "\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do From f52b71fa36143630d2c5a163a8e92cdff479dd60 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 19:20:19 +0100 Subject: [PATCH 25/38] Log IdP endpoint for update --- services/spar/src/Spar/API.hs | 2 + services/spar/test/Test/Spar/Saml/IdPSpec.hs | 42 ++++++++++++++++---- 2 files changed, 37 insertions(+), 7 deletions(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index e4643a2673d..b8a5ee1b51f 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -907,6 +907,8 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML zusr ( Log.field "new-certificates" ((intercalate ";; " . map certToString . toList) newCerts) . Log.field "removed-certificates" ((intercalate ";; " . map certToString . toList) removedCerts) + . Log.field "old-idp-endpoint" (previousIdP ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') + . Log.field "new-idp-endpoint" (idp ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') ) compareNonEmpty :: (Eq a) => NonEmpty a -> NonEmpty a -> ([a], [a]) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 0d88fdf08ba..126eef2d1e4 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -230,7 +230,11 @@ spec = it "should log IdP update" $ do idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary user :: User <- generate arbitrary - let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + let idPMetadataInfo' = + idPMetadataInfo + & idpMetadataRecord . SAML.edIssuer .~ issuer + & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + expectedLogLine = ( Info, "IdP updated, team=" @@ -239,7 +243,12 @@ spec = <> fromString issuerString <> ", domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", new-certificates=, removed-certificates=\n" + <> ", new-certificates=, removed-certificates=" + <> ", old-idp-endpoint=" + <> fromString idpEndpointString + <> ", new-idp-endpoint=" + <> fromString idpEndpointString + <> "\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -250,7 +259,11 @@ spec = it "should log IdP update with domain for multi-ingress" $ do idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary user :: User <- generate arbitrary - let idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + let idPMetadataInfo' = + idPMetadataInfo + & idpMetadataRecord . SAML.edIssuer .~ issuer + & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + expectedLogLine = ( Info, "IdP updated, team=" @@ -261,7 +274,12 @@ spec = <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText <> ", user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", new-certificates=, removed-certificates=\n" + <> ", new-certificates=, removed-certificates=" + <> ", old-idp-endpoint=" + <> fromString idpEndpointString + <> ", new-idp-endpoint=" + <> fromString idpEndpointString + <> "\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -274,8 +292,13 @@ spec = user :: User <- generate arbitrary newKeyInfo <- readSampleIO "okta-keyinfo-1.xml" let newIssuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://new.idp.example.com/auth" - newRequestURI = either (error . show) id . parseURI strictURIParserOptions . fromString $ "https://new.idp.example.com/login" - idPMetadataInfo' = idPMetadataInfo & idpMetadataRecord . SAML.edIssuer .~ issuer + newIdpEndpointString = "https://new.idp.example.com/login" + newRequestURI = either (error . show) id . parseURI strictURIParserOptions . fromString $ newIdpEndpointString + idPMetadataInfo' = + idPMetadataInfo + & idpMetadataRecord . SAML.edIssuer .~ issuer + & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + newCert = either (error . show) id $ DSig.parseKeyInfo False newKeyInfo newIdPMetadata :: IdPMetadata = IdPMetadata @@ -291,7 +314,12 @@ spec = <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://new.idp.example.com/auth, domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser <> ", new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34" - <> ", removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37\n" + <> ", removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> ", old-idp-endpoint=" + <> fromString idpEndpointString + <> ", new-idp-endpoint=" + <> fromString newIdpEndpointString + <> "\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do From dea06144d3e975737643e56b2d337f0812f8ef30 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 12 Jan 2026 19:28:04 +0100 Subject: [PATCH 26/38] Only log changed endpoints --- services/spar/src/Spar/API.hs | 12 ++++++++++-- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 18 ++++-------------- 2 files changed, 14 insertions(+), 16 deletions(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index b8a5ee1b51f..31f5d5dd0a1 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -907,9 +907,17 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML zusr ( Log.field "new-certificates" ((intercalate ";; " . map certToString . toList) newCerts) . Log.field "removed-certificates" ((intercalate ";; " . map certToString . toList) removedCerts) - . Log.field "old-idp-endpoint" (previousIdP ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') - . Log.field "new-idp-endpoint" (idp ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') + & logEndpointFields + (previousIdP ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') + (idp ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') ) + logEndpointFields oldEndpoint newEndpoint logFields = + if oldEndpoint /= newEndpoint + then + Log.field "old-idp-endpoint" oldEndpoint + . Log.field "new-idp-endpoint" newEndpoint + . logFields + else logFields compareNonEmpty :: (Eq a) => NonEmpty a -> NonEmpty a -> ([a], [a]) compareNonEmpty xs ys = diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 126eef2d1e4..f0943853c8d 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -243,12 +243,7 @@ spec = <> fromString issuerString <> ", domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", new-certificates=, removed-certificates=" - <> ", old-idp-endpoint=" - <> fromString idpEndpointString - <> ", new-idp-endpoint=" - <> fromString idpEndpointString - <> "\n" + <> ", new-certificates=, removed-certificates=\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -274,12 +269,7 @@ spec = <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText <> ", user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", new-certificates=, removed-certificates=" - <> ", old-idp-endpoint=" - <> fromString idpEndpointString - <> ", new-idp-endpoint=" - <> fromString idpEndpointString - <> "\n" + <> ", new-certificates=, removed-certificates=\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -313,12 +303,12 @@ spec = <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://new.idp.example.com/auth, domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34" - <> ", removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" <> ", old-idp-endpoint=" <> fromString idpEndpointString <> ", new-idp-endpoint=" <> fromString newIdpEndpointString + <> ", new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34" + <> ", removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" <> "\n" ) From 4d4c05f8b2d68099d2914bf9b602f3f66bdc090e Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 13 Jan 2026 08:23:03 +0100 Subject: [PATCH 27/38] Don't log empty fields --- services/spar/src/Spar/API.hs | 31 ++++++++++++-------- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 4 +-- 2 files changed, 21 insertions(+), 14 deletions(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 31f5d5dd0a1..6bb0668722b 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -72,6 +72,7 @@ import qualified Data.Text.Lazy as T import Data.Text.Lazy.Encoding import Data.Time import qualified Data.UUID as UUID +import qualified Data.X509 as X509 import Data.X509.Extended import Imports import Network.Wai (Request, requestHeaders) @@ -905,19 +906,25 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML "IdP updated" idp zusr - ( Log.field "new-certificates" ((intercalate ";; " . map certToString . toList) newCerts) - . Log.field "removed-certificates" ((intercalate ";; " . map certToString . toList) removedCerts) - & logEndpointFields - (previousIdP ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') - (idp ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') + ( logEndpointFields + (previousIdP ^. SAML.idpMetadata . SAML.edRequestURI) + (idp ^. SAML.idpMetadata . SAML.edRequestURI) + . logCertField "new-certificates" newCerts + . logCertField "removed-certificates" removedCerts ) - logEndpointFields oldEndpoint newEndpoint logFields = - if oldEndpoint /= newEndpoint - then - Log.field "old-idp-endpoint" oldEndpoint - . Log.field "new-idp-endpoint" newEndpoint - . logFields - else logFields + + logEndpointFields :: URI.URI -> URI.URI -> Msg -> Msg + logEndpointFields oldEndpoint newEndpoint + | oldEndpoint /= newEndpoint = + Log.field "old-idp-endpoint" (URI.serializeURIRef' oldEndpoint) + . Log.field "new-idp-endpoint" (URI.serializeURIRef' newEndpoint) + logEndpointFields _ _ = id + + logCertField :: ByteString -> [X509.SignedCertificate] -> Msg -> Msg + logCertField fieldName certs + | not (null certs) = + Log.field fieldName ((intercalate ";; " . map certToString . toList) certs) + logCertField _ _ = id compareNonEmpty :: (Eq a) => NonEmpty a -> NonEmpty a -> ([a], [a]) compareNonEmpty xs ys = diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index f0943853c8d..7bd3f9674fc 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -243,7 +243,7 @@ spec = <> fromString issuerString <> ", domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", new-certificates=, removed-certificates=\n" + <> "\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do @@ -269,7 +269,7 @@ spec = <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText <> ", user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", new-certificates=, removed-certificates=\n" + <> "\n" ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do From 25e6aa5f7086262a11851df128d557df458e1c95 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 13 Jan 2026 09:25:11 +0100 Subject: [PATCH 28/38] Improve update logging --- services/spar/src/Spar/API.hs | 36 ++++++++++++-------- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 7 ++++ 2 files changed, 29 insertions(+), 14 deletions(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 6bb0668722b..81099c27228 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -902,28 +902,36 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML compareNonEmpty (previousIdP ^. SAML.idpMetadata . SAML.edCertAuthnResponse) (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse) - in logIdPAction - "IdP updated" - idp - zusr - ( logEndpointFields + in 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 "user" (maybe "None" idToText zusr) + . logEndpointFields (previousIdP ^. SAML.idpMetadata . SAML.edRequestURI) (idp ^. SAML.idpMetadata . SAML.edRequestURI) - . logCertField "new-certificates" newCerts - . logCertField "removed-certificates" removedCerts - ) + . logCertField "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to toList) + . logCertField "new-certificates" newCerts + . logCertField "removed-certificates" removedCerts + + logScalarField :: (Eq a) => ByteString -> (a -> ByteString) -> a -> a -> Msg -> Msg + logScalarField baseFieldName toFieldVal old new + | old /= new = + Log.field ("old-" <> baseFieldName) (toFieldVal old) + . Log.field ("new-" <> baseFieldName) (toFieldVal new) + logScalarField baseFieldName toFieldVal old _new = + Log.field baseFieldName (toFieldVal old) logEndpointFields :: URI.URI -> URI.URI -> Msg -> Msg - logEndpointFields oldEndpoint newEndpoint - | oldEndpoint /= newEndpoint = - Log.field "old-idp-endpoint" (URI.serializeURIRef' oldEndpoint) - . Log.field "new-idp-endpoint" (URI.serializeURIRef' newEndpoint) - logEndpointFields _ _ = id + logEndpointFields oldEndpoint newEndpoint = + logScalarField "idp-endpoint" URI.serializeURIRef' oldEndpoint newEndpoint logCertField :: ByteString -> [X509.SignedCertificate] -> Msg -> Msg logCertField fieldName certs | not (null certs) = - Log.field fieldName ((intercalate ";; " . map certToString . toList) certs) + Log.field fieldName ((intercalate ";; " . map certToString) certs) logCertField _ _ = id compareNonEmpty :: (Eq a) => NonEmpty a -> NonEmpty a -> ([a], [a]) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 7bd3f9674fc..08d929c7222 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -243,6 +243,9 @@ spec = <> fromString issuerString <> ", domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" <> "\n" ) @@ -269,6 +272,9 @@ spec = <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText <> ", user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" <> "\n" ) @@ -307,6 +313,7 @@ spec = <> fromString idpEndpointString <> ", new-idp-endpoint=" <> fromString newIdpEndpointString + <> ", certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34" <> ", new-certificates=Issuer: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; Subject: Country=US,O=Okta,OU=SSOProvider,CN=dev-500508,Email Address=info@okta.com; SHA1 Fingerprint: 5C:42:5B:27:B3:96:CC:9D:1B:1F:0E:4F:2B:8A:B8:E4:3C:9E:96:34" <> ", removed-certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" <> "\n" From 2f4bee81ba57f7b5a9cc5bbc43f57448425df6f4 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 13 Jan 2026 09:43:06 +0100 Subject: [PATCH 29/38] Log old and new issuer --- services/spar/src/Spar/API.hs | 22 +++++++++++++------- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 10 +++++++-- 2 files changed, 22 insertions(+), 10 deletions(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 81099c27228..899a470c8f4 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -906,17 +906,27 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML 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")) + . logScalarField + "issuer" + URI.serializeURIRef' + (previousIdP ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer) + (idp ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer) + . logScalarField + "domain" + (fromMaybe "None") + (previousIdP ^. SAML.idpExtraInfo . domain) + (idp ^. SAML.idpExtraInfo . domain) . Log.field "user" (maybe "None" idToText zusr) - . logEndpointFields + . logScalarField + "idp-endpoint" + URI.serializeURIRef' (previousIdP ^. SAML.idpMetadata . SAML.edRequestURI) (idp ^. SAML.idpMetadata . SAML.edRequestURI) . logCertField "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to toList) . logCertField "new-certificates" newCerts . logCertField "removed-certificates" removedCerts - logScalarField :: (Eq a) => ByteString -> (a -> ByteString) -> a -> a -> Msg -> Msg + logScalarField :: (Eq a, Log.ToBytes b) => ByteString -> (a -> b) -> a -> a -> Msg -> Msg logScalarField baseFieldName toFieldVal old new | old /= new = Log.field ("old-" <> baseFieldName) (toFieldVal old) @@ -924,10 +934,6 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML logScalarField baseFieldName toFieldVal old _new = Log.field baseFieldName (toFieldVal old) - logEndpointFields :: URI.URI -> URI.URI -> Msg -> Msg - logEndpointFields oldEndpoint newEndpoint = - logScalarField "idp-endpoint" URI.serializeURIRef' oldEndpoint newEndpoint - logCertField :: ByteString -> [X509.SignedCertificate] -> Msg -> Msg logCertField fieldName certs | not (null certs) = diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 08d929c7222..10d5b59fe9f 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -287,7 +287,8 @@ spec = idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary user :: User <- generate arbitrary newKeyInfo <- readSampleIO "okta-keyinfo-1.xml" - let newIssuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ "https://new.idp.example.com/auth" + let newIssuerString = "https://new.idp.example.com/auth" + newIssuer = Issuer . (either (error . show) id) . parseURI strictURIParserOptions . fromString $ newIssuerString newIdpEndpointString = "https://new.idp.example.com/login" newRequestURI = either (error . show) id . parseURI strictURIParserOptions . fromString $ newIdpEndpointString idPMetadataInfo' = @@ -307,7 +308,12 @@ spec = ( Info, "IdP updated, team=" <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid - <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=https://new.idp.example.com/auth, domain=None, user=" + <> ", idpId=00000000-0000-0000-0000-000000000000" + <> ", old-issuer=" + <> fromString issuerString + <> ", new-issuer=" + <> fromString newIssuerString + <> ", domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser <> ", old-idp-endpoint=" <> fromString idpEndpointString From 6a0648ba23a606d36d408a55f5bff1742db3bd36 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 13 Jan 2026 09:45:38 +0100 Subject: [PATCH 30/38] rename function --- services/spar/src/Spar/API.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 899a470c8f4..93a4fa76ffc 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -906,18 +906,18 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML 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) - . logScalarField + . logChangeableScalar "issuer" URI.serializeURIRef' (previousIdP ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer) (idp ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer) - . logScalarField + . logChangeableScalar "domain" (fromMaybe "None") (previousIdP ^. SAML.idpExtraInfo . domain) (idp ^. SAML.idpExtraInfo . domain) . Log.field "user" (maybe "None" idToText zusr) - . logScalarField + . logChangeableScalar "idp-endpoint" URI.serializeURIRef' (previousIdP ^. SAML.idpMetadata . SAML.edRequestURI) @@ -926,12 +926,12 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML . logCertField "new-certificates" newCerts . logCertField "removed-certificates" removedCerts - logScalarField :: (Eq a, Log.ToBytes b) => ByteString -> (a -> b) -> a -> a -> Msg -> Msg - logScalarField baseFieldName toFieldVal old new + logChangeableScalar :: (Eq a, Log.ToBytes b) => ByteString -> (a -> b) -> a -> a -> Msg -> Msg + logChangeableScalar baseFieldName toFieldVal old new | old /= new = Log.field ("old-" <> baseFieldName) (toFieldVal old) . Log.field ("new-" <> baseFieldName) (toFieldVal new) - logScalarField baseFieldName toFieldVal old _new = + logChangeableScalar baseFieldName toFieldVal old _new = Log.field baseFieldName (toFieldVal old) logCertField :: ByteString -> [X509.SignedCertificate] -> Msg -> Msg From ae473ca134debdd63c017852f6f8f5cd2e97dbed Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 13 Jan 2026 10:00:14 +0100 Subject: [PATCH 31/38] Test changed domain --- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 58 ++++++++++++++++---- 1 file changed, 46 insertions(+), 12 deletions(-) diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 10d5b59fe9f..986879ba94a 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -63,9 +63,12 @@ spec = _cfgDomainConfigs = Left anyMultiIngressDomainCfg } host = Just "backend.example.com" - miHostAsText = "backend-2.example.com" - miDomain = either (error . show) id $ mkDomain miHostAsText - miHost = Just miHostAsText + miHost1AsText = "backend-1.example.com" + miDomain1 = either (error . show) id $ mkDomain miHost1AsText + miHost1 = Just miHost1AsText + miHost2AsText = "backend-2.example.com" + miDomain2 = either (error . show) id $ mkDomain miHost2AsText + miHost2 = Just miHost2AsText multiIngressSamlConfig = Config { -- The log level only matters for log output, not production. @@ -76,7 +79,7 @@ spec = _cfgSPPort = 8081, _cfgDomainConfigs = Right $ - Map.fromList [(miDomain, anyMultiIngressDomainCfg)] + Map.fromList [(miDomain1, anyMultiIngressDomainCfg), (miDomain2, anyMultiIngressDomainCfg)] } idpHandle = Just $ unsafeRange "some-idp" apiVersionV2 = Just WireIdPAPIV2 @@ -151,14 +154,14 @@ spec = <> fromString idpEndpointString <> "\n" ) - expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ miHostAsText + expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ miHost1AsText expectedLogLineWithoutDomain = expectedLogLine "None" forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do (logs, _res) <- interpretWithLoggingMock Nothing - (idpCreate multiIngressSamlConfig tid zUser miHost idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + (idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing (Just apiVersion) idpHandle) logs `shouldContain` [expectedLogLineWithDomain] -- >=V7 does not bother with multi-ingress domains for IdPs as it can @@ -212,7 +215,7 @@ spec = <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" <> fromString issuerString <> ", domain=" - <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText + <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText <> ", user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" @@ -222,7 +225,7 @@ spec = ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do - idp <- idpCreate multiIngressSamlConfig tid zUser miHost idPMetadataInfo' Nothing apiVersionV2 idpHandle + idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle idpDelete zUser (idp ^. idpId) Nothing logs `shouldContain` [expectedLogLine] @@ -254,7 +257,7 @@ spec = idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo' (idp ^. idpId) Nothing logs `shouldContain` [expectedLogLine] - it "should log IdP update with domain for multi-ingress" $ do + it "should log IdP update with domain for multi-ingress" $ do idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary user :: User <- generate arbitrary let idPMetadataInfo' = @@ -269,7 +272,7 @@ spec = <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" <> fromString issuerString <> ", domain=" - <> (TL.encodeUtf8 . TL.fromStrict) miHostAsText + <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText <> ", user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser <> ", idp-endpoint=" @@ -279,8 +282,39 @@ spec = ) (logs, _res) <- interpretWithLoggingMock (Just user) $ do - idp <- idpCreate multiIngressSamlConfig tid zUser miHost idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpUpdate multiIngressSamlConfig zUser miHost idPMetadataInfo' (idp ^. idpId) Nothing + idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate multiIngressSamlConfig zUser miHost1 idPMetadataInfo' (idp ^. idpId) Nothing + logs `shouldContain` [expectedLogLine] + + it "should log IdP update with changed domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + & idpMetadataRecord . SAML.edIssuer .~ issuer + & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + + expectedLogLine = + ( Info, + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", old-domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText + <> ", new-domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHost2AsText + <> ", user=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" + <> "\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle + idpUpdate multiIngressSamlConfig zUser miHost2 idPMetadataInfo' (idp ^. idpId) Nothing logs `shouldContain` [expectedLogLine] it "should log IdP update (changed cert)" $ do From 4d1eb76e927c077f8f539fcebf300e1551c03d44 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 13 Jan 2026 10:06:55 +0100 Subject: [PATCH 32/38] Reduce duplication in logging code --- services/spar/src/Spar/API.hs | 11 ++++------- services/spar/test/Test/Spar/Saml/IdPSpec.hs | 6 ++++-- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 93a4fa76ffc..08bca7ac297 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -591,9 +591,7 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co "IdP deleted" idp mbzusr - ( Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList)) - . Log.field "idp-endpoint" (idp ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') - ) + id pure NoContent where assertEmptyOrPurge :: TeamId -> Cas.Page (SAML.UserRef, UserId) -> Sem r () @@ -679,10 +677,7 @@ idpCreate samlConfig tid zUser uncheckedMbHost (IdPMetadataValue rawIdpMetadata "IdP created" idp zUser - ( Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList)) - . Log.field "replaces" (maybe "None" (UUID.toString . SAML.fromIdPId) mReplaces) - . Log.field "idp-endpoint" (idp ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') - ) + (Log.field "replaces" (maybe "None" (UUID.toString . SAML.fromIdPId) mReplaces)) pure idp where -- Ensure that the domain is not in use by an existing IDP @@ -709,6 +704,8 @@ logIdPAction msg idp zUser additionalFields = . 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 "user" (maybe "None" idToText zUser) + . Log.field "certificates" (idp ^. SAML.idpMetadata . SAML.edCertAuthnResponse . to (intercalate ";; " . map certToString . toList)) + . Log.field "idp-endpoint" (idp ^. SAML.idpMetadata . SAML.edRequestURI . to URI.serializeURIRef') . additionalFields -- | Only return a ZHost when multi-ingress is configured and the host value is a configured domain diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 986879ba94a..928e73323e0 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -112,9 +112,10 @@ spec = <> fromString issuerString <> ", domain=None, user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None" + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" <> ", idp-endpoint=" <> fromString idpEndpointString + <> ", replaces=None" <> "\n" ) @@ -149,9 +150,10 @@ spec = <> domainPart <> ", user=" <> (TL.encodeUtf8 . TL.fromStrict . idToText . fromJust) zUser - <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37, replaces=None" + <> ", certificates=Issuer: CN=accounts.accesscontrol.windows.net; Subject: CN=accounts.accesscontrol.windows.net; SHA1 Fingerprint: 15:28:A6:B8:5A:C5:36:80:B4:B0:95:C6:9A:FD:77:9C:D6:5C:78:37" <> ", idp-endpoint=" <> fromString idpEndpointString + <> ", replaces=None" <> "\n" ) expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ miHost1AsText From 3e4c745d9a5e54d60c76dc0671a31ee4c775a69c Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 13 Jan 2026 10:09:46 +0100 Subject: [PATCH 33/38] Typo / Improve docs --- services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs index 7c4f314ea23..a123f099de7 100644 --- a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs +++ b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs @@ -52,7 +52,8 @@ samlUserStoreToMem = (runState @(Map UserRefOrd UserId) mempty .) $ -- 'GetAllByIssuerPaginated' and 'NextPage' are workarounds, please also see docs at -- 'Spar.Sem.SAMLUserStore.Cassandra.getAllSAMLUsersByIssuerPaginated' -- - -- This mock only returns on `Page` for all results. + -- This mock only returns one `Page` for all results. This should be fine + -- for tests with small test samples. GetAllByIssuerPaginated is -> gets $ \userMap -> let entries = Data.Bifunctor.first unUserRefOrd From ccbdb299d6c00a1ead105909591f2730a9d4a129 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 13 Jan 2026 10:12:23 +0100 Subject: [PATCH 34/38] Add comment --- services/spar/src/Spar/API.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 08bca7ac297..2337528e162 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -894,6 +894,8 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML when otherIdpsOnSameDomain $ throwSparSem SparIdPDomainInUse + -- We cannot simply call `logIdPAction` here, because we need diffs for + -- some values (old vs. new) logIdPUpdate idp previousIdP = let (removedCerts, newCerts) = compareNonEmpty From fc3d762d5d9003f59ad0a70d7e26c4961b3efa1e Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 13 Jan 2026 10:15:53 +0100 Subject: [PATCH 35/38] Adjust types --- services/spar/src/Spar/API.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 2337528e162..23bb0073761 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -695,7 +695,7 @@ idpCreate samlConfig tid zUser uncheckedMbHost (IdPMetadataValue rawIdpMetadata when (zHost `elem` domains) $ throwSparSem SparIdPDomainInUse -logIdPAction :: (Member (Logger (Msg -> Msg)) r) => String -> IdP -> Maybe UserId -> (Msg -> Msg) -> Sem r () +logIdPAction :: (Member (Logger (Msg -> Msg)) log) => String -> IdP -> Maybe UserId -> (Msg -> Msg) -> Sem log () logIdPAction msg idp zUser additionalFields = Logger.info $ Log.msg (msg) @@ -896,6 +896,7 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML -- We cannot simply call `logIdPAction` here, because we need diffs for -- some values (old vs. new) + logIdPUpdate :: (Member (Logger (Msg -> Msg)) log) => IdP -> IdP -> Sem log () logIdPUpdate idp previousIdP = let (removedCerts, newCerts) = compareNonEmpty From 1ba5cbe219d200b1b9bebbfcfeee818dd70ca50e Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 13 Jan 2026 10:45:26 +0100 Subject: [PATCH 36/38] Update nix deps --- services/spar/default.nix | 2 ++ 1 file changed, 2 insertions(+) diff --git a/services/spar/default.nix b/services/spar/default.nix index 4b4b7bf58b5..60ad6c717a3 100644 --- a/services/spar/default.nix +++ b/services/spar/default.nix @@ -22,6 +22,7 @@ , crypton-x509 , exceptions , extended +, filepath , gitignoreSource , hscim , HsOpenSSL @@ -212,6 +213,7 @@ mkDerivation { bytestring-conversion containers cookie + filepath hscim hspec imports From 8e974b0a989e6f42d1ee282d2b968ae2e517d3ae Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Thu, 15 Jan 2026 16:39:56 +0100 Subject: [PATCH 37/38] No more IdPMetadataInfo lenses --- .../src/Wire/API/User/IdentityProvider.hs | 2 - services/spar/test/Test/Spar/Saml/IdPSpec.hs | 81 +++++++++++++------ 2 files changed, 56 insertions(+), 27 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index 8d591ad7986..441d5dc1a3b 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -170,8 +170,6 @@ data IdPMetadataInfo = IdPMetadataValue } deriving (Eq, Show, Generic) -makeLenses ''IdPMetadataInfo - -- | We want to store the raw xml text from the registration request in the database for -- trouble shooting, but @SAML.XML@ only gives us access to the xml tree, not the raw text. -- 'RawXML' helps with that. diff --git a/services/spar/test/Test/Spar/Saml/IdPSpec.hs b/services/spar/test/Test/Spar/Saml/IdPSpec.hs index 928e73323e0..ac0c67cf8e7 100644 --- a/services/spar/test/Test/Spar/Saml/IdPSpec.hs +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -1,7 +1,6 @@ module Test.Spar.Saml.IdPSpec where import Arbitrary () -import Control.Lens ((.~), (^.)) import Data.Domain import Data.Id (idToText, parseIdFromText) import qualified Data.List.NonEmpty as NonEmptyL @@ -28,7 +27,7 @@ import Spar.Sem.SAMLUserStore import Spar.Sem.SAMLUserStore.Mem import Spar.Sem.ScimTokenStore import Spar.Sem.ScimTokenStore.Mem -import System.FilePath +import System.FilePath (()) import System.Logger (Msg) import System.Logger.Class (Level (..)) import Test.Hspec @@ -37,7 +36,7 @@ import qualified Text.XML.DSig as DSig import URI.ByteString (parseURI, strictURIParserOptions) import URI.ByteString.QQ (uri) import Wire.API.User (User (..)) -import Wire.API.User.IdentityProvider (IdPMetadataInfo (..), WireIdPAPIVersion (..), idpMetadataRecord) +import Wire.API.User.IdentityProvider (IdPMetadataInfo (..), WireIdPAPIVersion (..)) import Wire.Sem.Logger.TinyLog (LogRecorder (..), newLogRecorder, recordLogs) import Wire.Sem.Random import Wire.Sem.Random.Null @@ -101,8 +100,12 @@ spec = idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary let idPMetadataInfo' = idPMetadataInfo - & idpMetadataRecord . SAML.edIssuer .~ issuer - & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } expectedLogLine = ( Info, @@ -136,8 +139,12 @@ spec = idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary let idPMetadataInfo' = idPMetadataInfo - & idpMetadataRecord . SAML.edIssuer .~ issuer - & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } expectedLogLine :: LByteString -> LogLine expectedLogLine domainPart = @@ -180,8 +187,12 @@ spec = user :: User <- generate arbitrary let idPMetadataInfo' = idPMetadataInfo - & idpMetadataRecord . SAML.edIssuer .~ issuer - & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } expectedLogLine = ( Info, @@ -199,7 +210,7 @@ spec = (logs, _res) <- interpretWithLoggingMock (Just user) $ do idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpDelete zUser (idp ^. idpId) Nothing + idpDelete zUser (idp._idpId) Nothing logs `shouldContain` [expectedLogLine] it "should log IdP deletion with domain for multi-ingress" $ do @@ -207,8 +218,12 @@ spec = user :: User <- generate arbitrary let idPMetadataInfo' = idPMetadataInfo - & idpMetadataRecord . SAML.edIssuer .~ issuer - & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } expectedLogLine = ( Info, @@ -228,7 +243,7 @@ spec = (logs, _res) <- interpretWithLoggingMock (Just user) $ do idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpDelete zUser (idp ^. idpId) Nothing + idpDelete zUser (idp._idpId) Nothing logs `shouldContain` [expectedLogLine] describe "idp-update" $ do @@ -237,8 +252,12 @@ spec = user :: User <- generate arbitrary let idPMetadataInfo' = idPMetadataInfo - & idpMetadataRecord . SAML.edIssuer .~ issuer - & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } expectedLogLine = ( Info, @@ -256,7 +275,7 @@ spec = (logs, _res) <- interpretWithLoggingMock (Just user) $ do idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo' (idp ^. idpId) Nothing + idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo' (idp._idpId) Nothing logs `shouldContain` [expectedLogLine] it "should log IdP update with domain for multi-ingress" $ do @@ -264,8 +283,12 @@ spec = user :: User <- generate arbitrary let idPMetadataInfo' = idPMetadataInfo - & idpMetadataRecord . SAML.edIssuer .~ issuer - & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } expectedLogLine = ( Info, @@ -285,7 +308,7 @@ spec = (logs, _res) <- interpretWithLoggingMock (Just user) $ do idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpUpdate multiIngressSamlConfig zUser miHost1 idPMetadataInfo' (idp ^. idpId) Nothing + idpUpdate multiIngressSamlConfig zUser miHost1 idPMetadataInfo' (idp._idpId) Nothing logs `shouldContain` [expectedLogLine] it "should log IdP update with changed domain for multi-ingress" $ do @@ -293,8 +316,12 @@ spec = user :: User <- generate arbitrary let idPMetadataInfo' = idPMetadataInfo - & idpMetadataRecord . SAML.edIssuer .~ issuer - & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } expectedLogLine = ( Info, @@ -316,7 +343,7 @@ spec = (logs, _res) <- interpretWithLoggingMock (Just user) $ do idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpUpdate multiIngressSamlConfig zUser miHost2 idPMetadataInfo' (idp ^. idpId) Nothing + idpUpdate multiIngressSamlConfig zUser miHost2 idPMetadataInfo' (idp._idpId) Nothing logs `shouldContain` [expectedLogLine] it "should log IdP update (changed cert)" $ do @@ -329,8 +356,12 @@ spec = newRequestURI = either (error . show) id . parseURI strictURIParserOptions . fromString $ newIdpEndpointString idPMetadataInfo' = idPMetadataInfo - & idpMetadataRecord . SAML.edIssuer .~ issuer - & idpMetadataRecord . SAML.edRequestURI .~ idpEndpoint + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } newCert = either (error . show) id $ DSig.parseKeyInfo False newKeyInfo newIdPMetadata :: IdPMetadata = @@ -363,7 +394,7 @@ spec = (logs, _res) <- interpretWithLoggingMock (Just user) $ do idp <- idpCreate singleIngressSamlConfig tid zUser host idPMetadataInfo' Nothing apiVersionV2 idpHandle - idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo'' (idp ^. idpId) Nothing + idpUpdate singleIngressSamlConfig zUser host idPMetadataInfo'' (idp._idpId) Nothing logs `shouldContain` [expectedLogLine] type LogLine = (Level, LByteString) From e78e4532ad465d0b0fba65e2a9bce9214b96626f Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Thu, 15 Jan 2026 16:42:06 +0100 Subject: [PATCH 38/38] Address Copilot review findings --- libs/extended/test/Test/Data/X509/ExtendedSpec.hs | 2 +- services/spar/src/Spar/API.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/libs/extended/test/Test/Data/X509/ExtendedSpec.hs b/libs/extended/test/Test/Data/X509/ExtendedSpec.hs index a5af755839e..21d5316799e 100644 --- a/libs/extended/test/Test/Data/X509/ExtendedSpec.hs +++ b/libs/extended/test/Test/Data/X509/ExtendedSpec.hs @@ -12,7 +12,7 @@ spec :: Spec spec = describe "Data.X509.Extended" $ do describe "certToString" $ do - it "should render a representative string of a certificate from stars' Keyloak" $ do + it "should render a representative string of a certificate from stars' Keycloak" $ do let pemFilePath = "test/data/" <> "sven-test.pem" expected = "Issuer: CN=sven-test; Subject: CN=sven-test; SHA1 Fingerprint: F4:A2:73:D7:B7:2E:EA:66:E1:CB:81:E9:58:BC:1A:E9:CF:3C:95:C4" checkDecodingWithPEMFile pemFilePath expected diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 23bb0073761..f36f6f80660 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -695,7 +695,7 @@ idpCreate samlConfig tid zUser uncheckedMbHost (IdPMetadataValue rawIdpMetadata when (zHost `elem` domains) $ throwSparSem SparIdPDomainInUse -logIdPAction :: (Member (Logger (Msg -> Msg)) log) => String -> IdP -> Maybe UserId -> (Msg -> Msg) -> Sem log () +logIdPAction :: (Member (Logger (Msg -> Msg)) r) => String -> IdP -> Maybe UserId -> (Msg -> Msg) -> Sem r () logIdPAction msg idp zUser additionalFields = Logger.info $ Log.msg (msg) @@ -896,7 +896,7 @@ idpUpdateXML zusr mDomain raw idpmeta idpid mHandle = withDebugLog "idpUpdateXML -- We cannot simply call `logIdPAction` here, because we need diffs for -- some values (old vs. new) - logIdPUpdate :: (Member (Logger (Msg -> Msg)) log) => IdP -> IdP -> Sem log () + logIdPUpdate :: (Member (Logger (Msg -> Msg)) r) => IdP -> IdP -> Sem r () logIdPUpdate idp previousIdP = let (removedCerts, newCerts) = compareNonEmpty