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. 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..964c2ee3028 --- /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 SHA1) + -- 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, + "SHA1 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..21d5316799e --- /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' 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 + + 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; 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 () +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/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/libs/wire-api/src/Wire/API/User/IdentityProvider.hs b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs index b6ffbd71299..441d5dc1a3b 100644 --- a/libs/wire-api/src/Wire/API/User/IdentityProvider.hs +++ b/libs/wire-api/src/Wire/API/User/IdentityProvider.hs @@ -164,7 +164,10 @@ 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) -- | We want to store the raw xml text from the registration request in the database for 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 diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 6d26c0d0f07..f4252f1c4f2 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 @@ -633,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 f5f9de0d1e9..f36f6f80660 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -42,6 +42,15 @@ 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, + idpUpdate, ) where @@ -62,6 +71,9 @@ 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 qualified Data.X509 as X509 +import Data.X509.Extended import Imports import Network.Wai (Request, requestHeaders) import Network.Wai.Utilities.Request @@ -107,6 +119,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 +226,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, @@ -239,7 +253,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 @@ -472,7 +486,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, @@ -505,7 +519,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, @@ -519,7 +533,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, @@ -542,7 +556,7 @@ idpGetAllByTeamId tid = do 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 +587,11 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co do IdPConfigStore.deleteConfig idp IdPRawMetadataStore.delete idpid + logIdPAction + "IdP deleted" + idp + mbzusr + id pure NoContent where assertEmptyOrPurge :: TeamId -> Cas.Page (SAML.UserRef, UserId) -> Sem r () @@ -626,7 +645,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 String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member ScimTokenStore r, @@ -636,13 +655,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 @@ -653,6 +673,11 @@ 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 + zUser + (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 @@ -670,6 +695,19 @@ idpCreate samlConfig tid uncheckedMbHost (IdPMetadataValue rawIdpMetadata idpmet when (zHost `elem` domains) $ throwSparSem SparIdPDomainInUse +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" (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 filterMultiIngressZHost :: Either SAML.MultiIngressDomainConfig (Map Domain SAML.MultiIngressDomainConfig) -> Maybe ZHostValue -> Maybe ZHostValue filterMultiIngressZHost (Right domainMap) (Just zHost) | (Domain zHost) `Map.member` domainMap = Just zHost @@ -677,7 +715,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, @@ -687,14 +725,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 @@ -736,7 +775,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 ) => @@ -760,8 +799,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 @@ -780,7 +819,7 @@ validateNewIdP apiversion _idpMetadata teamId mReplaces idpDomain idHandle = wit -- 'IdPMetadataInfo' directly where convenient. idpUpdate :: ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -800,7 +839,7 @@ idpUpdate samlConfig zusr uncheckedMbHost (IdPMetadataValue raw xml) = idpUpdateXML :: ( Member Random r, - Member (Logger String) r, + Member (Logger (Msg -> Msg)) r, Member GalleyAccess r, Member BrigAccess r, Member IdPConfigStore r, @@ -815,7 +854,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 +872,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 +894,60 @@ 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 :: (Member (Logger (Msg -> Msg)) r) => IdP -> IdP -> Sem r () + 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) + . logChangeableScalar + "issuer" + URI.serializeURIRef' + (previousIdP ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer) + (idp ^. SAML.idpMetadata . SAML.edIssuer . SAML.fromIssuer) + . logChangeableScalar + "domain" + (fromMaybe "None") + (previousIdP ^. SAML.idpExtraInfo . domain) + (idp ^. SAML.idpExtraInfo . domain) + . Log.field "user" (maybe "None" idToText zusr) + . logChangeableScalar + "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 + + 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) + logChangeableScalar baseFieldName toFieldVal old _new = + Log.field baseFieldName (toFieldVal old) + + logCertField :: ByteString -> [X509.SignedCertificate] -> Msg -> Msg + logCertField fieldName certs + | not (null certs) = + Log.field fieldName ((intercalate ";; " . map certToString) certs) + logCertField _ _ = id + + 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 @@ -862,7 +956,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, @@ -871,7 +965,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 +998,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 @@ -919,12 +1013,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 :: diff --git a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs index 131ae266814..a123f099de7 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,15 @@ 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 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 + <$> 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 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..ac0c67cf8e7 --- /dev/null +++ b/services/spar/test/Test/Spar/Saml/IdPSpec.hs @@ -0,0 +1,479 @@ +module Test.Spar.Saml.IdPSpec where + +import Arbitrary () +import Data.Domain +import Data.Id (idToText, 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, idpUpdate) +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.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 (..)) +import Wire.Sem.Logger.TinyLog (LogRecorder (..), newLogRecorder, recordLogs) +import Wire.Sem.Random +import Wire.Sem.Random.Null + +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. + -- Thus, we could put anything here, it just needs to be a valid + -- value. + _cfgLogLevel = Trace, + _cfgSPHost = "localhost", + _cfgSPPort = 8081, + _cfgDomainConfigs = Left anyMultiIngressDomainCfg + } + host = Just "backend.example.com" + 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. + -- Thus, we could put anything here, it just needs to be a valid + -- value. + _cfgLogLevel = Trace, + _cfgSPHost = "localhost", + _cfgSPPort = 8081, + _cfgDomainConfigs = + Right $ + Map.fromList [(miDomain1, anyMultiIngressDomainCfg), (miDomain2, anyMultiIngressDomainCfg)] + } + idpHandle = Just $ unsafeRange "some-idp" + apiVersionV2 = Just WireIdPAPIV2 + issuerString = "https://accounts.accesscontrol.windows.net/auth" + issuer = + either (error . show) Issuer + . 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 = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP created, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", 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" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", replaces=None" + <> "\n" + ) + + 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 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 idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine :: LByteString -> LogLine + expectedLogLine domainPart = + ( Info, + "IdP created, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=" + <> 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" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> ", replaces=None" + <> "\n" + ) + expectedLogLineWithDomain = expectedLogLine . TL.encodeUtf8 . TL.fromStrict $ miHost1AsText + expectedLogLineWithoutDomain = expectedLogLine "None" + + forM_ [(minBound :: WireIdPAPIVersion) .. maxBound] $ \apiVersion -> do + (logs, _res) <- + interpretWithLoggingMock + Nothing + (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 + -- only have one IdP per team anyways. + (logsV7, _res) <- + interpretWithLoggingMock + Nothing + (idpCreateV7 multiIngressSamlConfig tid zUser idPMetadataInfo' Nothing (Just apiVersion) idpHandle) + logsV7 `shouldContain` [expectedLogLineWithoutDomain] + + describe "idp-delete" $ do + it "should log IdP deletion" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP deleted, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", 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" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> "\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] + + it "should log IdP deletion with domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP deleted, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=" + <> (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" + <> ", idp-endpoint=" + <> fromString idpEndpointString + <> "\n" + ) + + (logs, _res) <- interpretWithLoggingMock (Just user) $ do + idp <- idpCreate multiIngressSamlConfig tid zUser miHost1 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 + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> 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" + ) + + (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] + + it "should log IdP update with domain for multi-ingress" $ do + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + let idPMetadataInfo' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + expectedLogLine = + ( Info, + "IdP updated, team=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", idpId=00000000-0000-0000-0000-000000000000, issuer=" + <> fromString issuerString + <> ", domain=" + <> (TL.encodeUtf8 . TL.fromStrict) miHost1AsText + <> ", 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 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 = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + 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 + idPMetadataInfo :: IdPMetadataInfo <- generate arbitrary + user :: User <- generate arbitrary + newKeyInfo <- readSampleIO "okta-keyinfo-1.xml" + 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' = + idPMetadataInfo + { _idpMetadataRecord = + (idPMetadataInfo._idpMetadataRecord) + { SAML._edIssuer = issuer, + SAML._edRequestURI = idpEndpoint + } + } + + 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=" + <> (TL.encodeUtf8 . TL.fromStrict . idToText) tid + <> ", 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 + <> ", 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" + ) + + (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) + +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 + pure (logs, either (error . show) id a) + +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 + +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 + ] + +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 + +