Log SAML IdP changes

changelog.d/2-features/log-saml-idp-changes

@@ -0,0 +1 @@
+Log changes to IdP configurations made via the IdP REST API to syslog.

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

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

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))

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; 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

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-----

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-----
+

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)
 

libs/wire-api/src/Wire/API/User/IdentityProvider.hs

@@ -164,9 +164,14 @@ deriveJSON (defaultOptsDropChar '_') ''IdPList
 -- implement @{"uri": <url>, "cert": <pinned_pubkey>}@.  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.

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