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

import Control.Lens (Lens', lens, (.~), (^.), view)
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy, asProxyTypeOf)
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 SAML2.Core.Namespaces
import SAML2.Core.Versioning
import qualified SAML2.Core.Assertions as SAML
import SAML2.Core.Identifiers
import SAML2.Bindings.General (RelayState)
import SAML2.Bindings.Identifiers

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

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

data ProtocolType = ProtocolType
  { ProtocolType -> String
protocolID :: XS.ID
  , ProtocolType -> SAMLVersion
protocolVersion :: SAMLVersion
  , ProtocolType -> DateTime
protocolIssueInstant :: DateTime
  , ProtocolType -> Maybe URI
protocolDestination :: Maybe AnyURI
  , ProtocolType -> IdentifiedURI Consent
protocolConsent :: IdentifiedURI Consent
  , ProtocolType -> Maybe Issuer
protocolIssuer :: Maybe SAML.Issuer
  , ProtocolType -> Maybe Signature
protocolSignature :: Maybe DS.Signature
  , ProtocolType -> [Node]
protocolExtensions :: [Node]
  , ProtocolType -> Maybe RelayState
relayState :: Maybe RelayState -- ^out-of-band data, not part of XML
  } deriving (ProtocolType -> ProtocolType -> Bool
(ProtocolType -> ProtocolType -> Bool)
-> (ProtocolType -> ProtocolType -> Bool) -> Eq ProtocolType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolType -> ProtocolType -> Bool
$c/= :: ProtocolType -> ProtocolType -> Bool
== :: ProtocolType -> ProtocolType -> Bool
$c== :: ProtocolType -> ProtocolType -> Bool
Eq, Int -> ProtocolType -> ShowS
[ProtocolType] -> ShowS
ProtocolType -> String
(Int -> ProtocolType -> ShowS)
-> (ProtocolType -> String)
-> ([ProtocolType] -> ShowS)
-> Show ProtocolType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolType] -> ShowS
$cshowList :: [ProtocolType] -> ShowS
show :: ProtocolType -> String
$cshow :: ProtocolType -> String
showsPrec :: Int -> ProtocolType -> ShowS
$cshowsPrec :: Int -> ProtocolType -> ShowS
Show)

instance XP.XmlPickler ProtocolType where
  xpickle :: PU ProtocolType
xpickle = ((((((((String, SAMLVersion), DateTime), Maybe URI),
     IdentifiedURI Consent),
    Maybe Issuer),
   Maybe Signature),
  Maybe [Node])
 -> ProtocolType,
 ProtocolType
 -> (((((((String, SAMLVersion), DateTime), Maybe URI),
        IdentifiedURI Consent),
       Maybe Issuer),
      Maybe Signature),
     Maybe [Node]))
-> PU
     (((((((String, SAMLVersion), DateTime), Maybe URI),
         IdentifiedURI Consent),
        Maybe Issuer),
       Maybe Signature),
      Maybe [Node])
-> PU ProtocolType
forall a b. (a -> b, b -> a) -> PU a -> PU b
XP.xpWrap ((((((((String, SAMLVersion), DateTime), Maybe URI),
    IdentifiedURI Consent),
   Maybe Issuer),
  Maybe Signature),
 Maybe [Node])
-> ProtocolType
pt, ProtocolType
-> (((((((String, SAMLVersion), DateTime), Maybe URI),
       IdentifiedURI Consent),
      Maybe Issuer),
     Maybe Signature),
    Maybe [Node])
tp)
    (PU
   (((((((String, SAMLVersion), DateTime), Maybe URI),
       IdentifiedURI Consent),
      Maybe Issuer),
     Maybe Signature),
    Maybe [Node])
 -> PU ProtocolType)
-> PU
     (((((((String, SAMLVersion), DateTime), Maybe URI),
         IdentifiedURI Consent),
        Maybe Issuer),
       Maybe Signature),
      Maybe [Node])
-> PU ProtocolType
forall a b. (a -> b) -> a -> b
$       (String -> PU String -> PU String
forall a. String -> PU a -> PU a
XP.xpAttr String
"ID" PU String
XS.xpID
      PU String -> PU SAMLVersion -> PU (String, SAMLVersion)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, 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 (String, SAMLVersion)
-> PU DateTime -> PU ((String, SAMLVersion), 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 ((String, SAMLVersion), DateTime)
-> PU (Maybe URI)
-> PU (((String, SAMLVersion), 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
"Destination" PU URI
XS.xpAnyURI
      PU (((String, SAMLVersion), DateTime), Maybe URI)
-> PU (IdentifiedURI Consent)
-> PU
     ((((String, SAMLVersion), DateTime), Maybe URI),
      IdentifiedURI Consent)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< IdentifiedURI Consent
-> PU (IdentifiedURI Consent) -> PU (IdentifiedURI Consent)
forall a. Eq a => a -> PU a -> PU a
XP.xpDefault (Consent -> IdentifiedURI Consent
forall b a. a -> Identified b a
Identified Consent
ConsentUnspecified) (String -> PU (IdentifiedURI Consent) -> PU (IdentifiedURI Consent)
forall a. String -> PU a -> PU a
XP.xpAttr String
"Consent" PU (IdentifiedURI Consent)
forall a. XmlPickler a => PU a
XP.xpickle)
      PU
  ((((String, SAMLVersion), DateTime), Maybe URI),
   IdentifiedURI Consent)
-> PU (Maybe Issuer)
-> PU
     (((((String, SAMLVersion), DateTime), Maybe URI),
       IdentifiedURI Consent),
      Maybe Issuer)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Issuer -> PU (Maybe Issuer)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU Issuer
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (((((String, SAMLVersion), DateTime), Maybe URI),
    IdentifiedURI Consent),
   Maybe Issuer)
-> PU (Maybe Signature)
-> PU
     ((((((String, SAMLVersion), DateTime), Maybe URI),
        IdentifiedURI Consent),
       Maybe 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
  ((((((String, SAMLVersion), DateTime), Maybe URI),
     IdentifiedURI Consent),
    Maybe Issuer),
   Maybe Signature)
-> PU (Maybe [Node])
-> PU
     (((((((String, SAMLVersion), DateTime), Maybe URI),
         IdentifiedURI Consent),
        Maybe Issuer),
       Maybe Signature),
      Maybe [Node])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU [Node] -> PU (Maybe [Node])
forall a. PU a -> PU (Maybe a)
XP.xpOption (String -> PU [Node] -> PU [Node]
forall a. String -> PU a -> PU a
xpElem String
"Extensions" (PU [Node] -> PU [Node]) -> PU [Node] -> PU [Node]
forall a b. (a -> b) -> a -> b
$ PU Node -> PU [Node]
forall a. PU a -> PU [a]
XP.xpList1 PU Node
xpTrimAnyElem))
    where
    pt :: (((((((String, SAMLVersion), DateTime), Maybe URI),
    IdentifiedURI Consent),
   Maybe Issuer),
  Maybe Signature),
 Maybe [Node])
-> ProtocolType
pt (((((((String
i, SAMLVersion
v), DateTime
t), Maybe URI
d), IdentifiedURI Consent
c), Maybe Issuer
u), Maybe Signature
g), Maybe [Node]
x) = String
-> SAMLVersion
-> DateTime
-> Maybe URI
-> IdentifiedURI Consent
-> Maybe Issuer
-> Maybe Signature
-> [Node]
-> Maybe RelayState
-> ProtocolType
ProtocolType String
i SAMLVersion
v DateTime
t Maybe URI
d IdentifiedURI Consent
c Maybe Issuer
u Maybe Signature
g ([Node] -> Maybe [Node] -> [Node]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Node]
x) Maybe RelayState
forall a. Maybe a
Nothing
    tp :: ProtocolType
-> (((((((String, SAMLVersion), DateTime), Maybe URI),
       IdentifiedURI Consent),
      Maybe Issuer),
     Maybe Signature),
    Maybe [Node])
tp (ProtocolType String
i SAMLVersion
v DateTime
t Maybe URI
d IdentifiedURI Consent
c Maybe Issuer
u Maybe Signature
g [] Maybe RelayState
_) = (((((((String
i, SAMLVersion
v), DateTime
t), Maybe URI
d), IdentifiedURI Consent
c), Maybe Issuer
u), Maybe Signature
g), Maybe [Node]
forall a. Maybe a
Nothing)
    tp (ProtocolType String
i SAMLVersion
v DateTime
t Maybe URI
d IdentifiedURI Consent
c Maybe Issuer
u Maybe Signature
g [Node]
x Maybe RelayState
_) = (((((((String
i, SAMLVersion
v), DateTime
t), Maybe URI
d), IdentifiedURI Consent
c), Maybe Issuer
u), Maybe Signature
g), [Node] -> Maybe [Node]
forall a. a -> Maybe a
Just [Node]
x)

instance DS.Signable ProtocolType where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
signature' = $(fieldLens 'protocolSignature)
  signedID :: ProtocolType -> String
signedID = ProtocolType -> String
protocolID
class (XP.XmlPickler a, DS.Signable a, Show a) => SAMLProtocol a where
  samlProtocol' :: Lens' a ProtocolType
  isSAMLResponse :: a -> Bool
  isSAMLResponse_ :: Proxy a -> Maybe Bool
  isSAMLResponse_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> (Proxy a -> Bool) -> Proxy a -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
forall a. SAMLProtocol a => a -> Bool
isSAMLResponse (a -> Bool) -> (Proxy a -> a) -> Proxy a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Proxy a -> a
forall a (proxy :: * -> *). a -> proxy a -> a
asProxyTypeOf a
forall a. HasCallStack => a
undefined

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

instance XP.XmlPickler RequestAbstractType where
  xpickle :: PU RequestAbstractType
xpickle = [XP.biCase|p <-> RequestAbstractType p|]
    Bijection (->) ProtocolType RequestAbstractType
-> PU ProtocolType -> PU RequestAbstractType
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< PU ProtocolType
forall a. XmlPickler a => PU a
XP.xpickle

class SAMLProtocol a => SAMLRequest a where
  samlRequest' :: Lens' a RequestAbstractType

requestProtocol' :: Lens' RequestAbstractType ProtocolType
requestProtocol' :: (ProtocolType -> f ProtocolType)
-> RequestAbstractType -> f RequestAbstractType
requestProtocol' = $(fieldLens 'requestProtocol)

-- |§3.2.2
data StatusResponseType = StatusResponseType
  { StatusResponseType -> ProtocolType
statusProtocol :: !ProtocolType
  , StatusResponseType -> Maybe String
statusInResponseTo :: Maybe XS.NCName
  , StatusResponseType -> Status
status :: Status
  } deriving (StatusResponseType -> StatusResponseType -> Bool
(StatusResponseType -> StatusResponseType -> Bool)
-> (StatusResponseType -> StatusResponseType -> Bool)
-> Eq StatusResponseType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusResponseType -> StatusResponseType -> Bool
$c/= :: StatusResponseType -> StatusResponseType -> Bool
== :: StatusResponseType -> StatusResponseType -> Bool
$c== :: StatusResponseType -> StatusResponseType -> Bool
Eq, Int -> StatusResponseType -> ShowS
[StatusResponseType] -> ShowS
StatusResponseType -> String
(Int -> StatusResponseType -> ShowS)
-> (StatusResponseType -> String)
-> ([StatusResponseType] -> ShowS)
-> Show StatusResponseType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusResponseType] -> ShowS
$cshowList :: [StatusResponseType] -> ShowS
show :: StatusResponseType -> String
$cshow :: StatusResponseType -> String
showsPrec :: Int -> StatusResponseType -> ShowS
$cshowsPrec :: Int -> StatusResponseType -> ShowS
Show)

instance XP.XmlPickler StatusResponseType where
  xpickle :: PU StatusResponseType
xpickle = [XP.biCase|((p, r), s) <-> StatusResponseType p r s|]
    Bijection
  (->) ((ProtocolType, Maybe String), Status) StatusResponseType
-> PU ((ProtocolType, Maybe String), Status)
-> PU StatusResponseType
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU ProtocolType
forall a. XmlPickler a => PU a
XP.xpickle
      PU ProtocolType
-> PU (Maybe String) -> PU (ProtocolType, 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 (ProtocolType, Maybe String)
-> PU Status -> PU ((ProtocolType, Maybe String), Status)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Status
forall a. XmlPickler a => PU a
XP.xpickle)

class SAMLProtocol a => SAMLResponse a where
  samlResponse' :: Lens' a StatusResponseType

statusProtocol' :: Lens' StatusResponseType ProtocolType
statusProtocol' :: (ProtocolType -> f ProtocolType)
-> StatusResponseType -> f StatusResponseType
statusProtocol' = $(fieldLens 'statusProtocol)

-- |§3.2.2.1
data Status = Status
  { Status -> StatusCode
statusCode :: StatusCode
  , Status -> Maybe String
statusMessage :: Maybe XString -- ^§3.2.2.3
  , Status -> Maybe [Node]
statusDetail :: Maybe Nodes -- ^§3.2.2.4
  } deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show)

instance XP.XmlPickler Status where
  xpickle :: PU Status
xpickle = String -> PU Status -> PU Status
forall a. String -> PU a -> PU a
xpElem String
"Status" (PU Status -> PU Status) -> PU Status -> PU Status
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((c, m), d) <-> Status c m d|]
    Bijection (->) ((StatusCode, Maybe String), Maybe [Node]) Status
-> PU ((StatusCode, Maybe String), Maybe [Node]) -> PU Status
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU StatusCode
forall a. XmlPickler a => PU a
XP.xpickle
      PU StatusCode -> PU (Maybe String) -> PU (StatusCode, Maybe String)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU String -> PU (Maybe String)
forall a. PU a -> PU (Maybe a)
XP.xpOption (String -> PU String -> PU String
forall a. String -> PU a -> PU a
xpElem String
"StatusMessage" PU String
XP.xpText0)
      PU (StatusCode, Maybe String)
-> PU (Maybe [Node])
-> PU ((StatusCode, Maybe String), Maybe [Node])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU [Node] -> PU (Maybe [Node])
forall a. PU a -> PU (Maybe a)
XP.xpOption (String -> PU [Node] -> PU [Node]
forall a. String -> PU a -> PU a
xpElem String
"StatusDetail" PU [Node]
XP.xpAnyCont))

-- |§3.2.2.2
data StatusCode = StatusCode
  { StatusCode -> StatusCode1
statusCode1 :: StatusCode1
  , StatusCode -> [IdentifiedURI StatusCode2]
statusCodes :: [IdentifiedURI StatusCode2]
  } deriving (StatusCode -> StatusCode -> Bool
(StatusCode -> StatusCode -> Bool)
-> (StatusCode -> StatusCode -> Bool) -> Eq StatusCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusCode -> StatusCode -> Bool
$c/= :: StatusCode -> StatusCode -> Bool
== :: StatusCode -> StatusCode -> Bool
$c== :: StatusCode -> StatusCode -> Bool
Eq, Int -> StatusCode -> ShowS
[StatusCode] -> ShowS
StatusCode -> String
(Int -> StatusCode -> ShowS)
-> (StatusCode -> String)
-> ([StatusCode] -> ShowS)
-> Show StatusCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusCode] -> ShowS
$cshowList :: [StatusCode] -> ShowS
show :: StatusCode -> String
$cshow :: StatusCode -> String
showsPrec :: Int -> StatusCode -> ShowS
$cshowsPrec :: Int -> StatusCode -> ShowS
Show)

instance XP.XmlPickler StatusCode where
  xpickle :: PU StatusCode
xpickle = String -> PU StatusCode -> PU StatusCode
forall a. String -> PU a -> PU a
xpElem String
"StatusCode" (PU StatusCode -> PU StatusCode) -> PU StatusCode -> PU StatusCode
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (v, c) <-> StatusCode v c|]
    Bijection
  (->) (StatusCode1, [IdentifiedURI StatusCode2]) StatusCode
-> PU (StatusCode1, [IdentifiedURI StatusCode2]) -> PU StatusCode
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU StatusCode1 -> PU StatusCode1
forall a. String -> PU a -> PU a
XP.xpAttr String
"Value" PU StatusCode1
forall a. XmlPickler a => PU a
XP.xpickle
      PU StatusCode1
-> PU [IdentifiedURI StatusCode2]
-> PU (StatusCode1, [IdentifiedURI StatusCode2])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU [IdentifiedURI StatusCode2]
xpStatusCodes) where
    xpStatusCodes :: PU [IdentifiedURI StatusCode2]
xpStatusCodes = [XP.biCase|
        Nothing <-> []
        Just (v, c) <-> v : c|]
      Bijection
  (->)
  (Maybe (IdentifiedURI StatusCode2, [IdentifiedURI StatusCode2]))
  [IdentifiedURI StatusCode2]
-> PU
     (Maybe (IdentifiedURI StatusCode2, [IdentifiedURI StatusCode2]))
-> PU [IdentifiedURI StatusCode2]
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< PU (IdentifiedURI StatusCode2, [IdentifiedURI StatusCode2])
-> PU
     (Maybe (IdentifiedURI StatusCode2, [IdentifiedURI StatusCode2]))
forall a. PU a -> PU (Maybe a)
XP.xpOption (String
-> PU (IdentifiedURI StatusCode2, [IdentifiedURI StatusCode2])
-> PU (IdentifiedURI StatusCode2, [IdentifiedURI StatusCode2])
forall a. String -> PU a -> PU a
xpElem String
"StatusCode" (PU (IdentifiedURI StatusCode2, [IdentifiedURI StatusCode2])
 -> PU (IdentifiedURI StatusCode2, [IdentifiedURI StatusCode2]))
-> PU (IdentifiedURI StatusCode2, [IdentifiedURI StatusCode2])
-> PU (IdentifiedURI StatusCode2, [IdentifiedURI StatusCode2])
forall a b. (a -> b) -> a -> b
$
               String
-> PU (IdentifiedURI StatusCode2) -> PU (IdentifiedURI StatusCode2)
forall a. String -> PU a -> PU a
XP.xpAttr String
"Value" PU (IdentifiedURI StatusCode2)
forall a. XmlPickler a => PU a
XP.xpickle
        PU (IdentifiedURI StatusCode2)
-> PU [IdentifiedURI StatusCode2]
-> PU (IdentifiedURI StatusCode2, [IdentifiedURI StatusCode2])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU [IdentifiedURI StatusCode2]
xpStatusCodes)

data StatusCode1
  = StatusSuccess
  | StatusRequester
  | StatusResponder
  | StatusVersionMismatch
  deriving (StatusCode1 -> StatusCode1 -> Bool
(StatusCode1 -> StatusCode1 -> Bool)
-> (StatusCode1 -> StatusCode1 -> Bool) -> Eq StatusCode1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusCode1 -> StatusCode1 -> Bool
$c/= :: StatusCode1 -> StatusCode1 -> Bool
== :: StatusCode1 -> StatusCode1 -> Bool
$c== :: StatusCode1 -> StatusCode1 -> Bool
Eq, StatusCode1
StatusCode1 -> StatusCode1 -> Bounded StatusCode1
forall a. a -> a -> Bounded a
maxBound :: StatusCode1
$cmaxBound :: StatusCode1
minBound :: StatusCode1
$cminBound :: StatusCode1
Bounded, Int -> StatusCode1
StatusCode1 -> Int
StatusCode1 -> [StatusCode1]
StatusCode1 -> StatusCode1
StatusCode1 -> StatusCode1 -> [StatusCode1]
StatusCode1 -> StatusCode1 -> StatusCode1 -> [StatusCode1]
(StatusCode1 -> StatusCode1)
-> (StatusCode1 -> StatusCode1)
-> (Int -> StatusCode1)
-> (StatusCode1 -> Int)
-> (StatusCode1 -> [StatusCode1])
-> (StatusCode1 -> StatusCode1 -> [StatusCode1])
-> (StatusCode1 -> StatusCode1 -> [StatusCode1])
-> (StatusCode1 -> StatusCode1 -> StatusCode1 -> [StatusCode1])
-> Enum StatusCode1
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 :: StatusCode1 -> StatusCode1 -> StatusCode1 -> [StatusCode1]
$cenumFromThenTo :: StatusCode1 -> StatusCode1 -> StatusCode1 -> [StatusCode1]
enumFromTo :: StatusCode1 -> StatusCode1 -> [StatusCode1]
$cenumFromTo :: StatusCode1 -> StatusCode1 -> [StatusCode1]
enumFromThen :: StatusCode1 -> StatusCode1 -> [StatusCode1]
$cenumFromThen :: StatusCode1 -> StatusCode1 -> [StatusCode1]
enumFrom :: StatusCode1 -> [StatusCode1]
$cenumFrom :: StatusCode1 -> [StatusCode1]
fromEnum :: StatusCode1 -> Int
$cfromEnum :: StatusCode1 -> Int
toEnum :: Int -> StatusCode1
$ctoEnum :: Int -> StatusCode1
pred :: StatusCode1 -> StatusCode1
$cpred :: StatusCode1 -> StatusCode1
succ :: StatusCode1 -> StatusCode1
$csucc :: StatusCode1 -> StatusCode1
Enum, Int -> StatusCode1 -> ShowS
[StatusCode1] -> ShowS
StatusCode1 -> String
(Int -> StatusCode1 -> ShowS)
-> (StatusCode1 -> String)
-> ([StatusCode1] -> ShowS)
-> Show StatusCode1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusCode1] -> ShowS
$cshowList :: [StatusCode1] -> ShowS
show :: StatusCode1 -> String
$cshow :: StatusCode1 -> String
showsPrec :: Int -> StatusCode1 -> ShowS
$cshowsPrec :: Int -> StatusCode1 -> ShowS
Show)

instance Identifiable URI StatusCode1 where
  identifier :: StatusCode1 -> URI
identifier = String -> (SAMLVersion, String) -> URI
samlURNIdentifier String
"status" ((SAMLVersion, String) -> URI)
-> (StatusCode1 -> (SAMLVersion, String)) -> StatusCode1 -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusCode1 -> (SAMLVersion, String)
f where
    f :: StatusCode1 -> (SAMLVersion, String)
f StatusCode1
StatusSuccess         = (SAMLVersion
SAML20, String
"Success")
    f StatusCode1
StatusRequester       = (SAMLVersion
SAML20, String
"Requester")
    f StatusCode1
StatusResponder       = (SAMLVersion
SAML20, String
"Responder")
    f StatusCode1
StatusVersionMismatch = (SAMLVersion
SAML20, String
"VersionMismatch")
instance XP.XmlPickler StatusCode1 where
  xpickle :: PU StatusCode1
xpickle = PU URI -> String -> PU StatusCode1
forall b a. Identifiable b a => PU b -> String -> PU a
xpIdentifier PU URI
XS.xpAnyURI String
"status"

data StatusCode2
  = StatusAuthnFailed
  | StatusInvalidAttrNameOrValue
  | StatusInvalidNameIDPolicy
  | StatusNoAuthnContext
  | StatusNoAvailableIDP
  | StatusNoPassive
  | StatusNoSupportedIDP
  | StatusPartialLogout
  | StatusProxyCountExceeded
  | StatusRequestDenied
  | StatusRequestUnsupported
  | StatusRequestVersionDeprecated
  | StatusRequestVersionTooHigh
  | StatusRequestVersionTooLow
  | StatusResourceNotRecognized
  | StatusTooManyResponses
  | StatusUnknownAttrProfile
  | StatusUnknownPrincipal
  | StatusUnsupportedBinding
  deriving (StatusCode2 -> StatusCode2 -> Bool
(StatusCode2 -> StatusCode2 -> Bool)
-> (StatusCode2 -> StatusCode2 -> Bool) -> Eq StatusCode2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusCode2 -> StatusCode2 -> Bool
$c/= :: StatusCode2 -> StatusCode2 -> Bool
== :: StatusCode2 -> StatusCode2 -> Bool
$c== :: StatusCode2 -> StatusCode2 -> Bool
Eq, StatusCode2
StatusCode2 -> StatusCode2 -> Bounded StatusCode2
forall a. a -> a -> Bounded a
maxBound :: StatusCode2
$cmaxBound :: StatusCode2
minBound :: StatusCode2
$cminBound :: StatusCode2
Bounded, Int -> StatusCode2
StatusCode2 -> Int
StatusCode2 -> [StatusCode2]
StatusCode2 -> StatusCode2
StatusCode2 -> StatusCode2 -> [StatusCode2]
StatusCode2 -> StatusCode2 -> StatusCode2 -> [StatusCode2]
(StatusCode2 -> StatusCode2)
-> (StatusCode2 -> StatusCode2)
-> (Int -> StatusCode2)
-> (StatusCode2 -> Int)
-> (StatusCode2 -> [StatusCode2])
-> (StatusCode2 -> StatusCode2 -> [StatusCode2])
-> (StatusCode2 -> StatusCode2 -> [StatusCode2])
-> (StatusCode2 -> StatusCode2 -> StatusCode2 -> [StatusCode2])
-> Enum StatusCode2
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 :: StatusCode2 -> StatusCode2 -> StatusCode2 -> [StatusCode2]
$cenumFromThenTo :: StatusCode2 -> StatusCode2 -> StatusCode2 -> [StatusCode2]
enumFromTo :: StatusCode2 -> StatusCode2 -> [StatusCode2]
$cenumFromTo :: StatusCode2 -> StatusCode2 -> [StatusCode2]
enumFromThen :: StatusCode2 -> StatusCode2 -> [StatusCode2]
$cenumFromThen :: StatusCode2 -> StatusCode2 -> [StatusCode2]
enumFrom :: StatusCode2 -> [StatusCode2]
$cenumFrom :: StatusCode2 -> [StatusCode2]
fromEnum :: StatusCode2 -> Int
$cfromEnum :: StatusCode2 -> Int
toEnum :: Int -> StatusCode2
$ctoEnum :: Int -> StatusCode2
pred :: StatusCode2 -> StatusCode2
$cpred :: StatusCode2 -> StatusCode2
succ :: StatusCode2 -> StatusCode2
$csucc :: StatusCode2 -> StatusCode2
Enum, Int -> StatusCode2 -> ShowS
[StatusCode2] -> ShowS
StatusCode2 -> String
(Int -> StatusCode2 -> ShowS)
-> (StatusCode2 -> String)
-> ([StatusCode2] -> ShowS)
-> Show StatusCode2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusCode2] -> ShowS
$cshowList :: [StatusCode2] -> ShowS
show :: StatusCode2 -> String
$cshow :: StatusCode2 -> String
showsPrec :: Int -> StatusCode2 -> ShowS
$cshowsPrec :: Int -> StatusCode2 -> ShowS
Show)

instance Identifiable URI StatusCode2 where
  identifier :: StatusCode2 -> URI
identifier = String -> (SAMLVersion, String) -> URI
samlURNIdentifier String
"status" ((SAMLVersion, String) -> URI)
-> (StatusCode2 -> (SAMLVersion, String)) -> StatusCode2 -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusCode2 -> (SAMLVersion, String)
f where
    f :: StatusCode2 -> (SAMLVersion, String)
f StatusCode2
StatusAuthnFailed               = (SAMLVersion
SAML20, String
"AuthnFailed")
    f StatusCode2
StatusInvalidAttrNameOrValue    = (SAMLVersion
SAML20, String
"InvalidAttrNameOrValue")
    f StatusCode2
StatusInvalidNameIDPolicy       = (SAMLVersion
SAML20, String
"InvalidNameIDPolicy")
    f StatusCode2
StatusNoAuthnContext            = (SAMLVersion
SAML20, String
"NoAuthnContext")
    f StatusCode2
StatusNoAvailableIDP            = (SAMLVersion
SAML20, String
"NoAvailableIDP")
    f StatusCode2
StatusNoPassive                 = (SAMLVersion
SAML20, String
"NoPassive")
    f StatusCode2
StatusNoSupportedIDP            = (SAMLVersion
SAML20, String
"NoSupportedIDP")
    f StatusCode2
StatusPartialLogout             = (SAMLVersion
SAML20, String
"PartialLogout")
    f StatusCode2
StatusProxyCountExceeded        = (SAMLVersion
SAML20, String
"ProxyCountExceeded")
    f StatusCode2
StatusRequestDenied             = (SAMLVersion
SAML20, String
"RequestDenied")
    f StatusCode2
StatusRequestUnsupported        = (SAMLVersion
SAML20, String
"RequestUnsupported")
    f StatusCode2
StatusRequestVersionDeprecated  = (SAMLVersion
SAML20, String
"RequestVersionDeprecated")
    f StatusCode2
StatusRequestVersionTooHigh     = (SAMLVersion
SAML20, String
"RequestVersionTooHigh")
    f StatusCode2
StatusRequestVersionTooLow      = (SAMLVersion
SAML20, String
"RequestVersionTooLow")
    f StatusCode2
StatusResourceNotRecognized     = (SAMLVersion
SAML20, String
"ResourceNotRecognized")
    f StatusCode2
StatusTooManyResponses          = (SAMLVersion
SAML20, String
"TooManyResponses")
    f StatusCode2
StatusUnknownAttrProfile        = (SAMLVersion
SAML20, String
"UnknownAttrProfile")
    f StatusCode2
StatusUnknownPrincipal          = (SAMLVersion
SAML20, String
"UnknownPrincipal")
    f StatusCode2
StatusUnsupportedBinding        = (SAMLVersion
SAML20, String
"UnsupportedBinding")

successStatus :: Status
successStatus :: Status
successStatus = StatusCode -> Maybe String -> Maybe [Node] -> Status
Status (StatusCode1 -> [IdentifiedURI StatusCode2] -> StatusCode
StatusCode StatusCode1
StatusSuccess []) Maybe String
forall a. Maybe a
Nothing Maybe [Node]
forall a. Maybe a
Nothing

-- |§3.3.1
data AssertionIDRequest = AssertionIDRequest
  { AssertionIDRequest -> RequestAbstractType
assertionIDRequest :: !RequestAbstractType
  , AssertionIDRequest -> List1 AssertionIDRef
assertionIDRequestRef :: List1 (SAML.AssertionIDRef)
  } deriving (AssertionIDRequest -> AssertionIDRequest -> Bool
(AssertionIDRequest -> AssertionIDRequest -> Bool)
-> (AssertionIDRequest -> AssertionIDRequest -> Bool)
-> Eq AssertionIDRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssertionIDRequest -> AssertionIDRequest -> Bool
$c/= :: AssertionIDRequest -> AssertionIDRequest -> Bool
== :: AssertionIDRequest -> AssertionIDRequest -> Bool
$c== :: AssertionIDRequest -> AssertionIDRequest -> Bool
Eq, Int -> AssertionIDRequest -> ShowS
[AssertionIDRequest] -> ShowS
AssertionIDRequest -> String
(Int -> AssertionIDRequest -> ShowS)
-> (AssertionIDRequest -> String)
-> ([AssertionIDRequest] -> ShowS)
-> Show AssertionIDRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssertionIDRequest] -> ShowS
$cshowList :: [AssertionIDRequest] -> ShowS
show :: AssertionIDRequest -> String
$cshow :: AssertionIDRequest -> String
showsPrec :: Int -> AssertionIDRequest -> ShowS
$cshowsPrec :: Int -> AssertionIDRequest -> ShowS
Show)

instance XP.XmlPickler AssertionIDRequest where
  xpickle :: PU AssertionIDRequest
xpickle = String -> PU AssertionIDRequest -> PU AssertionIDRequest
forall a. String -> PU a -> PU a
xpElem String
"AssertionIDRequest" (PU AssertionIDRequest -> PU AssertionIDRequest)
-> PU AssertionIDRequest -> PU AssertionIDRequest
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (q, r) <-> AssertionIDRequest q r|]
    Bijection
  (->) (RequestAbstractType, List1 AssertionIDRef) AssertionIDRequest
-> PU (RequestAbstractType, List1 AssertionIDRef)
-> PU AssertionIDRequest
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU RequestAbstractType
forall a. XmlPickler a => PU a
XP.xpickle
      PU RequestAbstractType
-> PU (List1 AssertionIDRef)
-> PU (RequestAbstractType, List1 AssertionIDRef)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU AssertionIDRef -> PU (List1 AssertionIDRef)
forall a. PU a -> PU (List1 a)
xpList1 PU AssertionIDRef
forall a. XmlPickler a => PU a
XP.xpickle)
instance DS.Signable AssertionIDRequest where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> AssertionIDRequest -> f AssertionIDRequest
signature' = (ProtocolType -> f ProtocolType)
-> AssertionIDRequest -> f AssertionIDRequest
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType)
 -> AssertionIDRequest -> f AssertionIDRequest)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> AssertionIDRequest
-> f AssertionIDRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: AssertionIDRequest -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (AssertionIDRequest -> ProtocolType)
-> AssertionIDRequest
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType AssertionIDRequest ProtocolType
-> AssertionIDRequest -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType AssertionIDRequest ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol AssertionIDRequest where
  samlProtocol' :: (ProtocolType -> f ProtocolType)
-> AssertionIDRequest -> f AssertionIDRequest
samlProtocol' = (RequestAbstractType -> f RequestAbstractType)
-> AssertionIDRequest -> f AssertionIDRequest
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> f RequestAbstractType)
 -> AssertionIDRequest -> f AssertionIDRequest)
-> ((ProtocolType -> f ProtocolType)
    -> RequestAbstractType -> f RequestAbstractType)
-> (ProtocolType -> f ProtocolType)
-> AssertionIDRequest
-> f AssertionIDRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> RequestAbstractType -> f RequestAbstractType
Lens
  RequestAbstractType RequestAbstractType ProtocolType ProtocolType
requestProtocol'
  isSAMLResponse :: AssertionIDRequest -> Bool
isSAMLResponse AssertionIDRequest
_ = Bool
False
instance SAMLRequest AssertionIDRequest where
  samlRequest' :: (RequestAbstractType -> f RequestAbstractType)
-> AssertionIDRequest -> f AssertionIDRequest
samlRequest' = $(fieldLens 'assertionIDRequest)

-- |§3.3.2.1
data SubjectQueryAbstractType = SubjectQueryAbstractType
  { SubjectQueryAbstractType -> RequestAbstractType
subjectQuery :: !RequestAbstractType
  , SubjectQueryAbstractType -> Subject
subjectQuerySubject :: SAML.Subject
  } deriving (SubjectQueryAbstractType -> SubjectQueryAbstractType -> Bool
(SubjectQueryAbstractType -> SubjectQueryAbstractType -> Bool)
-> (SubjectQueryAbstractType -> SubjectQueryAbstractType -> Bool)
-> Eq SubjectQueryAbstractType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubjectQueryAbstractType -> SubjectQueryAbstractType -> Bool
$c/= :: SubjectQueryAbstractType -> SubjectQueryAbstractType -> Bool
== :: SubjectQueryAbstractType -> SubjectQueryAbstractType -> Bool
$c== :: SubjectQueryAbstractType -> SubjectQueryAbstractType -> Bool
Eq, Int -> SubjectQueryAbstractType -> ShowS
[SubjectQueryAbstractType] -> ShowS
SubjectQueryAbstractType -> String
(Int -> SubjectQueryAbstractType -> ShowS)
-> (SubjectQueryAbstractType -> String)
-> ([SubjectQueryAbstractType] -> ShowS)
-> Show SubjectQueryAbstractType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubjectQueryAbstractType] -> ShowS
$cshowList :: [SubjectQueryAbstractType] -> ShowS
show :: SubjectQueryAbstractType -> String
$cshow :: SubjectQueryAbstractType -> String
showsPrec :: Int -> SubjectQueryAbstractType -> ShowS
$cshowsPrec :: Int -> SubjectQueryAbstractType -> ShowS
Show)

instance XP.XmlPickler SubjectQueryAbstractType where
  xpickle :: PU SubjectQueryAbstractType
xpickle = [XP.biCase|
      (q, r) <-> SubjectQueryAbstractType q r|]
    Bijection
  (->) (RequestAbstractType, Subject) SubjectQueryAbstractType
-> PU (RequestAbstractType, Subject) -> PU SubjectQueryAbstractType
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU RequestAbstractType
forall a. XmlPickler a => PU a
XP.xpickle
      PU RequestAbstractType
-> PU Subject -> PU (RequestAbstractType, Subject)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Subject
forall a. XmlPickler a => PU a
XP.xpickle)

subjectQuery' :: Lens' SubjectQueryAbstractType RequestAbstractType
subjectQuery' :: (RequestAbstractType -> f RequestAbstractType)
-> SubjectQueryAbstractType -> f SubjectQueryAbstractType
subjectQuery' = $(fieldLens 'subjectQuery)

-- |§3.3.2.2
data AuthnQuery = AuthnQuery
  { AuthnQuery -> SubjectQueryAbstractType
authnQuery :: !SubjectQueryAbstractType
  , AuthnQuery -> Maybe String
authnQuerySessionIndex :: Maybe XString
  , AuthnQuery -> Maybe RequestedAuthnContext
authnQueryRequestedAuthnContext :: Maybe RequestedAuthnContext
  } deriving (AuthnQuery -> AuthnQuery -> Bool
(AuthnQuery -> AuthnQuery -> Bool)
-> (AuthnQuery -> AuthnQuery -> Bool) -> Eq AuthnQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthnQuery -> AuthnQuery -> Bool
$c/= :: AuthnQuery -> AuthnQuery -> Bool
== :: AuthnQuery -> AuthnQuery -> Bool
$c== :: AuthnQuery -> AuthnQuery -> Bool
Eq, Int -> AuthnQuery -> ShowS
[AuthnQuery] -> ShowS
AuthnQuery -> String
(Int -> AuthnQuery -> ShowS)
-> (AuthnQuery -> String)
-> ([AuthnQuery] -> ShowS)
-> Show AuthnQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthnQuery] -> ShowS
$cshowList :: [AuthnQuery] -> ShowS
show :: AuthnQuery -> String
$cshow :: AuthnQuery -> String
showsPrec :: Int -> AuthnQuery -> ShowS
$cshowsPrec :: Int -> AuthnQuery -> ShowS
Show)

instance XP.XmlPickler AuthnQuery where
  xpickle :: PU AuthnQuery
xpickle = String -> PU AuthnQuery -> PU AuthnQuery
forall a. String -> PU a -> PU a
xpElem String
"AuthnQuery" (PU AuthnQuery -> PU AuthnQuery) -> PU AuthnQuery -> PU AuthnQuery
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((q, i), c) <-> AuthnQuery q i c|]
    Bijection
  (->)
  ((SubjectQueryAbstractType, Maybe String),
   Maybe RequestedAuthnContext)
  AuthnQuery
-> PU
     ((SubjectQueryAbstractType, Maybe String),
      Maybe RequestedAuthnContext)
-> PU AuthnQuery
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU SubjectQueryAbstractType
forall a. XmlPickler a => PU a
XP.xpickle
      PU SubjectQueryAbstractType
-> PU (Maybe String) -> PU (SubjectQueryAbstractType, 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 (SubjectQueryAbstractType, Maybe String)
-> PU (Maybe RequestedAuthnContext)
-> PU
     ((SubjectQueryAbstractType, Maybe String),
      Maybe RequestedAuthnContext)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU RequestedAuthnContext -> PU (Maybe RequestedAuthnContext)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU RequestedAuthnContext
forall a. XmlPickler a => PU a
XP.xpickle)
instance DS.Signable AuthnQuery where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> AuthnQuery -> f AuthnQuery
signature' = (ProtocolType -> f ProtocolType) -> AuthnQuery -> f AuthnQuery
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType) -> AuthnQuery -> f AuthnQuery)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> AuthnQuery
-> f AuthnQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: AuthnQuery -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (AuthnQuery -> ProtocolType) -> AuthnQuery -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType AuthnQuery ProtocolType
-> AuthnQuery -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType AuthnQuery ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol AuthnQuery where
  samlProtocol' :: (ProtocolType -> f ProtocolType) -> AuthnQuery -> f AuthnQuery
samlProtocol' = (RequestAbstractType -> f RequestAbstractType)
-> AuthnQuery -> f AuthnQuery
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> f RequestAbstractType)
 -> AuthnQuery -> f AuthnQuery)
-> ((ProtocolType -> f ProtocolType)
    -> RequestAbstractType -> f RequestAbstractType)
-> (ProtocolType -> f ProtocolType)
-> AuthnQuery
-> f AuthnQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> RequestAbstractType -> f RequestAbstractType
Lens
  RequestAbstractType RequestAbstractType ProtocolType ProtocolType
requestProtocol'
  isSAMLResponse :: AuthnQuery -> Bool
isSAMLResponse AuthnQuery
_ = Bool
False
instance SAMLRequest AuthnQuery where
  samlRequest' :: (RequestAbstractType -> f RequestAbstractType)
-> AuthnQuery -> f AuthnQuery
samlRequest' = (SubjectQueryAbstractType -> f SubjectQueryAbstractType)
-> AuthnQuery -> f AuthnQuery
authnQuery' ((SubjectQueryAbstractType -> f SubjectQueryAbstractType)
 -> AuthnQuery -> f AuthnQuery)
-> ((RequestAbstractType -> f RequestAbstractType)
    -> SubjectQueryAbstractType -> f SubjectQueryAbstractType)
-> (RequestAbstractType -> f RequestAbstractType)
-> AuthnQuery
-> f AuthnQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RequestAbstractType -> f RequestAbstractType)
-> SubjectQueryAbstractType -> f SubjectQueryAbstractType
Lens
  SubjectQueryAbstractType
  SubjectQueryAbstractType
  RequestAbstractType
  RequestAbstractType
subjectQuery' where
    authnQuery' :: (SubjectQueryAbstractType -> f SubjectQueryAbstractType)
-> AuthnQuery -> f AuthnQuery
authnQuery' = $(fieldLens 'authnQuery)

-- |§3.3.2.2.1
data RequestedAuthnContext = RequestedAuthnContext
  { RequestedAuthnContext -> Maybe AuthnContextComparisonType
requestedAuthnContextComparison :: Maybe AuthnContextComparisonType
  , RequestedAuthnContext -> AuthnContextRefs
requestedAuthnContextRefs :: AuthnContextRefs
  } deriving (RequestedAuthnContext -> RequestedAuthnContext -> Bool
(RequestedAuthnContext -> RequestedAuthnContext -> Bool)
-> (RequestedAuthnContext -> RequestedAuthnContext -> Bool)
-> Eq RequestedAuthnContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestedAuthnContext -> RequestedAuthnContext -> Bool
$c/= :: RequestedAuthnContext -> RequestedAuthnContext -> Bool
== :: RequestedAuthnContext -> RequestedAuthnContext -> Bool
$c== :: RequestedAuthnContext -> RequestedAuthnContext -> Bool
Eq, Int -> RequestedAuthnContext -> ShowS
[RequestedAuthnContext] -> ShowS
RequestedAuthnContext -> String
(Int -> RequestedAuthnContext -> ShowS)
-> (RequestedAuthnContext -> String)
-> ([RequestedAuthnContext] -> ShowS)
-> Show RequestedAuthnContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestedAuthnContext] -> ShowS
$cshowList :: [RequestedAuthnContext] -> ShowS
show :: RequestedAuthnContext -> String
$cshow :: RequestedAuthnContext -> String
showsPrec :: Int -> RequestedAuthnContext -> ShowS
$cshowsPrec :: Int -> RequestedAuthnContext -> ShowS
Show)

instance XP.XmlPickler RequestedAuthnContext where
  xpickle :: PU RequestedAuthnContext
xpickle = String -> PU RequestedAuthnContext -> PU RequestedAuthnContext
forall a. String -> PU a -> PU a
xpElem String
"RequestedAuthnContext" (PU RequestedAuthnContext -> PU RequestedAuthnContext)
-> PU RequestedAuthnContext -> PU RequestedAuthnContext
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (c, r) <-> RequestedAuthnContext c r|]
    Bijection
  (->)
  (Maybe AuthnContextComparisonType, AuthnContextRefs)
  RequestedAuthnContext
-> PU (Maybe AuthnContextComparisonType, AuthnContextRefs)
-> PU RequestedAuthnContext
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String
-> PU AuthnContextComparisonType
-> PU (Maybe AuthnContextComparisonType)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Comparison" PU AuthnContextComparisonType
forall a. XmlPickler a => PU a
XP.xpickle
      PU (Maybe AuthnContextComparisonType)
-> PU AuthnContextRefs
-> PU (Maybe AuthnContextComparisonType, AuthnContextRefs)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU AuthnContextRefs
forall a. XmlPickler a => PU a
XP.xpickle)

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

instance XP.XmlPickler AuthnContextRefs where
  xpickle :: PU AuthnContextRefs
xpickle = [XP.biCase|
      Left l <-> AuthnContextClassRefs l
      Right l <-> AuthnContextDeclRefs l|]
    Bijection (->) (Either (List1 URI) (List1 URI)) AuthnContextRefs
-> PU (Either (List1 URI) (List1 URI)) -> PU AuthnContextRefs
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU URI -> PU (List1 URI)
forall a. PU a -> PU (List1 a)
xpList1 (String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
SAML.xpElem String
"AuthnContextClassRef" PU URI
XS.xpAnyURI)
      PU (List1 URI)
-> PU (List1 URI) -> PU (Either (List1 URI) (List1 URI))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU URI -> PU (List1 URI)
forall a. PU a -> PU (List1 a)
xpList1 (String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
SAML.xpElem String
"AuthnContextDeclRef" PU URI
XS.xpAnyURI))

data AuthnContextComparisonType
  = ComparisonExact
  | ComparisonMinimum
  | ComparisonMaximum
  | ComparisonBetter
  deriving (AuthnContextComparisonType -> AuthnContextComparisonType -> Bool
(AuthnContextComparisonType -> AuthnContextComparisonType -> Bool)
-> (AuthnContextComparisonType
    -> AuthnContextComparisonType -> Bool)
-> Eq AuthnContextComparisonType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthnContextComparisonType -> AuthnContextComparisonType -> Bool
$c/= :: AuthnContextComparisonType -> AuthnContextComparisonType -> Bool
== :: AuthnContextComparisonType -> AuthnContextComparisonType -> Bool
$c== :: AuthnContextComparisonType -> AuthnContextComparisonType -> Bool
Eq, Int -> AuthnContextComparisonType
AuthnContextComparisonType -> Int
AuthnContextComparisonType -> [AuthnContextComparisonType]
AuthnContextComparisonType -> AuthnContextComparisonType
AuthnContextComparisonType
-> AuthnContextComparisonType -> [AuthnContextComparisonType]
AuthnContextComparisonType
-> AuthnContextComparisonType
-> AuthnContextComparisonType
-> [AuthnContextComparisonType]
(AuthnContextComparisonType -> AuthnContextComparisonType)
-> (AuthnContextComparisonType -> AuthnContextComparisonType)
-> (Int -> AuthnContextComparisonType)
-> (AuthnContextComparisonType -> Int)
-> (AuthnContextComparisonType -> [AuthnContextComparisonType])
-> (AuthnContextComparisonType
    -> AuthnContextComparisonType -> [AuthnContextComparisonType])
-> (AuthnContextComparisonType
    -> AuthnContextComparisonType -> [AuthnContextComparisonType])
-> (AuthnContextComparisonType
    -> AuthnContextComparisonType
    -> AuthnContextComparisonType
    -> [AuthnContextComparisonType])
-> Enum AuthnContextComparisonType
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 :: AuthnContextComparisonType
-> AuthnContextComparisonType
-> AuthnContextComparisonType
-> [AuthnContextComparisonType]
$cenumFromThenTo :: AuthnContextComparisonType
-> AuthnContextComparisonType
-> AuthnContextComparisonType
-> [AuthnContextComparisonType]
enumFromTo :: AuthnContextComparisonType
-> AuthnContextComparisonType -> [AuthnContextComparisonType]
$cenumFromTo :: AuthnContextComparisonType
-> AuthnContextComparisonType -> [AuthnContextComparisonType]
enumFromThen :: AuthnContextComparisonType
-> AuthnContextComparisonType -> [AuthnContextComparisonType]
$cenumFromThen :: AuthnContextComparisonType
-> AuthnContextComparisonType -> [AuthnContextComparisonType]
enumFrom :: AuthnContextComparisonType -> [AuthnContextComparisonType]
$cenumFrom :: AuthnContextComparisonType -> [AuthnContextComparisonType]
fromEnum :: AuthnContextComparisonType -> Int
$cfromEnum :: AuthnContextComparisonType -> Int
toEnum :: Int -> AuthnContextComparisonType
$ctoEnum :: Int -> AuthnContextComparisonType
pred :: AuthnContextComparisonType -> AuthnContextComparisonType
$cpred :: AuthnContextComparisonType -> AuthnContextComparisonType
succ :: AuthnContextComparisonType -> AuthnContextComparisonType
$csucc :: AuthnContextComparisonType -> AuthnContextComparisonType
Enum, AuthnContextComparisonType
AuthnContextComparisonType
-> AuthnContextComparisonType -> Bounded AuthnContextComparisonType
forall a. a -> a -> Bounded a
maxBound :: AuthnContextComparisonType
$cmaxBound :: AuthnContextComparisonType
minBound :: AuthnContextComparisonType
$cminBound :: AuthnContextComparisonType
Bounded, Int -> AuthnContextComparisonType -> ShowS
[AuthnContextComparisonType] -> ShowS
AuthnContextComparisonType -> String
(Int -> AuthnContextComparisonType -> ShowS)
-> (AuthnContextComparisonType -> String)
-> ([AuthnContextComparisonType] -> ShowS)
-> Show AuthnContextComparisonType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthnContextComparisonType] -> ShowS
$cshowList :: [AuthnContextComparisonType] -> ShowS
show :: AuthnContextComparisonType -> String
$cshow :: AuthnContextComparisonType -> String
showsPrec :: Int -> AuthnContextComparisonType -> ShowS
$cshowsPrec :: Int -> AuthnContextComparisonType -> ShowS
Show)

instance Identifiable XString AuthnContextComparisonType where
  identifier :: AuthnContextComparisonType -> String
identifier AuthnContextComparisonType
ComparisonExact = String
"exact"
  identifier AuthnContextComparisonType
ComparisonMinimum = String
"minimum"
  identifier AuthnContextComparisonType
ComparisonMaximum = String
"maximum"
  identifier AuthnContextComparisonType
ComparisonBetter = String
"better"
instance XP.XmlPickler AuthnContextComparisonType where
  xpickle :: PU AuthnContextComparisonType
xpickle = PU String -> String -> PU AuthnContextComparisonType
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
"AuthnContextComparisonType" [])) String
"AuthnContextComparisonType"

-- |§3.3.2.3
data AttributeQuery = AttributeQuery
  { AttributeQuery -> SubjectQueryAbstractType
attributeQuery :: !SubjectQueryAbstractType
  , AttributeQuery -> [Attribute]
attributeQueryAttributes :: [SAML.Attribute]
  } deriving (AttributeQuery -> AttributeQuery -> Bool
(AttributeQuery -> AttributeQuery -> Bool)
-> (AttributeQuery -> AttributeQuery -> Bool) -> Eq AttributeQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeQuery -> AttributeQuery -> Bool
$c/= :: AttributeQuery -> AttributeQuery -> Bool
== :: AttributeQuery -> AttributeQuery -> Bool
$c== :: AttributeQuery -> AttributeQuery -> Bool
Eq, Int -> AttributeQuery -> ShowS
[AttributeQuery] -> ShowS
AttributeQuery -> String
(Int -> AttributeQuery -> ShowS)
-> (AttributeQuery -> String)
-> ([AttributeQuery] -> ShowS)
-> Show AttributeQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeQuery] -> ShowS
$cshowList :: [AttributeQuery] -> ShowS
show :: AttributeQuery -> String
$cshow :: AttributeQuery -> String
showsPrec :: Int -> AttributeQuery -> ShowS
$cshowsPrec :: Int -> AttributeQuery -> ShowS
Show)

instance XP.XmlPickler AttributeQuery where
  xpickle :: PU AttributeQuery
xpickle = String -> PU AttributeQuery -> PU AttributeQuery
forall a. String -> PU a -> PU a
xpElem String
"AttributeQuery" (PU AttributeQuery -> PU AttributeQuery)
-> PU AttributeQuery -> PU AttributeQuery
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (q, a) <-> AttributeQuery q a|]
    Bijection
  (->) (SubjectQueryAbstractType, [Attribute]) AttributeQuery
-> PU (SubjectQueryAbstractType, [Attribute]) -> PU AttributeQuery
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU SubjectQueryAbstractType
forall a. XmlPickler a => PU a
XP.xpickle
      PU SubjectQueryAbstractType
-> PU [Attribute] -> PU (SubjectQueryAbstractType, [Attribute])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Attribute -> PU [Attribute]
forall a. PU a -> PU [a]
XP.xpList PU Attribute
forall a. XmlPickler a => PU a
XP.xpickle)
instance DS.Signable AttributeQuery where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> AttributeQuery -> f AttributeQuery
signature' = (ProtocolType -> f ProtocolType)
-> AttributeQuery -> f AttributeQuery
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType)
 -> AttributeQuery -> f AttributeQuery)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> AttributeQuery
-> f AttributeQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: AttributeQuery -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (AttributeQuery -> ProtocolType) -> AttributeQuery -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType AttributeQuery ProtocolType
-> AttributeQuery -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType AttributeQuery ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol AttributeQuery where
  samlProtocol' :: (ProtocolType -> f ProtocolType)
-> AttributeQuery -> f AttributeQuery
samlProtocol' = (RequestAbstractType -> f RequestAbstractType)
-> AttributeQuery -> f AttributeQuery
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> f RequestAbstractType)
 -> AttributeQuery -> f AttributeQuery)
-> ((ProtocolType -> f ProtocolType)
    -> RequestAbstractType -> f RequestAbstractType)
-> (ProtocolType -> f ProtocolType)
-> AttributeQuery
-> f AttributeQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> RequestAbstractType -> f RequestAbstractType
Lens
  RequestAbstractType RequestAbstractType ProtocolType ProtocolType
requestProtocol'
  isSAMLResponse :: AttributeQuery -> Bool
isSAMLResponse AttributeQuery
_ = Bool
False
instance SAMLRequest AttributeQuery where
  samlRequest' :: (RequestAbstractType -> f RequestAbstractType)
-> AttributeQuery -> f AttributeQuery
samlRequest' = (SubjectQueryAbstractType -> f SubjectQueryAbstractType)
-> AttributeQuery -> f AttributeQuery
attributeQuery' ((SubjectQueryAbstractType -> f SubjectQueryAbstractType)
 -> AttributeQuery -> f AttributeQuery)
-> ((RequestAbstractType -> f RequestAbstractType)
    -> SubjectQueryAbstractType -> f SubjectQueryAbstractType)
-> (RequestAbstractType -> f RequestAbstractType)
-> AttributeQuery
-> f AttributeQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RequestAbstractType -> f RequestAbstractType)
-> SubjectQueryAbstractType -> f SubjectQueryAbstractType
Lens
  SubjectQueryAbstractType
  SubjectQueryAbstractType
  RequestAbstractType
  RequestAbstractType
subjectQuery' where
    attributeQuery' :: (SubjectQueryAbstractType -> f SubjectQueryAbstractType)
-> AttributeQuery -> f AttributeQuery
attributeQuery' = $(fieldLens 'attributeQuery)

-- |§3.3.2.4
data AuthzDecisionQuery = AuthzDecisionQuery
  { AuthzDecisionQuery -> SubjectQueryAbstractType
authzDecisionQuery :: !SubjectQueryAbstractType
  , AuthzDecisionQuery -> URI
authzDecisionQueryResource :: AnyURI
  , AuthzDecisionQuery -> [Action]
authzDecisionQueryActions :: [SAML.Action]
  , AuthzDecisionQuery -> Evidence
authzDecisionQueryEvidence :: SAML.Evidence
  } deriving (AuthzDecisionQuery -> AuthzDecisionQuery -> Bool
(AuthzDecisionQuery -> AuthzDecisionQuery -> Bool)
-> (AuthzDecisionQuery -> AuthzDecisionQuery -> Bool)
-> Eq AuthzDecisionQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthzDecisionQuery -> AuthzDecisionQuery -> Bool
$c/= :: AuthzDecisionQuery -> AuthzDecisionQuery -> Bool
== :: AuthzDecisionQuery -> AuthzDecisionQuery -> Bool
$c== :: AuthzDecisionQuery -> AuthzDecisionQuery -> Bool
Eq, Int -> AuthzDecisionQuery -> ShowS
[AuthzDecisionQuery] -> ShowS
AuthzDecisionQuery -> String
(Int -> AuthzDecisionQuery -> ShowS)
-> (AuthzDecisionQuery -> String)
-> ([AuthzDecisionQuery] -> ShowS)
-> Show AuthzDecisionQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthzDecisionQuery] -> ShowS
$cshowList :: [AuthzDecisionQuery] -> ShowS
show :: AuthzDecisionQuery -> String
$cshow :: AuthzDecisionQuery -> String
showsPrec :: Int -> AuthzDecisionQuery -> ShowS
$cshowsPrec :: Int -> AuthzDecisionQuery -> ShowS
Show)

instance XP.XmlPickler AuthzDecisionQuery where
  xpickle :: PU AuthzDecisionQuery
xpickle = String -> PU AuthzDecisionQuery -> PU AuthzDecisionQuery
forall a. String -> PU a -> PU a
xpElem String
"AuthzDecisionQuery" (PU AuthzDecisionQuery -> PU AuthzDecisionQuery)
-> PU AuthzDecisionQuery -> PU AuthzDecisionQuery
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (((q, r), a), e) <-> AuthzDecisionQuery q r a e|]
    Bijection
  (->)
  (((SubjectQueryAbstractType, URI), [Action]), Evidence)
  AuthzDecisionQuery
-> PU (((SubjectQueryAbstractType, URI), [Action]), Evidence)
-> PU AuthzDecisionQuery
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU SubjectQueryAbstractType
forall a. XmlPickler a => PU a
XP.xpickle
      PU SubjectQueryAbstractType
-> PU URI -> PU (SubjectQueryAbstractType, URI)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU URI -> PU URI
forall a. String -> PU a -> PU a
XP.xpAttr String
"Resource" PU URI
XS.xpAnyURI
      PU (SubjectQueryAbstractType, URI)
-> PU [Action] -> PU ((SubjectQueryAbstractType, URI), [Action])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Action -> PU [Action]
forall a. PU a -> PU [a]
XP.xpList PU Action
forall a. XmlPickler a => PU a
XP.xpickle
      PU ((SubjectQueryAbstractType, URI), [Action])
-> PU Evidence
-> PU (((SubjectQueryAbstractType, URI), [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)
instance DS.Signable AuthzDecisionQuery where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> AuthzDecisionQuery -> f AuthzDecisionQuery
signature' = (ProtocolType -> f ProtocolType)
-> AuthzDecisionQuery -> f AuthzDecisionQuery
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType)
 -> AuthzDecisionQuery -> f AuthzDecisionQuery)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> AuthzDecisionQuery
-> f AuthzDecisionQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: AuthzDecisionQuery -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (AuthzDecisionQuery -> ProtocolType)
-> AuthzDecisionQuery
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType AuthzDecisionQuery ProtocolType
-> AuthzDecisionQuery -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType AuthzDecisionQuery ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol AuthzDecisionQuery where
  samlProtocol' :: (ProtocolType -> f ProtocolType)
-> AuthzDecisionQuery -> f AuthzDecisionQuery
samlProtocol' = (RequestAbstractType -> f RequestAbstractType)
-> AuthzDecisionQuery -> f AuthzDecisionQuery
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> f RequestAbstractType)
 -> AuthzDecisionQuery -> f AuthzDecisionQuery)
-> ((ProtocolType -> f ProtocolType)
    -> RequestAbstractType -> f RequestAbstractType)
-> (ProtocolType -> f ProtocolType)
-> AuthzDecisionQuery
-> f AuthzDecisionQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> RequestAbstractType -> f RequestAbstractType
Lens
  RequestAbstractType RequestAbstractType ProtocolType ProtocolType
requestProtocol'
  isSAMLResponse :: AuthzDecisionQuery -> Bool
isSAMLResponse AuthzDecisionQuery
_ = Bool
False
instance SAMLRequest AuthzDecisionQuery where
  samlRequest' :: (RequestAbstractType -> f RequestAbstractType)
-> AuthzDecisionQuery -> f AuthzDecisionQuery
samlRequest' = (SubjectQueryAbstractType -> f SubjectQueryAbstractType)
-> AuthzDecisionQuery -> f AuthzDecisionQuery
authzDecisionQuery' ((SubjectQueryAbstractType -> f SubjectQueryAbstractType)
 -> AuthzDecisionQuery -> f AuthzDecisionQuery)
-> ((RequestAbstractType -> f RequestAbstractType)
    -> SubjectQueryAbstractType -> f SubjectQueryAbstractType)
-> (RequestAbstractType -> f RequestAbstractType)
-> AuthzDecisionQuery
-> f AuthzDecisionQuery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RequestAbstractType -> f RequestAbstractType)
-> SubjectQueryAbstractType -> f SubjectQueryAbstractType
Lens
  SubjectQueryAbstractType
  SubjectQueryAbstractType
  RequestAbstractType
  RequestAbstractType
subjectQuery' where
    authzDecisionQuery' :: (SubjectQueryAbstractType -> f SubjectQueryAbstractType)
-> AuthzDecisionQuery -> f AuthzDecisionQuery
authzDecisionQuery' = $(fieldLens 'authzDecisionQuery)

-- |§3.3.3
data Response = Response
  { Response -> StatusResponseType
response :: !StatusResponseType
  , Response -> [PossiblyEncrypted Assertion]
responseAssertions :: [SAML.PossiblyEncrypted SAML.Assertion]
  } deriving (Response -> Response -> Bool
(Response -> Response -> Bool)
-> (Response -> Response -> Bool) -> Eq Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response -> Response -> Bool
$c/= :: Response -> Response -> Bool
== :: Response -> Response -> Bool
$c== :: Response -> Response -> Bool
Eq, Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show)

instance XP.XmlPickler Response where
  xpickle :: PU Response
xpickle = String -> PU Response -> PU Response
forall a. String -> PU a -> PU a
xpElem String
"Response" (PU Response -> PU Response) -> PU Response -> PU Response
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (r, a) <-> Response r a|]
    Bijection
  (->) (StatusResponseType, [PossiblyEncrypted Assertion]) Response
-> PU (StatusResponseType, [PossiblyEncrypted Assertion])
-> PU Response
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU StatusResponseType
forall a. XmlPickler a => PU a
XP.xpickle
      PU StatusResponseType
-> PU [PossiblyEncrypted Assertion]
-> PU (StatusResponseType, [PossiblyEncrypted Assertion])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU (PossiblyEncrypted Assertion)
-> PU [PossiblyEncrypted Assertion]
forall a. PU a -> PU [a]
XP.xpList PU (PossiblyEncrypted Assertion)
forall a.
(XmlPickler a, XmlPickler (EncryptedElement a)) =>
PU (PossiblyEncrypted a)
SAML.xpPossiblyEncrypted)
instance DS.Signable Response where
  signature' :: (Maybe Signature -> f (Maybe Signature)) -> Response -> f Response
signature' = (ProtocolType -> f ProtocolType) -> Response -> f Response
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType) -> Response -> f Response)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> Response
-> f Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: Response -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (Response -> ProtocolType) -> Response -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType Response ProtocolType
-> Response -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType Response ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol Response where
  samlProtocol' :: (ProtocolType -> f ProtocolType) -> Response -> f Response
samlProtocol' = (StatusResponseType -> f StatusResponseType)
-> Response -> f Response
forall a. SAMLResponse a => Lens' a StatusResponseType
samlResponse' ((StatusResponseType -> f StatusResponseType)
 -> Response -> f Response)
-> ((ProtocolType -> f ProtocolType)
    -> StatusResponseType -> f StatusResponseType)
-> (ProtocolType -> f ProtocolType)
-> Response
-> f Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> StatusResponseType -> f StatusResponseType
Lens
  StatusResponseType StatusResponseType ProtocolType ProtocolType
statusProtocol'
  isSAMLResponse :: Response -> Bool
isSAMLResponse Response
_ = Bool
True
instance SAMLResponse Response where
  samlResponse' :: (StatusResponseType -> f StatusResponseType)
-> Response -> f Response
samlResponse' = $(fieldLens 'response)

-- |§3.4.1
data AuthnRequest = AuthnRequest
  { AuthnRequest -> RequestAbstractType
authnRequest :: !RequestAbstractType
  , AuthnRequest -> Bool
authnRequestForceAuthn :: XS.Boolean
  , AuthnRequest -> Bool
authnRequestIsPassive :: XS.Boolean
  , AuthnRequest -> AssertionConsumerService
authnRequestAssertionConsumerService :: AssertionConsumerService
  , AuthnRequest -> Maybe UnsignedShort
authnRequestAssertionConsumingServiceIndex :: Maybe XS.UnsignedShort
  , AuthnRequest -> Maybe String
authnRequestProviderName :: Maybe XString
  , AuthnRequest -> Maybe Subject
authnRequestSubject :: Maybe SAML.Subject
  , AuthnRequest -> Maybe NameIDPolicy
authnRequestNameIDPolicy :: Maybe NameIDPolicy
  , AuthnRequest -> Maybe Conditions
authnRequestConditions :: Maybe SAML.Conditions
  , AuthnRequest -> Maybe RequestedAuthnContext
authnRequestRequestedAuthnContext :: Maybe RequestedAuthnContext
  , AuthnRequest -> Maybe Scoping
authnRequestScoping :: Maybe Scoping
  } deriving (AuthnRequest -> AuthnRequest -> Bool
(AuthnRequest -> AuthnRequest -> Bool)
-> (AuthnRequest -> AuthnRequest -> Bool) -> Eq AuthnRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthnRequest -> AuthnRequest -> Bool
$c/= :: AuthnRequest -> AuthnRequest -> Bool
== :: AuthnRequest -> AuthnRequest -> Bool
$c== :: AuthnRequest -> AuthnRequest -> Bool
Eq, Int -> AuthnRequest -> ShowS
[AuthnRequest] -> ShowS
AuthnRequest -> String
(Int -> AuthnRequest -> ShowS)
-> (AuthnRequest -> String)
-> ([AuthnRequest] -> ShowS)
-> Show AuthnRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthnRequest] -> ShowS
$cshowList :: [AuthnRequest] -> ShowS
show :: AuthnRequest -> String
$cshow :: AuthnRequest -> String
showsPrec :: Int -> AuthnRequest -> ShowS
$cshowsPrec :: Int -> AuthnRequest -> ShowS
Show)

data AssertionConsumerService
  = AssertionConsumerServiceIndex XS.UnsignedShort
  | AssertionConsumerServiceURL
    { AssertionConsumerService -> Maybe URI
authnRequestAssertionConsumerServiceURL :: Maybe AnyURI
    , AssertionConsumerService -> Maybe (IdentifiedURI Binding)
authnRequestProtocolBinding :: Maybe (IdentifiedURI Binding)
    }
  deriving (AssertionConsumerService -> AssertionConsumerService -> Bool
(AssertionConsumerService -> AssertionConsumerService -> Bool)
-> (AssertionConsumerService -> AssertionConsumerService -> Bool)
-> Eq AssertionConsumerService
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssertionConsumerService -> AssertionConsumerService -> Bool
$c/= :: AssertionConsumerService -> AssertionConsumerService -> Bool
== :: AssertionConsumerService -> AssertionConsumerService -> Bool
$c== :: AssertionConsumerService -> AssertionConsumerService -> Bool
Eq, Int -> AssertionConsumerService -> ShowS
[AssertionConsumerService] -> ShowS
AssertionConsumerService -> String
(Int -> AssertionConsumerService -> ShowS)
-> (AssertionConsumerService -> String)
-> ([AssertionConsumerService] -> ShowS)
-> Show AssertionConsumerService
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssertionConsumerService] -> ShowS
$cshowList :: [AssertionConsumerService] -> ShowS
show :: AssertionConsumerService -> String
$cshow :: AssertionConsumerService -> String
showsPrec :: Int -> AssertionConsumerService -> ShowS
$cshowsPrec :: Int -> AssertionConsumerService -> ShowS
Show)

instance XP.XmlPickler AuthnRequest where
  xpickle :: PU AuthnRequest
xpickle = String -> PU AuthnRequest -> PU AuthnRequest
forall a. String -> PU a -> PU a
xpElem String
"AuthnRequest" (PU AuthnRequest -> PU AuthnRequest)
-> PU AuthnRequest -> PU AuthnRequest
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((((((((((q, f), p), Left i), g), n), s), np), c), r), sc) <-> AuthnRequest q f p (AssertionConsumerServiceIndex i) g n s np c r sc
      ((((((((((q, f), p), Right (u, b)), g), n), s), np), c), r), sc) <-> AuthnRequest q f p (AssertionConsumerServiceURL u b) g n s np c r sc|]
    Bijection
  (->)
  ((((((((((RequestAbstractType, Bool), Bool),
          Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
         Maybe UnsignedShort),
        Maybe String),
       Maybe Subject),
      Maybe NameIDPolicy),
     Maybe Conditions),
    Maybe RequestedAuthnContext),
   Maybe Scoping)
  AuthnRequest
-> PU
     ((((((((((RequestAbstractType, Bool), Bool),
             Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
            Maybe UnsignedShort),
           Maybe String),
          Maybe Subject),
         Maybe NameIDPolicy),
        Maybe Conditions),
       Maybe RequestedAuthnContext),
      Maybe Scoping)
-> PU AuthnRequest
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU RequestAbstractType
forall a. XmlPickler a => PU a
XP.xpickle
      PU RequestAbstractType -> PU Bool -> PU (RequestAbstractType, Bool)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< Bool -> PU Bool -> PU Bool
forall a. Eq a => a -> PU a -> PU a
XP.xpDefault Bool
False (String -> PU Bool -> PU Bool
forall a. String -> PU a -> PU a
XP.xpAttr String
"ForceAuthn" PU Bool
XS.xpBoolean)
      PU (RequestAbstractType, Bool)
-> PU Bool -> PU ((RequestAbstractType, Bool), Bool)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< Bool -> PU Bool -> PU Bool
forall a. Eq a => a -> PU a -> PU a
XP.xpDefault Bool
False (String -> PU Bool -> PU Bool
forall a. String -> PU a -> PU a
XP.xpAttr String
"IsPassive" PU Bool
XS.xpBoolean)
      PU ((RequestAbstractType, Bool), Bool)
-> PU
     (Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding)))
-> PU
     (((RequestAbstractType, Bool), Bool),
      Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*<  (String -> PU UnsignedShort -> PU UnsignedShort
forall a. String -> PU a -> PU a
XP.xpAttr String
"AssertionConsumerServiceIndex" PU UnsignedShort
XS.xpUnsignedShort
        PU UnsignedShort
-> PU (Maybe URI, Maybe (IdentifiedURI Binding))
-> PU
     (Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding)))
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|<  (String -> PU URI -> PU (Maybe URI)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"AssertionConsumerServiceURL" PU URI
XS.xpAnyURI
          PU (Maybe URI)
-> PU (Maybe (IdentifiedURI Binding))
-> PU (Maybe URI, Maybe (IdentifiedURI Binding))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String
-> PU (IdentifiedURI Binding) -> PU (Maybe (IdentifiedURI Binding))
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"ProtocolBinding" PU (IdentifiedURI Binding)
forall a. XmlPickler a => PU a
XP.xpickle))
      PU
  (((RequestAbstractType, Bool), Bool),
   Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding)))
-> PU (Maybe UnsignedShort)
-> PU
     ((((RequestAbstractType, Bool), Bool),
       Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
      Maybe UnsignedShort)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String -> PU UnsignedShort -> PU (Maybe UnsignedShort)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"AttributeConsumingServiceIndex" PU UnsignedShort
XS.xpUnsignedShort
      PU
  ((((RequestAbstractType, Bool), Bool),
    Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
   Maybe UnsignedShort)
-> PU (Maybe String)
-> PU
     (((((RequestAbstractType, Bool), Bool),
        Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
       Maybe UnsignedShort),
      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
"ProviderName" PU String
XS.xpString
      PU
  (((((RequestAbstractType, Bool), Bool),
     Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
    Maybe UnsignedShort),
   Maybe String)
-> PU (Maybe Subject)
-> PU
     ((((((RequestAbstractType, Bool), Bool),
         Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
        Maybe UnsignedShort),
       Maybe String),
      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
  ((((((RequestAbstractType, Bool), Bool),
      Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
     Maybe UnsignedShort),
    Maybe String),
   Maybe Subject)
-> PU (Maybe NameIDPolicy)
-> PU
     (((((((RequestAbstractType, Bool), Bool),
          Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
         Maybe UnsignedShort),
        Maybe String),
       Maybe Subject),
      Maybe NameIDPolicy)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU NameIDPolicy -> PU (Maybe NameIDPolicy)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU NameIDPolicy
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (((((((RequestAbstractType, Bool), Bool),
       Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
      Maybe UnsignedShort),
     Maybe String),
    Maybe Subject),
   Maybe NameIDPolicy)
-> PU (Maybe Conditions)
-> PU
     ((((((((RequestAbstractType, Bool), Bool),
           Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
          Maybe UnsignedShort),
         Maybe String),
        Maybe Subject),
       Maybe NameIDPolicy),
      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
  ((((((((RequestAbstractType, Bool), Bool),
        Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
       Maybe UnsignedShort),
      Maybe String),
     Maybe Subject),
    Maybe NameIDPolicy),
   Maybe Conditions)
-> PU (Maybe RequestedAuthnContext)
-> PU
     (((((((((RequestAbstractType, Bool), Bool),
            Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
           Maybe UnsignedShort),
          Maybe String),
         Maybe Subject),
        Maybe NameIDPolicy),
       Maybe Conditions),
      Maybe RequestedAuthnContext)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU RequestedAuthnContext -> PU (Maybe RequestedAuthnContext)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU RequestedAuthnContext
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (((((((((RequestAbstractType, Bool), Bool),
         Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
        Maybe UnsignedShort),
       Maybe String),
      Maybe Subject),
     Maybe NameIDPolicy),
    Maybe Conditions),
   Maybe RequestedAuthnContext)
-> PU (Maybe Scoping)
-> PU
     ((((((((((RequestAbstractType, Bool), Bool),
             Either UnsignedShort (Maybe URI, Maybe (IdentifiedURI Binding))),
            Maybe UnsignedShort),
           Maybe String),
          Maybe Subject),
         Maybe NameIDPolicy),
        Maybe Conditions),
       Maybe RequestedAuthnContext),
      Maybe Scoping)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Scoping -> PU (Maybe Scoping)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU Scoping
forall a. XmlPickler a => PU a
XP.xpickle)
instance DS.Signable AuthnRequest where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> AuthnRequest -> f AuthnRequest
signature' = (ProtocolType -> f ProtocolType) -> AuthnRequest -> f AuthnRequest
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType)
 -> AuthnRequest -> f AuthnRequest)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> AuthnRequest
-> f AuthnRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: AuthnRequest -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (AuthnRequest -> ProtocolType) -> AuthnRequest -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType AuthnRequest ProtocolType
-> AuthnRequest -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType AuthnRequest ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol AuthnRequest where
  samlProtocol' :: (ProtocolType -> f ProtocolType) -> AuthnRequest -> f AuthnRequest
samlProtocol' = (RequestAbstractType -> f RequestAbstractType)
-> AuthnRequest -> f AuthnRequest
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> f RequestAbstractType)
 -> AuthnRequest -> f AuthnRequest)
-> ((ProtocolType -> f ProtocolType)
    -> RequestAbstractType -> f RequestAbstractType)
-> (ProtocolType -> f ProtocolType)
-> AuthnRequest
-> f AuthnRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> RequestAbstractType -> f RequestAbstractType
Lens
  RequestAbstractType RequestAbstractType ProtocolType ProtocolType
requestProtocol'
  isSAMLResponse :: AuthnRequest -> Bool
isSAMLResponse AuthnRequest
_ = Bool
False
instance SAMLRequest AuthnRequest where
  samlRequest' :: (RequestAbstractType -> f RequestAbstractType)
-> AuthnRequest -> f AuthnRequest
samlRequest' = $(fieldLens 'authnRequest)

-- |§3.4.1.1
data NameIDPolicy = NameIDPolicy
  { NameIDPolicy -> IdentifiedURI NameIDFormat
nameIDPolicyFormat :: IdentifiedURI NameIDFormat
  , NameIDPolicy -> Maybe String
nameIDPolicySPNameQualifier :: Maybe XString
  , NameIDPolicy -> Bool
nameIDPolicyAllowCreate :: Bool
  } deriving (NameIDPolicy -> NameIDPolicy -> Bool
(NameIDPolicy -> NameIDPolicy -> Bool)
-> (NameIDPolicy -> NameIDPolicy -> Bool) -> Eq NameIDPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameIDPolicy -> NameIDPolicy -> Bool
$c/= :: NameIDPolicy -> NameIDPolicy -> Bool
== :: NameIDPolicy -> NameIDPolicy -> Bool
$c== :: NameIDPolicy -> NameIDPolicy -> Bool
Eq, Int -> NameIDPolicy -> ShowS
[NameIDPolicy] -> ShowS
NameIDPolicy -> String
(Int -> NameIDPolicy -> ShowS)
-> (NameIDPolicy -> String)
-> ([NameIDPolicy] -> ShowS)
-> Show NameIDPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameIDPolicy] -> ShowS
$cshowList :: [NameIDPolicy] -> ShowS
show :: NameIDPolicy -> String
$cshow :: NameIDPolicy -> String
showsPrec :: Int -> NameIDPolicy -> ShowS
$cshowsPrec :: Int -> NameIDPolicy -> ShowS
Show)

instance XP.XmlPickler NameIDPolicy where
  xpickle :: PU NameIDPolicy
xpickle = String -> PU NameIDPolicy -> PU NameIDPolicy
forall a. String -> PU a -> PU a
xpElem String
"NameIDPolicy" (PU NameIDPolicy -> PU NameIDPolicy)
-> PU NameIDPolicy -> PU NameIDPolicy
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((f, q), c) <-> NameIDPolicy f q c|]
    Bijection
  (->)
  ((IdentifiedURI NameIDFormat, Maybe String), Bool)
  NameIDPolicy
-> PU ((IdentifiedURI NameIDFormat, Maybe String), Bool)
-> PU NameIDPolicy
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 (NameIDFormat -> IdentifiedURI NameIDFormat
forall b a. a -> Identified b a
Identified NameIDFormat
NameIDFormatUnspecified) (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
"SPNameQualifier" PU String
XS.xpString
      PU (IdentifiedURI NameIDFormat, Maybe String)
-> PU Bool -> PU ((IdentifiedURI NameIDFormat, Maybe String), Bool)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< Bool -> PU Bool -> PU Bool
forall a. Eq a => a -> PU a -> PU a
XP.xpDefault Bool
False (String -> PU Bool -> PU Bool
forall a. String -> PU a -> PU a
XP.xpAttr String
"AllowCreate" PU Bool
XS.xpBoolean))

-- |§3.4.1.2
data Scoping = Scoping
  { Scoping -> Maybe NonNegativeInteger
scopingProxyCount :: Maybe XS.NonNegativeInteger
  , Scoping -> Maybe IDPList
scopingIDPList :: Maybe IDPList
  , Scoping -> [URI]
scopingRequesterID :: [AnyURI]
  } deriving (Scoping -> Scoping -> Bool
(Scoping -> Scoping -> Bool)
-> (Scoping -> Scoping -> Bool) -> Eq Scoping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scoping -> Scoping -> Bool
$c/= :: Scoping -> Scoping -> Bool
== :: Scoping -> Scoping -> Bool
$c== :: Scoping -> Scoping -> Bool
Eq, Int -> Scoping -> ShowS
[Scoping] -> ShowS
Scoping -> String
(Int -> Scoping -> ShowS)
-> (Scoping -> String) -> ([Scoping] -> ShowS) -> Show Scoping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scoping] -> ShowS
$cshowList :: [Scoping] -> ShowS
show :: Scoping -> String
$cshow :: Scoping -> String
showsPrec :: Int -> Scoping -> ShowS
$cshowsPrec :: Int -> Scoping -> ShowS
Show)

instance XP.XmlPickler Scoping where
  xpickle :: PU Scoping
xpickle = String -> PU Scoping -> PU Scoping
forall a. String -> PU a -> PU a
xpElem String
"Scoping" (PU Scoping -> PU Scoping) -> PU Scoping -> PU Scoping
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((c, i), r) <-> Scoping c i r|]
    Bijection
  (->) ((Maybe NonNegativeInteger, Maybe IDPList), [URI]) Scoping
-> PU ((Maybe NonNegativeInteger, Maybe IDPList), [URI])
-> PU Scoping
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (String -> PU NonNegativeInteger -> PU (Maybe NonNegativeInteger)
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"ProxyCount" PU NonNegativeInteger
XS.xpNonNegativeInteger
      PU (Maybe NonNegativeInteger)
-> PU (Maybe IDPList)
-> PU (Maybe NonNegativeInteger, Maybe IDPList)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU IDPList -> PU (Maybe IDPList)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU IDPList
forall a. XmlPickler a => PU a
XP.xpickle
      PU (Maybe NonNegativeInteger, Maybe IDPList)
-> PU [URI]
-> PU ((Maybe NonNegativeInteger, Maybe IDPList), [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
"RequesterID" PU URI
XS.xpAnyURI))

-- |§3.4.1.3
data IDPList = IDPList
  { IDPList -> List1 IDPEntry
idpList :: List1 IDPEntry
  , IDPList -> Maybe URI
idpGetComplete :: Maybe AnyURI
  } deriving (IDPList -> IDPList -> Bool
(IDPList -> IDPList -> Bool)
-> (IDPList -> IDPList -> Bool) -> Eq IDPList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IDPList -> IDPList -> Bool
$c/= :: IDPList -> IDPList -> Bool
== :: IDPList -> IDPList -> Bool
$c== :: IDPList -> IDPList -> Bool
Eq, Int -> IDPList -> ShowS
[IDPList] -> ShowS
IDPList -> String
(Int -> IDPList -> ShowS)
-> (IDPList -> String) -> ([IDPList] -> ShowS) -> Show IDPList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IDPList] -> ShowS
$cshowList :: [IDPList] -> ShowS
show :: IDPList -> String
$cshow :: IDPList -> String
showsPrec :: Int -> IDPList -> ShowS
$cshowsPrec :: Int -> IDPList -> ShowS
Show)

instance XP.XmlPickler IDPList where
  xpickle :: PU IDPList
xpickle = String -> PU IDPList -> PU IDPList
forall a. String -> PU a -> PU a
xpElem String
"IDPList" (PU IDPList -> PU IDPList) -> PU IDPList -> PU IDPList
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (l, c) <-> IDPList l c|]
    Bijection (->) (List1 IDPEntry, Maybe URI) IDPList
-> PU (List1 IDPEntry, Maybe URI) -> PU IDPList
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU IDPEntry -> PU (List1 IDPEntry)
forall a. PU a -> PU (List1 a)
xpList1 PU IDPEntry
forall a. XmlPickler a => PU a
XP.xpickle
      PU (List1 IDPEntry)
-> PU (Maybe URI) -> PU (List1 IDPEntry, Maybe URI)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, 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
"GetComplete" PU URI
XS.xpAnyURI))

-- |§3.4.1.3.1
data IDPEntry = IDPEntry
  { IDPEntry -> URI
idpEntryProviderID :: AnyURI
  , IDPEntry -> Maybe String
idpEntryName :: Maybe XString
  , IDPEntry -> Maybe URI
idpEntryLoc :: Maybe AnyURI
  } deriving (IDPEntry -> IDPEntry -> Bool
(IDPEntry -> IDPEntry -> Bool)
-> (IDPEntry -> IDPEntry -> Bool) -> Eq IDPEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IDPEntry -> IDPEntry -> Bool
$c/= :: IDPEntry -> IDPEntry -> Bool
== :: IDPEntry -> IDPEntry -> Bool
$c== :: IDPEntry -> IDPEntry -> Bool
Eq, Int -> IDPEntry -> ShowS
[IDPEntry] -> ShowS
IDPEntry -> String
(Int -> IDPEntry -> ShowS)
-> (IDPEntry -> String) -> ([IDPEntry] -> ShowS) -> Show IDPEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IDPEntry] -> ShowS
$cshowList :: [IDPEntry] -> ShowS
show :: IDPEntry -> String
$cshow :: IDPEntry -> String
showsPrec :: Int -> IDPEntry -> ShowS
$cshowsPrec :: Int -> IDPEntry -> ShowS
Show)

instance XP.XmlPickler IDPEntry where
  xpickle :: PU IDPEntry
xpickle = String -> PU IDPEntry -> PU IDPEntry
forall a. String -> PU a -> PU a
xpElem String
"IDPEntry" (PU IDPEntry -> PU IDPEntry) -> PU IDPEntry -> PU IDPEntry
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((p, n), l) <-> IDPEntry p n l|]
    Bijection (->) ((URI, Maybe String), Maybe URI) IDPEntry
-> PU ((URI, Maybe String), Maybe URI) -> PU IDPEntry
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
"ProviderID" PU URI
XS.xpAnyURI
      PU URI -> PU (Maybe String) -> PU (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
"Name" PU String
XS.xpString
      PU (URI, Maybe String)
-> PU (Maybe URI) -> PU ((URI, Maybe String), 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
"Loc" PU URI
XS.xpAnyURI)

-- |§3.5.1
data ArtifactResolve = ArtifactResolve
  { ArtifactResolve -> RequestAbstractType
artifactResolve :: !RequestAbstractType
  , ArtifactResolve -> String
artifactResolveArtifact :: XString
  } deriving (ArtifactResolve -> ArtifactResolve -> Bool
(ArtifactResolve -> ArtifactResolve -> Bool)
-> (ArtifactResolve -> ArtifactResolve -> Bool)
-> Eq ArtifactResolve
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArtifactResolve -> ArtifactResolve -> Bool
$c/= :: ArtifactResolve -> ArtifactResolve -> Bool
== :: ArtifactResolve -> ArtifactResolve -> Bool
$c== :: ArtifactResolve -> ArtifactResolve -> Bool
Eq, Int -> ArtifactResolve -> ShowS
[ArtifactResolve] -> ShowS
ArtifactResolve -> String
(Int -> ArtifactResolve -> ShowS)
-> (ArtifactResolve -> String)
-> ([ArtifactResolve] -> ShowS)
-> Show ArtifactResolve
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArtifactResolve] -> ShowS
$cshowList :: [ArtifactResolve] -> ShowS
show :: ArtifactResolve -> String
$cshow :: ArtifactResolve -> String
showsPrec :: Int -> ArtifactResolve -> ShowS
$cshowsPrec :: Int -> ArtifactResolve -> ShowS
Show)

instance XP.XmlPickler ArtifactResolve where
  xpickle :: PU ArtifactResolve
xpickle = String -> PU ArtifactResolve -> PU ArtifactResolve
forall a. String -> PU a -> PU a
xpElem String
"ArtifactResolve" (PU ArtifactResolve -> PU ArtifactResolve)
-> PU ArtifactResolve -> PU ArtifactResolve
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (r, a) <-> ArtifactResolve r a|]
    Bijection (->) (RequestAbstractType, String) ArtifactResolve
-> PU (RequestAbstractType, String) -> PU ArtifactResolve
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU RequestAbstractType
forall a. XmlPickler a => PU a
XP.xpickle
      PU RequestAbstractType
-> PU String -> PU (RequestAbstractType, 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
xpElem String
"Artifact" PU String
XS.xpString)
instance DS.Signable ArtifactResolve where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> ArtifactResolve -> f ArtifactResolve
signature' = (ProtocolType -> f ProtocolType)
-> ArtifactResolve -> f ArtifactResolve
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType)
 -> ArtifactResolve -> f ArtifactResolve)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> ArtifactResolve
-> f ArtifactResolve
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: ArtifactResolve -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (ArtifactResolve -> ProtocolType) -> ArtifactResolve -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType ArtifactResolve ProtocolType
-> ArtifactResolve -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType ArtifactResolve ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol ArtifactResolve where
  samlProtocol' :: (ProtocolType -> f ProtocolType)
-> ArtifactResolve -> f ArtifactResolve
samlProtocol' = (RequestAbstractType -> f RequestAbstractType)
-> ArtifactResolve -> f ArtifactResolve
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> f RequestAbstractType)
 -> ArtifactResolve -> f ArtifactResolve)
-> ((ProtocolType -> f ProtocolType)
    -> RequestAbstractType -> f RequestAbstractType)
-> (ProtocolType -> f ProtocolType)
-> ArtifactResolve
-> f ArtifactResolve
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> RequestAbstractType -> f RequestAbstractType
Lens
  RequestAbstractType RequestAbstractType ProtocolType ProtocolType
requestProtocol'
  isSAMLResponse :: ArtifactResolve -> Bool
isSAMLResponse ArtifactResolve
_ = Bool
False
instance SAMLRequest ArtifactResolve where
  samlRequest' :: (RequestAbstractType -> f RequestAbstractType)
-> ArtifactResolve -> f ArtifactResolve
samlRequest' = $(fieldLens 'artifactResolve)

-- |§3.5.2
data ArtifactResponse = ArtifactResponse
  { ArtifactResponse -> StatusResponseType
artifactResponse :: !StatusResponseType
  , ArtifactResponse -> Maybe Node
artifactResponseMessage :: Maybe Node
  } deriving (ArtifactResponse -> ArtifactResponse -> Bool
(ArtifactResponse -> ArtifactResponse -> Bool)
-> (ArtifactResponse -> ArtifactResponse -> Bool)
-> Eq ArtifactResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArtifactResponse -> ArtifactResponse -> Bool
$c/= :: ArtifactResponse -> ArtifactResponse -> Bool
== :: ArtifactResponse -> ArtifactResponse -> Bool
$c== :: ArtifactResponse -> ArtifactResponse -> Bool
Eq, Int -> ArtifactResponse -> ShowS
[ArtifactResponse] -> ShowS
ArtifactResponse -> String
(Int -> ArtifactResponse -> ShowS)
-> (ArtifactResponse -> String)
-> ([ArtifactResponse] -> ShowS)
-> Show ArtifactResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArtifactResponse] -> ShowS
$cshowList :: [ArtifactResponse] -> ShowS
show :: ArtifactResponse -> String
$cshow :: ArtifactResponse -> String
showsPrec :: Int -> ArtifactResponse -> ShowS
$cshowsPrec :: Int -> ArtifactResponse -> ShowS
Show)

instance XP.XmlPickler ArtifactResponse where
  xpickle :: PU ArtifactResponse
xpickle = String -> PU ArtifactResponse -> PU ArtifactResponse
forall a. String -> PU a -> PU a
xpElem String
"ArtifactResponse" (PU ArtifactResponse -> PU ArtifactResponse)
-> PU ArtifactResponse -> PU ArtifactResponse
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (r, a) <-> ArtifactResponse r a|]
    Bijection (->) (StatusResponseType, Maybe Node) ArtifactResponse
-> PU (StatusResponseType, Maybe Node) -> PU ArtifactResponse
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU StatusResponseType
forall a. XmlPickler a => PU a
XP.xpickle
      PU StatusResponseType
-> PU (Maybe Node) -> PU (StatusResponseType, Maybe Node)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU Node -> PU (Maybe Node)
forall a. PU a -> PU (Maybe a)
XP.xpOption PU Node
xpTrimAnyElem)
instance DS.Signable ArtifactResponse where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> ArtifactResponse -> f ArtifactResponse
signature' = (ProtocolType -> f ProtocolType)
-> ArtifactResponse -> f ArtifactResponse
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType)
 -> ArtifactResponse -> f ArtifactResponse)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> ArtifactResponse
-> f ArtifactResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: ArtifactResponse -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (ArtifactResponse -> ProtocolType) -> ArtifactResponse -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType ArtifactResponse ProtocolType
-> ArtifactResponse -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType ArtifactResponse ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol ArtifactResponse where
  samlProtocol' :: (ProtocolType -> f ProtocolType)
-> ArtifactResponse -> f ArtifactResponse
samlProtocol' = (StatusResponseType -> f StatusResponseType)
-> ArtifactResponse -> f ArtifactResponse
forall a. SAMLResponse a => Lens' a StatusResponseType
samlResponse' ((StatusResponseType -> f StatusResponseType)
 -> ArtifactResponse -> f ArtifactResponse)
-> ((ProtocolType -> f ProtocolType)
    -> StatusResponseType -> f StatusResponseType)
-> (ProtocolType -> f ProtocolType)
-> ArtifactResponse
-> f ArtifactResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> StatusResponseType -> f StatusResponseType
Lens
  StatusResponseType StatusResponseType ProtocolType ProtocolType
statusProtocol'
  isSAMLResponse :: ArtifactResponse -> Bool
isSAMLResponse ArtifactResponse
_ = Bool
True
instance SAMLResponse ArtifactResponse where
  samlResponse' :: (StatusResponseType -> f StatusResponseType)
-> ArtifactResponse -> f ArtifactResponse
samlResponse' = $(fieldLens 'artifactResponse)

-- |§3.6.1
data ManageNameIDRequest = ManageNameIDRequest
  { ManageNameIDRequest -> RequestAbstractType
manageNameIDRequest :: !RequestAbstractType
  , ManageNameIDRequest -> PossiblyEncrypted NameID
manageNameIDRequestNameID :: SAML.PossiblyEncrypted SAML.NameID
  , ManageNameIDRequest -> Maybe (PossiblyEncrypted NewID)
manageNameIDRequestNewID :: Maybe (SAML.PossiblyEncrypted NewID)
  } deriving (ManageNameIDRequest -> ManageNameIDRequest -> Bool
(ManageNameIDRequest -> ManageNameIDRequest -> Bool)
-> (ManageNameIDRequest -> ManageNameIDRequest -> Bool)
-> Eq ManageNameIDRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ManageNameIDRequest -> ManageNameIDRequest -> Bool
$c/= :: ManageNameIDRequest -> ManageNameIDRequest -> Bool
== :: ManageNameIDRequest -> ManageNameIDRequest -> Bool
$c== :: ManageNameIDRequest -> ManageNameIDRequest -> Bool
Eq, Int -> ManageNameIDRequest -> ShowS
[ManageNameIDRequest] -> ShowS
ManageNameIDRequest -> String
(Int -> ManageNameIDRequest -> ShowS)
-> (ManageNameIDRequest -> String)
-> ([ManageNameIDRequest] -> ShowS)
-> Show ManageNameIDRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ManageNameIDRequest] -> ShowS
$cshowList :: [ManageNameIDRequest] -> ShowS
show :: ManageNameIDRequest -> String
$cshow :: ManageNameIDRequest -> String
showsPrec :: Int -> ManageNameIDRequest -> ShowS
$cshowsPrec :: Int -> ManageNameIDRequest -> ShowS
Show)

instance XP.XmlPickler ManageNameIDRequest where
  xpickle :: PU ManageNameIDRequest
xpickle = String -> PU ManageNameIDRequest -> PU ManageNameIDRequest
forall a. String -> PU a -> PU a
xpElem String
"ManageNameIDRequest" (PU ManageNameIDRequest -> PU ManageNameIDRequest)
-> PU ManageNameIDRequest -> PU ManageNameIDRequest
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((r, o), Left n) <-> ManageNameIDRequest r o (Just n)
      ((r, o), Right ()) <-> ManageNameIDRequest r o Nothing|]
    Bijection
  (->)
  ((RequestAbstractType, PossiblyEncrypted NameID),
   Either (PossiblyEncrypted NewID) ())
  ManageNameIDRequest
-> PU
     ((RequestAbstractType, PossiblyEncrypted NameID),
      Either (PossiblyEncrypted NewID) ())
-> PU ManageNameIDRequest
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU RequestAbstractType
forall a. XmlPickler a => PU a
XP.xpickle
      PU RequestAbstractType
-> PU (PossiblyEncrypted NameID)
-> PU (RequestAbstractType, PossiblyEncrypted NameID)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU (PossiblyEncrypted NameID)
forall a.
(XmlPickler a, XmlPickler (EncryptedElement a)) =>
PU (PossiblyEncrypted a)
SAML.xpPossiblyEncrypted
      PU (RequestAbstractType, PossiblyEncrypted NameID)
-> PU (Either (PossiblyEncrypted NewID) ())
-> PU
     ((RequestAbstractType, PossiblyEncrypted NameID),
      Either (PossiblyEncrypted NewID) ())
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< (PU (PossiblyEncrypted NewID)
forall a.
(XmlPickler a, XmlPickler (EncryptedElement a)) =>
PU (PossiblyEncrypted a)
SAML.xpPossiblyEncrypted
        PU (PossiblyEncrypted NewID)
-> PU () -> PU (Either (PossiblyEncrypted NewID) ())
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
"Terminate" PU ()
XP.xpUnit))
instance DS.Signable ManageNameIDRequest where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> ManageNameIDRequest -> f ManageNameIDRequest
signature' = (ProtocolType -> f ProtocolType)
-> ManageNameIDRequest -> f ManageNameIDRequest
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType)
 -> ManageNameIDRequest -> f ManageNameIDRequest)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> ManageNameIDRequest
-> f ManageNameIDRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: ManageNameIDRequest -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (ManageNameIDRequest -> ProtocolType)
-> ManageNameIDRequest
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType ManageNameIDRequest ProtocolType
-> ManageNameIDRequest -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType ManageNameIDRequest ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol ManageNameIDRequest where
  samlProtocol' :: (ProtocolType -> f ProtocolType)
-> ManageNameIDRequest -> f ManageNameIDRequest
samlProtocol' = (RequestAbstractType -> f RequestAbstractType)
-> ManageNameIDRequest -> f ManageNameIDRequest
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> f RequestAbstractType)
 -> ManageNameIDRequest -> f ManageNameIDRequest)
-> ((ProtocolType -> f ProtocolType)
    -> RequestAbstractType -> f RequestAbstractType)
-> (ProtocolType -> f ProtocolType)
-> ManageNameIDRequest
-> f ManageNameIDRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> RequestAbstractType -> f RequestAbstractType
Lens
  RequestAbstractType RequestAbstractType ProtocolType ProtocolType
requestProtocol'
  isSAMLResponse :: ManageNameIDRequest -> Bool
isSAMLResponse ManageNameIDRequest
_ = Bool
False
instance SAMLRequest ManageNameIDRequest where
  samlRequest' :: (RequestAbstractType -> f RequestAbstractType)
-> ManageNameIDRequest -> f ManageNameIDRequest
samlRequest' = $(fieldLens 'manageNameIDRequest)

newtype NewID = NewID{ NewID -> String
newID :: XString }
  deriving (NewID -> NewID -> Bool
(NewID -> NewID -> Bool) -> (NewID -> NewID -> Bool) -> Eq NewID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewID -> NewID -> Bool
$c/= :: NewID -> NewID -> Bool
== :: NewID -> NewID -> Bool
$c== :: NewID -> NewID -> Bool
Eq, Int -> NewID -> ShowS
[NewID] -> ShowS
NewID -> String
(Int -> NewID -> ShowS)
-> (NewID -> String) -> ([NewID] -> ShowS) -> Show NewID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewID] -> ShowS
$cshowList :: [NewID] -> ShowS
show :: NewID -> String
$cshow :: NewID -> String
showsPrec :: Int -> NewID -> ShowS
$cshowsPrec :: Int -> NewID -> ShowS
Show)

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

type NewEncryptedID = SAML.EncryptedElement NewID

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

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

instance XP.XmlPickler ManageNameIDResponse where
  xpickle :: PU ManageNameIDResponse
xpickle = String -> PU ManageNameIDResponse -> PU ManageNameIDResponse
forall a. String -> PU a -> PU a
xpElem String
"ManageNameIDResponse" (PU ManageNameIDResponse -> PU ManageNameIDResponse)
-> PU ManageNameIDResponse -> PU ManageNameIDResponse
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      r <-> ManageNameIDResponse r|]
    Bijection (->) StatusResponseType ManageNameIDResponse
-> PU StatusResponseType -> PU ManageNameIDResponse
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< PU StatusResponseType
forall a. XmlPickler a => PU a
XP.xpickle
instance DS.Signable ManageNameIDResponse where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> ManageNameIDResponse -> f ManageNameIDResponse
signature' = (ProtocolType -> f ProtocolType)
-> ManageNameIDResponse -> f ManageNameIDResponse
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType)
 -> ManageNameIDResponse -> f ManageNameIDResponse)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> ManageNameIDResponse
-> f ManageNameIDResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: ManageNameIDResponse -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (ManageNameIDResponse -> ProtocolType)
-> ManageNameIDResponse
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType ManageNameIDResponse ProtocolType
-> ManageNameIDResponse -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType ManageNameIDResponse ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol ManageNameIDResponse where
  samlProtocol' :: (ProtocolType -> f ProtocolType)
-> ManageNameIDResponse -> f ManageNameIDResponse
samlProtocol' = (StatusResponseType -> f StatusResponseType)
-> ManageNameIDResponse -> f ManageNameIDResponse
forall a. SAMLResponse a => Lens' a StatusResponseType
samlResponse' ((StatusResponseType -> f StatusResponseType)
 -> ManageNameIDResponse -> f ManageNameIDResponse)
-> ((ProtocolType -> f ProtocolType)
    -> StatusResponseType -> f StatusResponseType)
-> (ProtocolType -> f ProtocolType)
-> ManageNameIDResponse
-> f ManageNameIDResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> StatusResponseType -> f StatusResponseType
Lens
  StatusResponseType StatusResponseType ProtocolType ProtocolType
statusProtocol'
  isSAMLResponse :: ManageNameIDResponse -> Bool
isSAMLResponse ManageNameIDResponse
_ = Bool
True
instance SAMLResponse ManageNameIDResponse where
  samlResponse' :: (StatusResponseType -> f StatusResponseType)
-> ManageNameIDResponse -> f ManageNameIDResponse
samlResponse' = $(fieldLens 'manageNameIDResponse)

-- |§3.7.1
data LogoutRequest = LogoutRequest
  { LogoutRequest -> RequestAbstractType
logoutRequest :: !RequestAbstractType
  , LogoutRequest -> Maybe (Identified String LogoutReason)
logoutRequestReason :: Maybe (Identified XString LogoutReason)
  , LogoutRequest -> Maybe DateTime
logoutRequestNotOnOrAfter :: Maybe XS.DateTime
  , LogoutRequest -> PossiblyEncrypted Identifier
logoutRequestIdentifier :: SAML.PossiblyEncrypted SAML.Identifier
  , LogoutRequest -> [String]
logoutRequestSessionIndex :: [XString]
  } deriving (LogoutRequest -> LogoutRequest -> Bool
(LogoutRequest -> LogoutRequest -> Bool)
-> (LogoutRequest -> LogoutRequest -> Bool) -> Eq LogoutRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogoutRequest -> LogoutRequest -> Bool
$c/= :: LogoutRequest -> LogoutRequest -> Bool
== :: LogoutRequest -> LogoutRequest -> Bool
$c== :: LogoutRequest -> LogoutRequest -> Bool
Eq, Int -> LogoutRequest -> ShowS
[LogoutRequest] -> ShowS
LogoutRequest -> String
(Int -> LogoutRequest -> ShowS)
-> (LogoutRequest -> String)
-> ([LogoutRequest] -> ShowS)
-> Show LogoutRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogoutRequest] -> ShowS
$cshowList :: [LogoutRequest] -> ShowS
show :: LogoutRequest -> String
$cshow :: LogoutRequest -> String
showsPrec :: Int -> LogoutRequest -> ShowS
$cshowsPrec :: Int -> LogoutRequest -> ShowS
Show)

instance XP.XmlPickler LogoutRequest where
  xpickle :: PU LogoutRequest
xpickle = String -> PU LogoutRequest -> PU LogoutRequest
forall a. String -> PU a -> PU a
xpElem String
"LogoutRequest" (PU LogoutRequest -> PU LogoutRequest)
-> PU LogoutRequest -> PU LogoutRequest
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((((q, r), t), i), s) <-> LogoutRequest q r t i s|]
    Bijection
  (->)
  ((((RequestAbstractType, Maybe (Identified String LogoutReason)),
     Maybe DateTime),
    PossiblyEncrypted Identifier),
   [String])
  LogoutRequest
-> PU
     ((((RequestAbstractType, Maybe (Identified String LogoutReason)),
        Maybe DateTime),
       PossiblyEncrypted Identifier),
      [String])
-> PU LogoutRequest
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU RequestAbstractType
forall a. XmlPickler a => PU a
XP.xpickle
      PU RequestAbstractType
-> PU (Maybe (Identified String LogoutReason))
-> PU (RequestAbstractType, Maybe (Identified String LogoutReason))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< String
-> PU (Identified String LogoutReason)
-> PU (Maybe (Identified String LogoutReason))
forall a. String -> PU a -> PU (Maybe a)
XP.xpAttrImplied String
"Reason" PU (Identified String LogoutReason)
forall a. XmlPickler a => PU a
XP.xpickle
      PU (RequestAbstractType, Maybe (Identified String LogoutReason))
-> PU (Maybe DateTime)
-> PU
     ((RequestAbstractType, Maybe (Identified String LogoutReason)),
      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
  ((RequestAbstractType, Maybe (Identified String LogoutReason)),
   Maybe DateTime)
-> PU (PossiblyEncrypted Identifier)
-> PU
     (((RequestAbstractType, Maybe (Identified String LogoutReason)),
       Maybe DateTime),
      PossiblyEncrypted Identifier)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU (PossiblyEncrypted Identifier)
forall a.
(XmlPickler a, XmlPickler (EncryptedElement a)) =>
PU (PossiblyEncrypted a)
SAML.xpPossiblyEncrypted
      PU
  (((RequestAbstractType, Maybe (Identified String LogoutReason)),
    Maybe DateTime),
   PossiblyEncrypted Identifier)
-> PU [String]
-> PU
     ((((RequestAbstractType, Maybe (Identified String LogoutReason)),
        Maybe DateTime),
       PossiblyEncrypted Identifier),
      [String])
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU String -> PU [String]
forall a. PU a -> PU [a]
XP.xpList (String -> PU String -> PU String
forall a. String -> PU a -> PU a
xpElem String
"SessionIndex" PU String
XS.xpString))
instance DS.Signable LogoutRequest where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> LogoutRequest -> f LogoutRequest
signature' = (ProtocolType -> f ProtocolType)
-> LogoutRequest -> f LogoutRequest
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType)
 -> LogoutRequest -> f LogoutRequest)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> LogoutRequest
-> f LogoutRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: LogoutRequest -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (LogoutRequest -> ProtocolType) -> LogoutRequest -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType LogoutRequest ProtocolType
-> LogoutRequest -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType LogoutRequest ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol LogoutRequest where
  samlProtocol' :: (ProtocolType -> f ProtocolType)
-> LogoutRequest -> f LogoutRequest
samlProtocol' = (RequestAbstractType -> f RequestAbstractType)
-> LogoutRequest -> f LogoutRequest
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> f RequestAbstractType)
 -> LogoutRequest -> f LogoutRequest)
-> ((ProtocolType -> f ProtocolType)
    -> RequestAbstractType -> f RequestAbstractType)
-> (ProtocolType -> f ProtocolType)
-> LogoutRequest
-> f LogoutRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> RequestAbstractType -> f RequestAbstractType
Lens
  RequestAbstractType RequestAbstractType ProtocolType ProtocolType
requestProtocol'
  isSAMLResponse :: LogoutRequest -> Bool
isSAMLResponse LogoutRequest
_ = Bool
False
instance SAMLRequest LogoutRequest where
  samlRequest' :: (RequestAbstractType -> f RequestAbstractType)
-> LogoutRequest -> f LogoutRequest
samlRequest' = $(fieldLens 'logoutRequest)

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

instance XP.XmlPickler LogoutResponse where
  xpickle :: PU LogoutResponse
xpickle = String -> PU LogoutResponse -> PU LogoutResponse
forall a. String -> PU a -> PU a
xpElem String
"LogoutResponse" (PU LogoutResponse -> PU LogoutResponse)
-> PU LogoutResponse -> PU LogoutResponse
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      r <-> LogoutResponse r|]
    Bijection (->) StatusResponseType LogoutResponse
-> PU StatusResponseType -> PU LogoutResponse
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< PU StatusResponseType
forall a. XmlPickler a => PU a
XP.xpickle
instance DS.Signable LogoutResponse where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> LogoutResponse -> f LogoutResponse
signature' = (ProtocolType -> f ProtocolType)
-> LogoutResponse -> f LogoutResponse
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType)
 -> LogoutResponse -> f LogoutResponse)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> LogoutResponse
-> f LogoutResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: LogoutResponse -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (LogoutResponse -> ProtocolType) -> LogoutResponse -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType LogoutResponse ProtocolType
-> LogoutResponse -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType LogoutResponse ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol LogoutResponse where
  samlProtocol' :: (ProtocolType -> f ProtocolType)
-> LogoutResponse -> f LogoutResponse
samlProtocol' = (StatusResponseType -> f StatusResponseType)
-> LogoutResponse -> f LogoutResponse
forall a. SAMLResponse a => Lens' a StatusResponseType
samlResponse' ((StatusResponseType -> f StatusResponseType)
 -> LogoutResponse -> f LogoutResponse)
-> ((ProtocolType -> f ProtocolType)
    -> StatusResponseType -> f StatusResponseType)
-> (ProtocolType -> f ProtocolType)
-> LogoutResponse
-> f LogoutResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> StatusResponseType -> f StatusResponseType
Lens
  StatusResponseType StatusResponseType ProtocolType ProtocolType
statusProtocol'
  isSAMLResponse :: LogoutResponse -> Bool
isSAMLResponse LogoutResponse
_ = Bool
True
instance SAMLResponse LogoutResponse where
  samlResponse' :: (StatusResponseType -> f StatusResponseType)
-> LogoutResponse -> f LogoutResponse
samlResponse' = $(fieldLens 'logoutResponse)

-- |§3.7.3
data LogoutReason
  = LogoutReasonUser
  | LogoutReasonAdmin
  deriving (LogoutReason -> LogoutReason -> Bool
(LogoutReason -> LogoutReason -> Bool)
-> (LogoutReason -> LogoutReason -> Bool) -> Eq LogoutReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogoutReason -> LogoutReason -> Bool
$c/= :: LogoutReason -> LogoutReason -> Bool
== :: LogoutReason -> LogoutReason -> Bool
$c== :: LogoutReason -> LogoutReason -> Bool
Eq, Int -> LogoutReason
LogoutReason -> Int
LogoutReason -> [LogoutReason]
LogoutReason -> LogoutReason
LogoutReason -> LogoutReason -> [LogoutReason]
LogoutReason -> LogoutReason -> LogoutReason -> [LogoutReason]
(LogoutReason -> LogoutReason)
-> (LogoutReason -> LogoutReason)
-> (Int -> LogoutReason)
-> (LogoutReason -> Int)
-> (LogoutReason -> [LogoutReason])
-> (LogoutReason -> LogoutReason -> [LogoutReason])
-> (LogoutReason -> LogoutReason -> [LogoutReason])
-> (LogoutReason -> LogoutReason -> LogoutReason -> [LogoutReason])
-> Enum LogoutReason
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 :: LogoutReason -> LogoutReason -> LogoutReason -> [LogoutReason]
$cenumFromThenTo :: LogoutReason -> LogoutReason -> LogoutReason -> [LogoutReason]
enumFromTo :: LogoutReason -> LogoutReason -> [LogoutReason]
$cenumFromTo :: LogoutReason -> LogoutReason -> [LogoutReason]
enumFromThen :: LogoutReason -> LogoutReason -> [LogoutReason]
$cenumFromThen :: LogoutReason -> LogoutReason -> [LogoutReason]
enumFrom :: LogoutReason -> [LogoutReason]
$cenumFrom :: LogoutReason -> [LogoutReason]
fromEnum :: LogoutReason -> Int
$cfromEnum :: LogoutReason -> Int
toEnum :: Int -> LogoutReason
$ctoEnum :: Int -> LogoutReason
pred :: LogoutReason -> LogoutReason
$cpred :: LogoutReason -> LogoutReason
succ :: LogoutReason -> LogoutReason
$csucc :: LogoutReason -> LogoutReason
Enum, LogoutReason
LogoutReason -> LogoutReason -> Bounded LogoutReason
forall a. a -> a -> Bounded a
maxBound :: LogoutReason
$cmaxBound :: LogoutReason
minBound :: LogoutReason
$cminBound :: LogoutReason
Bounded, Int -> LogoutReason -> ShowS
[LogoutReason] -> ShowS
LogoutReason -> String
(Int -> LogoutReason -> ShowS)
-> (LogoutReason -> String)
-> ([LogoutReason] -> ShowS)
-> Show LogoutReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogoutReason] -> ShowS
$cshowList :: [LogoutReason] -> ShowS
show :: LogoutReason -> String
$cshow :: LogoutReason -> String
showsPrec :: Int -> LogoutReason -> ShowS
$cshowsPrec :: Int -> LogoutReason -> ShowS
Show)

instance Identifiable XString LogoutReason where
  identifier :: LogoutReason -> String
identifier = URI -> String
forall a. Show a => a -> String
show (URI -> String) -> (LogoutReason -> URI) -> LogoutReason -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (SAMLVersion, String) -> URI
samlURNIdentifier String
"logout" ((SAMLVersion, String) -> URI)
-> (LogoutReason -> (SAMLVersion, String)) -> LogoutReason -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogoutReason -> (SAMLVersion, String)
f where
    f :: LogoutReason -> (SAMLVersion, String)
f LogoutReason
LogoutReasonUser  = (SAMLVersion
SAML20, String
"user")
    f LogoutReason
LogoutReasonAdmin = (SAMLVersion
SAML20, String
"admin")
instance XP.XmlPickler (Identified XString LogoutReason) where
  xpickle :: PU (Identified String LogoutReason)
xpickle = PU String -> PU (Identified String LogoutReason)
forall b a. Identifiable b a => PU b -> PU (Identified b a)
xpIdentified PU String
XS.xpString

-- |§3.8.1
data NameIDMappingRequest = NameIDMappingRequest
  { NameIDMappingRequest -> RequestAbstractType
nameIDMappingRequest :: !RequestAbstractType
  , NameIDMappingRequest -> PossiblyEncrypted Identifier
nameIDMappingRequestIdentifier :: SAML.PossiblyEncrypted SAML.Identifier
  , NameIDMappingRequest -> NameIDPolicy
nameIDMappingRequestPolicy :: NameIDPolicy
  } deriving (NameIDMappingRequest -> NameIDMappingRequest -> Bool
(NameIDMappingRequest -> NameIDMappingRequest -> Bool)
-> (NameIDMappingRequest -> NameIDMappingRequest -> Bool)
-> Eq NameIDMappingRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameIDMappingRequest -> NameIDMappingRequest -> Bool
$c/= :: NameIDMappingRequest -> NameIDMappingRequest -> Bool
== :: NameIDMappingRequest -> NameIDMappingRequest -> Bool
$c== :: NameIDMappingRequest -> NameIDMappingRequest -> Bool
Eq, Int -> NameIDMappingRequest -> ShowS
[NameIDMappingRequest] -> ShowS
NameIDMappingRequest -> String
(Int -> NameIDMappingRequest -> ShowS)
-> (NameIDMappingRequest -> String)
-> ([NameIDMappingRequest] -> ShowS)
-> Show NameIDMappingRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameIDMappingRequest] -> ShowS
$cshowList :: [NameIDMappingRequest] -> ShowS
show :: NameIDMappingRequest -> String
$cshow :: NameIDMappingRequest -> String
showsPrec :: Int -> NameIDMappingRequest -> ShowS
$cshowsPrec :: Int -> NameIDMappingRequest -> ShowS
Show)

instance XP.XmlPickler NameIDMappingRequest where
  xpickle :: PU NameIDMappingRequest
xpickle = String -> PU NameIDMappingRequest -> PU NameIDMappingRequest
forall a. String -> PU a -> PU a
xpElem String
"NameIDMappingRequest" (PU NameIDMappingRequest -> PU NameIDMappingRequest)
-> PU NameIDMappingRequest -> PU NameIDMappingRequest
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      ((r, i), p) <-> NameIDMappingRequest r i p|]
    Bijection
  (->)
  ((RequestAbstractType, PossiblyEncrypted Identifier), NameIDPolicy)
  NameIDMappingRequest
-> PU
     ((RequestAbstractType, PossiblyEncrypted Identifier), NameIDPolicy)
-> PU NameIDMappingRequest
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU RequestAbstractType
forall a. XmlPickler a => PU a
XP.xpickle
      PU RequestAbstractType
-> PU (PossiblyEncrypted Identifier)
-> PU (RequestAbstractType, PossiblyEncrypted Identifier)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU (PossiblyEncrypted Identifier)
forall a.
(XmlPickler a, XmlPickler (EncryptedElement a)) =>
PU (PossiblyEncrypted a)
SAML.xpPossiblyEncrypted
      PU (RequestAbstractType, PossiblyEncrypted Identifier)
-> PU NameIDPolicy
-> PU
     ((RequestAbstractType, PossiblyEncrypted Identifier), NameIDPolicy)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU NameIDPolicy
forall a. XmlPickler a => PU a
XP.xpickle)
instance DS.Signable NameIDMappingRequest where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> NameIDMappingRequest -> f NameIDMappingRequest
signature' = (ProtocolType -> f ProtocolType)
-> NameIDMappingRequest -> f NameIDMappingRequest
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType)
 -> NameIDMappingRequest -> f NameIDMappingRequest)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> NameIDMappingRequest
-> f NameIDMappingRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: NameIDMappingRequest -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (NameIDMappingRequest -> ProtocolType)
-> NameIDMappingRequest
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType NameIDMappingRequest ProtocolType
-> NameIDMappingRequest -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType NameIDMappingRequest ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol NameIDMappingRequest where
  samlProtocol' :: (ProtocolType -> f ProtocolType)
-> NameIDMappingRequest -> f NameIDMappingRequest
samlProtocol' = (RequestAbstractType -> f RequestAbstractType)
-> NameIDMappingRequest -> f NameIDMappingRequest
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> f RequestAbstractType)
 -> NameIDMappingRequest -> f NameIDMappingRequest)
-> ((ProtocolType -> f ProtocolType)
    -> RequestAbstractType -> f RequestAbstractType)
-> (ProtocolType -> f ProtocolType)
-> NameIDMappingRequest
-> f NameIDMappingRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> RequestAbstractType -> f RequestAbstractType
Lens
  RequestAbstractType RequestAbstractType ProtocolType ProtocolType
requestProtocol'
  isSAMLResponse :: NameIDMappingRequest -> Bool
isSAMLResponse NameIDMappingRequest
_ = Bool
False
instance SAMLRequest NameIDMappingRequest where
  samlRequest' :: (RequestAbstractType -> f RequestAbstractType)
-> NameIDMappingRequest -> f NameIDMappingRequest
samlRequest' = $(fieldLens 'nameIDMappingRequest)

-- |§3.8.2
data NameIDMappingResponse = NameIDMappingResponse
  { NameIDMappingResponse -> StatusResponseType
nameIDMappingResponse :: !StatusResponseType
  , NameIDMappingResponse -> PossiblyEncrypted NameID
nameIDMappingResponseNameID :: SAML.PossiblyEncrypted SAML.NameID
  } deriving (NameIDMappingResponse -> NameIDMappingResponse -> Bool
(NameIDMappingResponse -> NameIDMappingResponse -> Bool)
-> (NameIDMappingResponse -> NameIDMappingResponse -> Bool)
-> Eq NameIDMappingResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameIDMappingResponse -> NameIDMappingResponse -> Bool
$c/= :: NameIDMappingResponse -> NameIDMappingResponse -> Bool
== :: NameIDMappingResponse -> NameIDMappingResponse -> Bool
$c== :: NameIDMappingResponse -> NameIDMappingResponse -> Bool
Eq, Int -> NameIDMappingResponse -> ShowS
[NameIDMappingResponse] -> ShowS
NameIDMappingResponse -> String
(Int -> NameIDMappingResponse -> ShowS)
-> (NameIDMappingResponse -> String)
-> ([NameIDMappingResponse] -> ShowS)
-> Show NameIDMappingResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameIDMappingResponse] -> ShowS
$cshowList :: [NameIDMappingResponse] -> ShowS
show :: NameIDMappingResponse -> String
$cshow :: NameIDMappingResponse -> String
showsPrec :: Int -> NameIDMappingResponse -> ShowS
$cshowsPrec :: Int -> NameIDMappingResponse -> ShowS
Show)

instance XP.XmlPickler NameIDMappingResponse where
  xpickle :: PU NameIDMappingResponse
xpickle = String -> PU NameIDMappingResponse -> PU NameIDMappingResponse
forall a. String -> PU a -> PU a
xpElem String
"NameIDMappingResponse" (PU NameIDMappingResponse -> PU NameIDMappingResponse)
-> PU NameIDMappingResponse -> PU NameIDMappingResponse
forall a b. (a -> b) -> a -> b
$ [XP.biCase|
      (r, a) <-> NameIDMappingResponse r a|]
    Bijection
  (->)
  (StatusResponseType, PossiblyEncrypted NameID)
  NameIDMappingResponse
-> PU (StatusResponseType, PossiblyEncrypted NameID)
-> PU NameIDMappingResponse
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU StatusResponseType
forall a. XmlPickler a => PU a
XP.xpickle
      PU StatusResponseType
-> PU (PossiblyEncrypted NameID)
-> PU (StatusResponseType, PossiblyEncrypted NameID)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
XP.>*< PU (PossiblyEncrypted NameID)
forall a.
(XmlPickler a, XmlPickler (EncryptedElement a)) =>
PU (PossiblyEncrypted a)
SAML.xpPossiblyEncrypted)
instance DS.Signable NameIDMappingResponse where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> NameIDMappingResponse -> f NameIDMappingResponse
signature' = (ProtocolType -> f ProtocolType)
-> NameIDMappingResponse -> f NameIDMappingResponse
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType)
 -> NameIDMappingResponse -> f NameIDMappingResponse)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> NameIDMappingResponse
-> f NameIDMappingResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: NameIDMappingResponse -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (NameIDMappingResponse -> ProtocolType)
-> NameIDMappingResponse
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType NameIDMappingResponse ProtocolType
-> NameIDMappingResponse -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType NameIDMappingResponse ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol NameIDMappingResponse where
  samlProtocol' :: (ProtocolType -> f ProtocolType)
-> NameIDMappingResponse -> f NameIDMappingResponse
samlProtocol' = (StatusResponseType -> f StatusResponseType)
-> NameIDMappingResponse -> f NameIDMappingResponse
forall a. SAMLResponse a => Lens' a StatusResponseType
samlResponse' ((StatusResponseType -> f StatusResponseType)
 -> NameIDMappingResponse -> f NameIDMappingResponse)
-> ((ProtocolType -> f ProtocolType)
    -> StatusResponseType -> f StatusResponseType)
-> (ProtocolType -> f ProtocolType)
-> NameIDMappingResponse
-> f NameIDMappingResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> StatusResponseType -> f StatusResponseType
Lens
  StatusResponseType StatusResponseType ProtocolType ProtocolType
statusProtocol'
  isSAMLResponse :: NameIDMappingResponse -> Bool
isSAMLResponse NameIDMappingResponse
_ = Bool
True
instance SAMLResponse NameIDMappingResponse where
  samlResponse' :: (StatusResponseType -> f StatusResponseType)
-> NameIDMappingResponse -> f NameIDMappingResponse
samlResponse' = $(fieldLens 'nameIDMappingResponse)

data AnyRequest
  = RequestAssertionIDRequest   !AssertionIDRequest
  | RequestAuthnQuery           !AuthnQuery
  | RequestAttributeQuery       !AttributeQuery
  | RequestAuthzDecisionQuery   !AuthzDecisionQuery
  | RequestAuthnRequest         !AuthnRequest
  | RequestArtifactResolve      !ArtifactResolve
  | RequestManageNameIDRequest  !ManageNameIDRequest
  | RequestLogoutRequest        !LogoutRequest
  | RequestNameIDMappingRequest !NameIDMappingRequest
  deriving (AnyRequest -> AnyRequest -> Bool
(AnyRequest -> AnyRequest -> Bool)
-> (AnyRequest -> AnyRequest -> Bool) -> Eq AnyRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnyRequest -> AnyRequest -> Bool
$c/= :: AnyRequest -> AnyRequest -> Bool
== :: AnyRequest -> AnyRequest -> Bool
$c== :: AnyRequest -> AnyRequest -> Bool
Eq, Int -> AnyRequest -> ShowS
[AnyRequest] -> ShowS
AnyRequest -> String
(Int -> AnyRequest -> ShowS)
-> (AnyRequest -> String)
-> ([AnyRequest] -> ShowS)
-> Show AnyRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnyRequest] -> ShowS
$cshowList :: [AnyRequest] -> ShowS
show :: AnyRequest -> String
$cshow :: AnyRequest -> String
showsPrec :: Int -> AnyRequest -> ShowS
$cshowsPrec :: Int -> AnyRequest -> ShowS
Show)

instance XP.XmlPickler AnyRequest where
  xpickle :: PU AnyRequest
xpickle = [XP.biCase|
      Left (Left (Left (Left (Left (Left (Left (Left r))))))) <-> RequestAssertionIDRequest r
      Left (Left (Left (Left (Left (Left (Left (Right r))))))) <-> RequestAuthnQuery r
      Left (Left (Left (Left (Left (Left (Right r)))))) <-> RequestAttributeQuery r
      Left (Left (Left (Left (Left (Right r))))) <-> RequestAuthzDecisionQuery r
      Left (Left (Left (Left (Right r)))) <-> RequestAuthnRequest r
      Left (Left (Left (Right r))) <-> RequestArtifactResolve r
      Left (Left (Right r)) <-> RequestManageNameIDRequest r
      Left (Right r) <-> RequestLogoutRequest r
      Right r <-> RequestNameIDMappingRequest r|]
    Bijection
  (->)
  (Either
     (Either
        (Either
           (Either
              (Either
                 (Either
                    (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
                    AuthzDecisionQuery)
                 AuthnRequest)
              ArtifactResolve)
           ManageNameIDRequest)
        LogoutRequest)
     NameIDMappingRequest)
  AnyRequest
-> PU
     (Either
        (Either
           (Either
              (Either
                 (Either
                    (Either
                       (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
                       AuthzDecisionQuery)
                    AuthnRequest)
                 ArtifactResolve)
              ManageNameIDRequest)
           LogoutRequest)
        NameIDMappingRequest)
-> PU AnyRequest
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU AssertionIDRequest
forall a. XmlPickler a => PU a
XP.xpickle
      PU AssertionIDRequest
-> PU AuthnQuery -> PU (Either AssertionIDRequest AuthnQuery)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU AuthnQuery
forall a. XmlPickler a => PU a
XP.xpickle
      PU (Either AssertionIDRequest AuthnQuery)
-> PU AttributeQuery
-> PU
     (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU AttributeQuery
forall a. XmlPickler a => PU a
XP.xpickle
      PU (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
-> PU AuthzDecisionQuery
-> PU
     (Either
        (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
        AuthzDecisionQuery)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU AuthzDecisionQuery
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (Either
     (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
     AuthzDecisionQuery)
-> PU AuthnRequest
-> PU
     (Either
        (Either
           (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
           AuthzDecisionQuery)
        AuthnRequest)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU AuthnRequest
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (Either
     (Either
        (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
        AuthzDecisionQuery)
     AuthnRequest)
-> PU ArtifactResolve
-> PU
     (Either
        (Either
           (Either
              (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
              AuthzDecisionQuery)
           AuthnRequest)
        ArtifactResolve)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU ArtifactResolve
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (Either
     (Either
        (Either
           (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
           AuthzDecisionQuery)
        AuthnRequest)
     ArtifactResolve)
-> PU ManageNameIDRequest
-> PU
     (Either
        (Either
           (Either
              (Either
                 (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
                 AuthzDecisionQuery)
              AuthnRequest)
           ArtifactResolve)
        ManageNameIDRequest)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU ManageNameIDRequest
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (Either
     (Either
        (Either
           (Either
              (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
              AuthzDecisionQuery)
           AuthnRequest)
        ArtifactResolve)
     ManageNameIDRequest)
-> PU LogoutRequest
-> PU
     (Either
        (Either
           (Either
              (Either
                 (Either
                    (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
                    AuthzDecisionQuery)
                 AuthnRequest)
              ArtifactResolve)
           ManageNameIDRequest)
        LogoutRequest)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU LogoutRequest
forall a. XmlPickler a => PU a
XP.xpickle
      PU
  (Either
     (Either
        (Either
           (Either
              (Either
                 (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
                 AuthzDecisionQuery)
              AuthnRequest)
           ArtifactResolve)
        ManageNameIDRequest)
     LogoutRequest)
-> PU NameIDMappingRequest
-> PU
     (Either
        (Either
           (Either
              (Either
                 (Either
                    (Either
                       (Either (Either AssertionIDRequest AuthnQuery) AttributeQuery)
                       AuthzDecisionQuery)
                    AuthnRequest)
                 ArtifactResolve)
              ManageNameIDRequest)
           LogoutRequest)
        NameIDMappingRequest)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU NameIDMappingRequest
forall a. XmlPickler a => PU a
XP.xpickle)
instance DS.Signable AnyRequest where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> AnyRequest -> f AnyRequest
signature' = (ProtocolType -> f ProtocolType) -> AnyRequest -> f AnyRequest
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType) -> AnyRequest -> f AnyRequest)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> AnyRequest
-> f AnyRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: AnyRequest -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (AnyRequest -> ProtocolType) -> AnyRequest -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType AnyRequest ProtocolType
-> AnyRequest -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType AnyRequest ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol AnyRequest where
  samlProtocol' :: (ProtocolType -> f ProtocolType) -> AnyRequest -> f AnyRequest
samlProtocol' = (RequestAbstractType -> f RequestAbstractType)
-> AnyRequest -> f AnyRequest
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> f RequestAbstractType)
 -> AnyRequest -> f AnyRequest)
-> ((ProtocolType -> f ProtocolType)
    -> RequestAbstractType -> f RequestAbstractType)
-> (ProtocolType -> f ProtocolType)
-> AnyRequest
-> f AnyRequest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> RequestAbstractType -> f RequestAbstractType
Lens
  RequestAbstractType RequestAbstractType ProtocolType ProtocolType
requestProtocol'
  isSAMLResponse :: AnyRequest -> Bool
isSAMLResponse AnyRequest
_ = Bool
False
instance SAMLRequest AnyRequest where
  samlRequest' :: (RequestAbstractType -> f RequestAbstractType)
-> AnyRequest -> f AnyRequest
samlRequest' = (AnyRequest -> RequestAbstractType)
-> (AnyRequest -> RequestAbstractType -> AnyRequest)
-> Lens' AnyRequest RequestAbstractType
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AnyRequest -> RequestAbstractType
g AnyRequest -> RequestAbstractType -> AnyRequest
s where
    g :: AnyRequest -> RequestAbstractType
g (RequestAssertionIDRequest   AssertionIDRequest
r) = AssertionIDRequest
r AssertionIDRequest
-> Getting
     RequestAbstractType AssertionIDRequest RequestAbstractType
-> RequestAbstractType
forall s a. s -> Getting a s a -> a
^. Getting RequestAbstractType AssertionIDRequest RequestAbstractType
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest'
    g (RequestAuthnQuery           AuthnQuery
r) = AuthnQuery
r AuthnQuery
-> Getting RequestAbstractType AuthnQuery RequestAbstractType
-> RequestAbstractType
forall s a. s -> Getting a s a -> a
^. Getting RequestAbstractType AuthnQuery RequestAbstractType
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest'
    g (RequestAttributeQuery       AttributeQuery
r) = AttributeQuery
r AttributeQuery
-> Getting RequestAbstractType AttributeQuery RequestAbstractType
-> RequestAbstractType
forall s a. s -> Getting a s a -> a
^. Getting RequestAbstractType AttributeQuery RequestAbstractType
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest'
    g (RequestAuthzDecisionQuery   AuthzDecisionQuery
r) = AuthzDecisionQuery
r AuthzDecisionQuery
-> Getting
     RequestAbstractType AuthzDecisionQuery RequestAbstractType
-> RequestAbstractType
forall s a. s -> Getting a s a -> a
^. Getting RequestAbstractType AuthzDecisionQuery RequestAbstractType
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest'
    g (RequestAuthnRequest         AuthnRequest
r) = AuthnRequest
r AuthnRequest
-> Getting RequestAbstractType AuthnRequest RequestAbstractType
-> RequestAbstractType
forall s a. s -> Getting a s a -> a
^. Getting RequestAbstractType AuthnRequest RequestAbstractType
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest'
    g (RequestArtifactResolve      ArtifactResolve
r) = ArtifactResolve
r ArtifactResolve
-> Getting RequestAbstractType ArtifactResolve RequestAbstractType
-> RequestAbstractType
forall s a. s -> Getting a s a -> a
^. Getting RequestAbstractType ArtifactResolve RequestAbstractType
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest'
    g (RequestManageNameIDRequest  ManageNameIDRequest
r) = ManageNameIDRequest
r ManageNameIDRequest
-> Getting
     RequestAbstractType ManageNameIDRequest RequestAbstractType
-> RequestAbstractType
forall s a. s -> Getting a s a -> a
^. Getting RequestAbstractType ManageNameIDRequest RequestAbstractType
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest'
    g (RequestLogoutRequest        LogoutRequest
r) = LogoutRequest
r LogoutRequest
-> Getting RequestAbstractType LogoutRequest RequestAbstractType
-> RequestAbstractType
forall s a. s -> Getting a s a -> a
^. Getting RequestAbstractType LogoutRequest RequestAbstractType
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest'
    g (RequestNameIDMappingRequest NameIDMappingRequest
r) = NameIDMappingRequest
r NameIDMappingRequest
-> Getting
     RequestAbstractType NameIDMappingRequest RequestAbstractType
-> RequestAbstractType
forall s a. s -> Getting a s a -> a
^. Getting
  RequestAbstractType NameIDMappingRequest RequestAbstractType
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest'
    s :: AnyRequest -> RequestAbstractType -> AnyRequest
s (RequestAssertionIDRequest   AssertionIDRequest
r) RequestAbstractType
q = AssertionIDRequest -> AnyRequest
RequestAssertionIDRequest   (AssertionIDRequest -> AnyRequest)
-> AssertionIDRequest -> AnyRequest
forall a b. (a -> b) -> a -> b
$ (RequestAbstractType -> Identity RequestAbstractType)
-> AssertionIDRequest -> Identity AssertionIDRequest
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> Identity RequestAbstractType)
 -> AssertionIDRequest -> Identity AssertionIDRequest)
-> RequestAbstractType -> AssertionIDRequest -> AssertionIDRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RequestAbstractType
q (AssertionIDRequest -> AssertionIDRequest)
-> AssertionIDRequest -> AssertionIDRequest
forall a b. (a -> b) -> a -> b
$ AssertionIDRequest
r
    s (RequestAuthnQuery           AuthnQuery
r) RequestAbstractType
q = AuthnQuery -> AnyRequest
RequestAuthnQuery           (AuthnQuery -> AnyRequest) -> AuthnQuery -> AnyRequest
forall a b. (a -> b) -> a -> b
$ (RequestAbstractType -> Identity RequestAbstractType)
-> AuthnQuery -> Identity AuthnQuery
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> Identity RequestAbstractType)
 -> AuthnQuery -> Identity AuthnQuery)
-> RequestAbstractType -> AuthnQuery -> AuthnQuery
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RequestAbstractType
q (AuthnQuery -> AuthnQuery) -> AuthnQuery -> AuthnQuery
forall a b. (a -> b) -> a -> b
$ AuthnQuery
r
    s (RequestAttributeQuery       AttributeQuery
r) RequestAbstractType
q = AttributeQuery -> AnyRequest
RequestAttributeQuery       (AttributeQuery -> AnyRequest) -> AttributeQuery -> AnyRequest
forall a b. (a -> b) -> a -> b
$ (RequestAbstractType -> Identity RequestAbstractType)
-> AttributeQuery -> Identity AttributeQuery
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> Identity RequestAbstractType)
 -> AttributeQuery -> Identity AttributeQuery)
-> RequestAbstractType -> AttributeQuery -> AttributeQuery
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RequestAbstractType
q (AttributeQuery -> AttributeQuery)
-> AttributeQuery -> AttributeQuery
forall a b. (a -> b) -> a -> b
$ AttributeQuery
r
    s (RequestAuthzDecisionQuery   AuthzDecisionQuery
r) RequestAbstractType
q = AuthzDecisionQuery -> AnyRequest
RequestAuthzDecisionQuery   (AuthzDecisionQuery -> AnyRequest)
-> AuthzDecisionQuery -> AnyRequest
forall a b. (a -> b) -> a -> b
$ (RequestAbstractType -> Identity RequestAbstractType)
-> AuthzDecisionQuery -> Identity AuthzDecisionQuery
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> Identity RequestAbstractType)
 -> AuthzDecisionQuery -> Identity AuthzDecisionQuery)
-> RequestAbstractType -> AuthzDecisionQuery -> AuthzDecisionQuery
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RequestAbstractType
q (AuthzDecisionQuery -> AuthzDecisionQuery)
-> AuthzDecisionQuery -> AuthzDecisionQuery
forall a b. (a -> b) -> a -> b
$ AuthzDecisionQuery
r
    s (RequestAuthnRequest         AuthnRequest
r) RequestAbstractType
q = AuthnRequest -> AnyRequest
RequestAuthnRequest         (AuthnRequest -> AnyRequest) -> AuthnRequest -> AnyRequest
forall a b. (a -> b) -> a -> b
$ (RequestAbstractType -> Identity RequestAbstractType)
-> AuthnRequest -> Identity AuthnRequest
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> Identity RequestAbstractType)
 -> AuthnRequest -> Identity AuthnRequest)
-> RequestAbstractType -> AuthnRequest -> AuthnRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RequestAbstractType
q (AuthnRequest -> AuthnRequest) -> AuthnRequest -> AuthnRequest
forall a b. (a -> b) -> a -> b
$ AuthnRequest
r
    s (RequestArtifactResolve      ArtifactResolve
r) RequestAbstractType
q = ArtifactResolve -> AnyRequest
RequestArtifactResolve      (ArtifactResolve -> AnyRequest) -> ArtifactResolve -> AnyRequest
forall a b. (a -> b) -> a -> b
$ (RequestAbstractType -> Identity RequestAbstractType)
-> ArtifactResolve -> Identity ArtifactResolve
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> Identity RequestAbstractType)
 -> ArtifactResolve -> Identity ArtifactResolve)
-> RequestAbstractType -> ArtifactResolve -> ArtifactResolve
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RequestAbstractType
q (ArtifactResolve -> ArtifactResolve)
-> ArtifactResolve -> ArtifactResolve
forall a b. (a -> b) -> a -> b
$ ArtifactResolve
r
    s (RequestManageNameIDRequest  ManageNameIDRequest
r) RequestAbstractType
q = ManageNameIDRequest -> AnyRequest
RequestManageNameIDRequest  (ManageNameIDRequest -> AnyRequest)
-> ManageNameIDRequest -> AnyRequest
forall a b. (a -> b) -> a -> b
$ (RequestAbstractType -> Identity RequestAbstractType)
-> ManageNameIDRequest -> Identity ManageNameIDRequest
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> Identity RequestAbstractType)
 -> ManageNameIDRequest -> Identity ManageNameIDRequest)
-> RequestAbstractType
-> ManageNameIDRequest
-> ManageNameIDRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RequestAbstractType
q (ManageNameIDRequest -> ManageNameIDRequest)
-> ManageNameIDRequest -> ManageNameIDRequest
forall a b. (a -> b) -> a -> b
$ ManageNameIDRequest
r
    s (RequestLogoutRequest        LogoutRequest
r) RequestAbstractType
q = LogoutRequest -> AnyRequest
RequestLogoutRequest        (LogoutRequest -> AnyRequest) -> LogoutRequest -> AnyRequest
forall a b. (a -> b) -> a -> b
$ (RequestAbstractType -> Identity RequestAbstractType)
-> LogoutRequest -> Identity LogoutRequest
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> Identity RequestAbstractType)
 -> LogoutRequest -> Identity LogoutRequest)
-> RequestAbstractType -> LogoutRequest -> LogoutRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RequestAbstractType
q (LogoutRequest -> LogoutRequest) -> LogoutRequest -> LogoutRequest
forall a b. (a -> b) -> a -> b
$ LogoutRequest
r
    s (RequestNameIDMappingRequest NameIDMappingRequest
r) RequestAbstractType
q = NameIDMappingRequest -> AnyRequest
RequestNameIDMappingRequest (NameIDMappingRequest -> AnyRequest)
-> NameIDMappingRequest -> AnyRequest
forall a b. (a -> b) -> a -> b
$ (RequestAbstractType -> Identity RequestAbstractType)
-> NameIDMappingRequest -> Identity NameIDMappingRequest
forall a. SAMLRequest a => Lens' a RequestAbstractType
samlRequest' ((RequestAbstractType -> Identity RequestAbstractType)
 -> NameIDMappingRequest -> Identity NameIDMappingRequest)
-> RequestAbstractType
-> NameIDMappingRequest
-> NameIDMappingRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RequestAbstractType
q (NameIDMappingRequest -> NameIDMappingRequest)
-> NameIDMappingRequest -> NameIDMappingRequest
forall a b. (a -> b) -> a -> b
$ NameIDMappingRequest
r

data AnyResponse
  = ResponseResponse         !Response
  | ResponseArtifactResponse !ArtifactResponse
  deriving (AnyResponse -> AnyResponse -> Bool
(AnyResponse -> AnyResponse -> Bool)
-> (AnyResponse -> AnyResponse -> Bool) -> Eq AnyResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnyResponse -> AnyResponse -> Bool
$c/= :: AnyResponse -> AnyResponse -> Bool
== :: AnyResponse -> AnyResponse -> Bool
$c== :: AnyResponse -> AnyResponse -> Bool
Eq, Int -> AnyResponse -> ShowS
[AnyResponse] -> ShowS
AnyResponse -> String
(Int -> AnyResponse -> ShowS)
-> (AnyResponse -> String)
-> ([AnyResponse] -> ShowS)
-> Show AnyResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnyResponse] -> ShowS
$cshowList :: [AnyResponse] -> ShowS
show :: AnyResponse -> String
$cshow :: AnyResponse -> String
showsPrec :: Int -> AnyResponse -> ShowS
$cshowsPrec :: Int -> AnyResponse -> ShowS
Show)

instance XP.XmlPickler AnyResponse where
  xpickle :: PU AnyResponse
xpickle = [XP.biCase|
      Left r <-> ResponseResponse r
      Right r <-> ResponseArtifactResponse r|]
    Bijection (->) (Either Response ArtifactResponse) AnyResponse
-> PU (Either Response ArtifactResponse) -> PU AnyResponse
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU Response
forall a. XmlPickler a => PU a
XP.xpickle
      PU Response
-> PU ArtifactResponse -> PU (Either Response ArtifactResponse)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU ArtifactResponse
forall a. XmlPickler a => PU a
XP.xpickle)
instance DS.Signable AnyResponse where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> AnyResponse -> f AnyResponse
signature' = (ProtocolType -> f ProtocolType) -> AnyResponse -> f AnyResponse
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType) -> AnyResponse -> f AnyResponse)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> AnyResponse
-> f AnyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: AnyResponse -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (AnyResponse -> ProtocolType) -> AnyResponse -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType AnyResponse ProtocolType
-> AnyResponse -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType AnyResponse ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol AnyResponse where
  samlProtocol' :: (ProtocolType -> f ProtocolType) -> AnyResponse -> f AnyResponse
samlProtocol' = (StatusResponseType -> f StatusResponseType)
-> AnyResponse -> f AnyResponse
forall a. SAMLResponse a => Lens' a StatusResponseType
samlResponse' ((StatusResponseType -> f StatusResponseType)
 -> AnyResponse -> f AnyResponse)
-> ((ProtocolType -> f ProtocolType)
    -> StatusResponseType -> f StatusResponseType)
-> (ProtocolType -> f ProtocolType)
-> AnyResponse
-> f AnyResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtocolType -> f ProtocolType)
-> StatusResponseType -> f StatusResponseType
Lens
  StatusResponseType StatusResponseType ProtocolType ProtocolType
statusProtocol'
  isSAMLResponse :: AnyResponse -> Bool
isSAMLResponse AnyResponse
_ = Bool
True
instance SAMLResponse AnyResponse where
  samlResponse' :: (StatusResponseType -> f StatusResponseType)
-> AnyResponse -> f AnyResponse
samlResponse' = (AnyResponse -> StatusResponseType)
-> (AnyResponse -> StatusResponseType -> AnyResponse)
-> Lens' AnyResponse StatusResponseType
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AnyResponse -> StatusResponseType
g AnyResponse -> StatusResponseType -> AnyResponse
s where
    g :: AnyResponse -> StatusResponseType
g (ResponseResponse         Response
r) = Response
r Response
-> Getting StatusResponseType Response StatusResponseType
-> StatusResponseType
forall s a. s -> Getting a s a -> a
^. Getting StatusResponseType Response StatusResponseType
forall a. SAMLResponse a => Lens' a StatusResponseType
samlResponse'
    g (ResponseArtifactResponse ArtifactResponse
r) = ArtifactResponse
r ArtifactResponse
-> Getting StatusResponseType ArtifactResponse StatusResponseType
-> StatusResponseType
forall s a. s -> Getting a s a -> a
^. Getting StatusResponseType ArtifactResponse StatusResponseType
forall a. SAMLResponse a => Lens' a StatusResponseType
samlResponse'
    s :: AnyResponse -> StatusResponseType -> AnyResponse
s (ResponseResponse         Response
r) StatusResponseType
q = Response -> AnyResponse
ResponseResponse         (Response -> AnyResponse) -> Response -> AnyResponse
forall a b. (a -> b) -> a -> b
$ (StatusResponseType -> Identity StatusResponseType)
-> Response -> Identity Response
forall a. SAMLResponse a => Lens' a StatusResponseType
samlResponse' ((StatusResponseType -> Identity StatusResponseType)
 -> Response -> Identity Response)
-> StatusResponseType -> Response -> Response
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StatusResponseType
q (Response -> Response) -> Response -> Response
forall a b. (a -> b) -> a -> b
$ Response
r
    s (ResponseArtifactResponse ArtifactResponse
r) StatusResponseType
q = ArtifactResponse -> AnyResponse
ResponseArtifactResponse (ArtifactResponse -> AnyResponse)
-> ArtifactResponse -> AnyResponse
forall a b. (a -> b) -> a -> b
$ (StatusResponseType -> Identity StatusResponseType)
-> ArtifactResponse -> Identity ArtifactResponse
forall a. SAMLResponse a => Lens' a StatusResponseType
samlResponse' ((StatusResponseType -> Identity StatusResponseType)
 -> ArtifactResponse -> Identity ArtifactResponse)
-> StatusResponseType -> ArtifactResponse -> ArtifactResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StatusResponseType
q (ArtifactResponse -> ArtifactResponse)
-> ArtifactResponse -> ArtifactResponse
forall a b. (a -> b) -> a -> b
$ ArtifactResponse
r

data AnyProtocol
  = ProtocolRequest  !AnyRequest
  | ProtocolResponse !AnyResponse
  deriving (AnyProtocol -> AnyProtocol -> Bool
(AnyProtocol -> AnyProtocol -> Bool)
-> (AnyProtocol -> AnyProtocol -> Bool) -> Eq AnyProtocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AnyProtocol -> AnyProtocol -> Bool
$c/= :: AnyProtocol -> AnyProtocol -> Bool
== :: AnyProtocol -> AnyProtocol -> Bool
$c== :: AnyProtocol -> AnyProtocol -> Bool
Eq, Int -> AnyProtocol -> ShowS
[AnyProtocol] -> ShowS
AnyProtocol -> String
(Int -> AnyProtocol -> ShowS)
-> (AnyProtocol -> String)
-> ([AnyProtocol] -> ShowS)
-> Show AnyProtocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AnyProtocol] -> ShowS
$cshowList :: [AnyProtocol] -> ShowS
show :: AnyProtocol -> String
$cshow :: AnyProtocol -> String
showsPrec :: Int -> AnyProtocol -> ShowS
$cshowsPrec :: Int -> AnyProtocol -> ShowS
Show)

instance XP.XmlPickler AnyProtocol where
  xpickle :: PU AnyProtocol
xpickle = [XP.biCase|
      Left r <-> ProtocolRequest r
      Right r <-> ProtocolResponse r|]
    Bijection (->) (Either AnyRequest AnyResponse) AnyProtocol
-> PU (Either AnyRequest AnyResponse) -> PU AnyProtocol
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$<  (PU AnyRequest
forall a. XmlPickler a => PU a
XP.xpickle
      PU AnyRequest
-> PU AnyResponse -> PU (Either AnyRequest AnyResponse)
forall (f :: * -> *) a b.
MonoidalAlt f =>
f a -> f b -> f (Either a b)
XP.>|< PU AnyResponse
forall a. XmlPickler a => PU a
XP.xpickle)
instance DS.Signable AnyProtocol where
  signature' :: (Maybe Signature -> f (Maybe Signature))
-> AnyProtocol -> f AnyProtocol
signature' = (ProtocolType -> f ProtocolType) -> AnyProtocol -> f AnyProtocol
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> f ProtocolType) -> AnyProtocol -> f AnyProtocol)
-> ((Maybe Signature -> f (Maybe Signature))
    -> ProtocolType -> f ProtocolType)
-> (Maybe Signature -> f (Maybe Signature))
-> AnyProtocol
-> f AnyProtocol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Signature -> f (Maybe Signature))
-> ProtocolType -> f ProtocolType
forall a. Signable a => Lens' a (Maybe Signature)
DS.signature'
  signedID :: AnyProtocol -> String
signedID = ProtocolType -> String
protocolID (ProtocolType -> String)
-> (AnyProtocol -> ProtocolType) -> AnyProtocol -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProtocolType AnyProtocol ProtocolType
-> AnyProtocol -> ProtocolType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProtocolType AnyProtocol ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
instance SAMLProtocol AnyProtocol where
  samlProtocol' :: (ProtocolType -> f ProtocolType) -> AnyProtocol -> f AnyProtocol
samlProtocol' = (AnyProtocol -> ProtocolType)
-> (AnyProtocol -> ProtocolType -> AnyProtocol)
-> Lens' AnyProtocol ProtocolType
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AnyProtocol -> ProtocolType
g AnyProtocol -> ProtocolType -> AnyProtocol
s where
    g :: AnyProtocol -> ProtocolType
g (ProtocolRequest  AnyRequest
r) = AnyRequest
r AnyRequest
-> Getting ProtocolType AnyRequest ProtocolType -> ProtocolType
forall s a. s -> Getting a s a -> a
^. Getting ProtocolType AnyRequest ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
    g (ProtocolResponse AnyResponse
r) = AnyResponse
r AnyResponse
-> Getting ProtocolType AnyResponse ProtocolType -> ProtocolType
forall s a. s -> Getting a s a -> a
^. Getting ProtocolType AnyResponse ProtocolType
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol'
    s :: AnyProtocol -> ProtocolType -> AnyProtocol
s (ProtocolRequest  AnyRequest
r) ProtocolType
q = AnyRequest -> AnyProtocol
ProtocolRequest  (AnyRequest -> AnyProtocol) -> AnyRequest -> AnyProtocol
forall a b. (a -> b) -> a -> b
$ (ProtocolType -> Identity ProtocolType)
-> AnyRequest -> Identity AnyRequest
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> Identity ProtocolType)
 -> AnyRequest -> Identity AnyRequest)
-> ProtocolType -> AnyRequest -> AnyRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtocolType
q (AnyRequest -> AnyRequest) -> AnyRequest -> AnyRequest
forall a b. (a -> b) -> a -> b
$ AnyRequest
r
    s (ProtocolResponse AnyResponse
r) ProtocolType
q = AnyResponse -> AnyProtocol
ProtocolResponse (AnyResponse -> AnyProtocol) -> AnyResponse -> AnyProtocol
forall a b. (a -> b) -> a -> b
$ (ProtocolType -> Identity ProtocolType)
-> AnyResponse -> Identity AnyResponse
forall a. SAMLProtocol a => Lens' a ProtocolType
samlProtocol' ((ProtocolType -> Identity ProtocolType)
 -> AnyResponse -> Identity AnyResponse)
-> ProtocolType -> AnyResponse -> AnyResponse
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtocolType
q (AnyResponse -> AnyResponse) -> AnyResponse -> AnyResponse
forall a b. (a -> b) -> a -> b
$ AnyResponse
r
  isSAMLResponse :: AnyProtocol -> Bool
isSAMLResponse (ProtocolRequest AnyRequest
_) = Bool
False
  isSAMLResponse (ProtocolResponse AnyResponse
_) = Bool
True
  isSAMLResponse_ :: Proxy AnyProtocol -> Maybe Bool
isSAMLResponse_ Proxy AnyProtocol
_ = Maybe Bool
forall a. Maybe a
Nothing