servant-auth-token-api-0.5.4.0: Servant based API for token based authorisation

Copyright(c) Anton Gushcha 2016
LicenseMIT
Maintainerncrashed@gmail.com
Stabilityexperimental
PortabilityPortable
Safe HaskellNone
LanguageHaskell2010

Servant.API.Auth.Token

Contents

Description

 
Synopsis

API specs

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

authDocs :: API Source #

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 # 
Instance details

Defined in Servant.API.Auth.Token

Methods

unliftPerms :: proxy [] -> [Permission] Source #

(UnliftPermSymbol x, PermsList xs) => PermsList (x ': xs) Source # 
Instance details

Defined in Servant.API.Auth.Token

Methods

unliftPerms :: proxy (x ': xs) -> [Permission] Source #

class UnliftPermSymbol (s :: PermSymbol) where Source #

Convertation of permission symbol into runtim string

class PermsList (a :: [PermSymbol]) where Source #

Unlifting compile-time permissions into list of run-time permissions

Methods

unliftPerms :: forall proxy. proxy a -> [Permission] Source #

Instances
PermsList ([] :: [PermSymbol]) Source # 
Instance details

Defined in Servant.API.Auth.Token

Methods

unliftPerms :: proxy [] -> [Permission] Source #

(UnliftPermSymbol x, PermsList xs) => PermsList (x ': xs) Source # 
Instance details

Defined in Servant.API.Auth.Token

Methods

unliftPerms :: proxy (x ': xs) -> [Permission] Source #

type family PlainPerms (p :: [Symbol]) :: [PermSymbol] where ... Source #

Helper type family to wrap all symbols into PermLabel

Equations

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.

Constructors

Token 

Fields

Instances
Eq (Token perms) Source # 
Instance details

Defined in Servant.API.Auth.Token

Methods

(==) :: Token perms -> Token perms -> Bool #

(/=) :: Token perms -> Token perms -> Bool #

Show (Token perms) Source # 
Instance details

Defined in Servant.API.Auth.Token

Methods

showsPrec :: Int -> Token perms -> ShowS #

show :: Token perms -> String #

showList :: [Token perms] -> ShowS #

ToHttpApiData (Token perms) Source # 
Instance details

Defined in Servant.API.Auth.Token

Methods

toUrlPiece :: Token perms -> Text #

toEncodedUrlPiece :: Token perms -> Builder #

toHeader :: Token perms -> ByteString #

toQueryParam :: Token perms -> Text #

FromHttpApiData (Token perms) Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSample (Token perms) Source # 
Instance details

Defined in Servant.API.Auth.Token

Methods

toSamples :: Proxy (Token perms) -> [(Text, Token perms)] #

ToParamSchema (Token perms) Source # 
Instance details

Defined in Servant.API.Auth.Token

Methods

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 UserId = Word Source #

Id of user that is used in the API

type Login = Text Source #

User name for login

type Password = Text Source #

Password for login

type Email = Text Source #

User email

type Permission = Text Source #

Special tag for a permission that a user has

type Seconds = Word Source #

Amount of seconds

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

Instances
Show ReqRegister Source # 
Instance details

Defined in Servant.API.Auth.Token

Generic ReqRegister Source # 
Instance details

Defined in Servant.API.Auth.Token

Associated Types

type Rep ReqRegister :: Type -> Type #

ToJSON ReqRegister Source # 
Instance details

Defined in Servant.API.Auth.Token

FromJSON ReqRegister Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSchema ReqRegister Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSample ReqRegister Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep ReqRegister Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep ReqRegister = D1 (MetaData "ReqRegister" "Servant.API.Auth.Token" "servant-auth-token-api-0.5.4.0-inplace" False) (C1 (MetaCons "ReqRegister" PrefixI True) ((S1 (MetaSel (Just "reqRegLogin") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Login) :*: S1 (MetaSel (Just "reqRegPassword") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Password)) :*: (S1 (MetaSel (Just "reqRegEmail") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Email) :*: (S1 (MetaSel (Just "reqRegPermissions") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 [Permission]) :*: S1 (MetaSel (Just "reqRegGroups") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe [UserGroupId]))))))

data RespUserInfo Source #

Response with user info

Instances
Show RespUserInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

Generic RespUserInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

Associated Types

type Rep RespUserInfo :: Type -> Type #

ToJSON RespUserInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

FromJSON RespUserInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSchema RespUserInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSample RespUserInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep RespUserInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep RespUserInfo = D1 (MetaData "RespUserInfo" "Servant.API.Auth.Token" "servant-auth-token-api-0.5.4.0-inplace" False) (C1 (MetaCons "RespUserInfo" PrefixI True) ((S1 (MetaSel (Just "respUserId") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 UserId) :*: S1 (MetaSel (Just "respUserLogin") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Login)) :*: (S1 (MetaSel (Just "respUserEmail") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Email) :*: (S1 (MetaSel (Just "respUserPermissions") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 [Permission]) :*: S1 (MetaSel (Just "respUserGroups") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 [UserGroupId])))))

data PatchUser Source #

Request body for patching user

Instances
Show PatchUser Source # 
Instance details

Defined in Servant.API.Auth.Token

Generic PatchUser Source # 
Instance details

Defined in Servant.API.Auth.Token

Associated Types

type Rep PatchUser :: Type -> Type #

ToJSON PatchUser Source # 
Instance details

Defined in Servant.API.Auth.Token

FromJSON PatchUser Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSchema PatchUser Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSample PatchUser Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep PatchUser Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep PatchUser = D1 (MetaData "PatchUser" "Servant.API.Auth.Token" "servant-auth-token-api-0.5.4.0-inplace" False) (C1 (MetaCons "PatchUser" PrefixI True) ((S1 (MetaSel (Just "patchUserLogin") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe Login)) :*: S1 (MetaSel (Just "patchUserPassword") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe Password))) :*: (S1 (MetaSel (Just "patchUserEmail") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe Email)) :*: (S1 (MetaSel (Just "patchUserPermissions") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe [Permission])) :*: S1 (MetaSel (Just "patchUserGroups") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe [UserGroupId]))))))

data RespUsersInfo Source #

Response with users info and pagination

Instances
Show RespUsersInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

Generic RespUsersInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

Associated Types

type Rep RespUsersInfo :: Type -> Type #

ToJSON RespUsersInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

FromJSON RespUsersInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSchema RespUsersInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSample RespUsersInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep RespUsersInfo Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep RespUsersInfo = D1 (MetaData "RespUsersInfo" "Servant.API.Auth.Token" "servant-auth-token-api-0.5.4.0-inplace" False) (C1 (MetaCons "RespUsersInfo" PrefixI True) (S1 (MetaSel (Just "respUsersItems") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 [RespUserInfo]) :*: S1 (MetaSel (Just "respUsersPages") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Word)))

data AuthSigninPostBody Source #

Constructors

AuthSigninPostBody 

Fields

Instances
Show AuthSigninPostBody Source # 
Instance details

Defined in Servant.API.Auth.Token

Generic AuthSigninPostBody Source # 
Instance details

Defined in Servant.API.Auth.Token

Associated Types

type Rep AuthSigninPostBody :: Type -> Type #

ToJSON AuthSigninPostBody Source # 
Instance details

Defined in Servant.API.Auth.Token

FromJSON AuthSigninPostBody Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSchema AuthSigninPostBody Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSample AuthSigninPostBody Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep AuthSigninPostBody Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep AuthSigninPostBody = D1 (MetaData "AuthSigninPostBody" "Servant.API.Auth.Token" "servant-auth-token-api-0.5.4.0-inplace" False) (C1 (MetaCons "AuthSigninPostBody" PrefixI True) (S1 (MetaSel (Just "authSigninBodyLogin") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Login) :*: (S1 (MetaSel (Just "authSigninBodyPassword") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Password) :*: S1 (MetaSel (Just "authSigninBodySeconds") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe Seconds)))))

User groups

type UserGroupId = Word Source #

Id of user group

data UserGroup Source #

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.

Instances
Show UserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

Generic UserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

Associated Types

type Rep UserGroup :: Type -> Type #

ToJSON UserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

FromJSON UserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSchema UserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSample UserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep UserGroup Source # 
Instance details

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

Instances
Show PatchUserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

Generic PatchUserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

Associated Types

type Rep PatchUserGroup :: Type -> Type #

ToJSON PatchUserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

FromJSON PatchUserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSchema PatchUserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

ToSample PatchUserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep PatchUserGroup Source # 
Instance details

Defined in Servant.API.Auth.Token

type Rep PatchUserGroup = D1 (MetaData "PatchUserGroup" "Servant.API.Auth.Token" "servant-auth-token-api-0.5.4.0-inplace" False) (C1 (MetaCons "PatchUserGroup" PrefixI True) ((S1 (MetaSel (Just "patchUserGroupName") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe Text)) :*: S1 (MetaSel (Just "patchUserGroupUsers") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe [UserId]))) :*: (S1 (MetaSel (Just "patchUserGroupPermissions") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe [Permission])) :*: (S1 (MetaSel (Just "patchUserGroupParent") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe UserGroupId)) :*: S1 (MetaSel (Just "patchUserGroupNoParent") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 (Maybe Bool))))))

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 # 
Instance details

Methods

toSamples :: Proxy Word -> [(Text, Word)] #

ToSample () Source # 
Instance details

Methods

toSamples :: Proxy () -> [(Text, ())] #

ToSample Text Source # 
Instance details

Methods

toSamples :: Proxy Text -> [(Text, Text)] #

ToSample Unit Source # 
Instance details

Methods

toSamples :: Proxy Unit -> [(Text, Unit)] #

ToParam (QueryParam "code" RestoreCode) Source # 
Instance details

ToParam (QueryParam "codes-count" Word) Source # 
Instance details

Methods

toParam :: Proxy (QueryParam "codes-count" Word) -> DocQueryParam #

ToParam (QueryParam "expire" Seconds) Source # 
Instance details

Methods

toParam :: Proxy (QueryParam "expire" Seconds) -> DocQueryParam #

ToParam (QueryParam "login" Login) Source # 
Instance details

Methods

toParam :: Proxy (QueryParam "login" Login) -> DocQueryParam #

ToParam (QueryParam "password" Password) Source # 
Instance details

Methods

toParam :: Proxy (QueryParam "password" Password) -> DocQueryParam #

ToCapture (Capture "group-id" UserGroupId) Source # 
Instance details

Methods

toCapture :: Proxy (Capture "group-id" UserGroupId) -> DocCapture #

ToCapture (Capture "user-id" UserId) Source # 
Instance details

Methods

toCapture :: Proxy (Capture "user-id" UserId) -> DocCapture #