Copyright | (c) Anton Gushcha 2016 |
---|---|
License | MIT |
Maintainer | ncrashed@gmail.com |
Stability | experimental |
Portability | Portable |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- type AuthAPI = AuthSigninMethod :<|> (AuthSigninPostMethod :<|> (AuthSigninGetCodeMethod :<|> (AuthSigninPostCodeMethod :<|> (AuthTouchMethod :<|> (AuthTokenInfoMethod :<|> (AuthSignoutMethod :<|> (AuthSignupMethod :<|> (AuthUsersMethod :<|> (AuthGetUserMethod :<|> (AuthPatchUserMethod :<|> (AuthPutUserMethod :<|> (AuthDeleteUserMethod :<|> (AuthRestoreMethod :<|> (AuthGetSingleUseCodes :<|> (AuthGetGroupMethod :<|> (AuthPostGroupMethod :<|> (AuthPutGroupMethod :<|> (AuthPatchGroupMethod :<|> (AuthDeleteGroupMethod :<|> (AuthGroupsMethod :<|> (AuthCheckPermissionsMethod :<|> (AuthGetUserIdMethod :<|> AuthFindUserByLogin))))))))))))))))))))))
- type AuthSigninMethod = "auth" :> ("signin" :> (QueryParam "login" Login :> (QueryParam "password" Password :> (QueryParam "expire" Seconds :> Get '[JSON] (OnlyField "token" SimpleToken)))))
- type AuthSigninPostMethod = "auth" :> ("signin" :> (ReqBody '[JSON] AuthSigninPostBody :> Post '[JSON] (OnlyField "token" SimpleToken)))
- type AuthSigninGetCodeMethod = "auth" :> ("signin" :> ("code" :> (QueryParam "login" Login :> Get '[JSON] Unit)))
- type AuthSigninPostCodeMethod = "auth" :> ("signin" :> ("code" :> (QueryParam "login" Login :> (QueryParam "code" SingleUseCode :> (QueryParam "expire" Seconds :> Post '[JSON] (OnlyField "token" SimpleToken))))))
- type AuthTouchMethod = "auth" :> ("touch" :> (QueryParam "expire" Seconds :> (TokenHeader '[] :> Post '[JSON] Unit)))
- type AuthTokenInfoMethod = "auth" :> ("token" :> (TokenHeader '[] :> Get '[JSON] RespUserInfo))
- type AuthSignoutMethod = "auth" :> ("signout" :> (TokenHeader '[] :> Post '[JSON] Unit))
- type AuthSignupMethod = "auth" :> ("signup" :> (ReqBody '[JSON] ReqRegister :> (TokenHeader' '["auth-register"] :> Post '[JSON] (OnlyField "user" UserId))))
- type AuthUsersMethod = "auth" :> ("users" :> (PageParam :> (PageSizeParam :> (TokenHeader' '["auth-info"] :> Get '[JSON] RespUsersInfo))))
- type AuthGetUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (TokenHeader' '["auth-info"] :> Get '[JSON] RespUserInfo)))
- type AuthPatchUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (ReqBody '[JSON] PatchUser :> (TokenHeader' '["auth-update"] :> Patch '[JSON] Unit))))
- type AuthPutUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (ReqBody '[JSON] ReqRegister :> (TokenHeader' '["auth-update"] :> Put '[JSON] Unit))))
- type AuthDeleteUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (TokenHeader' '["auth-delete"] :> Delete '[JSON] Unit)))
- type AuthRestoreMethod = "auth" :> ("restore" :> (Capture "user-id" UserId :> (QueryParam "code" RestoreCode :> (QueryParam "password" Password :> Post '[JSON] Unit))))
- type AuthGetSingleUseCodes = "auth" :> ("codes" :> (Capture "user-id" UserId :> (QueryParam "codes-count" Word :> (TokenHeader' '["auth-single-codes"] :> Get '[JSON] (OnlyField "codes" [SingleUseCode])))))
- type AuthGetGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (TokenHeader' '["auth-info"] :> Get '[JSON] UserGroup)))
- type AuthPostGroupMethod = "auth" :> ("group" :> (ReqBody '[JSON] UserGroup :> (TokenHeader' '["auth-update"] :> Post '[JSON] (OnlyId UserGroupId))))
- type AuthPutGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (ReqBody '[JSON] UserGroup :> (TokenHeader' '["auth-update"] :> Put '[JSON] Unit))))
- type AuthPatchGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (ReqBody '[JSON] PatchUserGroup :> (TokenHeader' '["auth-update"] :> Patch '[JSON] Unit))))
- type AuthDeleteGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (TokenHeader' '["auth-delete"] :> Delete '[JSON] Unit)))
- type AuthGroupsMethod = "auth" :> ("group" :> (PageParam :> (PageSizeParam :> (TokenHeader' '["auth-info"] :> Get '[JSON] (PagedList UserGroupId UserGroup)))))
- type AuthCheckPermissionsMethod = "auth" :> ("check" :> (TokenHeader' '["auth-check"] :> (ReqBody '[JSON] (OnlyField "permissions" [Permission]) :> Post '[JSON] Bool)))
- type AuthGetUserIdMethod = "auth" :> ("userid" :> (TokenHeader' '["auth-userid"] :> Get '[JSON] (OnlyId UserId)))
- authAPI :: Proxy AuthAPI
- authDocs :: API
- data PermSymbol
- class UnliftPermSymbol (s :: PermSymbol) where
- unliftPermSymbol :: Proxy s -> String
- class PermsList (a :: [PermSymbol]) where
- unliftPerms :: forall proxy. proxy a -> [Permission]
- type family PlainPerms (p :: [Symbol]) :: [PermSymbol] where ...
- newtype Token (perms :: [PermSymbol]) = Token {}
- type Token' (perms :: [Symbol]) = Token (PlainPerms perms)
- type MToken (perms :: [PermSymbol]) = Maybe (Token perms)
- type MToken' (perms :: [Symbol]) = MToken (PlainPerms perms)
- type TokenHeader (perms :: [PermSymbol]) = Header "Authorization" (Token perms)
- type TokenHeader' (perms :: [Symbol]) = TokenHeader (PlainPerms perms)
- type SimpleToken = Text
- downgradeToken' :: True ~ PermsSubset ts' ts => Token ts -> Token ts'
- downgradeToken :: True ~ PermsSubset ts' ts => MToken ts -> MToken ts'
- type UserId = Word
- type Login = Text
- type Password = Text
- type Email = Text
- type Permission = Text
- type Seconds = Word
- type RestoreCode = Text
- type SingleUseCode = Text
- data ReqRegister = ReqRegister {
- reqRegLogin :: !Login
- reqRegPassword :: !Password
- reqRegEmail :: !Email
- reqRegPermissions :: ![Permission]
- reqRegGroups :: !(Maybe [UserGroupId])
- data RespUserInfo = RespUserInfo {
- respUserId :: !UserId
- respUserLogin :: !Login
- respUserEmail :: !Email
- respUserPermissions :: ![Permission]
- respUserGroups :: ![UserGroupId]
- data PatchUser = PatchUser {
- patchUserLogin :: !(Maybe Login)
- patchUserPassword :: !(Maybe Password)
- patchUserEmail :: !(Maybe Email)
- patchUserPermissions :: !(Maybe [Permission])
- patchUserGroups :: !(Maybe [UserGroupId])
- data RespUsersInfo = RespUsersInfo {
- respUsersItems :: ![RespUserInfo]
- respUsersPages :: !Word
- data AuthSigninPostBody = AuthSigninPostBody {}
- type UserGroupId = Word
- data UserGroup = UserGroup {
- userGroupName :: !Text
- userGroupUsers :: ![UserId]
- userGroupPermissions :: ![Permission]
- userGroupParent :: !(Maybe UserGroupId)
- data PatchUserGroup = PatchUserGroup {
- patchUserGroupName :: !(Maybe Text)
- patchUserGroupUsers :: !(Maybe [UserId])
- patchUserGroupPermissions :: !(Maybe [Permission])
- patchUserGroupParent :: !(Maybe UserGroupId)
- patchUserGroupNoParent :: !(Maybe Bool)
- adminPerm :: Permission
- authCheckPerm :: Permission
- authDeletePerm :: Permission
- authInfoPerm :: Permission
- authUpdatePerm :: Permission
- authUserIdPerm :: Permission
- registerPerm :: Permission
- authOperations :: Traversal' Swagger Operation
API specs
type AuthAPI = AuthSigninMethod :<|> (AuthSigninPostMethod :<|> (AuthSigninGetCodeMethod :<|> (AuthSigninPostCodeMethod :<|> (AuthTouchMethod :<|> (AuthTokenInfoMethod :<|> (AuthSignoutMethod :<|> (AuthSignupMethod :<|> (AuthUsersMethod :<|> (AuthGetUserMethod :<|> (AuthPatchUserMethod :<|> (AuthPutUserMethod :<|> (AuthDeleteUserMethod :<|> (AuthRestoreMethod :<|> (AuthGetSingleUseCodes :<|> (AuthGetGroupMethod :<|> (AuthPostGroupMethod :<|> (AuthPutGroupMethod :<|> (AuthPatchGroupMethod :<|> (AuthDeleteGroupMethod :<|> (AuthGroupsMethod :<|> (AuthCheckPermissionsMethod :<|> (AuthGetUserIdMethod :<|> AuthFindUserByLogin)))))))))))))))))))))) Source #
Generic authorization API
type AuthSigninMethod = "auth" :> ("signin" :> (QueryParam "login" Login :> (QueryParam "password" Password :> (QueryParam "expire" Seconds :> Get '[JSON] (OnlyField "token" SimpleToken))))) Source #
Deprecated: AuthSigninPostMethod is more secure
How to get a token, expire of Nothing
means
some default value (server config).
Logic of authorisation via this method is:
- Client sends GET request to the endpoint with user specified login and password and optional expire
- Server responds with token or error
- Client uses the token with other requests as authorisation header
- Client can extend lifetime of token by periodically pinging
of
AuthTouchMethod
endpoint - Client can invalidate token instantly by
AuthSignoutMethod
- Client can get info about user with
AuthTokenInfoMethod
endpoint.
type AuthSigninPostMethod = "auth" :> ("signin" :> (ReqBody '[JSON] AuthSigninPostBody :> Post '[JSON] (OnlyField "token" SimpleToken))) Source #
How to get a token, expire of Nothing
means
some default value (server config).
Logic of authorisation via this method is:
- Client sends POST request to the endpoint with user specified login and password and optional expire
- Server responds with token or error
- Client uses the token with other requests as authorisation header
- Client can extend lifetime of token by periodically pinging
of
AuthTouchMethod
endpoint - Client can invalidate token instantly by
AuthSignoutMethod
- Client can get info about user with
AuthTokenInfoMethod
endpoint.
type AuthSigninGetCodeMethod = "auth" :> ("signin" :> ("code" :> (QueryParam "login" Login :> Get '[JSON] Unit))) Source #
Authorisation via code of single usage.
Logic of authorisation via this method is:
- Client sends GET request to
AuthSigninGetCodeMethod
endpoint - Server generates single use token and sends it via SMS or email (server specific implementation)
- Client sends POST request to
AuthSigninPostCodeMethod
endpoint - Server responds with auth token.
- Client uses the token with other requests as authorisation header
- Client can extend lifetime of token by periodically pinging
of
AuthTouchMethod
endpoint - Client can invalidate token instantly by
AuthSignoutMethod
- Client can get info about user with
AuthTokenInfoMethod
endpoint.
type AuthSigninPostCodeMethod = "auth" :> ("signin" :> ("code" :> (QueryParam "login" Login :> (QueryParam "code" SingleUseCode :> (QueryParam "expire" Seconds :> Post '[JSON] (OnlyField "token" SimpleToken)))))) Source #
Authorisation via code of single usage.
Logic of authorisation via this method is:
- Client sends GET request to
AuthSigninGetCodeMethod
endpoint - Server generates single use token and sends it via SMS or email (server specific implementation)
- Client sends POST request to
AuthSigninPostCodeMethod
endpoint - Server responds with auth token.
- Client uses the token with other requests as authorisation header
- Client can extend lifetime of token by periodically pinging
of
AuthTouchMethod
endpoint - Client can invalidate token instantly by
AuthSignoutMethod
- Client can get info about user with
AuthTokenInfoMethod
endpoint.
type AuthTouchMethod = "auth" :> ("touch" :> (QueryParam "expire" Seconds :> (TokenHeader '[] :> Post '[JSON] Unit))) Source #
Client cat expand the token lifetime, no permissions are required
type AuthTokenInfoMethod = "auth" :> ("token" :> (TokenHeader '[] :> Get '[JSON] RespUserInfo)) Source #
Get client info that is binded to the token
type AuthSignoutMethod = "auth" :> ("signout" :> (TokenHeader '[] :> Post '[JSON] Unit)) Source #
Close session, after call of the method the token in header is not valid.
type AuthSignupMethod = "auth" :> ("signup" :> (ReqBody '[JSON] ReqRegister :> (TokenHeader' '["auth-register"] :> Post '[JSON] (OnlyField "user" UserId)))) Source #
Creation of new user, requires registerPerm
for token
type AuthUsersMethod = "auth" :> ("users" :> (PageParam :> (PageSizeParam :> (TokenHeader' '["auth-info"] :> Get '[JSON] RespUsersInfo)))) Source #
Getting list of all users, requires authInfoPerm
for token
type AuthGetUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (TokenHeader' '["auth-info"] :> Get '[JSON] RespUserInfo))) Source #
Getting info about user, requires authInfoPerm
for token
type AuthPatchUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (ReqBody '[JSON] PatchUser :> (TokenHeader' '["auth-update"] :> Patch '[JSON] Unit)))) Source #
Updating loginemailpassword, requires authUpdatePerm
for token
type AuthPutUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (ReqBody '[JSON] ReqRegister :> (TokenHeader' '["auth-update"] :> Put '[JSON] Unit)))) Source #
Replace user with the user in the body, requires authUpdatePerm
for token
type AuthDeleteUserMethod = "auth" :> ("user" :> (Capture "user-id" UserId :> (TokenHeader' '["auth-delete"] :> Delete '[JSON] Unit))) Source #
Delete user from DB, requires authDeletePerm
and will cause cascade
deletion, that is your usually want
type AuthRestoreMethod = "auth" :> ("restore" :> (Capture "user-id" UserId :> (QueryParam "code" RestoreCode :> (QueryParam "password" Password :> Post '[JSON] Unit)))) Source #
Generate new password for user. There is two phases, first, the method
is called without code
parameter. The system sends email with a restore code
to user email or sms (its depends on server). After that a call of the method
with the code is needed to change password.
type AuthGetSingleUseCodes = "auth" :> ("codes" :> (Capture "user-id" UserId :> (QueryParam "codes-count" Word :> (TokenHeader' '["auth-single-codes"] :> Get '[JSON] (OnlyField "codes" [SingleUseCode]))))) Source #
Generate single usage codes that user can write down and use later for emergency authorisation.
Nothing
for "codes-count" parameter means some default value defined by server. Server
can restrict maximum count of such codes.
Server should invalidate previous codes on subsequent calls of the endpoint.
Special authorisation tag can be used to disable the feature, merely don't give the tag to users and they won't be able to generate codes.
See also: AuthSigninPostCodeMethod
for utilisation of the codes.
type AuthGetGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (TokenHeader' '["auth-info"] :> Get '[JSON] UserGroup))) Source #
Getting info about user group, requires authInfoPerm
for token
type AuthPostGroupMethod = "auth" :> ("group" :> (ReqBody '[JSON] UserGroup :> (TokenHeader' '["auth-update"] :> Post '[JSON] (OnlyId UserGroupId)))) Source #
Inserting new user group, requires authUpdatePerm
for token
type AuthPutGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (ReqBody '[JSON] UserGroup :> (TokenHeader' '["auth-update"] :> Put '[JSON] Unit)))) Source #
Replace info about given user group, requires authUpdatePerm
for token
type AuthPatchGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (ReqBody '[JSON] PatchUserGroup :> (TokenHeader' '["auth-update"] :> Patch '[JSON] Unit)))) Source #
Patch info about given user group, requires authUpdatePerm
for token
type AuthDeleteGroupMethod = "auth" :> ("group" :> (Capture "group-id" UserGroupId :> (TokenHeader' '["auth-delete"] :> Delete '[JSON] Unit))) Source #
Delete all info about given user group, requires authDeletePerm
for token
type AuthGroupsMethod = "auth" :> ("group" :> (PageParam :> (PageSizeParam :> (TokenHeader' '["auth-info"] :> Get '[JSON] (PagedList UserGroupId UserGroup))))) Source #
Get list of user groups, requires authInfoPerm
for token
type AuthCheckPermissionsMethod = "auth" :> ("check" :> (TokenHeader' '["auth-check"] :> (ReqBody '[JSON] (OnlyField "permissions" [Permission]) :> Post '[JSON] Bool))) Source #
Check permissions of the token, if the passed token doesn't have permissions
that are passed via body, server returns False
. 401 status is returned
if the token owner is not permitted to check self permissions.
type AuthGetUserIdMethod = "auth" :> ("userid" :> (TokenHeader' '["auth-userid"] :> Get '[JSON] (OnlyId UserId))) Source #
Get the user id of the owner of specified token. 401 error is raised if the token doesn't have 'auth-userid' token.
authAPI :: Proxy AuthAPI Source #
Proxy type for auth API, used to pass the type-level info into client/docs generation functions
Servant.Docs documentation of the Auth API
Permission symbol
data PermSymbol Source #
Type level permission type that allows to construct complex permission labels
Instances
PermsList ([] :: [PermSymbol]) Source # | |
Defined in Servant.API.Auth.Token unliftPerms :: proxy [] -> [Permission] Source # | |
(UnliftPermSymbol x, PermsList xs) => PermsList (x ': xs) Source # | |
Defined in Servant.API.Auth.Token unliftPerms :: proxy (x ': xs) -> [Permission] Source # |
class UnliftPermSymbol (s :: PermSymbol) where Source #
Convertation of permission symbol into runtim string
unliftPermSymbol :: Proxy s -> String Source #
Instances
KnownSymbol s => UnliftPermSymbol (PermLabel s) Source # | |
Defined in Servant.API.Auth.Token | |
(UnliftPermSymbol p1, UnliftPermSymbol p2) => UnliftPermSymbol (PermConcat p1 p2) Source # | |
Defined in Servant.API.Auth.Token unliftPermSymbol :: Proxy (PermConcat p1 p2) -> String Source # |
class PermsList (a :: [PermSymbol]) where Source #
Unlifting compile-time permissions into list of run-time permissions
unliftPerms :: forall proxy. proxy a -> [Permission] Source #
Instances
PermsList ([] :: [PermSymbol]) Source # | |
Defined in Servant.API.Auth.Token unliftPerms :: proxy [] -> [Permission] Source # | |
(UnliftPermSymbol x, PermsList xs) => PermsList (x ': xs) Source # | |
Defined in Servant.API.Auth.Token unliftPerms :: proxy (x ': xs) -> [Permission] Source # |
type family PlainPerms (p :: [Symbol]) :: [PermSymbol] where ... Source #
Helper type family to wrap all symbols into PermLabel
PlainPerms '[] = '[] | |
PlainPerms (s ': ss) = PermLabel s ': PlainPerms ss |
Token
newtype Token (perms :: [PermSymbol]) Source #
Token is simple string marked by permissions that are expected from the token to pass guarding functions.
Instances
Eq (Token perms) Source # | |
Show (Token perms) Source # | |
ToHttpApiData (Token perms) Source # | |
Defined in Servant.API.Auth.Token toUrlPiece :: Token perms -> Text # toEncodedUrlPiece :: Token perms -> Builder # toHeader :: Token perms -> ByteString # toQueryParam :: Token perms -> Text # | |
FromHttpApiData (Token perms) Source # | |
Defined in Servant.API.Auth.Token parseUrlPiece :: Text -> Either Text (Token perms) # parseHeader :: ByteString -> Either Text (Token perms) # | |
ToSample (Token perms) Source # | |
ToParamSchema (Token perms) Source # | |
Defined in Servant.API.Auth.Token toParamSchema :: Proxy (Token perms) -> ParamSchema t # |
type Token' (perms :: [Symbol]) = Token (PlainPerms perms) Source #
Token is simple string marked by permissions that are expected from the token to pass guarding functions.
Simplified version that takes plain symbols as permissions.
type MToken (perms :: [PermSymbol]) = Maybe (Token perms) Source #
Shortcut for Maybe Token with attached permissions
type MToken' (perms :: [Symbol]) = MToken (PlainPerms perms) Source #
Shortcut for Maybe Token with attached permissions
Simplified version that takes plain symbols as permissions.
type TokenHeader (perms :: [PermSymbol]) = Header "Authorization" (Token perms) Source #
Token header that we require for authorization marked by permissions that are expected from the token to pass guarding functions.
type TokenHeader' (perms :: [Symbol]) = TokenHeader (PlainPerms perms) Source #
Token header that we require for authorization marked by permissions that are expected from the token to pass guarding functions.
Simplified version that takes plain symbols as permissions.
type SimpleToken = Text Source #
Token that doesn't have attached compile-time permissions
downgradeToken' :: True ~ PermsSubset ts' ts => Token ts -> Token ts' Source #
Cast token to permissions that are lower than original one
The cast is safe, the permissions are cheked on compile time.
downgradeToken :: True ~ PermsSubset ts' ts => MToken ts -> MToken ts' Source #
Cast token to permissions that are lower than original one.
The cast is safe, the permissions are cheked on compile time.
User
type Permission = Text Source #
Special tag for a permission that a user has
type RestoreCode = Text Source #
Special tag for password restore
type SingleUseCode = Text Source #
Single use code used for authorisation via AuthSigninGetCodeMethod
and
AuthSigninPostCodeMethod
endpoints
data ReqRegister Source #
Request body for user registration
ReqRegister | |
|
Instances
data RespUserInfo Source #
Response with user info
RespUserInfo | |
|
Instances
Request body for patching user
PatchUser | |
|
Instances
data RespUsersInfo Source #
Response with users info and pagination
Instances
data AuthSigninPostBody Source #
Body for AuthSigninPostMethod
AuthSigninPostBody | |
|
Instances
User groups
type UserGroupId = Word Source #
Id of user group
Data of user group, groups allows to group permissions and assign them to particular users in batch manner.
Also a group hierarchy can be formed.
UserGroup | |
|
Instances
Show UserGroup Source # | |
Generic UserGroup Source # | |
ToJSON UserGroup Source # | |
Defined in Servant.API.Auth.Token | |
FromJSON UserGroup Source # | |
ToSchema UserGroup Source # | |
Defined in Servant.API.Auth.Token | |
ToSample UserGroup Source # | |
type Rep UserGroup Source # | |
Defined in Servant.API.Auth.Token type Rep UserGroup = D1 (MetaData "UserGroup" "Servant.API.Auth.Token" "servant-auth-token-api-0.5.4.0-inplace" False) (C1 (MetaCons "UserGroup" PrefixI True) ((S1 (MetaSel (Just "userGroupName") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Text) :*: S1 (MetaSel (Just "userGroupUsers") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 [UserId])) :*: (S1 (MetaSel (Just "userGroupPermissions") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 [Permission]) :*: S1 (MetaSel (Just "userGroupParent") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe UserGroupId))))) |
data PatchUserGroup Source #
Data type that is used to patch UserGroup
PatchUserGroup | |
|
Instances
Default permissions
adminPerm :: Permission Source #
Permission that allows everything by default
authCheckPerm :: Permission Source #
Permission that allows to check permissions of token that has the permission.
authDeletePerm :: Permission Source #
Permission that allows to delete users and cause cascade deletion
authInfoPerm :: Permission Source #
Permission that allows to query info about other users
authUpdatePerm :: Permission Source #
Permission that allows to update fields of an user
authUserIdPerm :: Permission Source #
Permission that allows to get user ID of owner of token.
registerPerm :: Permission Source #
Permission that allows registration of new users
Swagger helpers
authOperations :: Traversal' Swagger Operation Source #
Select only operations of the Auth API
Orphan instances
ToSample Word Source # | |
ToSample () Source # | |
ToSample Text Source # | |
ToSample Unit Source # | |
ToParam (QueryParam "code" RestoreCode) Source # | |
toParam :: Proxy (QueryParam "code" RestoreCode) -> DocQueryParam # | |
ToParam (QueryParam "codes-count" Word) Source # | |
toParam :: Proxy (QueryParam "codes-count" Word) -> DocQueryParam # | |
ToParam (QueryParam "expire" Seconds) Source # | |
toParam :: Proxy (QueryParam "expire" Seconds) -> DocQueryParam # | |
ToParam (QueryParam "login" Login) Source # | |
toParam :: Proxy (QueryParam "login" Login) -> DocQueryParam # | |
ToParam (QueryParam "password" Password) Source # | |
toParam :: Proxy (QueryParam "password" Password) -> DocQueryParam # | |
ToCapture (Capture "group-id" UserGroupId) Source # | |
toCapture :: Proxy (Capture "group-id" UserGroupId) -> DocCapture # | |
ToCapture (Capture "user-id" UserId) Source # | |