{-# LANGUAGE OverloadedStrings #-}

-- | WARNING: these optics make assumptions about the shape of the AuthnResponse that are not valid
-- in general.  e.g., we assume that there is exactly one 'SubjectConfirmation', but 'Subject'
-- contains a list of them that could have length 0 or 5.  similarly, we only take the first of a
-- (non-empty) list of assertions into account, and ignore the others.
module SAML2.WebSSO.Test.Lenses where

import Control.Lens
import Data.List.NonEmpty as NL
import SAML2.WebSSO
import Test.QuickCheck.Instances ()

_nlhead :: Lens' (NonEmpty a) a
_nlhead :: forall a (f :: * -> *).
Functor f =>
(a -> f a) -> NonEmpty a -> f (NonEmpty a)
_nlhead a -> f a
f (a
a :| [a]
as) = (a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
as) (a -> NonEmpty a) -> f a -> f (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
a

assertionL :: Lens' AuthnResponse Assertion
assertionL :: Lens' AuthnResponse Assertion
assertionL = (NonEmpty Assertion -> f (NonEmpty Assertion))
-> AuthnResponse -> f AuthnResponse
forall payload (f :: * -> *).
Functor f =>
(payload -> f payload) -> Response payload -> f (Response payload)
rspPayload ((NonEmpty Assertion -> f (NonEmpty Assertion))
 -> AuthnResponse -> f AuthnResponse)
-> ((Assertion -> f Assertion)
    -> NonEmpty Assertion -> f (NonEmpty Assertion))
-> (Assertion -> f Assertion)
-> AuthnResponse
-> f AuthnResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Assertion -> f Assertion)
-> NonEmpty Assertion -> f (NonEmpty Assertion)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> NonEmpty a -> f (NonEmpty a)
_nlhead

conditionsL :: Traversal' AuthnResponse Conditions
conditionsL :: Traversal' AuthnResponse Conditions
conditionsL = (Assertion -> f Assertion) -> AuthnResponse -> f AuthnResponse
Lens' AuthnResponse Assertion
assertionL ((Assertion -> f Assertion) -> AuthnResponse -> f AuthnResponse)
-> ((Conditions -> f Conditions) -> Assertion -> f Assertion)
-> (Conditions -> f Conditions)
-> AuthnResponse
-> f AuthnResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Conditions -> f (Maybe Conditions))
-> Assertion -> f Assertion
Lens' Assertion (Maybe Conditions)
assConditions ((Maybe Conditions -> f (Maybe Conditions))
 -> Assertion -> f Assertion)
-> ((Conditions -> f Conditions)
    -> Maybe Conditions -> f (Maybe Conditions))
-> (Conditions -> f Conditions)
-> Assertion
-> f Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Conditions -> f Conditions)
-> Maybe Conditions -> f (Maybe Conditions)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just

subjL :: Lens' AuthnResponse Subject
subjL :: Lens' AuthnResponse Subject
subjL = (Assertion -> f Assertion) -> AuthnResponse -> f AuthnResponse
Lens' AuthnResponse Assertion
assertionL ((Assertion -> f Assertion) -> AuthnResponse -> f AuthnResponse)
-> ((Subject -> f Subject) -> Assertion -> f Assertion)
-> (Subject -> f Subject)
-> AuthnResponse
-> f AuthnResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubjectAndStatements -> f SubjectAndStatements)
-> Assertion -> f Assertion
Lens' Assertion SubjectAndStatements
assContents ((SubjectAndStatements -> f SubjectAndStatements)
 -> Assertion -> f Assertion)
-> ((Subject -> f Subject)
    -> SubjectAndStatements -> f SubjectAndStatements)
-> (Subject -> f Subject)
-> Assertion
-> f Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Subject -> f Subject)
-> SubjectAndStatements -> f SubjectAndStatements
Lens' SubjectAndStatements Subject
sasSubject

scdataL :: Traversal' AuthnResponse SubjectConfirmationData
scdataL :: Traversal' AuthnResponse SubjectConfirmationData
scdataL = (Subject -> f Subject) -> AuthnResponse -> f AuthnResponse
Lens' AuthnResponse Subject
subjL ((Subject -> f Subject) -> AuthnResponse -> f AuthnResponse)
-> ((SubjectConfirmationData -> f SubjectConfirmationData)
    -> Subject -> f Subject)
-> (SubjectConfirmationData -> f SubjectConfirmationData)
-> AuthnResponse
-> f AuthnResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SubjectConfirmation] -> f [SubjectConfirmation])
-> Subject -> f Subject
Lens' Subject [SubjectConfirmation]
subjectConfirmations (([SubjectConfirmation] -> f [SubjectConfirmation])
 -> Subject -> f Subject)
-> ((SubjectConfirmationData -> f SubjectConfirmationData)
    -> [SubjectConfirmation] -> f [SubjectConfirmation])
-> (SubjectConfirmationData -> f SubjectConfirmationData)
-> Subject
-> f Subject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index [SubjectConfirmation]
-> Traversal' [SubjectConfirmation] (IxValue [SubjectConfirmation])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index [SubjectConfirmation]
0 ((SubjectConfirmation -> f SubjectConfirmation)
 -> [SubjectConfirmation] -> f [SubjectConfirmation])
-> ((SubjectConfirmationData -> f SubjectConfirmationData)
    -> SubjectConfirmation -> f SubjectConfirmation)
-> (SubjectConfirmationData -> f SubjectConfirmationData)
-> [SubjectConfirmation]
-> f [SubjectConfirmation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe SubjectConfirmationData
 -> f (Maybe SubjectConfirmationData))
-> SubjectConfirmation -> f SubjectConfirmation
Lens' SubjectConfirmation (Maybe SubjectConfirmationData)
scData ((Maybe SubjectConfirmationData
  -> f (Maybe SubjectConfirmationData))
 -> SubjectConfirmation -> f SubjectConfirmation)
-> ((SubjectConfirmationData -> f SubjectConfirmationData)
    -> Maybe SubjectConfirmationData
    -> f (Maybe SubjectConfirmationData))
-> (SubjectConfirmationData -> f SubjectConfirmationData)
-> SubjectConfirmation
-> f SubjectConfirmation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubjectConfirmationData -> f SubjectConfirmationData)
-> Maybe SubjectConfirmationData
-> f (Maybe SubjectConfirmationData)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just

statementL :: Lens' AuthnResponse Statement
statementL :: Lens' AuthnResponse Statement
statementL = (Assertion -> f Assertion) -> AuthnResponse -> f AuthnResponse
Lens' AuthnResponse Assertion
assertionL ((Assertion -> f Assertion) -> AuthnResponse -> f AuthnResponse)
-> ((Statement -> f Statement) -> Assertion -> f Assertion)
-> (Statement -> f Statement)
-> AuthnResponse
-> f AuthnResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SubjectAndStatements -> f SubjectAndStatements)
-> Assertion -> f Assertion
Lens' Assertion SubjectAndStatements
assContents ((SubjectAndStatements -> f SubjectAndStatements)
 -> Assertion -> f Assertion)
-> ((Statement -> f Statement)
    -> SubjectAndStatements -> f SubjectAndStatements)
-> (Statement -> f Statement)
-> Assertion
-> f Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Statement -> f (NonEmpty Statement))
-> SubjectAndStatements -> f SubjectAndStatements
Lens' SubjectAndStatements (NonEmpty Statement)
sasStatements ((NonEmpty Statement -> f (NonEmpty Statement))
 -> SubjectAndStatements -> f SubjectAndStatements)
-> ((Statement -> f Statement)
    -> NonEmpty Statement -> f (NonEmpty Statement))
-> (Statement -> f Statement)
-> SubjectAndStatements
-> f SubjectAndStatements
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Statement -> f Statement)
-> NonEmpty Statement -> f (NonEmpty Statement)
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> NonEmpty a -> f (NonEmpty a)
_nlhead

userRefL :: Getter AuthnResponse UserRef
userRefL :: Getter AuthnResponse UserRef
userRefL = (AuthnResponse -> UserRef) -> Optic' (->) f AuthnResponse UserRef
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((AuthnResponse -> UserRef) -> Optic' (->) f AuthnResponse UserRef)
-> (AuthnResponse -> UserRef)
-> Optic' (->) f AuthnResponse UserRef
forall a b. (a -> b) -> a -> b
$ \AuthnResponse
aresp ->
  let tenant :: Issuer
tenant = AuthnResponse
aresp AuthnResponse -> Getting Issuer AuthnResponse Issuer -> Issuer
forall s a. s -> Getting a s a -> a
^. (Assertion -> Const Issuer Assertion)
-> AuthnResponse -> Const Issuer AuthnResponse
Lens' AuthnResponse Assertion
assertionL ((Assertion -> Const Issuer Assertion)
 -> AuthnResponse -> Const Issuer AuthnResponse)
-> ((Issuer -> Const Issuer Issuer)
    -> Assertion -> Const Issuer Assertion)
-> Getting Issuer AuthnResponse Issuer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Issuer -> Const Issuer Issuer)
-> Assertion -> Const Issuer Assertion
Lens' Assertion Issuer
assIssuer
      subject :: NameID
subject = AuthnResponse
aresp AuthnResponse -> Getting NameID AuthnResponse NameID -> NameID
forall s a. s -> Getting a s a -> a
^. (Subject -> Const NameID Subject)
-> AuthnResponse -> Const NameID AuthnResponse
Lens' AuthnResponse Subject
subjL ((Subject -> Const NameID Subject)
 -> AuthnResponse -> Const NameID AuthnResponse)
-> ((NameID -> Const NameID NameID)
    -> Subject -> Const NameID Subject)
-> Getting NameID AuthnResponse NameID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NameID -> Const NameID NameID) -> Subject -> Const NameID Subject
Lens' Subject NameID
subjectID
   in Issuer -> NameID -> UserRef
UserRef Issuer
tenant NameID
subject