Implement a parser for NameIDFormat

Author: fumieval

src/Network/Wai/SAML2/Assertion.hs

@@ -29,6 +29,7 @@ import Data.Time
 
 import Text.XML.Cursor
 
+import Network.Wai.SAML2.NameIDFormat
 import Network.Wai.SAML2.XML
 
 --------------------------------------------------------------------------------
@@ -95,19 +96,21 @@ data NameId = NameId {
     nameIdSPProvidedID :: !(Maybe T.Text),
     -- | A URI reference describing the format of the value. If not specified it
     -- defaults to @urn:oasis:names:tc:SAML:1.0:nameid-format:unspecified@
-    nameIdFormat :: !(Maybe T.Text),
+    nameIdFormat :: !(Maybe NameIDFormat),
     -- | Some textual identifier for the subject, such as an email address.
     nameIdValue :: !T.Text
 } deriving (Eq, Show)
 
 instance FromXML NameId where
     parseXML cursor = do
+        nameIdFormat <- traverse parseNameIDFormat
+            $ listToMaybe (attribute "Format" cursor)
         pure NameId {
             nameIdQualifier = listToMaybe $ attribute "NameQualifier" cursor,
             nameIdSPNameQualifier =
                 listToMaybe $ attribute "SPNameQualifier" cursor,
             nameIdSPProvidedID = listToMaybe $ attribute "SPProvidedID" cursor,
-            nameIdFormat = listToMaybe $ attribute "Format" cursor,
+            nameIdFormat = nameIdFormat,
             nameIdValue = T.concat $ cursor $/ content
         }
 

src/Network/Wai/SAML2/NameIDFormat.hs

@@ -0,0 +1,65 @@
+--------------------------------------------------------------------------------
+-- 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 DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+
+-- | This modules defines 'NameIDFormat', the datatype specifying the format
+-- of the identifier in an assertion.
+module Network.Wai.SAML2.NameIDFormat (
+    NameIDFormat(..),
+    parseNameIDFormat
+) where
+
+import Data.Text (Text, unpack)
+import GHC.Generics (Generic)
+
+-- | Format of the subject identifier.
+-- See 8.3 Name Identifier Format Identifiers in https://docs.oasis-open.org/security/saml/v2.0/saml-core-2.0-os.pdf
+data NameIDFormat
+    -- | The interpretation is left to individual implementations
+    = Unspecified
+    -- | @addr-spec@ as defined in IETF RFC 2822
+    | EmailAddress
+    -- | contents of the @<ds:X509SubjectName>@ element in the XML Signature Recommendation
+    | X509SubjectName
+    -- | String of the form @DomainName\UserName@
+    | WindowsDomainQualifiedName
+    -- | Kerberos principal name using the format @name[/instance]@REALM@
+    | KerberosPrincipalName
+    -- | identifier of an entity that provides SAML-based services
+    -- (such as a SAML authority, requester, or responder) or is a participant in SAML profiles (such as a service
+    -- provider supporting the browser SSO profile)
+    | Entity
+    -- | identifier of a provider of SAML-based services
+    -- (such as a SAML authority) or a participant in SAML
+    -- profiles (such as a service provider supporting the browser profiles)
+    | Provider
+    -- | persistent opaque identifier that corresponds to an identity
+    -- federation between an identity provider and a service provider
+    | Federated
+    -- | an identifier with transient semantics and SHOULD be treated
+    -- as an opaque and temporary value by the relying party
+    | Transient
+    -- | persistent opaque identifier for a principal that is specific to
+    -- an identity provider and a service provider or affiliation of service providers
+    | Persistent
+    deriving (Eq, Ord, Show, Generic)
+
+-- | Parse a 'NameIDFormat' (prefixed by @urn:oasis:names:tc:SAML:*:nameid-format@).
+parseNameIDFormat :: MonadFail m => Text -> m NameIDFormat
+parseNameIDFormat = \case
+    "urn:oasis:names:tc:SAML:1.1:nameid-format:Kerberos" -> pure KerberosPrincipalName
+    "urn:oasis:names:tc:SAML:1.1:nameid-format:WindowsDomainQualifiedName" -> pure WindowsDomainQualifiedName
+    "urn:oasis:names:tc:SAML:1.1:nameid-format:X509SubjectName" -> pure X509SubjectName
+    "urn:oasis:names:tc:SAML:1.1:nameid-format:emailAddress" -> pure EmailAddress
+    "urn:oasis:names:tc:SAML:1.1:nameid-format:unspecified" -> pure Unspecified
+    "urn:oasis:names:tc:SAML:2.0:nameid-format:entity" -> pure Entity
+    "urn:oasis:names:tc:SAML:2.0:nameid-format:federated" -> pure Federated
+    "urn:oasis:names:tc:SAML:2.0:nameid-format:persistent" -> pure Persistent
+    "urn:oasis:names:tc:SAML:2.0:nameid-format:provider" -> pure Provider
+    "urn:oasis:names:tc:SAML:2.0:nameid-format:transient" -> pure Transient
+    unknown -> fail $ "parseNameIDFormat: unknown format " <> unpack unknown

tests/data/google.xml.expected

@@ -47,8 +47,7 @@ Response
                       { nameIdQualifier = Nothing
                       , nameIdSPNameQualifier = Nothing
                       , nameIdSPProvidedID = Nothing
-                      , nameIdFormat =
-                          Just "urn:oasis:names:tc:SAML:1.1:nameid-format:emailAddress"
+                      , nameIdFormat = Just EmailAddress
                       , nameIdValue = "sdlc-standard@herp.chat"
                       }
                 }

wai-saml2.cabal

@@ -39,6 +39,7 @@ library
       Network.Wai.SAML2.Config
       Network.Wai.SAML2.Error
       Network.Wai.SAML2.KeyInfo
+      Network.Wai.SAML2.NameIDFormat
       Network.Wai.SAML2.Request
       Network.Wai.SAML2.Response
       Network.Wai.SAML2.Signature