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

-- | Types to represent SAML2 assertions and functions to parse them from XML.
module Network.Wai.SAML2.Assertion (
    SubjectConfirmationMethod(..),
    SubjectConfirmation(..),
    Subject(..),
    Conditions(..),
    AuthnStatement(..),
    AssertionAttribute(..),
    AttributeStatement,
    parseAttributeStatement,
    Assertion(..)
) where

--------------------------------------------------------------------------------

import Control.Monad

import qualified Data.Text as T
import Data.Time

import Text.XML.Cursor

import Network.Wai.SAML2.XML

--------------------------------------------------------------------------------

-- | Enumerates different subject confirmation methods.
-- See http://docs.oasis-open.org/security/saml/Post2.0/sstc-saml-tech-overview-2.0-cd-02.html#4.2.1.Subject%20Confirmation%20|outline
data SubjectConfirmationMethod
    = HolderOfKey -- ^ urn:oasis:names:tc:SAML:2.0:cm:holder-of-key
    | SenderVouches -- ^ urn:oasis:names:tc:SAML:2.0:cm:sender-vouches
    | Bearer -- ^ urn:oasis:names:tc:SAML:2.0:cm:bearer
    deriving (SubjectConfirmationMethod -> SubjectConfirmationMethod -> Bool
(SubjectConfirmationMethod -> SubjectConfirmationMethod -> Bool)
-> (SubjectConfirmationMethod -> SubjectConfirmationMethod -> Bool)
-> Eq SubjectConfirmationMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubjectConfirmationMethod -> SubjectConfirmationMethod -> Bool
$c/= :: SubjectConfirmationMethod -> SubjectConfirmationMethod -> Bool
== :: SubjectConfirmationMethod -> SubjectConfirmationMethod -> Bool
$c== :: SubjectConfirmationMethod -> SubjectConfirmationMethod -> Bool
Eq, Int -> SubjectConfirmationMethod -> ShowS
[SubjectConfirmationMethod] -> ShowS
SubjectConfirmationMethod -> String
(Int -> SubjectConfirmationMethod -> ShowS)
-> (SubjectConfirmationMethod -> String)
-> ([SubjectConfirmationMethod] -> ShowS)
-> Show SubjectConfirmationMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubjectConfirmationMethod] -> ShowS
$cshowList :: [SubjectConfirmationMethod] -> ShowS
show :: SubjectConfirmationMethod -> String
$cshow :: SubjectConfirmationMethod -> String
showsPrec :: Int -> SubjectConfirmationMethod -> ShowS
$cshowsPrec :: Int -> SubjectConfirmationMethod -> ShowS
Show)

instance FromXML SubjectConfirmationMethod where 
    parseXML :: Cursor -> m SubjectConfirmationMethod
parseXML Cursor
cursor = case [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"Method" Cursor
cursor of 
        Text
"urn:oasis:names:tc:SAML:2.0:cm:holder-of-key" -> SubjectConfirmationMethod -> m SubjectConfirmationMethod
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubjectConfirmationMethod
HolderOfKey
        Text
"urn:oasis:names:tc:SAML:2.0:cm:sender-vouches" -> SubjectConfirmationMethod -> m SubjectConfirmationMethod
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubjectConfirmationMethod
SenderVouches
        Text
"urn:oasis:names:tc:SAML:2.0:cm:bearer" -> SubjectConfirmationMethod -> m SubjectConfirmationMethod
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubjectConfirmationMethod
Bearer
        Text
_ -> String -> m SubjectConfirmationMethod
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a valid SubjectConfirmationMethod."

--------------------------------------------------------------------------------

-- | Represents a subject confirmation record.
data SubjectConfirmation = SubjectConfirmation {
    -- | The subject confirmation method used.
    SubjectConfirmation -> SubjectConfirmationMethod
subjectConfirmationMethod :: !SubjectConfirmationMethod,
    -- | The address of the subject.
    SubjectConfirmation -> Text
subjectConfirmationAddress :: !T.Text,
    -- | A timestamp.
    SubjectConfirmation -> UTCTime
subjectConfirmationNotOnOrAfter :: !UTCTime,
    -- | The recipient.
    SubjectConfirmation -> Text
subjectConfirmationRecipient :: !T.Text
} deriving (SubjectConfirmation -> SubjectConfirmation -> Bool
(SubjectConfirmation -> SubjectConfirmation -> Bool)
-> (SubjectConfirmation -> SubjectConfirmation -> Bool)
-> Eq SubjectConfirmation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubjectConfirmation -> SubjectConfirmation -> Bool
$c/= :: SubjectConfirmation -> SubjectConfirmation -> Bool
== :: SubjectConfirmation -> SubjectConfirmation -> Bool
$c== :: SubjectConfirmation -> SubjectConfirmation -> Bool
Eq, Int -> SubjectConfirmation -> ShowS
[SubjectConfirmation] -> ShowS
SubjectConfirmation -> String
(Int -> SubjectConfirmation -> ShowS)
-> (SubjectConfirmation -> String)
-> ([SubjectConfirmation] -> ShowS)
-> Show SubjectConfirmation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubjectConfirmation] -> ShowS
$cshowList :: [SubjectConfirmation] -> ShowS
show :: SubjectConfirmation -> String
$cshow :: SubjectConfirmation -> String
showsPrec :: Int -> SubjectConfirmation -> ShowS
$cshowsPrec :: Int -> SubjectConfirmation -> ShowS
Show)

instance FromXML SubjectConfirmation where 
    parseXML :: Cursor -> m SubjectConfirmation
parseXML Cursor
cursor = do 
        SubjectConfirmationMethod
method <- Cursor -> m SubjectConfirmationMethod
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML Cursor
cursor

        UTCTime
notOnOrAfter <- Text -> m UTCTime
forall (m :: * -> *). MonadFail m => Text -> m UTCTime
parseUTCTime (Text -> m UTCTime) -> Text -> m UTCTime
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
            Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"SubjectConfirmationData") 
                  Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [Text]
attribute Name
"NotOnOrAfter"

        SubjectConfirmation -> m SubjectConfirmation
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubjectConfirmation :: SubjectConfirmationMethod
-> Text -> UTCTime -> Text -> SubjectConfirmation
SubjectConfirmation{
            subjectConfirmationMethod :: SubjectConfirmationMethod
subjectConfirmationMethod = SubjectConfirmationMethod
method,
            subjectConfirmationAddress :: Text
subjectConfirmationAddress = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"SubjectConfirmationData")
                      Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [Text]
attribute Name
"Address",
            subjectConfirmationNotOnOrAfter :: UTCTime
subjectConfirmationNotOnOrAfter = UTCTime
notOnOrAfter,
            subjectConfirmationRecipient :: Text
subjectConfirmationRecipient = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
                Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"SubjectConfirmationData")
                      Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [Text]
attribute Name
"Recipient"
        }

-- | The subject of the assertion.
data Subject = Subject {
    -- | The list of subject confirmation elements, if any.
    Subject -> [SubjectConfirmation]
subjectConfirmations :: ![SubjectConfirmation]
} deriving (Subject -> Subject -> Bool
(Subject -> Subject -> Bool)
-> (Subject -> Subject -> Bool) -> Eq Subject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subject -> Subject -> Bool
$c/= :: Subject -> Subject -> Bool
== :: Subject -> Subject -> Bool
$c== :: Subject -> Subject -> Bool
Eq, Int -> Subject -> ShowS
[Subject] -> ShowS
Subject -> String
(Int -> Subject -> ShowS)
-> (Subject -> String) -> ([Subject] -> ShowS) -> Show Subject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subject] -> ShowS
$cshowList :: [Subject] -> ShowS
show :: Subject -> String
$cshow :: Subject -> String
showsPrec :: Int -> Subject -> ShowS
$cshowsPrec :: Int -> Subject -> ShowS
Show)

instance FromXML Subject where 
    parseXML :: Cursor -> m Subject
parseXML Cursor
cursor = do 
        [SubjectConfirmation]
confirmations <- [m SubjectConfirmation] -> m [SubjectConfirmation]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m SubjectConfirmation] -> m [SubjectConfirmation])
-> [m SubjectConfirmation] -> m [SubjectConfirmation]
forall a b. (a -> b) -> a -> b
$ 
            Cursor
cursor Cursor
-> (Cursor -> [m SubjectConfirmation]) -> [m SubjectConfirmation]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"SubjectConfirmation") Axis
-> (Cursor -> m SubjectConfirmation)
-> Cursor
-> [m SubjectConfirmation]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| Cursor -> m SubjectConfirmation
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML

        Subject -> m Subject
forall (f :: * -> *) a. Applicative f => a -> f a
pure Subject :: [SubjectConfirmation] -> Subject
Subject{
            subjectConfirmations :: [SubjectConfirmation]
subjectConfirmations = [SubjectConfirmation]
confirmations
        }

--------------------------------------------------------------------------------

-- | Conditions under which a SAML assertion is issued.
data Conditions = Conditions {
    -- | The time when the assertion is valid from (inclusive).
    Conditions -> UTCTime
conditionsNotBefore :: !UTCTime,
    -- | The time the assertion is valid to (not inclusive).
    Conditions -> UTCTime
conditionsNotOnOrAfter :: !UTCTime,
    -- | The intended audience of the assertion.
    Conditions -> Text
conditionsAudience :: !T.Text
} deriving (Conditions -> Conditions -> Bool
(Conditions -> Conditions -> Bool)
-> (Conditions -> Conditions -> Bool) -> Eq Conditions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Conditions -> Conditions -> Bool
$c/= :: Conditions -> Conditions -> Bool
== :: Conditions -> Conditions -> Bool
$c== :: Conditions -> Conditions -> Bool
Eq, Int -> Conditions -> ShowS
[Conditions] -> ShowS
Conditions -> String
(Int -> Conditions -> ShowS)
-> (Conditions -> String)
-> ([Conditions] -> ShowS)
-> Show Conditions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Conditions] -> ShowS
$cshowList :: [Conditions] -> ShowS
show :: Conditions -> String
$cshow :: Conditions -> String
showsPrec :: Int -> Conditions -> ShowS
$cshowsPrec :: Int -> Conditions -> ShowS
Show)

instance FromXML Conditions where
    parseXML :: Cursor -> m Conditions
parseXML Cursor
cursor = do 
        UTCTime
notBefore <- Text -> m UTCTime
forall (m :: * -> *). MonadFail m => Text -> m UTCTime
parseUTCTime (Text -> m UTCTime) -> Text -> m UTCTime
forall a b. (a -> b) -> a -> b
$ 
            [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"NotBefore" Cursor
cursor
        UTCTime
notOnOrAfter <- Text -> m UTCTime
forall (m :: * -> *). MonadFail m => Text -> m UTCTime
parseUTCTime (Text -> m UTCTime) -> Text -> m UTCTime
forall a b. (a -> b) -> a -> b
$ 
            [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"NotOnOrAfter" Cursor
cursor

        Conditions -> m Conditions
forall (f :: * -> *) a. Applicative f => a -> f a
pure Conditions :: UTCTime -> UTCTime -> Text -> Conditions
Conditions{
            conditionsNotBefore :: UTCTime
conditionsNotBefore = UTCTime
notBefore,
            conditionsNotOnOrAfter :: UTCTime
conditionsNotOnOrAfter = UTCTime
notOnOrAfter,
            conditionsAudience :: Text
conditionsAudience = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ 
                Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"AudienceRestriction")
                    Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
saml2Name Text
"Audience")
                    Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
        }

--------------------------------------------------------------------------------

-- | SAML2 authentication statements.
data AuthnStatement = AuthnStatement {
    -- | The timestamp when the assertion was issued.
    AuthnStatement -> UTCTime
authnStatementInstant :: !UTCTime,
    -- | The session index.
    AuthnStatement -> Text
authnStatementSessionIndex :: !T.Text,
    -- | The statement locality.
    AuthnStatement -> Text
authnStatementLocality :: !T.Text
} deriving (AuthnStatement -> AuthnStatement -> Bool
(AuthnStatement -> AuthnStatement -> Bool)
-> (AuthnStatement -> AuthnStatement -> Bool) -> Eq AuthnStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthnStatement -> AuthnStatement -> Bool
$c/= :: AuthnStatement -> AuthnStatement -> Bool
== :: AuthnStatement -> AuthnStatement -> Bool
$c== :: AuthnStatement -> AuthnStatement -> Bool
Eq, Int -> AuthnStatement -> ShowS
[AuthnStatement] -> ShowS
AuthnStatement -> String
(Int -> AuthnStatement -> ShowS)
-> (AuthnStatement -> String)
-> ([AuthnStatement] -> ShowS)
-> Show AuthnStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthnStatement] -> ShowS
$cshowList :: [AuthnStatement] -> ShowS
show :: AuthnStatement -> String
$cshow :: AuthnStatement -> String
showsPrec :: Int -> AuthnStatement -> ShowS
$cshowsPrec :: Int -> AuthnStatement -> ShowS
Show)

instance FromXML AuthnStatement where
    parseXML :: Cursor -> m AuthnStatement
parseXML Cursor
cursor = do 
        UTCTime
issueInstant <- Text -> m UTCTime
forall (m :: * -> *). MonadFail m => Text -> m UTCTime
parseUTCTime (Text -> m UTCTime) -> Text -> m UTCTime
forall a b. (a -> b) -> a -> b
$ 
            [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"AuthnInstant" Cursor
cursor

        AuthnStatement -> m AuthnStatement
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthnStatement :: UTCTime -> Text -> Text -> AuthnStatement
AuthnStatement{
            authnStatementInstant :: UTCTime
authnStatementInstant = UTCTime
issueInstant,
            authnStatementSessionIndex :: Text
authnStatementSessionIndex = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ 
                Name -> Cursor -> [Text]
attribute Name
"SessionIndex" Cursor
cursor, 
            authnStatementLocality :: Text
authnStatementLocality = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ 
                Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"SubjectLocality") 
                    Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [Text]
attribute Name
"Address"
        }

--------------------------------------------------------------------------------

-- | SAML2 assertion attributes.
data AssertionAttribute = AssertionAttribute {
    -- | The name of the attribute.
    AssertionAttribute -> Text
attributeName :: !T.Text,
    -- | A friendly attribute name, if it exists.
    AssertionAttribute -> Maybe Text
attributeFriendlyName :: !(Maybe T.Text),
    -- | The name format.
    AssertionAttribute -> Text
attributeNameFormat :: !T.Text,
    -- | The value of the attribute.
    AssertionAttribute -> Text
attributeValue :: !T.Text
} deriving (AssertionAttribute -> AssertionAttribute -> Bool
(AssertionAttribute -> AssertionAttribute -> Bool)
-> (AssertionAttribute -> AssertionAttribute -> Bool)
-> Eq AssertionAttribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssertionAttribute -> AssertionAttribute -> Bool
$c/= :: AssertionAttribute -> AssertionAttribute -> Bool
== :: AssertionAttribute -> AssertionAttribute -> Bool
$c== :: AssertionAttribute -> AssertionAttribute -> Bool
Eq, Int -> AssertionAttribute -> ShowS
[AssertionAttribute] -> ShowS
AssertionAttribute -> String
(Int -> AssertionAttribute -> ShowS)
-> (AssertionAttribute -> String)
-> ([AssertionAttribute] -> ShowS)
-> Show AssertionAttribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssertionAttribute] -> ShowS
$cshowList :: [AssertionAttribute] -> ShowS
show :: AssertionAttribute -> String
$cshow :: AssertionAttribute -> String
showsPrec :: Int -> AssertionAttribute -> ShowS
$cshowsPrec :: Int -> AssertionAttribute -> ShowS
Show)

instance FromXML AssertionAttribute where
    parseXML :: Cursor -> m AssertionAttribute
parseXML Cursor
cursor = do  
        AssertionAttribute -> m AssertionAttribute
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssertionAttribute :: Text -> Maybe Text -> Text -> Text -> AssertionAttribute
AssertionAttribute{
            attributeName :: Text
attributeName = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"Name" Cursor
cursor,
            attributeFriendlyName :: Maybe Text
attributeFriendlyName = 
                [Text] -> Maybe Text
toMaybeText ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"FriendlyName" Cursor
cursor,
            attributeNameFormat :: Text
attributeNameFormat = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"NameFormat" Cursor
cursor,
            attributeValue :: Text
attributeValue = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ 
                Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"AttributeValue") Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
        }

-- | SAML2 assertion statements (collections of assertion attributes).
type AttributeStatement = [AssertionAttribute]

-- | 'parseAttributeStatement' @cursor@ parses an 'AttributeStatement'.
parseAttributeStatement :: Cursor -> AttributeStatement
parseAttributeStatement :: Cursor -> [AssertionAttribute]
parseAttributeStatement Cursor
cursor = 
    Cursor
cursor Cursor -> (Cursor -> [AssertionAttribute]) -> [AssertionAttribute]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"Attribute") Axis
-> (Cursor -> [AssertionAttribute])
-> Cursor
-> [AssertionAttribute]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [AssertionAttribute]
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML

--------------------------------------------------------------------------------

-- | Represents a SAML2 assertion.
data Assertion = Assertion {
    -- | The unique ID of this assertion. It is important to keep track of
    -- these in order to avoid replay attacks. 
    Assertion -> Text
assertionId :: !T.Text,
    -- | The date and time when the assertion was issued.
    Assertion -> UTCTime
assertionIssued :: !UTCTime,
    -- | The name of the entity that issued this assertion.
    Assertion -> Text
assertionIssuer :: !T.Text,
    -- | The subject of the assertion.
    Assertion -> Subject
assertionSubject :: !Subject,
    -- | The conditions under which the assertion is issued.
    Assertion -> Conditions
assertionConditions :: !Conditions,
    -- | The authentication statement included in the assertion.
    Assertion -> AuthnStatement
assertionAuthnStatement :: !AuthnStatement,
    -- | The assertion's attribute statement.
    Assertion -> [AssertionAttribute]
assertionAttributeStatement :: !AttributeStatement
} deriving (Assertion -> Assertion -> Bool
(Assertion -> Assertion -> Bool)
-> (Assertion -> Assertion -> Bool) -> Eq Assertion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assertion -> Assertion -> Bool
$c/= :: Assertion -> Assertion -> Bool
== :: Assertion -> Assertion -> Bool
$c== :: Assertion -> Assertion -> Bool
Eq, Int -> Assertion -> ShowS
[Assertion] -> ShowS
Assertion -> String
(Int -> Assertion -> ShowS)
-> (Assertion -> String)
-> ([Assertion] -> ShowS)
-> Show Assertion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assertion] -> ShowS
$cshowList :: [Assertion] -> ShowS
show :: Assertion -> String
$cshow :: Assertion -> String
showsPrec :: Int -> Assertion -> ShowS
$cshowsPrec :: Int -> Assertion -> ShowS
Show)

instance FromXML Assertion where 
    parseXML :: Cursor -> m Assertion
parseXML Cursor
cursor = do 
        UTCTime
issueInstant <- Text -> m UTCTime
forall (m :: * -> *). MonadFail m => Text -> m UTCTime
parseUTCTime (Text -> m UTCTime) -> Text -> m UTCTime
forall a b. (a -> b) -> a -> b
$  
            [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"IssueInstant" Cursor
cursor

        Subject
subject <- String -> [Subject] -> m Subject
forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"Subject is required" ([Subject] -> m Subject) -> [Subject] -> m Subject
forall a b. (a -> b) -> a -> b
$
            Cursor
cursor Cursor -> (Cursor -> [Subject]) -> [Subject]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"Subject") Axis -> (Cursor -> [Subject]) -> Cursor -> [Subject]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Subject]
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML

        Conditions
conditions <- String -> [Conditions] -> m Conditions
forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"Conditions are required" ([Conditions] -> m Conditions) -> [Conditions] -> m Conditions
forall a b. (a -> b) -> a -> b
$
            Cursor
cursor Cursor -> (Cursor -> [Conditions]) -> [Conditions]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"Conditions") Axis -> (Cursor -> [Conditions]) -> Cursor -> [Conditions]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Conditions]
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML

        AuthnStatement
authnStatement <- String -> [AuthnStatement] -> m AuthnStatement
forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"AuthnStatement is required" ([AuthnStatement] -> m AuthnStatement)
-> [AuthnStatement] -> m AuthnStatement
forall a b. (a -> b) -> a -> b
$ 
            Cursor
cursor Cursor -> (Cursor -> [AuthnStatement]) -> [AuthnStatement]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"AuthnStatement") Axis -> (Cursor -> [AuthnStatement]) -> Cursor -> [AuthnStatement]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [AuthnStatement]
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML

        Assertion -> m Assertion
forall (f :: * -> *) a. Applicative f => a -> f a
pure Assertion :: Text
-> UTCTime
-> Text
-> Subject
-> Conditions
-> AuthnStatement
-> [AssertionAttribute]
-> Assertion
Assertion{
            assertionId :: Text
assertionId = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"ID" Cursor
cursor,
            assertionIssued :: UTCTime
assertionIssued = UTCTime
issueInstant,
            assertionIssuer :: Text
assertionIssuer = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ 
                Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"Issuer") Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content,
            assertionSubject :: Subject
assertionSubject = Subject
subject,
            assertionConditions :: Conditions
assertionConditions = Conditions
conditions,
            assertionAuthnStatement :: AuthnStatement
assertionAuthnStatement = AuthnStatement
authnStatement,
            assertionAttributeStatement :: [AssertionAttribute]
assertionAttributeStatement = 
                Cursor
cursor Cursor -> (Cursor -> [AssertionAttribute]) -> [AssertionAttribute]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"AttributeStatement") 
                    Axis
-> (Cursor -> [AssertionAttribute])
-> Cursor
-> [AssertionAttribute]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [AssertionAttribute]
parseAttributeStatement 
        }

--------------------------------------------------------------------------------