Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- type JWT = SignedJWT
- type Keycloak a = KeycloakT IO a
- newtype KeycloakT m a = KeycloakT {
- unKeycloakT :: ReaderT KCConfig (ExceptT KCError m) a
- data KCError
- data KCConfig = KCConfig {}
- type Realm = Text
- type ClientId = Text
- type ServerURL = Text
- data AdapterConfig = AdapterConfig {}
- data ClientCredentials = ClientCredentials {
- _confSecret :: Text
- trainDrop :: Int -> Options
- defaultAdapterConfig :: AdapterConfig
- runKeycloak :: Monad m => KeycloakT m a -> KCConfig -> m (Either KCError a)
- type Path = Text
- data TokenRep = TokenRep {
- accessToken :: Text
- expiresIn :: Int
- refreshExpriresIn :: Int
- refreshToken :: Text
- tokenType :: Text
- notBeforePolicy :: Int
- sessionState :: Text
- tokenScope :: Text
- newtype ScopeName = ScopeName {
- unScopeName :: Text
- newtype ScopeId = ScopeId {}
- data Scope = Scope {}
- data PermReq = PermReq {}
- data Permission = Permission {}
- type Username = Text
- type Password = Text
- type First = Int
- type Max = Int
- newtype UserId = UserId {}
- data User = User {
- userId :: Maybe UserId
- userUsername :: Username
- userFirstName :: Maybe Text
- userLastName :: Maybe Text
- userEmail :: Maybe Text
- userAttributes :: Maybe (Map Text Value)
- unCapitalize :: String -> String
- data Owner = Owner {}
- type ResourceName = Text
- type ResourceType = Text
- newtype ResourceId = ResourceId {}
- data Resource = Resource {
- resId :: Maybe ResourceId
- resName :: ResourceName
- resType :: Maybe ResourceType
- resUris :: [Text]
- resScopes :: [Scope]
- resOwner :: Owner
- resOwnerManagedAccess :: Bool
- resAttributes :: [Attribute]
- data Attribute = Attribute {}
- confJWKs :: Lens' KCConfig [JWK]
- confAdapterConfig :: Lens' KCConfig AdapterConfig
- confSecret :: Iso' ClientCredentials Text
- confResource :: Lens' AdapterConfig ClientId
- confRealm :: Lens' AdapterConfig Realm
- confCredentials :: Lens' AdapterConfig ClientCredentials
- confAuthServerUrl :: Lens' AdapterConfig ServerURL
Documentation
Keycloak Monad
type Keycloak a = KeycloakT IO a Source #
Keycloak Monad stack: a simple Reader monad containing the config, and an ExceptT to handle HTTPErrors and parse errors.
You can extract the value using runKeycloak
.
Example: keys <- runKeycloak getJWKs defaultKCConfig
newtype KeycloakT m a Source #
Instances
MonadTrans KeycloakT Source # | |
Defined in Keycloak.Types | |
MonadIO m => MonadIO (KeycloakT m) Source # | |
Defined in Keycloak.Types | |
Monad m => Applicative (KeycloakT m) Source # | |
Defined in Keycloak.Types | |
Functor m => Functor (KeycloakT m) Source # | |
Monad m => Monad (KeycloakT m) Source # | |
MonadTime m => MonadTime (KeycloakT m) Source # | |
Defined in Keycloak.Types currentTime :: KeycloakT m UTCTime # monotonicTime :: KeycloakT m Double # |
Contains HTTP errors and parse errors.
HTTPError HttpException | Keycloak returned an HTTP error. |
ParseError Text | Failed when parsing the response |
JWTError JWTError | Failed to decode the token |
EmptyError | Empty error to serve as a zero element for Monoid. |
Instances
Instances
Generic KCConfig Source # | |
Show KCConfig Source # | |
Eq KCConfig Source # | |
type Rep KCConfig Source # | |
Defined in Keycloak.Types type Rep KCConfig = D1 ('MetaData "KCConfig" "Keycloak.Types" "keycloak-hs-3.0.2-1D5hbGS3N1dGc3ClrNAkve" 'False) (C1 ('MetaCons "KCConfig" 'PrefixI 'True) (S1 ('MetaSel ('Just "_confAdapterConfig") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 AdapterConfig) :*: S1 ('MetaSel ('Just "_confJWKs") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [JWK]))) |
data AdapterConfig Source #
Configuration of Keycloak.
AdapterConfig | |
|
Instances
data ClientCredentials Source #
Instances
defaultAdapterConfig :: AdapterConfig Source #
Default configuration
runKeycloak :: Monad m => KeycloakT m a -> KCConfig -> m (Either KCError a) Source #
Run a Keycloak monad within IO.
Token
Token reply from Keycloak
TokenRep | |
|
Permissions
Scope name, such as "houses:view" You need to create the scopes in ClientAuthorization panelAuthorization scopes tab
Instances
FromJSON ScopeName Source # | |
ToJSON ScopeName Source # | |
Defined in Keycloak.Types | |
Generic ScopeName Source # | |
Show ScopeName Source # | |
Eq ScopeName Source # | |
Ord ScopeName Source # | |
Defined in Keycloak.Types | |
Hashable ScopeName Source # | |
Defined in Keycloak.Types | |
type Rep ScopeName Source # | |
Defined in Keycloak.Types |
Scope Id
Keycloak scope
Instances
FromJSON Scope Source # | |
ToJSON Scope Source # | |
Defined in Keycloak.Types | |
Generic Scope Source # | |
Show Scope Source # | |
Eq Scope Source # | |
type Rep Scope Source # | |
Defined in Keycloak.Types type Rep Scope = D1 ('MetaData "Scope" "Keycloak.Types" "keycloak-hs-3.0.2-1D5hbGS3N1dGc3ClrNAkve" 'False) (C1 ('MetaCons "Scope" 'PrefixI 'True) (S1 ('MetaSel ('Just "scopeId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe ScopeId)) :*: S1 ('MetaSel ('Just "scopeName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ScopeName))) |
permission request You can perform a request on a specific resourse, or on all resources. You can request permission on multiple scopes at once.
PermReq | |
|
Instances
Generic PermReq Source # | |
Show PermReq Source # | |
Eq PermReq Source # | |
Ord PermReq Source # | |
Hashable PermReq Source # | |
Defined in Keycloak.Types | |
type Rep PermReq Source # | |
Defined in Keycloak.Types type Rep PermReq = D1 ('MetaData "PermReq" "Keycloak.Types" "keycloak-hs-3.0.2-1D5hbGS3N1dGc3ClrNAkve" 'False) (C1 ('MetaCons "PermReq" 'PrefixI 'True) (S1 ('MetaSel ('Just "permReqResourceId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe ResourceId)) :*: S1 ('MetaSel ('Just "permReqScopes") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [ScopeName]))) |
data Permission Source #
Keycloak permission on a resource Returned by Keycloak after a permission request is made.
Permission | |
|
Instances
User
Id of a user
User
User | |
|
Instances
unCapitalize :: String -> String Source #
Owner
A resource owner
Instances
FromJSON Owner Source # | |
ToJSON Owner Source # | |
Defined in Keycloak.Types | |
Generic Owner Source # | |
Show Owner Source # | |
type Rep Owner Source # | |
Defined in Keycloak.Types type Rep Owner = D1 ('MetaData "Owner" "Keycloak.Types" "keycloak-hs-3.0.2-1D5hbGS3N1dGc3ClrNAkve" 'False) (C1 ('MetaCons "Owner" 'PrefixI 'True) (S1 ('MetaSel ('Just "ownId") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)) :*: S1 ('MetaSel ('Just "ownName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Username)))) |
Resource
type ResourceName = Text Source #
type ResourceType = Text Source #
newtype ResourceId Source #
A resource Id
Instances
A complete resource Resources are created in Keycloak in Client/ You can create resources in ClientAuthorization panelResources scopes tab
Resource | |
|
Instances
A resource attribute
Instances
FromJSON Attribute Source # | |
ToJSON Attribute Source # | |
Defined in Keycloak.Types | |
Generic Attribute Source # | |
Show Attribute Source # | |
type Rep Attribute Source # | |
Defined in Keycloak.Types type Rep Attribute = D1 ('MetaData "Attribute" "Keycloak.Types" "keycloak-hs-3.0.2-1D5hbGS3N1dGc3ClrNAkve" 'False) (C1 ('MetaCons "Attribute" 'PrefixI 'True) (S1 ('MetaSel ('Just "attName") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Just "attValues") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Text]))) |