EntityDescriptor: allow multiple certificates in IDPSSODescriptor

mbg · Jul 17, 2024 · 89bcf67 · 89bcf67
1 parent e837904
commit 89bcf67
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 11 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,5 +1,7 @@
 # Changelog for `wai-saml2`
 
+-   Replaced `x509Certificate` to `x509Certificates` in `IDPSSODescriptor` so that it may have more than one certificate (TBD)
+
 ## 0.6
 
 -   Switch from `x509-*` to `crypton-x509-*` ([#50](https://github.com/mbg/wai-saml2/pull/50) by [@mbg](https://github.com/mbg)).

diff --git a/src/Network/Wai/SAML2/EntityDescriptor.hs b/src/Network/Wai/SAML2/EntityDescriptor.hs
@@ -37,7 +37,7 @@ data IDPSSODescriptor
         -- | IdP Entity ID. 'Network.Wai.SAML2.Config.saml2ExpectedIssuer' should be compared against this identifier
         entityID :: Text
         -- | The X.509 certificate for signed assertions
-    ,   x509Certificate :: X509.SignedExact X509.Certificate
+    ,   x509Certificates :: [X509.SignedExact X509.Certificate]
         -- | Supported NameID formats
     ,   nameIDFormats :: [Text]
         -- | List of SSO urls corresponding to 'Binding's
@@ -66,16 +66,18 @@ instance FromXML IDPSSODescriptor where
         let entityID = T.concat $ attribute "entityID" cursor
         descriptor <- oneOrFail "IDPSSODescriptor is required"
             $ cursor $/ element (mdName "IDPSSODescriptor")
-        rawCertificate <- oneOrFail "X509Certificate is required" $ descriptor
-            $/ element (mdName "KeyDescriptor")
-            &/ element (dsName "KeyInfo")
-            &/ element (dsName "X509Data")
-            &/ element (dsName "X509Certificate")
-            &/ content
-        x509Certificate <- either fail pure
-            $ X509.decodeSignedObject
-            $ Base64.decodeLenient
-            $ T.encodeUtf8 rawCertificate
+        let rawCertificates = descriptor
+                $/ element (mdName "KeyDescriptor")
+                &/ element (dsName "KeyInfo")
+                &/ element (dsName "X509Data")
+                &/ element (dsName "X509Certificate")
+                &/ content
+        x509Certificates <- traverse
+            ( either fail pure
+            . X509.decodeSignedObject
+            . Base64.decodeLenient
+            . T.encodeUtf8
+            ) rawCertificates
         let nameIDFormats = descriptor
                 $/ element (mdName "NameIDFormat")
                 &/ content