Fix stripping schema attributes for XML canonicalisation (#51)

When parsing a SAML response, it has been inappropriately stripping `xmlns:xs="http://www.w3.org/2001/XMLSchema"` attribute in saml2:Assertion. This was causing a discrepancy between Okta's digest and our digest (but only when AttributeStatement is present).

This change fixes the problem by setting `psRetainNamespaces = True` and adding "xs" to the list of allowed prefixes for c14n.

Special thanks to @hiroqn for figuring this out

CHANGELOG.md

@@ -3,6 +3,7 @@
 ## Unreleased changes
 
 -   Support GHC 9.6 ([#53](https://github.com/mbg/wai-saml2/pull/53) by [@mbg](https://github.com/mbg))
+-   Fixed a bug in XML canonicalisation causing a digest mismatch on Okta when assertion attributes are present (special thanks to @hiroqn) ([#51](https://github.com/mbg/wai-saml2/pull/51) by [@fumieval](https://github.com/fumieval))
 
 ## 0.4
 

src/Network/Wai/SAML2/C14N.hs

@@ -14,16 +14,19 @@ module Network.Wai.SAML2.C14N (
 --------------------------------------------------------------------------------
 
 import qualified Data.ByteString as BS
+import Data.Text (Text)
+import qualified Data.Text.Encoding as T
 
 import Foreign.C.Types
 
 import Text.XML.C14N
 
 --------------------------------------------------------------------------------
 
--- | 'canonicalise' @xml@ produces a canonical representation of @xml@.
-canonicalise :: BS.ByteString -> IO BS.ByteString
-canonicalise xml = c14n c14nOpts c14n_exclusive_1_0 [] False Nothing xml
+-- | 'canonicalise' @prefixList@ @xml@ produces a canonical representation of @xml@
+-- while retaining namespaces matching @prefixList@.
+canonicalise :: [Text] -> BS.ByteString -> IO BS.ByteString
+canonicalise prefixList xml = c14n c14nOpts c14n_exclusive_1_0 (map T.encodeUtf8 prefixList) False Nothing xml
 
 -- | The options we want to use for canonicalisation of XML documents.
 c14nOpts :: [CInt]

src/Network/Wai/SAML2/Response.hs

@@ -11,6 +11,7 @@ module Network.Wai.SAML2.Response (
     Response(..),
     removeSignature,
     extractSignedInfo,
+    extractPrefixList,
 
     -- * Re-exports
     module Network.Wai.SAML2.StatusCode,
@@ -133,6 +134,16 @@ extractSignedInfo cursor = do
                           ) >>= nodes
     pure signedInfo
 
+-- | Obtain a list of InclusiveNamespaces entries used for exclusive XML canonicalisation.
+extractPrefixList :: Cursor -> [T.Text]
+extractPrefixList cursor = concatMap T.words
+    $ concatMap (attribute "PrefixList")
+    $ cursor
+    $/ element (dsName "Reference")
+    &/ element (dsName "Transforms")
+    &/ element (dsName "Transform")
+    &/ element (ecName "InclusiveNamespaces")
+
 --------------------------------------------------------------------------------
 
 -- Reference [StatusResponseType]

src/Network/Wai/SAML2/Validation.hs

@@ -71,7 +71,7 @@ decodeResponse responseData = do
 
     -- try to parse the XML document; throw an exception if it is not
     -- a valid XML document
-    responseXmlDoc <- case XML.parseLBS def (LBS.fromStrict resXmlDocData) of
+    responseXmlDoc <- case XML.parseLBS parseSettings (LBS.fromStrict resXmlDocData) of
         Left err -> throwError $ InvalidResponseXml err
         Right responseXmlDoc -> pure responseXmlDoc
 
@@ -132,8 +132,9 @@ validateSAMLResponse cfg responseXmlDoc samlResponse now = do
     let signedInfoXml = XML.renderLBS def doc
 
     -- canonicalise the textual representation of the SignedInfo element
+    let prefixList = extractPrefixList (XML.fromDocument doc)
     signedInfoCanonResult <- liftIO $ try $
-        canonicalise (LBS.toStrict signedInfoXml)
+        canonicalise prefixList (LBS.toStrict signedInfoXml)
 
     normalisedSignedInfo <- case signedInfoCanonResult of
         Left err -> throwError $ CanonicalisationFailure err
@@ -163,7 +164,7 @@ validateSAMLResponse cfg responseXmlDoc samlResponse now = do
 
     -- then render the resulting document and canonicalise it
     let renderedXml = XML.renderLBS def docMinusSignature
-    refCanonResult <- liftIO $ try $ canonicalise (LBS.toStrict renderedXml)
+    refCanonResult <- liftIO $ try $ canonicalise prefixList (LBS.toStrict renderedXml)
 
     normalised <- case refCanonResult of
         Left err -> throwError $ CanonicalisationFailure err

src/Network/Wai/SAML2/XML.hs

@@ -13,6 +13,7 @@ module Network.Wai.SAML2.XML (
     xencName,
     dsName,
     mdName,
+    ecName,
 
     -- * Utility functions
     toMaybeText,
@@ -21,7 +22,8 @@ module Network.Wai.SAML2.XML (
 
     -- * XML parsing
     FromXML(..),
-    oneOrFail
+    oneOrFail,
+    parseSettings
 ) where
 
 --------------------------------------------------------------------------------
@@ -66,6 +68,12 @@ mdName name =
     Name name (Just "urn:oasis:names:tc:SAML:2.0:metadata") (Just "md")
 
 
+-- | 'ecName' @name@ constructs a 'Name' for @name@ in the
+-- http://www.w3.org/2001/10/xml-exc-c14n# namespace.
+ecName :: T.Text -> Name
+ecName name =
+    Name name (Just "http://www.w3.org/2001/10/xml-exc-c14n#") (Just "ec")
+
 -- | '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
@@ -100,3 +108,8 @@ oneOrFail err [] = fail err
 oneOrFail _ (x:_) = pure x
 
 --------------------------------------------------------------------------------
+
+-- | It is important to retain namespaces in order to calculate the hash of the canonicalised XML correctly.
+-- see: https://stackoverflow.com/questions/69252831/saml-2-0-digest-value-calculation-in-saml-assertion
+parseSettings :: ParseSettings
+parseSettings = def { psRetainNamespaces = True }