{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- |
-- SAML Assertions
--
-- <https://docs.oasis-open.org/security/saml/v2.0/saml-core-2.0-os.pdf saml-core-2.0-os> §2
module SAML2.Core.Assertions where

import qualified Text.XML.HXT.Arrow.Pickle.Schema as XPS

import SAML2.Lens
import SAML2.XML
import qualified Text.XML.HXT.Arrow.Pickle.Xml.Invertible as XP
import qualified SAML2.XML.Schema as XS
import qualified SAML2.XML.Signature.Types as DS
import qualified SAML2.XML.Encryption as XEnc
import SAML2.Core.Namespaces
import SAML2.Core.Versioning
import SAML2.Core.Identifiers
import SAML2.Profiles.ConfirmationMethod

ns :: Namespace
ns :: Namespace
ns = String -> URI -> Namespace
mkNamespace String
"" (URI -> Namespace) -> URI -> Namespace
forall a b. (a -> b) -> a -> b
$ SAMLVersion -> [String] -> URI
samlURN SAMLVersion
SAML20 [String
"assertion"]

xpElem :: String -> XP.PU a -> XP.PU a
xpElem :: String -> PU a -> PU a
xpElem = Namespace -> String -> PU a -> PU a
forall a. Namespace -> String -> PU a -> PU a
xpTrimElemNS Namespace
ns

-- |§2.2.1
data BaseID id = BaseID
  { BaseID id -> Maybe String
baseNameQualifier :: Maybe XString
  , BaseID id -> Maybe String
baseSPNameQualifier :: Maybe XString
  , BaseID id -> id
baseID :: !id
  } deriving (BaseID id -> BaseID id -> Bool
(BaseID id -> BaseID id -> Bool)
-> (BaseID id -> BaseID id -> Bool) -> Eq (BaseID id)
forall id. Eq id => BaseID id -> BaseID id -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BaseID id -> BaseID id -> Bool
$c/= :: forall id. Eq id => BaseID id -> BaseID id -> Bool
== :: BaseID id -> BaseID id -> Bool
$c== :: forall id. Eq id => BaseID id -> BaseID id -> Bool
Eq, Int -> BaseID id -> ShowS
[BaseID id] -> ShowS
BaseID id -> String
(Int -> BaseID id -> ShowS)
-> (BaseID id -> String)
-> ([BaseID id] -> ShowS)
-> Show (BaseID id)
forall id. Show id => Int -> BaseID id -> ShowS
forall id. Show id => [BaseID id] -> ShowS
forall id. Show id => BaseID id -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BaseID id] -> ShowS
$cshowList :: forall id. Show id => [BaseID id] -> ShowS
show :: BaseID id -> String
$cshow :: forall id. Show id => BaseID id -> String
showsPrec :: Int -> BaseID id -> ShowS
$cshowsPrec :: forall id. Show id => Int -> BaseID id -> ShowS
Show)

xpBaseID :: XP.PU id -> XP.PU (BaseID id)
xpBaseID :: PU id -> PU (BaseID id)
xpBaseID PU id
idp = [XP.biCase|((n, s), i) <-> BaseID n s i|]
  Bijection (->) ((Maybe String, Maybe String), id) (BaseID id)
-> PU ((Maybe String, Maybe String), id) -> PU (BaseID id)
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"NameQualifier"   PU String
XS.xpString
    PU (Maybe String)
-> PU (Maybe String) -> PU (Maybe String, Maybe String)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"SPNameQualifier" PU String
XS.xpString
    PU (Maybe String, Maybe String)
-> PU id -> PU ((Maybe String, Maybe String), id)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU id
idp)

-- |§2.2.3
data NameID = NameID
  { NameID -> BaseID String
nameBaseID :: BaseID XString
  , NameID -> IdentifiedURI NameIDFormat
nameIDFormat :: IdentifiedURI NameIDFormat
  , NameID -> Maybe String
nameSPProvidedID :: Maybe XString
  } deriving (NameID -> NameID -> Bool
(NameID -> NameID -> Bool)
-> (NameID -> NameID -> Bool) -> Eq NameID
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
(Int -> NameID -> ShowS)
-> (NameID -> String) -> ([NameID] -> ShowS) -> Show NameID
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)

simpleNameID :: NameIDFormat -> XString -> NameID
simpleNameID :: NameIDFormat -> String -> NameID
simpleNameID NameIDFormat
f String
s = BaseID String
-> IdentifiedURI NameIDFormat -> Maybe String -> NameID
NameID (Maybe String -> Maybe String -> String -> BaseID String
forall id. Maybe String -> Maybe String -> id -> BaseID id
BaseID Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing String
s) (NameIDFormat -> IdentifiedURI NameIDFormat
forall b a. a -> Identified b a
Identified NameIDFormat
f) Maybe String
forall a. Maybe a
Nothing

xpNameIDDefaulting :: IdentifiedURI NameIDFormat -> XP.PU NameID
xpNameIDDefaulting :: IdentifiedURI NameIDFormat -> PU NameID
xpNameIDDefaulting IdentifiedURI NameIDFormat
fmt = [XP.biCase|((f, p), b) <-> NameID b f p|]
  Bijection
  (->)
  ((IdentifiedURI NameIDFormat, Maybe String), BaseID String)
  NameID
-> PU ((IdentifiedURI NameIDFormat, Maybe String), BaseID String)
-> PU NameID
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (IdentifiedURI NameIDFormat
-> PU (IdentifiedURI NameIDFormat)
-> PU (IdentifiedURI NameIDFormat)
forall a. Eq a => a -> PU a -> PU a
XP.xpDefault IdentifiedURI NameIDFormat
fmt (String
-> PU (IdentifiedURI NameIDFormat)
-> PU (IdentifiedURI NameIDFormat)
forall a. String -> PU a -> PU a
XP.xpAttr String
"Format" PU (IdentifiedURI NameIDFormat)
forall a. XmlPickler a => PU a
XP.xpickle)
    PU (IdentifiedURI NameIDFormat)
-> PU (Maybe String)
-> PU (IdentifiedURI NameIDFormat, Maybe String)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"SPProvidedID" PU String
XS.xpString
    PU (IdentifiedURI NameIDFormat, Maybe String)
-> PU (BaseID String)
-> PU ((IdentifiedURI NameIDFormat, Maybe String), BaseID String)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU String -> PU (BaseID String)
forall id. PU id -> PU (BaseID id)
xpBaseID PU String
XS.xpString)

xpNameID :: XP.PU NameID
xpNameID :: PU NameID
xpNameID = IdentifiedURI NameIDFormat -> PU NameID
xpNameIDDefaulting (IdentifiedURI NameIDFormat -> PU NameID)
-> IdentifiedURI NameIDFormat -> PU NameID
forall a b. (a -> b) -> a -> b
$ NameIDFormat -> IdentifiedURI NameIDFormat
forall b a. a -> Identified b a
Identified NameIDFormat
NameIDFormatUnspecified

instance XP.XmlPickler NameID where
  xpickle :: PU NameID
xpickle = String -> PU NameID -> PU NameID
forall a. String -> PU a -> PU a
xpElem String
"NameID" PU NameID
xpNameID

type EncryptedNameID = EncryptedElement NameID

instance XP.XmlPickler EncryptedNameID where
  xpickle :: PU EncryptedNameID
xpickle = String -> PU EncryptedNameID -> PU EncryptedNameID
forall a. String -> PU a -> PU a
xpElem String
"EncryptedID" PU EncryptedNameID
forall a. PU (EncryptedElement a)
xpEncryptedElement

data Identifier
  = IdentifierName NameID
  | IdentifierBase (BaseID Nodes)
  deriving (Identifier -> Identifier -> Bool
(Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool) -> Eq Identifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identifier -> Identifier -> Bool
$c/= :: Identifier -> Identifier -> Bool
== :: Identifier -> Identifier -> Bool
$c== :: Identifier -> Identifier -> Bool
Eq, Int -> Identifier -> ShowS
[Identifier] -> ShowS
Identifier -> String
(Int -> Identifier -> ShowS)
-> (Identifier -> String)
-> ([Identifier] -> ShowS)
-> Show Identifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Identifier] -> ShowS
$cshowList :: [Identifier] -> ShowS
show :: Identifier -> String
$cshow :: Identifier -> String
showsPrec :: Int -> Identifier -> ShowS
$cshowsPrec :: Int -> Identifier -> ShowS
Show)

instance XP.XmlPickler Identifier where
  xpickle :: PU Identifier
xpickle = [XP.biCase|
      Left n <-> IdentifierName n
      Right b <-> IdentifierBase b |]
    Bijection (->) (Either NameID (BaseID Nodes)) Identifier
-> PU (Either NameID (BaseID Nodes)) -> PU Identifier
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (PU NameID
forall a. XmlPickler a => PU a
XP.xpickle PU NameID -> PU (BaseID Nodes) -> PU (Either NameID (BaseID Nodes))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU (BaseID Nodes) -> PU (BaseID Nodes)
forall a. String -> PU a -> PU a
xpElem String
"BaseID" (PU Nodes -> PU (BaseID Nodes)
forall id. PU id -> PU (BaseID id)
xpBaseID PU Nodes
XP.xpTrees))

-- |§2.2.4
type EncryptedID = EncryptedElement Identifier

instance XP.XmlPickler EncryptedID where
  xpickle :: PU EncryptedID
xpickle = String -> PU EncryptedID -> PU EncryptedID
forall a. String -> PU a -> PU a
xpElem String
"EncryptedID" PU EncryptedID
forall a. PU (EncryptedElement a)
xpEncryptedElement

data EncryptedElement a = EncryptedElement
  { EncryptedElement a -> EncryptedData
encryptedData :: XEnc.EncryptedData
  , EncryptedElement a -> [EncryptedKey]
encryptedKey :: [XEnc.EncryptedKey]
  } deriving (EncryptedElement a -> EncryptedElement a -> Bool
(EncryptedElement a -> EncryptedElement a -> Bool)
-> (EncryptedElement a -> EncryptedElement a -> Bool)
-> Eq (EncryptedElement a)
forall a. EncryptedElement a -> EncryptedElement a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncryptedElement a -> EncryptedElement a -> Bool
$c/= :: forall a. EncryptedElement a -> EncryptedElement a -> Bool
== :: EncryptedElement a -> EncryptedElement a -> Bool
$c== :: forall a. EncryptedElement a -> EncryptedElement a -> Bool
Eq, Int -> EncryptedElement a -> ShowS
[EncryptedElement a] -> ShowS
EncryptedElement a -> String
(Int -> EncryptedElement a -> ShowS)
-> (EncryptedElement a -> String)
-> ([EncryptedElement a] -> ShowS)
-> Show (EncryptedElement a)
forall a. Int -> EncryptedElement a -> ShowS
forall a. [EncryptedElement a] -> ShowS
forall a. EncryptedElement a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncryptedElement a] -> ShowS
$cshowList :: forall a. [EncryptedElement a] -> ShowS
show :: EncryptedElement a -> String
$cshow :: forall a. EncryptedElement a -> String
showsPrec :: Int -> EncryptedElement a -> ShowS
$cshowsPrec :: forall a. Int -> EncryptedElement a -> ShowS
Show)

xpEncryptedElement :: XP.PU (EncryptedElement a)
xpEncryptedElement :: PU (EncryptedElement a)
xpEncryptedElement = [XP.biCase|(d, k) <-> EncryptedElement d k|]
  Bijection (->) (EncryptedData, [EncryptedKey]) (EncryptedElement a)
-> PU (EncryptedData, [EncryptedKey]) -> PU (EncryptedElement a)
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (PU EncryptedData
forall a. XmlPickler a => PU a
XP.xpickle
    PU EncryptedData
-> PU [EncryptedKey] -> PU (EncryptedData, [EncryptedKey])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU EncryptedKey -> PU [EncryptedKey]
forall a. PU a -> PU [a]
XP.xpList PU EncryptedKey
forall a. XmlPickler a => PU a
XP.xpickle)

data PossiblyEncrypted a
  = NotEncrypted !a
  | SoEncrypted (EncryptedElement a)
  deriving (PossiblyEncrypted a -> PossiblyEncrypted a -> Bool
(PossiblyEncrypted a -> PossiblyEncrypted a -> Bool)
-> (PossiblyEncrypted a -> PossiblyEncrypted a -> Bool)
-> Eq (PossiblyEncrypted a)
forall a.
Eq a =>
PossiblyEncrypted a -> PossiblyEncrypted a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PossiblyEncrypted a -> PossiblyEncrypted a -> Bool
$c/= :: forall a.
Eq a =>
PossiblyEncrypted a -> PossiblyEncrypted a -> Bool
== :: PossiblyEncrypted a -> PossiblyEncrypted a -> Bool
$c== :: forall a.
Eq a =>
PossiblyEncrypted a -> PossiblyEncrypted a -> Bool
Eq, Int -> PossiblyEncrypted a -> ShowS
[PossiblyEncrypted a] -> ShowS
PossiblyEncrypted a -> String
(Int -> PossiblyEncrypted a -> ShowS)
-> (PossiblyEncrypted a -> String)
-> ([PossiblyEncrypted a] -> ShowS)
-> Show (PossiblyEncrypted a)
forall a. Show a => Int -> PossiblyEncrypted a -> ShowS
forall a. Show a => [PossiblyEncrypted a] -> ShowS
forall a. Show a => PossiblyEncrypted a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PossiblyEncrypted a] -> ShowS
$cshowList :: forall a. Show a => [PossiblyEncrypted a] -> ShowS
show :: PossiblyEncrypted a -> String
$cshow :: forall a. Show a => PossiblyEncrypted a -> String
showsPrec :: Int -> PossiblyEncrypted a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PossiblyEncrypted a -> ShowS
Show)

xpPossiblyEncrypted :: (XP.XmlPickler a, XP.XmlPickler (EncryptedElement a)) => XP.PU (PossiblyEncrypted a)
xpPossiblyEncrypted :: PU (PossiblyEncrypted a)
xpPossiblyEncrypted = [XP.biCase|
    Left a <-> NotEncrypted a
    Right a <-> SoEncrypted a |]
  Bijection
  (->) (Either a (EncryptedElement a)) (PossiblyEncrypted a)
-> PU (Either a (EncryptedElement a)) -> PU (PossiblyEncrypted a)
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< (PU a
forall a. XmlPickler a => PU a
XP.xpickle PU a
-> PU (EncryptedElement a) -> PU (Either a (EncryptedElement a))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU (EncryptedElement a)
forall a. XmlPickler a => PU a
XP.xpickle)

data AssertionRef
  = AssertionRefID AssertionIDRef
  | AssertionURIRef AnyURI -- ^§2.3.2
  | AssertionRef (PossiblyEncrypted Assertion)
  deriving (AssertionRef -> AssertionRef -> Bool
(AssertionRef -> AssertionRef -> Bool)
-> (AssertionRef -> AssertionRef -> Bool) -> Eq AssertionRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssertionRef -> AssertionRef -> Bool
$c/= :: AssertionRef -> AssertionRef -> Bool
== :: AssertionRef -> AssertionRef -> Bool
$c== :: AssertionRef -> AssertionRef -> Bool
Eq, Int -> AssertionRef -> ShowS
[AssertionRef] -> ShowS
AssertionRef -> String
(Int -> AssertionRef -> ShowS)
-> (AssertionRef -> String)
-> ([AssertionRef] -> ShowS)
-> Show AssertionRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssertionRef] -> ShowS
$cshowList :: [AssertionRef] -> ShowS
show :: AssertionRef -> String
$cshow :: AssertionRef -> String
showsPrec :: Int -> AssertionRef -> ShowS
$cshowsPrec :: Int -> AssertionRef -> ShowS
Show)

instance XP.XmlPickler AssertionRef where
  xpickle :: PU AssertionRef
xpickle = [XP.biCase|
      Left (Left i) <-> AssertionRefID i
      Left (Right u) <-> AssertionURIRef u
      Right a <-> AssertionRef a|]
    Bijection
  (->)
  (Either (Either AssertionIDRef URI) (PossiblyEncrypted Assertion))
  AssertionRef
-> PU
     (Either (Either AssertionIDRef URI) (PossiblyEncrypted Assertion))
-> PU AssertionRef
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU AssertionIDRef
forall a. XmlPickler a => PU a
XP.xpickle
      PU AssertionIDRef -> PU URI -> PU (Either AssertionIDRef URI)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
xpElem String
"AssertionURIRef" PU URI
XS.xpAnyURI
      PU (Either AssertionIDRef URI)
-> PU (PossiblyEncrypted Assertion)
-> PU
     (Either (Either AssertionIDRef URI) (PossiblyEncrypted Assertion))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU (PossiblyEncrypted Assertion)
forall a.
(XmlPickler a, XmlPickler (EncryptedElement a)) =>
PU (PossiblyEncrypted a)
xpPossiblyEncrypted)

-- |§2.2.5
newtype Issuer = Issuer{ Issuer -> NameID
issuer :: NameID }
  deriving (Issuer -> Issuer -> Bool
(Issuer -> Issuer -> Bool)
-> (Issuer -> Issuer -> Bool) -> Eq Issuer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issuer -> Issuer -> Bool
$c/= :: Issuer -> Issuer -> Bool
== :: Issuer -> Issuer -> Bool
$c== :: Issuer -> Issuer -> Bool
Eq, Int -> Issuer -> ShowS
[Issuer] -> ShowS
Issuer -> String
(Int -> Issuer -> ShowS)
-> (Issuer -> String) -> ([Issuer] -> ShowS) -> Show Issuer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issuer] -> ShowS
$cshowList :: [Issuer] -> ShowS
show :: Issuer -> String
$cshow :: Issuer -> String
showsPrec :: Int -> Issuer -> ShowS
$cshowsPrec :: Int -> Issuer -> ShowS
Show)

instance XP.XmlPickler Issuer where
  xpickle :: PU Issuer
xpickle = String -> PU Issuer -> PU Issuer
forall a. String -> PU a -> PU a
xpElem String
"Issuer" (PU Issuer -> PU Issuer) -> PU Issuer -> PU Issuer
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      n <-> Issuer n|]
    Bijection (->) NameID Issuer -> PU NameID -> PU Issuer
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< IdentifiedURI NameIDFormat -> PU NameID
xpNameIDDefaulting (NameIDFormat -> IdentifiedURI NameIDFormat
forall b a. a -> Identified b a
Identified NameIDFormat
NameIDFormatEntity)

-- |§2.3.1
newtype AssertionIDRef = AssertionIDRef{ AssertionIDRef -> String
assertionIDRef :: ID }
  deriving (AssertionIDRef -> AssertionIDRef -> Bool
(AssertionIDRef -> AssertionIDRef -> Bool)
-> (AssertionIDRef -> AssertionIDRef -> Bool) -> Eq AssertionIDRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssertionIDRef -> AssertionIDRef -> Bool
$c/= :: AssertionIDRef -> AssertionIDRef -> Bool
== :: AssertionIDRef -> AssertionIDRef -> Bool
$c== :: AssertionIDRef -> AssertionIDRef -> Bool
Eq, Int -> AssertionIDRef -> ShowS
[AssertionIDRef] -> ShowS
AssertionIDRef -> String
(Int -> AssertionIDRef -> ShowS)
-> (AssertionIDRef -> String)
-> ([AssertionIDRef] -> ShowS)
-> Show AssertionIDRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssertionIDRef] -> ShowS
$cshowList :: [AssertionIDRef] -> ShowS
show :: AssertionIDRef -> String
$cshow :: AssertionIDRef -> String
showsPrec :: Int -> AssertionIDRef -> ShowS
$cshowsPrec :: Int -> AssertionIDRef -> ShowS
Show)

instance XP.XmlPickler AssertionIDRef where
  xpickle :: PU AssertionIDRef
xpickle = String -> PU AssertionIDRef -> PU AssertionIDRef
forall a. String -> PU a -> PU a
xpElem String
"AssertionIDRef" (PU AssertionIDRef -> PU AssertionIDRef)
-> PU AssertionIDRef -> PU AssertionIDRef
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      i <-> AssertionIDRef i|]
    Bijection (->) String AssertionIDRef
-> PU String -> PU AssertionIDRef
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< PU String
XS.xpID

-- |§2.3.3
data Assertion = Assertion
  { Assertion -> SAMLVersion
assertionVersion :: SAMLVersion
  , Assertion -> String
assertionID :: ID
  , Assertion -> DateTime
assertionIssueInstant :: DateTime
  , Assertion -> Issuer
assertionIssuer :: Issuer
  , Assertion -> Maybe Signature
assertionSignature :: Maybe DS.Signature
  , Assertion -> Subject
assertionSubject :: Subject -- ^use 'noSubject' to omit
  , Assertion -> Maybe Conditions
assertionConditions :: Maybe Conditions
  , Assertion -> Maybe Advice
assertionAdvice :: Maybe Advice
  , Assertion -> [Statement]
assertionStatement :: [Statement]
  } 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 XP.XmlPickler Assertion where
  xpickle :: PU Assertion
xpickle = String -> PU Assertion -> PU Assertion
forall a. String -> PU a -> PU a
xpElem String
"Assertion" (PU Assertion -> PU Assertion) -> PU Assertion -> PU Assertion
forall a b. (a -> b) -> a -> b
$
    [XP.biCase|
      ((((((((v, i), t), n), s), Nothing), c), a), l) <-> Assertion v i t n s (Subject Nothing []) c a l
      ((((((((v, i), t), n), s), Just r), c), a), l) <-> Assertion v i t n s r c a l|] 
    Bijection
  (->)
  ((((((((SAMLVersion, String), DateTime), Issuer), Maybe Signature),
      Maybe Subject),
     Maybe Conditions),
    Maybe Advice),
   [Statement])
  Assertion
-> PU
     ((((((((SAMLVersion, String), DateTime), Issuer), Maybe Signature),
         Maybe Subject),
        Maybe Conditions),
       Maybe Advice),
      [Statement])
-> PU Assertion
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU SAMLVersion -> PU SAMLVersion
forall a. String -> PU a -> PU a
XP.xpAttr String
"Version" PU SAMLVersion
forall a. XmlPickler a => PU a
XP.xpickle
      PU SAMLVersion -> PU String -> PU (SAMLVersion, String)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU String -> PU String
forall a. String -> PU a -> PU a
XP.xpAttr String
"ID" PU String
XS.xpID
      PU (SAMLVersion, String)
-> PU DateTime -> PU ((SAMLVersion, String), DateTime)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU DateTime -> PU DateTime
forall a. String -> PU a -> PU a
XP.xpAttr String
"IssueInstant" PU DateTime
XS.xpDateTime
      PU ((SAMLVersion, String), DateTime)
-> PU Issuer -> PU (((SAMLVersion, String), DateTime), Issuer)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Issuer
forall a. XmlPickler a => PU a
XP.xpickle
      PU (((SAMLVersion, String), DateTime), Issuer)
-> PU (Maybe Signature)
-> PU
     ((((SAMLVersion, String), DateTime), Issuer), Maybe Signature)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Signature -> PU (Maybe Signature)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU Signature
forall a. XmlPickler a => PU a
XP.xpickle
      PU ((((SAMLVersion, String), DateTime), Issuer), Maybe Signature)
-> PU (Maybe Subject)
-> PU
     (((((SAMLVersion, String), DateTime), Issuer), Maybe Signature),
      Maybe Subject)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Subject -> PU (Maybe Subject)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU Subject
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (((((SAMLVersion, String), DateTime), Issuer), Maybe Signature),
   Maybe Subject)
-> PU (Maybe Conditions)
-> PU
     ((((((SAMLVersion, String), DateTime), Issuer), Maybe Signature),
       Maybe Subject),
      Maybe Conditions)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Conditions -> PU (Maybe Conditions)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU Conditions
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  ((((((SAMLVersion, String), DateTime), Issuer), Maybe Signature),
    Maybe Subject),
   Maybe Conditions)
-> PU (Maybe Advice)
-> PU
     (((((((SAMLVersion, String), DateTime), Issuer), Maybe Signature),
        Maybe Subject),
       Maybe Conditions),
      Maybe Advice)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Advice -> PU (Maybe Advice)
forall a. PU a -> PU (Maybe a)
XP.xpOption (String -> PU Advice -> PU Advice
forall a. String -> PU a -> PU a
xpElem String
"Advice" (PU Advice -> PU Advice) -> PU Advice -> PU Advice
forall a b. (a -> b) -> a -> b
$ PU AdviceElement -> PU Advice
forall a. PU a -> PU [a]
XP.xpList PU AdviceElement
forall a. XmlPickler a => PU a
XP.xpickle)
      PU
  (((((((SAMLVersion, String), DateTime), Issuer), Maybe Signature),
     Maybe Subject),
    Maybe Conditions),
   Maybe Advice)
-> PU [Statement]
-> PU
     ((((((((SAMLVersion, String), DateTime), Issuer), Maybe Signature),
         Maybe Subject),
        Maybe Conditions),
       Maybe Advice),
      [Statement])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Statement -> PU [Statement]
forall a. PU a -> PU [a]
XP.xpList PU Statement
forall a. XmlPickler a => PU a
XP.xpickle)

instance DS.Signable Assertion where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> Assertion -> f Assertion
signature' = $(fieldLens 'assertionSignature)
  signedID :: Assertion -> String
signedID = Assertion -> String
assertionID

-- |§2.3.4
type EncryptedAssertion = EncryptedElement Assertion

instance XP.XmlPickler EncryptedAssertion where
  xpickle :: PU EncryptedAssertion
xpickle = String -> PU EncryptedAssertion -> PU EncryptedAssertion
forall a. String -> PU a -> PU a
xpElem String
"EncryptedAssertion" PU EncryptedAssertion
forall a. PU (EncryptedElement a)
xpEncryptedElement

-- |§2.4.1
data Subject = Subject
  { Subject -> Maybe (PossiblyEncrypted Identifier)
subjectIdentifier :: Maybe (PossiblyEncrypted Identifier)
  , Subject -> [SubjectConfirmation]
subjectConfirmation :: [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 XP.XmlPickler Subject where
  xpickle :: PU Subject
xpickle = String -> PU Subject -> PU Subject
forall a. String -> PU a -> PU a
xpElem String
"Subject" (PU Subject -> PU Subject) -> PU Subject -> PU Subject
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (i, c) <-> Subject i c|]
    Bijection
  (->)
  (Maybe (PossiblyEncrypted Identifier), [SubjectConfirmation])
  Subject
-> PU (Maybe (PossiblyEncrypted Identifier), [SubjectConfirmation])
-> PU Subject
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU (PossiblyEncrypted Identifier)
-> PU (Maybe (PossiblyEncrypted Identifier))
forall a. PU a -> PU (Maybe a)
XP.xpOption PU (PossiblyEncrypted Identifier)
forall a.
(XmlPickler a, XmlPickler (EncryptedElement a)) =>
PU (PossiblyEncrypted a)
xpPossiblyEncrypted
      PU (Maybe (PossiblyEncrypted Identifier))
-> PU [SubjectConfirmation]
-> PU (Maybe (PossiblyEncrypted Identifier), [SubjectConfirmation])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU SubjectConfirmation -> PU [SubjectConfirmation]
forall a. PU a -> PU [a]
XP.xpList PU SubjectConfirmation
forall a. XmlPickler a => PU a
XP.xpickle)

noSubject :: Subject
noSubject :: Subject
noSubject = Maybe (PossiblyEncrypted Identifier)
-> [SubjectConfirmation] -> Subject
Subject Maybe (PossiblyEncrypted Identifier)
forall a. Maybe a
Nothing []

-- |§2.4.1.1
data SubjectConfirmation = SubjectConfirmation
  { SubjectConfirmation -> IdentifiedURI ConfirmationMethod
subjectConfirmationMethod :: IdentifiedURI ConfirmationMethod
  , SubjectConfirmation -> Maybe (PossiblyEncrypted Identifier)
subjectConfirmationIdentifier :: Maybe (PossiblyEncrypted Identifier)
  , SubjectConfirmation -> Maybe SubjectConfirmationData
subjectConfirmationData :: Maybe SubjectConfirmationData
  } 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 XP.XmlPickler SubjectConfirmation where
  xpickle :: PU SubjectConfirmation
xpickle = String -> PU SubjectConfirmation -> PU SubjectConfirmation
forall a. String -> PU a -> PU a
xpElem String
"SubjectConfirmation" (PU SubjectConfirmation -> PU SubjectConfirmation)
-> PU SubjectConfirmation -> PU SubjectConfirmation
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((m, i), d) <-> SubjectConfirmation m i d|]
    Bijection
  (->)
  ((IdentifiedURI ConfirmationMethod,
    Maybe (PossiblyEncrypted Identifier)),
   Maybe SubjectConfirmationData)
  SubjectConfirmation
-> PU
     ((IdentifiedURI ConfirmationMethod,
       Maybe (PossiblyEncrypted Identifier)),
      Maybe SubjectConfirmationData)
-> PU SubjectConfirmation
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String
-> PU (IdentifiedURI ConfirmationMethod)
-> PU (IdentifiedURI ConfirmationMethod)
forall a. String -> PU a -> PU a
XP.xpAttr String
"Method" PU (IdentifiedURI ConfirmationMethod)
forall a. XmlPickler a => PU a
XP.xpickle
      PU (IdentifiedURI ConfirmationMethod)
-> PU (Maybe (PossiblyEncrypted Identifier))
-> PU
     (IdentifiedURI ConfirmationMethod,
      Maybe (PossiblyEncrypted Identifier))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU (PossiblyEncrypted Identifier)
-> PU (Maybe (PossiblyEncrypted Identifier))
forall a. PU a -> PU (Maybe a)
XP.xpOption PU (PossiblyEncrypted Identifier)
forall a.
(XmlPickler a, XmlPickler (EncryptedElement a)) =>
PU (PossiblyEncrypted a)
xpPossiblyEncrypted
      PU
  (IdentifiedURI ConfirmationMethod,
   Maybe (PossiblyEncrypted Identifier))
-> PU (Maybe SubjectConfirmationData)
-> PU
     ((IdentifiedURI ConfirmationMethod,
       Maybe (PossiblyEncrypted Identifier)),
      Maybe SubjectConfirmationData)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU SubjectConfirmationData -> PU (Maybe SubjectConfirmationData)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU SubjectConfirmationData
forall a. XmlPickler a => PU a
XP.xpickle)

-- |§2.4.1.2
data SubjectConfirmationData = SubjectConfirmationData
  { SubjectConfirmationData -> Maybe DateTime
subjectConfirmationNotBefore
  , SubjectConfirmationData -> Maybe DateTime
subjectConfirmationNotOnOrAfter :: Maybe DateTime
  , SubjectConfirmationData -> Maybe URI
subjectConfirmationRecipient :: Maybe AnyURI
  , SubjectConfirmationData -> Maybe String
subjectConfirmationInResponseTo :: Maybe ID
  , SubjectConfirmationData -> Maybe String
subjectConfirmationAddress :: Maybe IP
  , SubjectConfirmationData -> [KeyInfo]
subjectConfirmationKeyInfo :: [DS.KeyInfo]
  , SubjectConfirmationData -> Nodes
subjectConfirmationXML :: Nodes -- ^anything
  } deriving (SubjectConfirmationData -> SubjectConfirmationData -> Bool
(SubjectConfirmationData -> SubjectConfirmationData -> Bool)
-> (SubjectConfirmationData -> SubjectConfirmationData -> Bool)
-> Eq SubjectConfirmationData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubjectConfirmationData -> SubjectConfirmationData -> Bool
$c/= :: SubjectConfirmationData -> SubjectConfirmationData -> Bool
== :: SubjectConfirmationData -> SubjectConfirmationData -> Bool
$c== :: SubjectConfirmationData -> SubjectConfirmationData -> Bool
Eq, Int -> SubjectConfirmationData -> ShowS
[SubjectConfirmationData] -> ShowS
SubjectConfirmationData -> String
(Int -> SubjectConfirmationData -> ShowS)
-> (SubjectConfirmationData -> String)
-> ([SubjectConfirmationData] -> ShowS)
-> Show SubjectConfirmationData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubjectConfirmationData] -> ShowS
$cshowList :: [SubjectConfirmationData] -> ShowS
show :: SubjectConfirmationData -> String
$cshow :: SubjectConfirmationData -> String
showsPrec :: Int -> SubjectConfirmationData -> ShowS
$cshowsPrec :: Int -> SubjectConfirmationData -> ShowS
Show)

instance XP.XmlPickler SubjectConfirmationData where
  xpickle :: PU SubjectConfirmationData
xpickle = String -> PU SubjectConfirmationData -> PU SubjectConfirmationData
forall a. String -> PU a -> PU a
xpElem String
"SubjectConfirmationData" (PU SubjectConfirmationData -> PU SubjectConfirmationData)
-> PU SubjectConfirmationData -> PU SubjectConfirmationData
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((((((s, e), r), i), a), k), x) <-> SubjectConfirmationData s e r i a k x|]
    Bijection
  (->)
  ((((((Maybe DateTime, Maybe DateTime), Maybe URI), Maybe String),
     Maybe String),
    [KeyInfo]),
   Nodes)
  SubjectConfirmationData
-> PU
     ((((((Maybe DateTime, Maybe DateTime), Maybe URI), Maybe String),
        Maybe String),
       [KeyInfo]),
      Nodes)
-> PU SubjectConfirmationData
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU DateTime -> PU (Maybe DateTime)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"NotBefore" PU DateTime
XS.xpDateTime
      PU (Maybe DateTime)
-> PU (Maybe DateTime) -> PU (Maybe DateTime, Maybe DateTime)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU DateTime -> PU (Maybe DateTime)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"NotOnOrAfter" PU DateTime
XS.xpDateTime
      PU (Maybe DateTime, Maybe DateTime)
-> PU (Maybe URI)
-> PU ((Maybe DateTime, Maybe DateTime), Maybe URI)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU URI -> PU (Maybe URI)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Recipient" PU URI
XS.xpAnyURI
      PU ((Maybe DateTime, Maybe DateTime), Maybe URI)
-> PU (Maybe String)
-> PU (((Maybe DateTime, Maybe DateTime), Maybe URI), Maybe String)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"InResponseTo" PU String
XS.xpNCName
      PU (((Maybe DateTime, Maybe DateTime), Maybe URI), Maybe String)
-> PU (Maybe String)
-> PU
     ((((Maybe DateTime, Maybe DateTime), Maybe URI), Maybe String),
      Maybe String)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Address" PU String
xpIP
      PU
  ((((Maybe DateTime, Maybe DateTime), Maybe URI), Maybe String),
   Maybe String)
-> PU [KeyInfo]
-> PU
     (((((Maybe DateTime, Maybe DateTime), Maybe URI), Maybe String),
       Maybe String),
      [KeyInfo])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU KeyInfo -> PU [KeyInfo]
forall a. PU a -> PU [a]
XP.xpList PU KeyInfo
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (((((Maybe DateTime, Maybe DateTime), Maybe URI), Maybe String),
    Maybe String),
   [KeyInfo])
-> PU Nodes
-> PU
     ((((((Maybe DateTime, Maybe DateTime), Maybe URI), Maybe String),
        Maybe String),
       [KeyInfo]),
      Nodes)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Nodes
XP.xpAny)

-- |§2.5.1
data Conditions = Conditions
  { Conditions -> Maybe DateTime
conditionsNotBefore
  , Conditions -> Maybe DateTime
conditionsNotOnOrAfter :: Maybe DateTime
  , Conditions -> [Condition]
conditions :: [Condition]
  } 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 XP.XmlPickler Conditions where
  xpickle :: PU Conditions
xpickle = String -> PU Conditions -> PU Conditions
forall a. String -> PU a -> PU a
xpElem String
"Conditions" (PU Conditions -> PU Conditions) -> PU Conditions -> PU Conditions
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((s, e), c) <-> Conditions s e c|]
    Bijection
  (->) ((Maybe DateTime, Maybe DateTime), [Condition]) Conditions
-> PU ((Maybe DateTime, Maybe DateTime), [Condition])
-> PU Conditions
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU DateTime -> PU (Maybe DateTime)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"NotBefore" PU DateTime
XS.xpDateTime
      PU (Maybe DateTime)
-> PU (Maybe DateTime) -> PU (Maybe DateTime, Maybe DateTime)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU DateTime -> PU (Maybe DateTime)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"NotOnOrAfter" PU DateTime
XS.xpDateTime
      PU (Maybe DateTime, Maybe DateTime)
-> PU [Condition]
-> PU ((Maybe DateTime, Maybe DateTime), [Condition])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Condition -> PU [Condition]
forall a. PU a -> PU [a]
XP.xpList PU Condition
forall a. XmlPickler a => PU a
XP.xpickle)

data Condition
  = Condition Node -- ^§2.5.1.3
  | AudienceRestriction (List1 Audience) -- ^§2.5.1.4
  | OneTimeUse -- ^§2.5.1.5
  | ProxyRestriction
    { Condition -> Maybe NonNegativeInteger
proxyRestrictionCount :: Maybe XS.NonNegativeInteger
    , Condition -> [Audience]
proxyRestrictionAudience :: [Audience]
    } -- ^§2.5.1.6
  deriving (Condition -> Condition -> Bool
(Condition -> Condition -> Bool)
-> (Condition -> Condition -> Bool) -> Eq Condition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c== :: Condition -> Condition -> Bool
Eq, Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
(Int -> Condition -> ShowS)
-> (Condition -> String)
-> ([Condition] -> ShowS)
-> Show Condition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Condition] -> ShowS
$cshowList :: [Condition] -> ShowS
show :: Condition -> String
$cshow :: Condition -> String
showsPrec :: Int -> Condition -> ShowS
$cshowsPrec :: Int -> Condition -> ShowS
Show)

instance XP.XmlPickler Condition where
  xpickle :: PU Condition
xpickle = [XP.biCase|
      Left (Left (Left a)) <-> AudienceRestriction a
      Left (Left (Right ())) <-> OneTimeUse
      Left (Right (c, a)) <-> ProxyRestriction c a
      Right x <-> Condition x|]
    Bijection
  (->)
  (Either
     (Either
        (Either (List1 Audience) ())
        (Maybe NonNegativeInteger, [Audience]))
     Node)
  Condition
-> PU
     (Either
        (Either
           (Either (List1 Audience) ())
           (Maybe NonNegativeInteger, [Audience]))
        Node)
-> PU Condition
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU (List1 Audience) -> PU (List1 Audience)
forall a. String -> PU a -> PU a
xpElem String
"AudienceRestriction" (PU Audience -> PU (List1 Audience)
forall a. PU a -> PU (List1 a)
xpList1 PU Audience
forall a. XmlPickler a => PU a
XP.xpickle)
      PU (List1 Audience) -> PU () -> PU (Either (List1 Audience) ())
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU () -> PU ()
forall a. String -> PU a -> PU a
xpElem String
"OneTimeUse" PU ()
XP.xpUnit
      PU (Either (List1 Audience) ())
-> PU (Maybe NonNegativeInteger, [Audience])
-> PU
     (Either
        (Either (List1 Audience) ())
        (Maybe NonNegativeInteger, [Audience]))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String
-> PU (Maybe NonNegativeInteger, [Audience])
-> PU (Maybe NonNegativeInteger, [Audience])
forall a. String -> PU a -> PU a
xpElem String
"ProxyRestriction"
              (String -> PU NonNegativeInteger -> PU (Maybe NonNegativeInteger)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Count" PU NonNegativeInteger
XS.xpNonNegativeInteger
        PU (Maybe NonNegativeInteger)
-> PU [Audience] -> PU (Maybe NonNegativeInteger, [Audience])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Audience -> PU [Audience]
forall a. PU a -> PU [a]
XP.xpList PU Audience
forall a. XmlPickler a => PU a
XP.xpickle)
      PU
  (Either
     (Either (List1 Audience) ())
     (Maybe NonNegativeInteger, [Audience]))
-> PU Node
-> PU
     (Either
        (Either
           (Either (List1 Audience) ())
           (Maybe NonNegativeInteger, [Audience]))
        Node)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU Node
xpTrimAnyElem)

-- |§2.5.1.4
newtype Audience = Audience{ Audience -> URI
audience :: AnyURI }
  deriving (Audience -> Audience -> Bool
(Audience -> Audience -> Bool)
-> (Audience -> Audience -> Bool) -> Eq Audience
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Audience -> Audience -> Bool
$c/= :: Audience -> Audience -> Bool
== :: Audience -> Audience -> Bool
$c== :: Audience -> Audience -> Bool
Eq, Int -> Audience -> ShowS
[Audience] -> ShowS
Audience -> String
(Int -> Audience -> ShowS)
-> (Audience -> String) -> ([Audience] -> ShowS) -> Show Audience
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Audience] -> ShowS
$cshowList :: [Audience] -> ShowS
show :: Audience -> String
$cshow :: Audience -> String
showsPrec :: Int -> Audience -> ShowS
$cshowsPrec :: Int -> Audience -> ShowS
Show)

instance XP.XmlPickler Audience where
  xpickle :: PU Audience
xpickle = String -> PU Audience -> PU Audience
forall a. String -> PU a -> PU a
xpElem String
"Audience" (PU Audience -> PU Audience) -> PU Audience -> PU Audience
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      u <-> Audience u|]
    Bijection (->) URI Audience -> PU URI -> PU Audience
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< PU URI
XS.xpAnyURI

-- |§2.6.1
type Advice = [AdviceElement]
data AdviceElement
  = AdviceAssertion AssertionRef
  | Advice Node
  deriving (AdviceElement -> AdviceElement -> Bool
(AdviceElement -> AdviceElement -> Bool)
-> (AdviceElement -> AdviceElement -> Bool) -> Eq AdviceElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdviceElement -> AdviceElement -> Bool
$c/= :: AdviceElement -> AdviceElement -> Bool
== :: AdviceElement -> AdviceElement -> Bool
$c== :: AdviceElement -> AdviceElement -> Bool
Eq, Int -> AdviceElement -> ShowS
Advice -> ShowS
AdviceElement -> String
(Int -> AdviceElement -> ShowS)
-> (AdviceElement -> String)
-> (Advice -> ShowS)
-> Show AdviceElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: Advice -> ShowS
$cshowList :: Advice -> ShowS
show :: AdviceElement -> String
$cshow :: AdviceElement -> String
showsPrec :: Int -> AdviceElement -> ShowS
$cshowsPrec :: Int -> AdviceElement -> ShowS
Show)

instance XP.XmlPickler AdviceElement where
  xpickle :: PU AdviceElement
xpickle = [XP.biCase|
      Left a <-> AdviceAssertion a
      Right x <-> Advice x|]
    Bijection (->) (Either AssertionRef Node) AdviceElement
-> PU (Either AssertionRef Node) -> PU AdviceElement
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU AssertionRef
forall a. XmlPickler a => PU a
XP.xpickle
      PU AssertionRef -> PU Node -> PU (Either AssertionRef Node)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU Node
xpTrimAnyElem)

-- |§2.7.1
data Statement
  = StatementAuthn AuthnStatement
  | StatementAttribute AttributeStatement
  | StatementAuthzDecision AuthzDecisionStatement
  | Statement Node
  deriving (Statement -> Statement -> Bool
(Statement -> Statement -> Bool)
-> (Statement -> Statement -> Bool) -> Eq Statement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Statement -> Statement -> Bool
$c/= :: Statement -> Statement -> Bool
== :: Statement -> Statement -> Bool
$c== :: Statement -> Statement -> Bool
Eq, Int -> Statement -> ShowS
[Statement] -> ShowS
Statement -> String
(Int -> Statement -> ShowS)
-> (Statement -> String)
-> ([Statement] -> ShowS)
-> Show Statement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Statement] -> ShowS
$cshowList :: [Statement] -> ShowS
show :: Statement -> String
$cshow :: Statement -> String
showsPrec :: Int -> Statement -> ShowS
$cshowsPrec :: Int -> Statement -> ShowS
Show)

instance XP.XmlPickler Statement where
  xpickle :: PU Statement
xpickle = [XP.biCase|
      Left (Left (Left s)) <-> StatementAuthn s
      Left (Left (Right s)) <-> StatementAttribute s
      Left (Right s) <-> StatementAuthzDecision s
      Right x <-> Statement x|]
    Bijection
  (->)
  (Either
     (Either
        (Either AuthnStatement AttributeStatement) AuthzDecisionStatement)
     Node)
  Statement
-> PU
     (Either
        (Either
           (Either AuthnStatement AttributeStatement) AuthzDecisionStatement)
        Node)
-> PU Statement
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU AuthnStatement
forall a. XmlPickler a => PU a
XP.xpickle
      PU AuthnStatement
-> PU AttributeStatement
-> PU (Either AuthnStatement AttributeStatement)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU AttributeStatement
forall a. XmlPickler a => PU a
XP.xpickle
      PU (Either AuthnStatement AttributeStatement)
-> PU AuthzDecisionStatement
-> PU
     (Either
        (Either AuthnStatement AttributeStatement) AuthzDecisionStatement)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU AuthzDecisionStatement
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (Either
     (Either AuthnStatement AttributeStatement) AuthzDecisionStatement)
-> PU Node
-> PU
     (Either
        (Either
           (Either AuthnStatement AttributeStatement) AuthzDecisionStatement)
        Node)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU Node
xpTrimAnyElem)

-- |§2.7.2
data AuthnStatement = AuthnStatement
  { AuthnStatement -> DateTime
authnStatementInstant :: DateTime
  , AuthnStatement -> Maybe String
authnStatementSessionIndex :: Maybe XString
  , AuthnStatement -> Maybe DateTime
authnStatementSessionNotOnOrAfter :: Maybe DateTime
  , AuthnStatement -> Maybe SubjectLocality
authnStatementSubjectLocality :: Maybe SubjectLocality
  , AuthnStatement -> AuthnContext
authnStatementContext :: AuthnContext
  } 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 XP.XmlPickler AuthnStatement where
  xpickle :: PU AuthnStatement
xpickle = String -> PU AuthnStatement -> PU AuthnStatement
forall a. String -> PU a -> PU a
xpElem String
"AuthnStatement" (PU AuthnStatement -> PU AuthnStatement)
-> PU AuthnStatement -> PU AuthnStatement
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((((t, i), e), l), c) <-> AuthnStatement t i e l c|]
    Bijection
  (->)
  ((((DateTime, Maybe String), Maybe DateTime),
    Maybe SubjectLocality),
   AuthnContext)
  AuthnStatement
-> PU
     ((((DateTime, Maybe String), Maybe DateTime),
       Maybe SubjectLocality),
      AuthnContext)
-> PU AuthnStatement
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU DateTime -> PU DateTime
forall a. String -> PU a -> PU a
XP.xpAttr String
"AuthnInstant" PU DateTime
XS.xpDateTime
      PU DateTime -> PU (Maybe String) -> PU (DateTime, Maybe String)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"SessionIndex" PU String
XS.xpString
      PU (DateTime, Maybe String)
-> PU (Maybe DateTime)
-> PU ((DateTime, Maybe String), Maybe DateTime)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU DateTime -> PU (Maybe DateTime)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"SessionNotOnOrAfter" PU DateTime
XS.xpDateTime
      PU ((DateTime, Maybe String), Maybe DateTime)
-> PU (Maybe SubjectLocality)
-> PU
     (((DateTime, Maybe String), Maybe DateTime), Maybe SubjectLocality)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU SubjectLocality -> PU (Maybe SubjectLocality)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU SubjectLocality
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (((DateTime, Maybe String), Maybe DateTime), Maybe SubjectLocality)
-> PU AuthnContext
-> PU
     ((((DateTime, Maybe String), Maybe DateTime),
       Maybe SubjectLocality),
      AuthnContext)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU AuthnContext
forall a. XmlPickler a => PU a
XP.xpickle)

-- |§2.7.2.1
data SubjectLocality = SubjectLocality
  { SubjectLocality -> Maybe String
subjectLocalityAddress :: Maybe IP
  , SubjectLocality -> Maybe String
subjectLocalityDNSName :: Maybe XString
  } deriving (SubjectLocality -> SubjectLocality -> Bool
(SubjectLocality -> SubjectLocality -> Bool)
-> (SubjectLocality -> SubjectLocality -> Bool)
-> Eq SubjectLocality
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubjectLocality -> SubjectLocality -> Bool
$c/= :: SubjectLocality -> SubjectLocality -> Bool
== :: SubjectLocality -> SubjectLocality -> Bool
$c== :: SubjectLocality -> SubjectLocality -> Bool
Eq, Int -> SubjectLocality -> ShowS
[SubjectLocality] -> ShowS
SubjectLocality -> String
(Int -> SubjectLocality -> ShowS)
-> (SubjectLocality -> String)
-> ([SubjectLocality] -> ShowS)
-> Show SubjectLocality
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubjectLocality] -> ShowS
$cshowList :: [SubjectLocality] -> ShowS
show :: SubjectLocality -> String
$cshow :: SubjectLocality -> String
showsPrec :: Int -> SubjectLocality -> ShowS
$cshowsPrec :: Int -> SubjectLocality -> ShowS
Show)

instance XP.XmlPickler SubjectLocality where
  xpickle :: PU SubjectLocality
xpickle = String -> PU SubjectLocality -> PU SubjectLocality
forall a. String -> PU a -> PU a
xpElem String
"SubjectLocality" (PU SubjectLocality -> PU SubjectLocality)
-> PU SubjectLocality -> PU SubjectLocality
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (a, d) <-> SubjectLocality a d|]
    Bijection (->) (Maybe String, Maybe String) SubjectLocality
-> PU (Maybe String, Maybe String) -> PU SubjectLocality
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Address" PU String
xpIP
      PU (Maybe String)
-> PU (Maybe String) -> PU (Maybe String, Maybe String)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"DNSName" PU String
XS.xpString)

-- |§2.7.2.2
data AuthnContext = AuthnContext
  { AuthnContext -> Maybe URI
authnContextClassRef :: Maybe AnyURI
  , AuthnContext -> Maybe AuthnContextDecl
authnContextDecl :: Maybe AuthnContextDecl
  , AuthnContext -> [URI]
authnContextAuthenticatingAuthority :: [AnyURI]
  } deriving (AuthnContext -> AuthnContext -> Bool
(AuthnContext -> AuthnContext -> Bool)
-> (AuthnContext -> AuthnContext -> Bool) -> Eq AuthnContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthnContext -> AuthnContext -> Bool
$c/= :: AuthnContext -> AuthnContext -> Bool
== :: AuthnContext -> AuthnContext -> Bool
$c== :: AuthnContext -> AuthnContext -> Bool
Eq, Int -> AuthnContext -> ShowS
[AuthnContext] -> ShowS
AuthnContext -> String
(Int -> AuthnContext -> ShowS)
-> (AuthnContext -> String)
-> ([AuthnContext] -> ShowS)
-> Show AuthnContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthnContext] -> ShowS
$cshowList :: [AuthnContext] -> ShowS
show :: AuthnContext -> String
$cshow :: AuthnContext -> String
showsPrec :: Int -> AuthnContext -> ShowS
$cshowsPrec :: Int -> AuthnContext -> ShowS
Show)

instance XP.XmlPickler AuthnContext where
  xpickle :: PU AuthnContext
xpickle = String -> PU AuthnContext -> PU AuthnContext
forall a. String -> PU a -> PU a
xpElem String
"AuthnContext" (PU AuthnContext -> PU AuthnContext)
-> PU AuthnContext -> PU AuthnContext
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((c, d), a) <-> AuthnContext c d a|]
    Bijection
  (->) ((Maybe URI, Maybe AuthnContextDecl), [URI]) AuthnContext
-> PU ((Maybe URI, Maybe AuthnContextDecl), [URI])
-> PU AuthnContext
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU URI -> PU (Maybe URI)
forall a. PU a -> PU (Maybe a)
XP.xpOption (String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
xpElem String
"AuthnContextClassRef" PU URI
XS.xpAnyURI)
      PU (Maybe URI)
-> PU (Maybe AuthnContextDecl)
-> PU (Maybe URI, Maybe AuthnContextDecl)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU AuthnContextDecl -> PU (Maybe AuthnContextDecl)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU AuthnContextDecl
forall a. XmlPickler a => PU a
XP.xpickle
      PU (Maybe URI, Maybe AuthnContextDecl)
-> PU [URI] -> PU ((Maybe URI, Maybe AuthnContextDecl), [URI])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU URI -> PU [URI]
forall a. PU a -> PU [a]
XP.xpList (String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
xpElem String
"AuthenticatingAuthority" PU URI
XS.xpAnyURI))

data AuthnContextDecl
  = AuthnContextDecl Nodes
  | AuthnContextDeclRef AnyURI
  deriving (AuthnContextDecl -> AuthnContextDecl -> Bool
(AuthnContextDecl -> AuthnContextDecl -> Bool)
-> (AuthnContextDecl -> AuthnContextDecl -> Bool)
-> Eq AuthnContextDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthnContextDecl -> AuthnContextDecl -> Bool
$c/= :: AuthnContextDecl -> AuthnContextDecl -> Bool
== :: AuthnContextDecl -> AuthnContextDecl -> Bool
$c== :: AuthnContextDecl -> AuthnContextDecl -> Bool
Eq, Int -> AuthnContextDecl -> ShowS
[AuthnContextDecl] -> ShowS
AuthnContextDecl -> String
(Int -> AuthnContextDecl -> ShowS)
-> (AuthnContextDecl -> String)
-> ([AuthnContextDecl] -> ShowS)
-> Show AuthnContextDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthnContextDecl] -> ShowS
$cshowList :: [AuthnContextDecl] -> ShowS
show :: AuthnContextDecl -> String
$cshow :: AuthnContextDecl -> String
showsPrec :: Int -> AuthnContextDecl -> ShowS
$cshowsPrec :: Int -> AuthnContextDecl -> ShowS
Show)

instance XP.XmlPickler AuthnContextDecl where
  xpickle :: PU AuthnContextDecl
xpickle = [XP.biCase|
      Left d <-> AuthnContextDecl d
      Right r <-> AuthnContextDeclRef r|]
    Bijection (->) (Either Nodes URI) AuthnContextDecl
-> PU (Either Nodes URI) -> PU AuthnContextDecl
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU Nodes -> PU Nodes
forall a. String -> PU a -> PU a
xpElem String
"AuthnContextDecl" PU Nodes
XP.xpAny
      PU Nodes -> PU URI -> PU (Either Nodes URI)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
xpElem String
"AuthnContextDeclRef" PU URI
XS.xpAnyURI)

-- |§2.7.3
newtype AttributeStatement = AttributeStatement{ AttributeStatement -> List1 (PossiblyEncrypted Attribute)
attributeStatement :: List1 (PossiblyEncrypted Attribute) }
  deriving (AttributeStatement -> AttributeStatement -> Bool
(AttributeStatement -> AttributeStatement -> Bool)
-> (AttributeStatement -> AttributeStatement -> Bool)
-> Eq AttributeStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeStatement -> AttributeStatement -> Bool
$c/= :: AttributeStatement -> AttributeStatement -> Bool
== :: AttributeStatement -> AttributeStatement -> Bool
$c== :: AttributeStatement -> AttributeStatement -> Bool
Eq, Int -> AttributeStatement -> ShowS
[AttributeStatement] -> ShowS
AttributeStatement -> String
(Int -> AttributeStatement -> ShowS)
-> (AttributeStatement -> String)
-> ([AttributeStatement] -> ShowS)
-> Show AttributeStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeStatement] -> ShowS
$cshowList :: [AttributeStatement] -> ShowS
show :: AttributeStatement -> String
$cshow :: AttributeStatement -> String
showsPrec :: Int -> AttributeStatement -> ShowS
$cshowsPrec :: Int -> AttributeStatement -> ShowS
Show)

instance XP.XmlPickler AttributeStatement where
  xpickle :: PU AttributeStatement
xpickle = String -> PU AttributeStatement -> PU AttributeStatement
forall a. String -> PU a -> PU a
xpElem String
"AttributeStatement" (PU AttributeStatement -> PU AttributeStatement)
-> PU AttributeStatement -> PU AttributeStatement
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      l <-> AttributeStatement l|]
    Bijection
  (->) (List1 (PossiblyEncrypted Attribute)) AttributeStatement
-> PU (List1 (PossiblyEncrypted Attribute))
-> PU AttributeStatement
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< PU (PossiblyEncrypted Attribute)
-> PU (List1 (PossiblyEncrypted Attribute))
forall a. PU a -> PU (List1 a)
xpList1 PU (PossiblyEncrypted Attribute)
forall a.
(XmlPickler a, XmlPickler (EncryptedElement a)) =>
PU (PossiblyEncrypted a)
xpPossiblyEncrypted

-- |§2.7.3.1
data Attribute = Attribute
  { Attribute -> String
attributeName :: XString
  , Attribute -> IdentifiedURI AttributeNameFormat
attributeNameFormat :: IdentifiedURI AttributeNameFormat
  , Attribute -> Maybe String
attributeFriendlyName :: Maybe XString
  , Attribute -> Nodes
attributeAttrs :: Nodes -- attributes
  , Attribute -> [Nodes]
attributeValues :: [Nodes] -- ^§2.7.3.1.1
  } deriving (Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq, Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> String
(Int -> Attribute -> ShowS)
-> (Attribute -> String)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> String
$cshow :: Attribute -> String
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show)

xpAttributeType :: XP.PU Attribute
xpAttributeType :: PU Attribute
xpAttributeType = [XP.biCase|
    ((((n, f), u), x), v) <-> Attribute n f u x v|]
  Bijection
  (->)
  ((((String, IdentifiedURI AttributeNameFormat), Maybe String),
    Nodes),
   [Nodes])
  Attribute
-> PU
     ((((String, IdentifiedURI AttributeNameFormat), Maybe String),
       Nodes),
      [Nodes])
-> PU Attribute
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU String -> PU String
forall a. String -> PU a -> PU a
XP.xpAttr String
"Name" PU String
XS.xpString
    PU String
-> PU (IdentifiedURI AttributeNameFormat)
-> PU (String, IdentifiedURI AttributeNameFormat)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< IdentifiedURI AttributeNameFormat
-> PU (IdentifiedURI AttributeNameFormat)
-> PU (IdentifiedURI AttributeNameFormat)
forall a. Eq a => a -> PU a -> PU a
XP.xpDefault (AttributeNameFormat -> IdentifiedURI AttributeNameFormat
forall b a. a -> Identified b a
Identified AttributeNameFormat
AttributeNameFormatUnspecified) (String
-> PU (IdentifiedURI AttributeNameFormat)
-> PU (IdentifiedURI AttributeNameFormat)
forall a. String -> PU a -> PU a
XP.xpAttr String
"NameFormat" PU (IdentifiedURI AttributeNameFormat)
forall a. XmlPickler a => PU a
XP.xpickle)
    PU (String, IdentifiedURI AttributeNameFormat)
-> PU (Maybe String)
-> PU ((String, IdentifiedURI AttributeNameFormat), Maybe String)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU String -> PU (Maybe String)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"FriendlyName" PU String
XS.xpString
    PU ((String, IdentifiedURI AttributeNameFormat), Maybe String)
-> PU Nodes
-> PU
     (((String, IdentifiedURI AttributeNameFormat), Maybe String),
      Nodes)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Nodes
XP.xpAnyAttrs
    PU
  (((String, IdentifiedURI AttributeNameFormat), Maybe String),
   Nodes)
-> PU [Nodes]
-> PU
     ((((String, IdentifiedURI AttributeNameFormat), Maybe String),
       Nodes),
      [Nodes])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Nodes -> PU [Nodes]
forall a. PU a -> PU [a]
XP.xpList (String -> PU Nodes -> PU Nodes
forall a. String -> PU a -> PU a
xpElem String
"AttributeValue" PU Nodes
XP.xpAny))

instance XP.XmlPickler Attribute where
  xpickle :: PU Attribute
xpickle = String -> PU Attribute -> PU Attribute
forall a. String -> PU a -> PU a
xpElem String
"Attribute" PU Attribute
xpAttributeType

-- |§2.7.3.2
type EncryptedAttribute = EncryptedElement Attribute

instance XP.XmlPickler EncryptedAttribute where
  xpickle :: PU EncryptedAttribute
xpickle = String -> PU EncryptedAttribute -> PU EncryptedAttribute
forall a. String -> PU a -> PU a
xpElem String
"EncryptedAttribute" PU EncryptedAttribute
forall a. PU (EncryptedElement a)
xpEncryptedElement

-- |§2.7.4
data AuthzDecisionStatement = AuthzDecisionStatement
  { AuthzDecisionStatement -> URI
authzDecisionStatementResource :: AnyURI
  , AuthzDecisionStatement -> DecisionType
authzDecisionStatementDecision :: DecisionType
  , AuthzDecisionStatement -> List1 Action
authzDecisionStatementAction :: List1 Action
  , AuthzDecisionStatement -> Evidence
authzDecisionStatementEvidence :: Evidence
  } deriving (AuthzDecisionStatement -> AuthzDecisionStatement -> Bool
(AuthzDecisionStatement -> AuthzDecisionStatement -> Bool)
-> (AuthzDecisionStatement -> AuthzDecisionStatement -> Bool)
-> Eq AuthzDecisionStatement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthzDecisionStatement -> AuthzDecisionStatement -> Bool
$c/= :: AuthzDecisionStatement -> AuthzDecisionStatement -> Bool
== :: AuthzDecisionStatement -> AuthzDecisionStatement -> Bool
$c== :: AuthzDecisionStatement -> AuthzDecisionStatement -> Bool
Eq, Int -> AuthzDecisionStatement -> ShowS
[AuthzDecisionStatement] -> ShowS
AuthzDecisionStatement -> String
(Int -> AuthzDecisionStatement -> ShowS)
-> (AuthzDecisionStatement -> String)
-> ([AuthzDecisionStatement] -> ShowS)
-> Show AuthzDecisionStatement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthzDecisionStatement] -> ShowS
$cshowList :: [AuthzDecisionStatement] -> ShowS
show :: AuthzDecisionStatement -> String
$cshow :: AuthzDecisionStatement -> String
showsPrec :: Int -> AuthzDecisionStatement -> ShowS
$cshowsPrec :: Int -> AuthzDecisionStatement -> ShowS
Show)

instance XP.XmlPickler AuthzDecisionStatement where
  xpickle :: PU AuthzDecisionStatement
xpickle = String -> PU AuthzDecisionStatement -> PU AuthzDecisionStatement
forall a. String -> PU a -> PU a
xpElem String
"AuthzDecisionStatement" (PU AuthzDecisionStatement -> PU AuthzDecisionStatement)
-> PU AuthzDecisionStatement -> PU AuthzDecisionStatement
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (((r, d), a), e) <-> AuthzDecisionStatement r d a e|]
    Bijection
  (->)
  (((URI, DecisionType), List1 Action), Evidence)
  AuthzDecisionStatement
-> PU (((URI, DecisionType), List1 Action), Evidence)
-> PU AuthzDecisionStatement
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
XP.xpAttr String
"Resource" PU URI
XS.xpAnyURI
      PU URI -> PU DecisionType -> PU (URI, DecisionType)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU DecisionType -> PU DecisionType
forall a. String -> PU a -> PU a
XP.xpAttr String
"Decision" PU DecisionType
forall a. XmlPickler a => PU a
XP.xpickle
      PU (URI, DecisionType)
-> PU (List1 Action) -> PU ((URI, DecisionType), List1 Action)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Action -> PU (List1 Action)
forall a. PU a -> PU (List1 a)
xpList1 PU Action
forall a. XmlPickler a => PU a
XP.xpickle
      PU ((URI, DecisionType), List1 Action)
-> PU Evidence
-> PU (((URI, DecisionType), List1 Action), Evidence)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Evidence
forall a. XmlPickler a => PU a
XP.xpickle)

-- |§2.7.4.1
data DecisionType
  = DecisionTypePermit
  | DecisionTypeDeny
  | DecisionTypeIndeterminate
  deriving (DecisionType -> DecisionType -> Bool
(DecisionType -> DecisionType -> Bool)
-> (DecisionType -> DecisionType -> Bool) -> Eq DecisionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecisionType -> DecisionType -> Bool
$c/= :: DecisionType -> DecisionType -> Bool
== :: DecisionType -> DecisionType -> Bool
$c== :: DecisionType -> DecisionType -> Bool
Eq, Int -> DecisionType
DecisionType -> Int
DecisionType -> [DecisionType]
DecisionType -> DecisionType
DecisionType -> DecisionType -> [DecisionType]
DecisionType -> DecisionType -> DecisionType -> [DecisionType]
(DecisionType -> DecisionType)
-> (DecisionType -> DecisionType)
-> (Int -> DecisionType)
-> (DecisionType -> Int)
-> (DecisionType -> [DecisionType])
-> (DecisionType -> DecisionType -> [DecisionType])
-> (DecisionType -> DecisionType -> [DecisionType])
-> (DecisionType -> DecisionType -> DecisionType -> [DecisionType])
-> Enum DecisionType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DecisionType -> DecisionType -> DecisionType -> [DecisionType]
$cenumFromThenTo :: DecisionType -> DecisionType -> DecisionType -> [DecisionType]
enumFromTo :: DecisionType -> DecisionType -> [DecisionType]
$cenumFromTo :: DecisionType -> DecisionType -> [DecisionType]
enumFromThen :: DecisionType -> DecisionType -> [DecisionType]
$cenumFromThen :: DecisionType -> DecisionType -> [DecisionType]
enumFrom :: DecisionType -> [DecisionType]
$cenumFrom :: DecisionType -> [DecisionType]
fromEnum :: DecisionType -> Int
$cfromEnum :: DecisionType -> Int
toEnum :: Int -> DecisionType
$ctoEnum :: Int -> DecisionType
pred :: DecisionType -> DecisionType
$cpred :: DecisionType -> DecisionType
succ :: DecisionType -> DecisionType
$csucc :: DecisionType -> DecisionType
Enum, DecisionType
DecisionType -> DecisionType -> Bounded DecisionType
forall a. a -> a -> Bounded a
maxBound :: DecisionType
$cmaxBound :: DecisionType
minBound :: DecisionType
$cminBound :: DecisionType
Bounded, Int -> DecisionType -> ShowS
[DecisionType] -> ShowS
DecisionType -> String
(Int -> DecisionType -> ShowS)
-> (DecisionType -> String)
-> ([DecisionType] -> ShowS)
-> Show DecisionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecisionType] -> ShowS
$cshowList :: [DecisionType] -> ShowS
show :: DecisionType -> String
$cshow :: DecisionType -> String
showsPrec :: Int -> DecisionType -> ShowS
$cshowsPrec :: Int -> DecisionType -> ShowS
Show)

instance Identifiable XString DecisionType where
  identifier :: DecisionType -> String
identifier DecisionType
DecisionTypePermit = String
"Permit"
  identifier DecisionType
DecisionTypeDeny = String
"Deny"
  identifier DecisionType
DecisionTypeIndeterminate = String
"Indeterminate"
instance XP.XmlPickler DecisionType where
  xpickle :: PU DecisionType
xpickle = PU String -> String -> PU DecisionType
forall b a. Identifiable b a => PU b -> String -> PU a
xpIdentifier (Schema -> PU String
XP.xpTextDT (String -> String -> Attributes -> Schema
XPS.scDT (Namespace -> String
namespaceURIString Namespace
ns) String
"DecisionType" [])) String
"DecisionType"

-- |§2.7.4.2
data Action = Action
  { Action -> IdentifiedURI ActionNamespace
actionNamespace :: IdentifiedURI ActionNamespace
  , Action -> String
action :: XString
  } deriving (Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Eq, Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Action] -> ShowS
$cshowList :: [Action] -> ShowS
show :: Action -> String
$cshow :: Action -> String
showsPrec :: Int -> Action -> ShowS
$cshowsPrec :: Int -> Action -> ShowS
Show)

instance XP.XmlPickler Action where
  xpickle :: PU Action
xpickle = String -> PU Action -> PU Action
forall a. String -> PU a -> PU a
xpElem String
"Action" (PU Action -> PU Action) -> PU Action -> PU Action
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (n, a) <-> Action n a|]
    Bijection (->) (IdentifiedURI ActionNamespace, String) Action
-> PU (IdentifiedURI ActionNamespace, String) -> PU Action
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String
-> PU (IdentifiedURI ActionNamespace)
-> PU (IdentifiedURI ActionNamespace)
forall a. String -> PU a -> PU a
XP.xpAttr String
"Namespace" PU (IdentifiedURI ActionNamespace)
forall a. XmlPickler a => PU a
XP.xpickle
      PU (IdentifiedURI ActionNamespace)
-> PU String -> PU (IdentifiedURI ActionNamespace, String)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU String
XP.xpText0)

-- |§2.7.4.3
newtype Evidence = Evidence{ Evidence -> [AssertionRef]
evidence :: [AssertionRef] }
  deriving (Evidence -> Evidence -> Bool
(Evidence -> Evidence -> Bool)
-> (Evidence -> Evidence -> Bool) -> Eq Evidence
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Evidence -> Evidence -> Bool
$c/= :: Evidence -> Evidence -> Bool
== :: Evidence -> Evidence -> Bool
$c== :: Evidence -> Evidence -> Bool
Eq, Int -> Evidence -> ShowS
[Evidence] -> ShowS
Evidence -> String
(Int -> Evidence -> ShowS)
-> (Evidence -> String) -> ([Evidence] -> ShowS) -> Show Evidence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Evidence] -> ShowS
$cshowList :: [Evidence] -> ShowS
show :: Evidence -> String
$cshow :: Evidence -> String
showsPrec :: Int -> Evidence -> ShowS
$cshowsPrec :: Int -> Evidence -> ShowS
Show
#if MIN_VERSION_base(4,11,0)
    , b -> Evidence -> Evidence
NonEmpty Evidence -> Evidence
Evidence -> Evidence -> Evidence
(Evidence -> Evidence -> Evidence)
-> (NonEmpty Evidence -> Evidence)
-> (forall b. Integral b => b -> Evidence -> Evidence)
-> Semigroup Evidence
forall b. Integral b => b -> Evidence -> Evidence
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Evidence -> Evidence
$cstimes :: forall b. Integral b => b -> Evidence -> Evidence
sconcat :: NonEmpty Evidence -> Evidence
$csconcat :: NonEmpty Evidence -> Evidence
<> :: Evidence -> Evidence -> Evidence
$c<> :: Evidence -> Evidence -> Evidence
Semigroup
#endif
    , Semigroup Evidence
Evidence
Semigroup Evidence
-> Evidence
-> (Evidence -> Evidence -> Evidence)
-> ([Evidence] -> Evidence)
-> Monoid Evidence
[Evidence] -> Evidence
Evidence -> Evidence -> Evidence
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Evidence] -> Evidence
$cmconcat :: [Evidence] -> Evidence
mappend :: Evidence -> Evidence -> Evidence
$cmappend :: Evidence -> Evidence -> Evidence
mempty :: Evidence
$cmempty :: Evidence
$cp1Monoid :: Semigroup Evidence
Monoid)

instance XP.XmlPickler Evidence where
  xpickle :: PU Evidence
xpickle = [XP.biCase|
      Nothing <-> Evidence []
      Just l <-> Evidence l|]
    Bijection (->) (Maybe [AssertionRef]) Evidence
-> PU (Maybe [AssertionRef]) -> PU Evidence
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< PU [AssertionRef] -> PU (Maybe [AssertionRef])
forall a. PU a -> PU (Maybe a)
XP.xpOption (String -> PU [AssertionRef] -> PU [AssertionRef]
forall a. String -> PU a -> PU a
xpElem String
"Evidence" (PU [AssertionRef] -> PU [AssertionRef])
-> PU [AssertionRef] -> PU [AssertionRef]
forall a b. (a -> b) -> a -> b
$ PU AssertionRef -> PU [AssertionRef]
forall a. PU a -> PU [a]
XP.xpList1 PU AssertionRef
forall a. XmlPickler a => PU a
XP.xpickle)