module Network.Wai.SAML2.Assertion (
SubjectConfirmationMethod(..),
SubjectConfirmation(..),
Subject(..),
NameID(..),
Conditions(..),
AudienceRestriction(..),
AuthnStatement(..),
AssertionAttribute(..),
AttributeStatement,
parseAttributeStatement,
Assertion(..)
) where
import Control.Monad
import Data.Maybe (listToMaybe)
import qualified Data.Text as T
import Data.Time
import Text.XML.Cursor
import Network.Wai.SAML2.NameIDFormat
import Network.Wai.SAML2.XML
data SubjectConfirmationMethod
= HolderOfKey
| SenderVouches
| Bearer
deriving (SubjectConfirmationMethod -> SubjectConfirmationMethod -> Bool
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
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 :: forall (m :: * -> *).
MonadFail m =>
Cursor -> m SubjectConfirmationMethod
parseXML Cursor
cursor = case [Text] -> Text
T.concat 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" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SubjectConfirmationMethod
HolderOfKey
Text
"urn:oasis:names:tc:SAML:2.0:cm:sender-vouches" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SubjectConfirmationMethod
SenderVouches
Text
"urn:oasis:names:tc:SAML:2.0:cm:bearer" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure SubjectConfirmationMethod
Bearer
Text
_ -> 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
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
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 :: forall (m :: * -> *).
MonadFail m =>
Cursor -> m SubjectConfirmation
parseXML Cursor
cursor = do
SubjectConfirmationMethod
method <- forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML Cursor
cursor
UTCTime
notOnOrAfter <- forall (m :: * -> *). MonadFail m => Text -> m UTCTime
parseUTCTime forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"SubjectConfirmationData")
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [Text]
attribute Name
"NotOnOrAfter"
forall (f :: * -> *) a. Applicative f => a -> f a
pure SubjectConfirmation{
subjectConfirmationMethod :: SubjectConfirmationMethod
subjectConfirmationMethod = SubjectConfirmationMethod
method,
subjectConfirmationAddress :: Text
subjectConfirmationAddress = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"SubjectConfirmationData")
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 forall a b. (a -> b) -> a -> b
$
Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"SubjectConfirmationData")
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [Text]
attribute Name
"Recipient"
}
data NameID = NameID {
NameID -> Maybe Text
nameIDQualifier :: !(Maybe T.Text),
NameID -> Maybe Text
nameIDSPNameQualifier :: !(Maybe T.Text),
NameID -> Maybe Text
nameIDSPProvidedID :: !(Maybe T.Text),
NameID -> Maybe NameIDFormat
nameIDFormat :: !(Maybe NameIDFormat),
NameID -> Text
nameIDValue :: !T.Text
} deriving (NameID -> NameID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameID -> NameID -> Bool
$c/= :: NameID -> NameID -> Bool
== :: NameID -> NameID -> Bool
$c== :: NameID -> NameID -> Bool
Eq, Int -> NameID -> ShowS
[NameID] -> ShowS
NameID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameID] -> ShowS
$cshowList :: [NameID] -> ShowS
show :: NameID -> String
$cshow :: NameID -> String
showsPrec :: Int -> NameID -> ShowS
$cshowsPrec :: Int -> NameID -> ShowS
Show)
instance FromXML NameID where
parseXML :: forall (m :: * -> *). MonadFail m => Cursor -> m NameID
parseXML Cursor
cursor = do
Maybe NameIDFormat
nameIDFormat <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (m :: * -> *). MonadFail m => Text -> m NameIDFormat
parseNameIDFormat
forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe (Name -> Cursor -> [Text]
attribute Name
"Format" Cursor
cursor)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NameID {
nameIDQualifier :: Maybe Text
nameIDQualifier = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"NameQualifier" Cursor
cursor,
nameIDSPNameQualifier :: Maybe Text
nameIDSPNameQualifier =
forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"SPNameQualifier" Cursor
cursor,
nameIDSPProvidedID :: Maybe Text
nameIDSPProvidedID = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"SPProvidedID" Cursor
cursor,
nameIDFormat :: Maybe NameIDFormat
nameIDFormat = Maybe NameIDFormat
nameIDFormat,
nameIDValue :: Text
nameIDValue = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content
}
data Subject = Subject {
Subject -> [SubjectConfirmation]
subjectConfirmations :: ![SubjectConfirmation],
Subject -> NameID
subjectNameID :: !NameID
} deriving (Subject -> Subject -> Bool
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
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 :: forall (m :: * -> *). MonadFail m => Cursor -> m Subject
parseXML Cursor
cursor = do
[SubjectConfirmation]
confirmations <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$
Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"SubjectConfirmation") forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML
NameID
nameID <- forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"SubjectNameID is required" forall a b. (a -> b) -> a -> b
$
Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"NameID") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML
forall (f :: * -> *) a. Applicative f => a -> f a
pure Subject{
subjectConfirmations :: [SubjectConfirmation]
subjectConfirmations = [SubjectConfirmation]
confirmations,
subjectNameID :: NameID
subjectNameID = NameID
nameID
}
data AudienceRestriction = AudienceRestriction {
AudienceRestriction -> [Text]
audienceRestrictionAudience :: ![T.Text]
} deriving (AudienceRestriction -> AudienceRestriction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AudienceRestriction -> AudienceRestriction -> Bool
$c/= :: AudienceRestriction -> AudienceRestriction -> Bool
== :: AudienceRestriction -> AudienceRestriction -> Bool
$c== :: AudienceRestriction -> AudienceRestriction -> Bool
Eq, Int -> AudienceRestriction -> ShowS
[AudienceRestriction] -> ShowS
AudienceRestriction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AudienceRestriction] -> ShowS
$cshowList :: [AudienceRestriction] -> ShowS
show :: AudienceRestriction -> String
$cshow :: AudienceRestriction -> String
showsPrec :: Int -> AudienceRestriction -> ShowS
$cshowsPrec :: Int -> AudienceRestriction -> ShowS
Show)
instance FromXML AudienceRestriction where
parseXML :: forall (m :: * -> *).
MonadFail m =>
Cursor -> m AudienceRestriction
parseXML Cursor
cursor =
forall (f :: * -> *) a. Applicative f => a -> f a
pure AudienceRestriction{
audienceRestrictionAudience :: [Text]
audienceRestrictionAudience =
let elements :: [Cursor]
elements = Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"Audience")
in [ [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Cursor
element forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Cursor -> [Text]
content
| Cursor
element <- [Cursor]
elements
]
}
data Conditions = Conditions {
Conditions -> UTCTime
conditionsNotBefore :: !UTCTime,
Conditions -> UTCTime
conditionsNotOnOrAfter :: !UTCTime,
Conditions -> [AudienceRestriction]
conditionsAudienceRestrictions :: ![AudienceRestriction]
} deriving (Conditions -> Conditions -> Bool
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
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 :: forall (m :: * -> *). MonadFail m => Cursor -> m Conditions
parseXML Cursor
cursor = do
UTCTime
notBefore <- forall (m :: * -> *). MonadFail m => Text -> m UTCTime
parseUTCTime forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"NotBefore" Cursor
cursor
UTCTime
notOnOrAfter <- forall (m :: * -> *). MonadFail m => Text -> m UTCTime
parseUTCTime forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"NotOnOrAfter" Cursor
cursor
forall (f :: * -> *) a. Applicative f => a -> f a
pure Conditions{
conditionsNotBefore :: UTCTime
conditionsNotBefore = UTCTime
notBefore,
conditionsNotOnOrAfter :: UTCTime
conditionsNotOnOrAfter = UTCTime
notOnOrAfter,
conditionsAudienceRestrictions :: [AudienceRestriction]
conditionsAudienceRestrictions =
Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"AudienceRestriction")
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML
}
data AuthnStatement = AuthnStatement {
AuthnStatement -> UTCTime
authnStatementInstant :: !UTCTime,
AuthnStatement -> Text
authnStatementSessionIndex :: !T.Text,
AuthnStatement -> Text
authnStatementLocality :: !T.Text
} deriving (AuthnStatement -> AuthnStatement -> Bool
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
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 :: forall (m :: * -> *). MonadFail m => Cursor -> m AuthnStatement
parseXML Cursor
cursor = do
UTCTime
issueInstant <- forall (m :: * -> *). MonadFail m => Text -> m UTCTime
parseUTCTime forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"AuthnInstant" Cursor
cursor
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthnStatement{
authnStatementInstant :: UTCTime
authnStatementInstant = UTCTime
issueInstant,
authnStatementSessionIndex :: Text
authnStatementSessionIndex = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
Name -> Cursor -> [Text]
attribute Name
"SessionIndex" Cursor
cursor,
authnStatementLocality :: Text
authnStatementLocality = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"SubjectLocality")
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
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
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 :: forall (m :: * -> *). MonadFail m => Cursor -> m AssertionAttribute
parseXML Cursor
cursor = do
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssertionAttribute{
attributeName :: Text
attributeName = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"Name" Cursor
cursor,
attributeFriendlyName :: Maybe Text
attributeFriendlyName =
[Text] -> Maybe Text
toMaybeText forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"FriendlyName" Cursor
cursor,
attributeNameFormat :: Text
attributeNameFormat = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"NameFormat" Cursor
cursor,
attributeValue :: Text
attributeValue = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"AttributeValue") 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 forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"Attribute") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> 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
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
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 :: forall (m :: * -> *). MonadFail m => Cursor -> m Assertion
parseXML Cursor
cursor = do
UTCTime
issueInstant <- forall (m :: * -> *). MonadFail m => Text -> m UTCTime
parseUTCTime forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"IssueInstant" Cursor
cursor
Subject
subject <- forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"Subject is required" forall a b. (a -> b) -> a -> b
$
Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"Subject") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML
Conditions
conditions <- forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"Conditions are required" forall a b. (a -> b) -> a -> b
$
Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"Conditions") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML
AuthnStatement
authnStatement <- forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"AuthnStatement is required" forall a b. (a -> b) -> a -> b
$
Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"AuthnStatement") forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML
forall (f :: * -> *) a. Applicative f => a -> f a
pure Assertion{
assertionId :: Text
assertionId = [Text] -> Text
T.concat 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 forall a b. (a -> b) -> a -> b
$
Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"Issuer") 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 forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
saml2Name Text
"AttributeStatement")
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [AssertionAttribute]
parseAttributeStatement
}