Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- type SP m = (HasConfig m, HasLogger m, HasCreateUUID m, HasNow m)
- class HasLogger m where
- class HasCreateUUID m where
- createUUID :: m UUID
- class HasNow m where
- type SPStore m = (SP m, SPStoreID AuthnRequest m, SPStoreID Assertion m)
- class SPStoreID i m where
- class MonadError err m => SPStoreIdP err m where
- type IdPConfigExtra m :: Type
- type IdPConfigSPId m :: Type
- storeIdPConfig :: IdPConfig (IdPConfigExtra m) -> m ()
- getIdPConfig :: IdPId -> m (IdPConfig (IdPConfigExtra m))
- getIdPConfigByIssuer :: Issuer -> IdPConfigSPId m -> m (IdPConfig (IdPConfigExtra m))
- getIdPConfigByIssuerOptionalSPId :: Issuer -> Maybe (IdPConfigSPId m) -> m (IdPConfig (IdPConfigExtra m))
- class (SP m, SPStore m, SPStoreIdP err m, MonadError err m) => SPHandler err m where
- storeAssertion :: (Monad m, SPStore m) => ID Assertion -> Time -> m Bool
- loggerConfIO :: (HasConfig m, MonadIO m) => Level -> String -> m ()
- loggerIO :: MonadIO m => Level -> Level -> String -> m ()
- createUUIDIO :: MonadIO m => m UUID
- getNowIO :: MonadIO m => m Time
- createID :: (Functor m, SP m) => m (ID a)
- createAuthnRequest :: (Monad m, SP m, SPStore m) => NominalDiffTime -> m Issuer -> m AuthnRequest
- tolerance :: NominalDiffTime
- earlier :: Time -> Time -> Bool
- noLater :: Time -> Time -> Bool
- getSsoURI :: forall m endpoint api. (HasCallStack, Functor m, HasConfig m, IsElem endpoint api, HasLink endpoint, ToHttpApiData (MkLink endpoint)) => Proxy api -> Proxy endpoint -> m URI
- getSsoURI' :: forall endpoint api a (f :: Type -> Type) t. (Functor f, HasConfig f, MkLink endpoint ~ (t -> a), HasLink endpoint, ToHttpApiData a, IsElem endpoint api) => Proxy api -> Proxy endpoint -> t -> f URI
- newtype JudgeT m a = JudgeT {
- fromJudgeT :: ExceptT DeniedReason (WriterT [DeniedReason] (ReaderT JudgeCtx m)) a
- data JudgeCtx = JudgeCtx {}
- judgeCtxResponseURI :: Lens' JudgeCtx URI
- judgeCtxAudience :: Lens' JudgeCtx Issuer
- runJudgeT :: forall m. (Monad m, SP m) => JudgeCtx -> JudgeT m AccessVerdict -> m AccessVerdict
- class (Functor m, Applicative m, Monad m) => MonadJudge m where
- getJudgeCtx :: m JudgeCtx
- deny :: DeniedReason -> m ()
- giveup :: DeniedReason -> m a
- judge :: (Monad m, SP m, SPStore m) => AuthnResponse -> JudgeCtx -> m AccessVerdict
- judge' :: (HasCallStack, MonadJudge m, SP m, SPStore m) => AuthnResponse -> m AccessVerdict
- checkInResponseTo :: (SPStore m, MonadJudge m) => String -> ID AuthnRequest -> m ()
- checkIsInPast :: (SP m, MonadJudge m) => (Time -> Time -> DeniedReason) -> Time -> m ()
- checkDestination :: (HasConfig m, MonadJudge m) => (String -> String -> DeniedReason) -> URI -> m ()
- checkAssertions :: (SP m, SPStore m, MonadJudge m) => Maybe Issuer -> NonEmpty Assertion -> UserRef -> m AccessVerdict
- checkStatement :: (SP m, MonadJudge m) => Statement -> m ()
- checkSubjectConfirmations :: (SP m, SPStore m, MonadJudge m) => [Assertion] -> m ()
- data HasBearerConfirmation
- checkSubjectConfirmation :: (SPStore m, MonadJudge m) => Assertion -> SubjectConfirmation -> m HasBearerConfirmation
- checkSubjectConfirmationData :: (HasConfig m, SP m, SPStore m, MonadJudge m) => SubjectConfirmationData -> m ()
- checkConditions :: forall m. (HasCallStack, MonadJudge m, SP m) => Conditions -> m ()
Documentation
type SP m = (HasConfig m, HasLogger m, HasCreateUUID m, HasNow m) Source #
Application logic of the service provider.
class HasLogger m where Source #
Nothing
class HasCreateUUID m where Source #
Nothing
createUUID :: m UUID Source #
default createUUID :: MonadIO m => m UUID Source #
Instances
HasCreateUUID SimpleSP Source # | |
Defined in SAML2.WebSSO.API.Example | |
HasCreateUUID TestSP Source # | |
Defined in SAML2.WebSSO.Test.Util.TestSP createUUID :: TestSP UUID Source # | |
(Monad m, HasCreateUUID m) => HasCreateUUID (JudgeT m) Source # | |
Defined in SAML2.WebSSO.SP createUUID :: JudgeT m UUID Source # |
Nothing
Instances
class MonadError err m => SPStoreIdP err m where Source #
type IdPConfigExtra m :: Type Source #
type IdPConfigSPId m :: Type Source #
storeIdPConfig :: IdPConfig (IdPConfigExtra m) -> m () Source #
getIdPConfig :: IdPId -> m (IdPConfig (IdPConfigExtra m)) Source #
getIdPConfigByIssuer :: Issuer -> IdPConfigSPId m -> m (IdPConfig (IdPConfigExtra m)) Source #
getIdPConfigByIssuerOptionalSPId :: Issuer -> Maybe (IdPConfigSPId m) -> m (IdPConfig (IdPConfigExtra m)) Source #
Instances
class (SP m, SPStore m, SPStoreIdP err m, MonadError err m) => SPHandler err m where Source #
HTTP handling of the service provider.
createUUIDIO :: MonadIO m => m UUID Source #
createID :: (Functor m, SP m) => m (ID a) Source #
(Microsoft Active Directory likes IDs to be of the form idhex digits
: ID . cs . ("id"
<>) . filter (/=
. Hopefully the more common form
produced by this function is also ok.)-
) . cs . UUID.toText $ createUUID
createAuthnRequest :: (Monad m, SP m, SPStore m) => NominalDiffTime -> m Issuer -> m AuthnRequest Source #
Generate an AuthnRequest
value for the initiate-login response. The NameIdPolicy
is
NameIDFUnspecified
.
We do not use XML encryption (which appears to have been dead for years). We do not sign
AuthnRequest
values. Both encryption and signatures are optional, and rarely found in the
wild. Security: (1) the AuthnReq
ID
is stored, and Assertion
s need to refer to a valid one
in order to get a positive AccessVerdict
by judge
. AuthnResponse
s answering requests not
originating from us will be ignored. (2) the request Issuer
is there to help the IdP construct
an AuthnResponse
that we will accept. If it is changed by an attacker (either in the browser
or on the wire, which is weakly procted by TLS) and passed on to the legitimate IdP, there will
either be no access-granting AuthnResponse
, or it will contain the wrong audience and be
rejected by us. (3) The nameID policy is expected to be configured on the IdP side to not
support any set of name spaces that overlap (e.g. because user A has an email that is the account
name of user B).
tolerance :: NominalDiffTime Source #
The clock drift between IdP and us that we allow for.
FUTUREWORK: make this configurable
earlier :: Time -> Time -> Bool Source #
First arg must be comfortably earlier than the latter: if tolerance
is one minute, then
("4:32:14"
.earlier
"4:31:15") == True
If this returns False
you should be *more* inclined to throw an error, so a good calling
pattern is unless (a
, which is very different from earlier
b) throwSomethingwhen (b
.earlier
a) throwSomething
noLater :: Time -> Time -> Bool Source #
Even though this makes little sense, the standard requires to distinguish between "less"
and "less or equal". For all practical purposes, you may consider noLater == earlier
.
getSsoURI :: forall m endpoint api. (HasCallStack, Functor m, HasConfig m, IsElem endpoint api, HasLink endpoint, ToHttpApiData (MkLink endpoint)) => Proxy api -> Proxy endpoint -> m URI Source #
getSsoURI' :: forall endpoint api a (f :: Type -> Type) t. (Functor f, HasConfig f, MkLink endpoint ~ (t -> a), HasLink endpoint, ToHttpApiData a, IsElem endpoint api) => Proxy api -> Proxy endpoint -> t -> f URI Source #
This monad collects errors in a writer, so that the reasons for access denial are as helpful as possible. It is a little like an exception monad, except you can throw several exceptions without interrupting the flow, and will get a list of them at the end.
NOTE: -XGeneralizedNewtypeDeriving
does not help with the boilerplate instances below, since
this is a transformer stack and not a concrete Monad
.
JudgeT | |
|
Instances
(Monad m, SPStoreID i m) => SPStoreID (i :: k) (JudgeT m) Source # | |
(Functor m, Applicative m, Monad m) => Applicative (JudgeT m) Source # | |
(Functor m, Applicative m, Monad m) => Functor (JudgeT m) Source # | |
(Functor m, Applicative m, Monad m) => Monad (JudgeT m) Source # | |
(Monad m, HasConfig m) => HasConfig (JudgeT m) Source # | |
(Monad m, HasCreateUUID m) => HasCreateUUID (JudgeT m) Source # | |
Defined in SAML2.WebSSO.SP createUUID :: JudgeT m UUID Source # | |
(Monad m, HasLogger m) => HasLogger (JudgeT m) Source # | |
(Monad m, HasNow m) => HasNow (JudgeT m) Source # | |
(Functor m, Applicative m, Monad m) => MonadJudge (JudgeT m) Source # | |
Defined in SAML2.WebSSO.SP getJudgeCtx :: JudgeT m JudgeCtx Source # deny :: DeniedReason -> JudgeT m () Source # giveup :: DeniedReason -> JudgeT m a Source # |
Note on security: we assume that the SP has only one audience, which is defined here. If you
have different sub-services running on your SP, associate a dedicated IdP with each sub-service.
(To be more specific, construct AuthnReq
s to different IdPs for each sub-service.) Secure
association with the service can then be guaranteed via the Issuer
in the signed Assertion
.
runJudgeT :: forall m. (Monad m, SP m) => JudgeCtx -> JudgeT m AccessVerdict -> m AccessVerdict Source #
class (Functor m, Applicative m, Monad m) => MonadJudge m where Source #
getJudgeCtx :: m JudgeCtx Source #
deny :: DeniedReason -> m () Source #
giveup :: DeniedReason -> m a Source #
Instances
(Functor m, Applicative m, Monad m) => MonadJudge (JudgeT m) Source # | |
Defined in SAML2.WebSSO.SP getJudgeCtx :: JudgeT m JudgeCtx Source # deny :: DeniedReason -> JudgeT m () Source # giveup :: DeniedReason -> JudgeT m a Source # |
judge :: (Monad m, SP m, SPStore m) => AuthnResponse -> JudgeCtx -> m AccessVerdict Source #
- 3/4.1.4.2
- , [3/4.1.4.3]; specific to active-directory: https://docs.microsoft.com/en-us/azure/active-directory/develop/active-directory-single-sign-on-protocol-reference
judge
does not consider the following parts of the AuthnResponse
.
* subjectID
* scdAddress
("If any bearer SubjectConfirmationData includes an Address attribute, the
service provider MAY check the user agent's client address against it." [3/4.1.4.3])
* astSessionIndex
* astSubjectLocality
("This element is entirely advisory, since both of these fields are
quite easily “spoofed,” but may be useful information in some applications." [1/2.7.2.1])
judge
does check the rspStatus
field, even though that makes no sense: most IdPs encrypt the
Assertion
s, but not the entire response, and we make taht an assumption when validating
signatures. So the status info is not signed, and could easily be changed by an attacker
attempting to authenticate.
judge' :: (HasCallStack, MonadJudge m, SP m, SPStore m) => AuthnResponse -> m AccessVerdict Source #
checkInResponseTo :: (SPStore m, MonadJudge m) => String -> ID AuthnRequest -> m () Source #
checkIsInPast :: (SP m, MonadJudge m) => (Time -> Time -> DeniedReason) -> Time -> m () Source #
checkDestination :: (HasConfig m, MonadJudge m) => (String -> String -> DeniedReason) -> URI -> m () Source #
Check that the response is intended for us (based on config's finalize-login uri stored in
JudgeCtx
).
checkAssertions :: (SP m, SPStore m, MonadJudge m) => Maybe Issuer -> NonEmpty Assertion -> UserRef -> m AccessVerdict Source #
checkStatement :: (SP m, MonadJudge m) => Statement -> m () Source #
checkSubjectConfirmations :: (SP m, SPStore m, MonadJudge m) => [Assertion] -> m () Source #
Check all SubjectConfirmation
s and Subject
s in all Assertion
. Deny if not at least one
confirmation has method "bearer".
data HasBearerConfirmation Source #
Instances
checkSubjectConfirmation :: (SPStore m, MonadJudge m) => Assertion -> SubjectConfirmation -> m HasBearerConfirmation Source #
Locally check one SubjectConfirmation
and deny if there is a problem. If this is a
confirmation of method "bearer", return HasBearerConfirmation
.
checkSubjectConfirmationData :: (HasConfig m, SP m, SPStore m, MonadJudge m) => SubjectConfirmationData -> m () Source #
checkConditions :: forall m. (HasCallStack, MonadJudge m, SP m) => Conditions -> m () Source #