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
data SubjectConfirmationMethod
= HolderOfKey
| SenderVouches
| 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."
data SubjectConfirmation = SubjectConfirmation {
SubjectConfirmation -> SubjectConfirmationMethod
subjectConfirmationMethod :: !SubjectConfirmationMethod,
SubjectConfirmation -> Text
subjectConfirmationAddress :: !T.Text,
SubjectConfirmation -> UTCTime
subjectConfirmationNotOnOrAfter :: !UTCTime,
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"
}
data Subject = Subject {
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
}
data Conditions = Conditions {
Conditions -> UTCTime
conditionsNotBefore :: !UTCTime,
Conditions -> UTCTime
conditionsNotOnOrAfter :: !UTCTime,
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
}
data AuthnStatement = AuthnStatement {
AuthnStatement -> UTCTime
authnStatementInstant :: !UTCTime,
AuthnStatement -> Text
authnStatementSessionIndex :: !T.Text,
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"
}
data AssertionAttribute = AssertionAttribute {
AssertionAttribute -> Text
attributeName :: !T.Text,
AssertionAttribute -> Maybe Text
attributeFriendlyName :: !(Maybe T.Text),
AssertionAttribute -> Text
attributeNameFormat :: !T.Text,
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
}
type AttributeStatement = [AssertionAttribute]
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
data Assertion = Assertion {
Assertion -> Text
assertionId :: !T.Text,
Assertion -> UTCTime
assertionIssued :: !UTCTime,
Assertion -> Text
assertionIssuer :: !T.Text,
Assertion -> Subject
assertionSubject :: !Subject,
Assertion -> Conditions
assertionConditions :: !Conditions,
Assertion -> AuthnStatement
assertionAuthnStatement :: !AuthnStatement,
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
}