Copyright | (c) Anton Gushcha 2016 |
---|---|
License | MIT |
Maintainer | ncrashed@gmail.com |
Stability | experimental |
Portability | Portable |
Safe Haskell | None |
Language | Haskell2010 |
Servant.Server.Auth.Token
Description
The module is server side implementation of Servant.API.Auth.Token API and intended to be used as drop in module for user servers or as external micro service.
Use guardAuthToken
to check authorisation headers in endpoints of your server:
-- | Read a single customer from DB customerGet :: CustomerId -- ^ Customer unique id -> MToken' '["customer-read"] -- ^ Required permissions for auth token -> ServerM Customer -- ^ Customer data customerGet i token = do guardAuthToken token guard404 "customer" $ getCustomer i
- authServer :: AuthHandler m => ServerT AuthAPI m
- class MonadIO m => HasStorage m where
- type AuthHandler m = (HasAuthConfig m, MonadError ServantErr m, MonadIO m, HasStorage m)
- guardAuthToken :: forall perms m. (PermsList perms, AuthHandler m) => MToken perms -> m ()
- guardAuthToken' :: AuthHandler m => Maybe SimpleToken -> [Permission] -> m (WithId AuthTokenId AuthToken)
- class WithAuthToken a where
- ensureAdmin :: HasStorage m => Int -> Login -> Password -> Email -> m ()
- authUserByToken :: AuthHandler m => MToken '[] -> m UserImplId
- data AuthPerm perms
- newtype AuthAction = AuthAction {
- unAuthAction :: Maybe SimpleToken -> [Permission] -> Handler ()
- authSignin :: AuthHandler m => Maybe Login -> Maybe Password -> Maybe Seconds -> m (OnlyField "token" SimpleToken)
- authSigninGetCode :: AuthHandler m => Maybe Login -> m Unit
- authSigninPostCode :: AuthHandler m => Maybe Login -> Maybe SingleUseCode -> Maybe Seconds -> m (OnlyField "token" SimpleToken)
- authTouch :: AuthHandler m => Maybe Seconds -> MToken '[] -> m Unit
- authToken :: AuthHandler m => MToken '[] -> m RespUserInfo
- authSignout :: AuthHandler m => Maybe (Token '[]) -> m Unit
- authSignup :: AuthHandler m => ReqRegister -> MToken' '["auth-register"] -> m (OnlyField "user" UserId)
- authUsersInfo :: AuthHandler m => Maybe Page -> Maybe PageSize -> MToken' '["auth-info"] -> m RespUsersInfo
- authUserInfo :: AuthHandler m => UserId -> MToken' '["auth-info"] -> m RespUserInfo
- authUserPatch :: AuthHandler m => UserId -> PatchUser -> MToken' '["auth-update"] -> m Unit
- authUserPut :: AuthHandler m => UserId -> ReqRegister -> MToken' '["auth-update"] -> m Unit
- authUserDelete :: AuthHandler m => UserId -> MToken' '["auth-delete"] -> m Unit
- authRestore :: AuthHandler m => UserId -> Maybe RestoreCode -> Maybe Password -> m Unit
- authGetSingleUseCodes :: AuthHandler m => UserId -> Maybe Word -> MToken' '["auth-single-codes"] -> m (OnlyField "codes" [SingleUseCode])
- authGroupGet :: AuthHandler m => UserGroupId -> MToken' '["auth-info"] -> m UserGroup
- authGroupPost :: AuthHandler m => UserGroup -> MToken' '["auth-update"] -> m (OnlyId UserGroupId)
- authGroupPut :: AuthHandler m => UserGroupId -> UserGroup -> MToken' '["auth-update"] -> m Unit
- authGroupPatch :: AuthHandler m => UserGroupId -> PatchUserGroup -> MToken' '["auth-update"] -> m Unit
- authGroupDelete :: AuthHandler m => UserGroupId -> MToken' '["auth-delete"] -> m Unit
- authGroupList :: AuthHandler m => Maybe Page -> Maybe PageSize -> MToken' '["auth-info"] -> m (PagedList UserGroupId UserGroup)
- authCheckPermissionsMethod :: AuthHandler m => MToken' '["auth-check"] -> OnlyField "permissions" [Permission] -> m Bool
- authGetUserIdMethod :: AuthHandler m => MToken' '["auth-userid"] -> m (OnlyId UserId)
- authFindUserByLogin :: AuthHandler m => Maybe Login -> MToken' '["auth-info"] -> m RespUserInfo
- getAuthToken :: AuthHandler m => UserImplId -> Maybe Seconds -> m SimpleToken
- hashPassword :: AuthHandler m => Password -> m Text
- setUserPasswordHash :: AuthHandler m => Text -> UserId -> m ()
- ensureAdminHash :: AuthHandler m => Int -> Login -> Text -> Email -> m ()
- signinByHashUnsafe :: AuthHandler m => Login -> Text -> Maybe Seconds -> m SimpleToken
Implementation
authServer :: AuthHandler m => ServerT AuthAPI m Source #
Implementation of AuthAPI
Server API
class MonadIO m => HasStorage m where Source #
Abstract storage interface. External libraries can implement this in terms of PostgreSQL or acid-state.
Methods
getUserImpl :: UserImplId -> m (Maybe UserImpl) Source #
Getting user from storage
getUserImpl :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m (Maybe UserImpl) Source #
Getting user from storage
getUserImplByLogin :: Login -> m (Maybe (WithId UserImplId UserImpl)) Source #
Getting user from storage by login
getUserImplByLogin :: (m ~ t n, MonadTrans t, HasStorage n) => Login -> m (Maybe (WithId UserImplId UserImpl)) Source #
Getting user from storage by login
listUsersPaged :: Page -> PageSize -> m ([WithId UserImplId UserImpl], Word) Source #
Get paged list of users and total count of users
listUsersPaged :: (m ~ t n, MonadTrans t, HasStorage n) => Page -> PageSize -> m ([WithId UserImplId UserImpl], Word) Source #
Get paged list of users and total count of users
getUserImplPermissions :: UserImplId -> m [WithId UserPermId UserPerm] Source #
Get user permissions, ascending by tag
getUserImplPermissions :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m [WithId UserPermId UserPerm] Source #
Get user permissions, ascending by tag
deleteUserPermissions :: UserImplId -> m () Source #
Delete user permissions
deleteUserPermissions :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m () Source #
Delete user permissions
insertUserPerm :: UserPerm -> m UserPermId Source #
Insertion of new user permission
insertUserPerm :: (m ~ t n, MonadTrans t, HasStorage n) => UserPerm -> m UserPermId Source #
Insertion of new user permission
insertUserImpl :: UserImpl -> m UserImplId Source #
Insertion of new user
insertUserImpl :: (m ~ t n, MonadTrans t, HasStorage n) => UserImpl -> m UserImplId Source #
Insertion of new user
replaceUserImpl :: UserImplId -> UserImpl -> m () Source #
Replace user with new value
replaceUserImpl :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UserImpl -> m () Source #
Replace user with new value
deleteUserImpl :: UserImplId -> m () Source #
Delete user by id
deleteUserImpl :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m () Source #
Delete user by id
hasPerm :: UserImplId -> Permission -> m Bool Source #
Check whether the user has particular permission
hasPerm :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> Permission -> m Bool Source #
Check whether the user has particular permission
getFirstUserByPerm :: Permission -> m (Maybe (WithId UserImplId UserImpl)) Source #
Get any user with given permission
getFirstUserByPerm :: (m ~ t n, MonadTrans t, HasStorage n) => Permission -> m (Maybe (WithId UserImplId UserImpl)) Source #
Get any user with given permission
selectUserImplGroups :: UserImplId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers] Source #
Select user groups and sort them by ascending name
selectUserImplGroups :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers] Source #
Select user groups and sort them by ascending name
clearUserImplGroups :: UserImplId -> m () Source #
Remove user from all groups
clearUserImplGroups :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m () Source #
Remove user from all groups
insertAuthUserGroup :: AuthUserGroup -> m AuthUserGroupId Source #
Add new user group
insertAuthUserGroup :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroup -> m AuthUserGroupId Source #
Add new user group
insertAuthUserGroupUsers :: AuthUserGroupUsers -> m AuthUserGroupUsersId Source #
Add user to given group
insertAuthUserGroupUsers :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupUsers -> m AuthUserGroupUsersId Source #
Add user to given group
insertAuthUserGroupPerms :: AuthUserGroupPerms -> m AuthUserGroupPermsId Source #
Add permission to given group
insertAuthUserGroupPerms :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupPerms -> m AuthUserGroupPermsId Source #
Add permission to given group
getAuthUserGroup :: AuthUserGroupId -> m (Maybe AuthUserGroup) Source #
Find user group by id
getAuthUserGroup :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m (Maybe AuthUserGroup) Source #
Find user group by id
listAuthUserGroupPermissions :: AuthUserGroupId -> m [WithId AuthUserGroupPermsId AuthUserGroupPerms] Source #
Get list of permissions of given group
listAuthUserGroupPermissions :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m [WithId AuthUserGroupPermsId AuthUserGroupPerms] Source #
Get list of permissions of given group
listAuthUserGroupUsers :: AuthUserGroupId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers] Source #
Get list of all users of the group
listAuthUserGroupUsers :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers] Source #
Get list of all users of the group
replaceAuthUserGroup :: AuthUserGroupId -> AuthUserGroup -> m () Source #
Replace record of user group
replaceAuthUserGroup :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> AuthUserGroup -> m () Source #
Replace record of user group
clearAuthUserGroupUsers :: AuthUserGroupId -> m () Source #
Remove all users from group
clearAuthUserGroupUsers :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m () Source #
Remove all users from group
clearAuthUserGroupPerms :: AuthUserGroupId -> m () Source #
Remove all permissions from group
clearAuthUserGroupPerms :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m () Source #
Remove all permissions from group
deleteAuthUserGroup :: AuthUserGroupId -> m () Source #
Delete user group from storage
deleteAuthUserGroup :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m () Source #
Delete user group from storage
listGroupsPaged :: Page -> PageSize -> m ([WithId AuthUserGroupId AuthUserGroup], Word) Source #
Get paged list of user groups with total count
listGroupsPaged :: (m ~ t n, MonadTrans t, HasStorage n) => Page -> PageSize -> m ([WithId AuthUserGroupId AuthUserGroup], Word) Source #
Get paged list of user groups with total count
setAuthUserGroupName :: AuthUserGroupId -> Text -> m () Source #
Set group name
setAuthUserGroupName :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> Text -> m () Source #
Set group name
setAuthUserGroupParent :: AuthUserGroupId -> Maybe AuthUserGroupId -> m () Source #
Set group parent
setAuthUserGroupParent :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> Maybe AuthUserGroupId -> m () Source #
Set group parent
insertSingleUseCode :: UserSingleUseCode -> m UserSingleUseCodeId Source #
Add new single use code
insertSingleUseCode :: (m ~ t n, MonadTrans t, HasStorage n) => UserSingleUseCode -> m UserSingleUseCodeId Source #
Add new single use code
setSingleUseCodeUsed :: UserSingleUseCodeId -> Maybe UTCTime -> m () Source #
Set usage time of the single use code
setSingleUseCodeUsed :: (m ~ t n, MonadTrans t, HasStorage n) => UserSingleUseCodeId -> Maybe UTCTime -> m () Source #
Set usage time of the single use code
getUnusedCode :: SingleUseCode -> UserImplId -> UTCTime -> m (Maybe (WithId UserSingleUseCodeId UserSingleUseCode)) Source #
Find unused code for the user and expiration time greater than the given time
getUnusedCode :: (m ~ t n, MonadTrans t, HasStorage n) => SingleUseCode -> UserImplId -> UTCTime -> m (Maybe (WithId UserSingleUseCodeId UserSingleUseCode)) Source #
Find unused code for the user and expiration time greater than the given time
invalidatePermanentCodes :: UserImplId -> UTCTime -> m () Source #
Invalidate all permanent codes for user and set use time for them
invalidatePermanentCodes :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UTCTime -> m () Source #
Invalidate all permanent codes for user and set use time for them
selectLastRestoreCode :: UserImplId -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore)) Source #
Select last valid restoration code by the given current time
selectLastRestoreCode :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore)) Source #
Select last valid restoration code by the given current time
insertUserRestore :: UserRestore -> m UserRestoreId Source #
Insert new restore code
insertUserRestore :: (m ~ t n, MonadTrans t, HasStorage n) => UserRestore -> m UserRestoreId Source #
Insert new restore code
findRestoreCode :: UserImplId -> RestoreCode -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore)) Source #
Find unexpired by the time restore code
findRestoreCode :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> RestoreCode -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore)) Source #
Find unexpired by the time restore code
replaceRestoreCode :: UserRestoreId -> UserRestore -> m () Source #
Replace restore code with new value
replaceRestoreCode :: (m ~ t n, MonadTrans t, HasStorage n) => UserRestoreId -> UserRestore -> m () Source #
Replace restore code with new value
findAuthToken :: UserImplId -> UTCTime -> m (Maybe (WithId AuthTokenId AuthToken)) Source #
Find first non-expired by the time token for user
findAuthToken :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UTCTime -> m (Maybe (WithId AuthTokenId AuthToken)) Source #
Find first non-expired by the time token for user
findAuthTokenByValue :: SimpleToken -> m (Maybe (WithId AuthTokenId AuthToken)) Source #
Find token by value
findAuthTokenByValue :: (m ~ t n, MonadTrans t, HasStorage n) => SimpleToken -> m (Maybe (WithId AuthTokenId AuthToken)) Source #
Find token by value
insertAuthToken :: AuthToken -> m AuthTokenId Source #
Insert new token
insertAuthToken :: (m ~ t n, MonadTrans t, HasStorage n) => AuthToken -> m AuthTokenId Source #
Insert new token
replaceAuthToken :: AuthTokenId -> AuthToken -> m () Source #
Replace auth token with new value
replaceAuthToken :: (m ~ t n, MonadTrans t, HasStorage n) => AuthTokenId -> AuthToken -> m () Source #
Replace auth token with new value
Instances
(HasStorage m, Monoid w) => HasStorage (WriterT w m) Source # | |
HasStorage m => HasStorage (StateT s m) Source # | |
HasStorage m => HasStorage (ExceptT e m) Source # | |
HasStorage m => HasStorage (StateT s m) Source # | |
(HasStorage m, Monoid w) => HasStorage (WriterT w m) Source # | |
HasStorage m => HasStorage (ReaderT * r m) Source # | |
HasStorage m => HasStorage (ContT * r m) Source # | |
(HasStorage m, Monoid w) => HasStorage (RWST r w s m) Source # | |
(HasStorage m, Monoid w) => HasStorage (RWST r w s m) Source # | |
type AuthHandler m = (HasAuthConfig m, MonadError ServantErr m, MonadIO m, HasStorage m) Source #
Context that is needed to run the auth server
Helpers
guardAuthToken :: forall perms m. (PermsList perms, AuthHandler m) => MToken perms -> m () Source #
If the token is missing or the user of the token doesn't have needed permissions, throw 401 response
guardAuthToken' :: AuthHandler m => Maybe SimpleToken -> [Permission] -> m (WithId AuthTokenId AuthToken) Source #
Same as guardAuthToken
but returns record about the token
class WithAuthToken a where Source #
Minimal complete definition
Methods
withAuthToken :: PermsList perms => a -> MToken perms -> a Source #
Authenticate an entire API rather than each individual endpoint.
As such, for a given HasServer
instance api
, if you have:
f :: ServerT
api m
then:
withAuthToken f :: (AuthHandler m) => ServerT (TokenHeader
perms :> api) m
(Note that the types don't reflect this, as it isn't possible to
guarantee what all possible ServerT
instances might be.)
Instances
AuthHandler m => WithAuthToken (m a) Source # | |
WithAuthToken r => WithAuthToken (a -> r) Source # | |
(WithAuthToken a, WithAuthToken b) => WithAuthToken ((:<|>) a b) Source # | |
ensureAdmin :: HasStorage m => Int -> Login -> Password -> Email -> m () Source #
Ensures that DB has at leas one admin, if not, creates a new one with specified info.
authUserByToken :: AuthHandler m => MToken '[] -> m UserImplId Source #
Getting user id by token
Combinators
An authentication combinator.
TODO maybe move in the servant-auth-api library
newtype AuthAction Source #
An authentication handler.
Constructors
AuthAction | |
Fields
|
API methods
Arguments
:: AuthHandler m | |
=> Maybe Login | Login query parameter |
-> Maybe Password | Password query parameter |
-> Maybe Seconds | Expire query parameter, how many seconds the token is valid |
-> m (OnlyField "token" SimpleToken) | If everything is OK, return token |
Implementation of "signin" method
Arguments
:: AuthHandler m | |
=> Maybe Login | User login, required |
-> m Unit |
Authorisation via code of single usage.
Implementation of AuthSigninGetCodeMethod
endpoint.
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, defined in configuration by
singleUseCodeSender
field. - 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.
See also: authSigninPostCode
Arguments
:: AuthHandler m | |
=> Maybe Login | User login, required |
-> Maybe SingleUseCode | Received single usage code, required |
-> Maybe Seconds | Time interval after which the token expires, |
-> m (OnlyField "token" SimpleToken) |
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, defined in configuration by
singleUseCodeSender
field. - 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.
See also: authSigninGetCode
Arguments
:: AuthHandler m | |
=> Maybe Seconds | Expire query parameter, how many seconds the token should be valid by now. |
-> MToken '[] | Authorisation header with token |
-> m Unit |
Implementation of "touch" method
Arguments
:: AuthHandler m | |
=> MToken '[] | Authorisation header with token |
-> m RespUserInfo |
Implementation of "token" method, return info about user binded to the token
Arguments
:: AuthHandler m | |
=> Maybe (Token '[]) | Authorisation header with token |
-> m Unit |
Implementation of "signout" method
Arguments
:: AuthHandler m | |
=> ReqRegister | Registration info |
-> MToken' '["auth-register"] | Authorisation header with token |
-> m (OnlyField "user" UserId) |
Implementation of "signup" method
Arguments
:: AuthHandler m | |
=> Maybe Page | Page num parameter |
-> Maybe PageSize | Page size parameter |
-> MToken' '["auth-info"] | Authorisation header with token |
-> m RespUsersInfo |
Implementation of get "users" method
Arguments
:: AuthHandler m | |
=> UserId | User id |
-> MToken' '["auth-info"] | Authorisation header with token |
-> m RespUserInfo |
Implementation of get "user" method
Arguments
:: AuthHandler m | |
=> UserId | User id |
-> PatchUser | JSON with fields for patching |
-> MToken' '["auth-update"] | Authorisation header with token |
-> m Unit |
Implementation of patch "user" method
Arguments
:: AuthHandler m | |
=> UserId | User id |
-> ReqRegister | New user |
-> MToken' '["auth-update"] | Authorisation header with token |
-> m Unit |
Implementation of put "user" method
Arguments
:: AuthHandler m | |
=> UserId | User id |
-> MToken' '["auth-delete"] | Authorisation header with token |
-> m Unit |
Implementation of patch "user" method
Arguments
:: AuthHandler m | |
=> UserId | User id |
-> Maybe RestoreCode | |
-> Maybe Password | |
-> m Unit |
authGetSingleUseCodes Source #
Arguments
:: AuthHandler m | |
=> UserId | Id of user |
-> Maybe Word | Number of codes. |
-> MToken' '["auth-single-codes"] | |
-> m (OnlyField "codes" [SingleUseCode]) |
Implementation of AuthGetSingleUseCodes
endpoint.
Arguments
:: AuthHandler m | |
=> UserGroupId | |
-> MToken' '["auth-info"] | Authorisation header with token |
-> m UserGroup |
Getting info about user group, requires authInfoPerm
for token
Arguments
:: AuthHandler m | |
=> UserGroup | |
-> MToken' '["auth-update"] | Authorisation header with token |
-> m (OnlyId UserGroupId) |
Inserting new user group, requires authUpdatePerm
for token
Arguments
:: AuthHandler m | |
=> UserGroupId | |
-> UserGroup | |
-> MToken' '["auth-update"] | Authorisation header with token |
-> m Unit |
Replace info about given user group, requires authUpdatePerm
for token
Arguments
:: AuthHandler m | |
=> UserGroupId | |
-> PatchUserGroup | |
-> MToken' '["auth-update"] | Authorisation header with token |
-> m Unit |
Patch info about given user group, requires authUpdatePerm
for token
Arguments
:: AuthHandler m | |
=> UserGroupId | |
-> MToken' '["auth-delete"] | Authorisation header with token |
-> m Unit |
Delete all info about given user group, requires authDeletePerm
for token
Arguments
:: AuthHandler m | |
=> Maybe Page | |
-> Maybe PageSize | |
-> MToken' '["auth-info"] | Authorisation header with token |
-> m (PagedList UserGroupId UserGroup) |
Get list of user groups, requires authInfoPerm
for token
authCheckPermissionsMethod Source #
Arguments
:: AuthHandler m | |
=> MToken' '["auth-check"] | Authorisation header with token |
-> OnlyField "permissions" [Permission] | Body with permissions to check |
-> m Bool |
|
Check that the token has required permissions and return False
if it doesn't.
Arguments
:: AuthHandler m | |
=> MToken' '["auth-userid"] | Authorisation header with token |
-> m (OnlyId UserId) |
Get user ID for the owner of the speified token.
Arguments
:: AuthHandler m | |
=> Maybe Login | Login, |
-> MToken' '["auth-info"] | |
-> m RespUserInfo |
Implementation of AuthFindUserByLogin
. Find user by login, throw 404 error
if cannot find user by such login.
Low-level API
Arguments
:: AuthHandler m | |
=> UserImplId | User for whom we want token |
-> Maybe Seconds | Expiration duration, |
-> m SimpleToken | Old token (if it doesn't expire) or new one |
Helper to get or generate new token for user
hashPassword :: AuthHandler m => Password -> m Text Source #
Generate hash from given password and return it as text. May be useful if you don't like storing unencrypt passwords in config files.
setUserPasswordHash :: AuthHandler m => Text -> UserId -> m () Source #
Update password hash of user. Can be used to set direct hash for user password when it is taken from config file.
ensureAdminHash :: AuthHandler m => Int -> Login -> Text -> Email -> m () Source #
Ensures that DB has at least one admin, if not, creates a new one with specified info and direct password hash. May be useful if you don't like storing unencrypt passwords in config files.
Arguments
:: AuthHandler m | |
=> Login | User login |
-> Text | Hash of admin password |
-> Maybe Seconds | Expire |
-> m SimpleToken |
If you use password hash in configs, you cannot use them in signin method. This helper allows to get token by password hash and the function is not available for remote call (no endpoint).
Throws 401 if cannot find user or authorisation is failed.
WARNING: Do not expose the function to end user, never!