Add a parser for IDPSSODescriptor a.k.a. IDP metadata

src/Network/Wai/SAML2/EntityDescriptor.hs

@@ -0,0 +1,94 @@
+--------------------------------------------------------------------------------
+-- SAML2 Middleware for WAI                                                   --
+--------------------------------------------------------------------------------
+-- This source code is licensed under the MIT license found in the LICENSE    --
+-- file in the root directory of this source tree.                            --
+--------------------------------------------------------------------------------
+{-# LANGUAGE LambdaCase #-}
+
+-- | This module provides a datatype for IDP metadata containing certificate,
+-- SSO URLs etc.
+module Network.Wai.SAML2.EntityDescriptor (
+    IDPSSODescriptor(..),
+    Binding(..)
+) where
+
+
+import qualified Data.ByteString.Base64 as Base64
+import qualified Data.X509 as X509
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import Network.Wai.SAML2.XML
+import Text.XML.Cursor
+
+-- | Datatype describing metadata of an identity provider.
+-- See also section 2.4.3 of [Metadata for the OASIS Security Assertion Markup Language (SAML) V2.0](https://docs.oasis-open.org/security/saml/v2.0/saml-metadata-2.0-os.pdf).
+data IDPSSODescriptor
+    = 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
+        -- | Supported NameID formats
+    ,   nameIDFormats :: [Text]
+        -- | List of SSO urls corresponding to 'Binding's
+    ,   singleSignOnServices :: [(Binding, Text)]
+    } deriving Show
+
+-- | urn:oasis:names:tc:SAML:2.0:bindings
+-- https://docs.oasis-open.org/security/saml/v2.0/saml-bindings-2.0-os.pdf
+data Binding
+    -- | SAML protocol messages are transmitted within the base64-encoded content of an HTML form control
+    = HTTPPost
+    -- | SAML protocol messages are transmitted within URL parameters
+    | HTTPRedirect
+    -- | The request and/or response are transmitted by reference using a small stand-in called an artifact
+    | HTTPArtifact
+    -- | Reverse HTTP Binding for SOAP specification
+    | PAOS
+    -- | SOAP is a lightweight protocol intended for exchanging structured information in a decentralized, distributed environment
+    | SOAP
+    -- | SAML protocol messages are encoded into a URL via the DEFLATE compression method
+    | URLEncodingDEFLATE
+    deriving (Show, Eq)
+
+instance FromXML IDPSSODescriptor where
+    parseXML cursor = do
+        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 nameIDFormats = descriptor
+                $/ element (mdName "NameIDFormat")
+                &/ content
+        singleSignOnServices <- traverse parseService
+            $ descriptor $/ element (mdName "SingleSignOnService")
+        pure IDPSSODescriptor{..}
+
+parseService :: MonadFail m => Cursor -> m (Binding, Text)
+parseService cursor = do
+    binding <- oneOrFail "Binding is required" (attribute "Binding" cursor)
+        >>= parseBinding
+    location <- oneOrFail "Location is required" $ attribute "Location" cursor
+    pure (binding, location)
+
+parseBinding :: MonadFail m => Text -> m Binding
+parseBinding = \case
+    "urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Artifact" -> pure HTTPArtifact
+    "urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST" -> pure HTTPPost
+    "urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect" -> pure HTTPRedirect
+    "urn:oasis:names:tc:SAML:2.0:bindings:PAOS" -> pure PAOS
+    "urn:oasis:names:tc:SAML:2.0:bindings:SOAP" -> pure SOAP
+    "urn:oasis:names:tc:SAML:2.0:bindings:URL-Encoding:DEFLATE"
+        -> pure URLEncodingDEFLATE
+    other -> fail $ "Unknown Binding: " <> show other

src/Network/Wai/SAML2/XML.hs

@@ -12,6 +12,7 @@ module Network.Wai.SAML2.XML (
     saml2pName,
     xencName,
     dsName,
+    mdName,
 
     -- * Utility functions
     toMaybeText,
@@ -57,6 +58,12 @@ dsName :: T.Text -> Name
 dsName name =
     Name name (Just "http://www.w3.org/2000/09/xmldsig#") (Just "ds")
 
+-- urn:oasis:names:tc:SAML:2.0:metadata namespace
+mdName :: T.Text -> Name
+mdName name =
+    Name name (Just "urn:oasis:names:tc:SAML:2.0:metadata") (Just "md")
+
+
 -- | 'toMaybeText' @xs@ returns 'Nothing' if @xs@ is the empty list, or
 -- the result of concatenating @xs@ wrapped in 'Just' otherwise.
 toMaybeText :: [T.Text] -> Maybe T.Text

stack-lts-16.1.yaml

@@ -2,5 +2,5 @@ resolver: lts-16.1
 packages:
 - .
 
-extra-deps: 
-- c14n-0.1.0.1@sha256:c56a513c1363d126ee704656b59d2e2af1cfe878587a97cb69ab0122b82e2d4d,1371
+extra-deps:
+- c14n-0.1.0.1@sha256:c56a513c1363d126ee704656b59d2e2af1cfe878587a97cb69ab0122b82e2d4d,1371

tests/Parser.hs

@@ -1,3 +1,7 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeApplications #-}
+import Network.Wai.SAML2.EntityDescriptor
 import Network.Wai.SAML2.Response
 import Network.Wai.SAML2.XML
 import System.FilePath
@@ -8,22 +12,25 @@ import Text.XML.Cursor
 import qualified Data.ByteString.Lazy.Char8 as BC
 import qualified Text.XML as XML
 
-run :: FilePath -> IO BC.ByteString
+run :: forall t. (FromXML t, Show t) => FilePath -> IO BC.ByteString
 run src = do
     doc <- XML.readFile XML.def src
     resp <- parseXML (fromDocument doc)
-    pure $ BC.pack $ ppShow (resp :: Response)
+    pure $ BC.pack $ ppShow (resp :: t)
 
 main :: IO ()
 main = defaultMain $ testGroup "Parse SAML2 response"
-    [ mkGolden $ prefix </> "keycloak.xml"
-    , mkGolden $ prefix </> "okta.xml"
-    , mkGolden $ prefix </> "google.xml"
+    [ mkGolden @Response $ prefix </> "keycloak.xml"
+    , mkGolden @Response $ prefix </> "okta.xml"
+    , mkGolden @Response $ prefix </> "google.xml"
+    , mkGolden @IDPSSODescriptor $ prefix </> "metadata/keycloak.xml"
+    , mkGolden @IDPSSODescriptor $ prefix </> "metadata/google.xml"
     ]
     where
         prefix = "tests/data"
+        mkGolden :: forall t. (FromXML t, Show t) => FilePath -> TestTree
         mkGolden path = goldenVsStringDiff
                 (takeBaseName path)
                 (\ref new -> ["diff", "-u", ref, new])
                 (path <.> "expected")
-                (run path)
+                (run @t path)

tests/data/metadata/google.xml

@@ -0,0 +1,29 @@
+<?xml version="1.0" encoding="UTF-8"?><md:EntityDescriptor xmlns:md="urn:oasis:names:tc:SAML:2.0:metadata" entityID="https://accounts.google.com/o/saml2?idpid=C01aa60hc" validUntil="2027-07-20T09:18:00.000Z">
+  <md:IDPSSODescriptor WantAuthnRequestsSigned="false" protocolSupportEnumeration="urn:oasis:names:tc:SAML:2.0:protocol">
+    <md:KeyDescriptor use="signing">
+      <ds:KeyInfo xmlns:ds="http://www.w3.org/2000/09/xmldsig#">
+        <ds:X509Data>
+          <ds:X509Certificate>MIIDdDCCAlygAwIBAgIGAYIgDLo9MA0GCSqGSIb3DQEBCwUAMHsxFDASBgNVBAoTC0dvb2dsZSBJ
+bmMuMRYwFAYDVQQHEw1Nb3VudGFpbiBWaWV3MQ8wDQYDVQQDEwZHb29nbGUxGDAWBgNVBAsTD0dv
+b2dsZSBGb3IgV29yazELMAkGA1UEBhMCVVMxEzARBgNVBAgTCkNhbGlmb3JuaWEwHhcNMjIwNzIx
+MDkxODAwWhcNMjcwNzIwMDkxODAwWjB7MRQwEgYDVQQKEwtHb29nbGUgSW5jLjEWMBQGA1UEBxMN
+TW91bnRhaW4gVmlldzEPMA0GA1UEAxMGR29vZ2xlMRgwFgYDVQQLEw9Hb29nbGUgRm9yIFdvcmsx
+CzAJBgNVBAYTAlVTMRMwEQYDVQQIEwpDYWxpZm9ybmlhMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8A
+MIIBCgKCAQEA9KQNdYuN7oPUsJ1SK2L58egBELYIWr5cRd9PXuV1k1s2hzt2vMoPS1l788+/hVb4
+CtZCeabZDFYfNMbS2olbhG06FrS9+ptm2pKucXqEp+KM9FozmK/qn7+geQl7uHdcT0xRqfVK46Wr
+RB4S8VdbK9WIK2prCvHIPu1O9eH+m9g+G1Y116RIqKKGfGbsWdhyNY47+LcxXzThgdfi4BPwcB/i
+K/X/i4qNje4FLHrAJQ7S6bRiTXPyv7q9Md96R1T9hXdFA9siW9rmrJCg/H022TrqxwctlIkQjPGj
+yskF3vCcwuIj5M8PuP37k6AuiBZdV73gG8t8SgoMHhElWSLKowIDAQABMA0GCSqGSIb3DQEBCwUA
+A4IBAQDuIthaqITon7u3aZg70NutC54EsQ6NLfWsbwgadOahb5EtGnBkKB7bairnTSAMtH4wLnNj
+BrgxswnxVd5DdrmqpuoY+Pn3hAXYBCFwmAzEEYwmfkZbTVa7AcT6bw6nOqHrfnYump9LhUwxI4dV
+4Yr2YkLL767CeSMLv58GBlFAqxP63HVMa1BJAhZhjamqvSYQCJZYnBG7Nuy2ek6Y5kHQM/8L0h6n
+gx1Jv0nPvPI+9NlWRkUhDN/jQkzxKcYnCNlT/bi3xY+QjFWD4z/Qx2h9hrxZtLRtcrp6WqUmpXha
+dq1JsmSbXwRj4Tu7IVZ4tYqeY/mOJGYf8fr5h/Q8GRCd</ds:X509Certificate>
+        </ds:X509Data>
+      </ds:KeyInfo>
+    </md:KeyDescriptor>
+    <md:NameIDFormat>urn:oasis:names:tc:SAML:1.1:nameid-format:emailAddress</md:NameIDFormat>
+    <md:SingleSignOnService Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect" Location="https://accounts.google.com/o/saml2/idp?idpid=C01aa60hc"/>
+    <md:SingleSignOnService Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST" Location="https://accounts.google.com/o/saml2/idp?idpid=C01aa60hc"/>
+  </md:IDPSSODescriptor>
+</md:EntityDescriptor>