Servant.Server.Auth.Token

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

Implementation

authServer :: AuthHandler m => ServerT AuthAPI m

Implementation of AuthAPI

Server API

class MonadIO m => HasStorage m where

Abstract storage interface. External libraries can implement this in terms of PostgreSQL or acid-state.

Minimal complete definition

getUserImpl, getUserImplByLogin, listUsersPaged, getUserImplPermissions, deleteUserPermissions, insertUserPerm, insertUserImpl, replaceUserImpl, deleteUserImpl, hasPerm, getFirstUserByPerm, selectUserImplGroups, clearUserImplGroups, insertAuthUserGroup, insertAuthUserGroupUsers, insertAuthUserGroupPerms, getAuthUserGroup, listAuthUserGroupPermissions, listAuthUserGroupUsers, replaceAuthUserGroup, clearAuthUserGroupUsers, clearAuthUserGroupPerms, deleteAuthUserGroup, listGroupsPaged, setAuthUserGroupName, setAuthUserGroupParent, insertSingleUseCode, setSingleUseCodeUsed, getUnusedCode, invalidatePermamentCodes, selectLastRestoreCode, insertUserRestore, findRestoreCode, replaceRestoreCode, findAuthToken, findAuthTokenByValue, insertAuthToken, replaceAuthToken

Methods

getUserImpl :: UserImplId -> m (Maybe UserImpl)

Getting user from storage

getUserImplByLogin :: Login -> m (Maybe (WithId UserImplId UserImpl))

Getting user from storage by login

listUsersPaged :: Page -> PageSize -> m ([WithId UserImplId UserImpl], Word)

Get paged list of users and total count of users

getUserImplPermissions :: UserImplId -> m [WithId UserPermId UserPerm]

Get user permissions, ascending by tag

deleteUserPermissions :: UserImplId -> m ()

Delete user permissions

insertUserPerm :: UserPerm -> m UserPermId

Insertion of new user permission

insertUserImpl :: UserImpl -> m UserImplId

Insertion of new user

replaceUserImpl :: UserImplId -> UserImpl -> m ()

Replace user with new value

deleteUserImpl :: UserImplId -> m ()

Delete user by id

hasPerm :: UserImplId -> Permission -> m Bool

Check whether the user has particular permission

getFirstUserByPerm :: Permission -> m (Maybe (WithId UserImplId UserImpl))

Get any user with given permission

selectUserImplGroups :: UserImplId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]

Select user groups and sort them by ascending name

clearUserImplGroups :: UserImplId -> m ()

Remove user from all groups

insertAuthUserGroup :: AuthUserGroup -> m AuthUserGroupId

Add new user group

insertAuthUserGroupUsers :: AuthUserGroupUsers -> m AuthUserGroupUsersId

Add user to given group

insertAuthUserGroupPerms :: AuthUserGroupPerms -> m AuthUserGroupPermsId

Add permission to given group

getAuthUserGroup :: AuthUserGroupId -> m (Maybe AuthUserGroup)

Find user group by id

listAuthUserGroupPermissions :: AuthUserGroupId -> m [WithId AuthUserGroupPermsId AuthUserGroupPerms]

Get list of permissions of given group

listAuthUserGroupUsers :: AuthUserGroupId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]

Get list of all users of the group

replaceAuthUserGroup :: AuthUserGroupId -> AuthUserGroup -> m ()

Replace record of user group

clearAuthUserGroupUsers :: AuthUserGroupId -> m ()

Remove all users from group

clearAuthUserGroupPerms :: AuthUserGroupId -> m ()

Remove all permissions from group

deleteAuthUserGroup :: AuthUserGroupId -> m ()

Delete user group from storage

listGroupsPaged :: Page -> PageSize -> m ([WithId AuthUserGroupId AuthUserGroup], Word)

Get paged list of user groups with total count

setAuthUserGroupName :: AuthUserGroupId -> Text -> m ()

Set group name

setAuthUserGroupParent :: AuthUserGroupId -> Maybe AuthUserGroupId -> m ()

Set group parent

insertSingleUseCode :: UserSingleUseCode -> m UserSingleUseCodeId

Add new single use code

setSingleUseCodeUsed :: UserSingleUseCodeId -> Maybe UTCTime -> m ()

Set usage time of the single use code

getUnusedCode :: SingleUseCode -> UserImplId -> UTCTime -> m (Maybe (WithId UserSingleUseCodeId UserSingleUseCode))

Find unused code for the user and expiration time greater than the given time

invalidatePermamentCodes :: UserImplId -> UTCTime -> m ()

Invalidate all permament codes for user and set use time for them

selectLastRestoreCode :: UserImplId -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))

Select last valid restoration code by the given current time

insertUserRestore :: UserRestore -> m UserRestoreId

Insert new restore code

findRestoreCode :: UserImplId -> RestoreCode -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))

Find unexpired by the time restore code

replaceRestoreCode :: UserRestoreId -> UserRestore -> m ()

Replace restore code with new value

findAuthToken :: UserImplId -> UTCTime -> m (Maybe (WithId AuthTokenId AuthToken))

Find first non-expired by the time token for user

findAuthTokenByValue :: SimpleToken -> m (Maybe (WithId AuthTokenId AuthToken))

Find token by value

insertAuthToken :: AuthToken -> m AuthTokenId

Insert new token

replaceAuthToken :: AuthTokenId -> AuthToken -> m ()

Replace auth token with new value

type AuthHandler m = (HasAuthConfig m, MonadError ServantErr m, MonadIO m, HasStorage m)

Context that is needed to run the auth server

Helpers

guardAuthToken :: forall perms m. (PermsList perms, AuthHandler m) => MToken perms -> m ()

If the token is missing or the user of the token doesn't have needed permissions, throw 401 response

ensureAdmin :: HasStorage m => Int -> Login -> Password -> Email -> m ()

Ensures that DB has at leas one admin, if not, creates a new one with specified info.

authUserByToken :: AuthHandler m => MToken '[] -> m UserImplId

Getting user id by token

API methods

authSignin

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

authSigninGetCode

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

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, Nothing means some default value

-> 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

authTouch

Arguments

:: AuthHandler m

=> Maybe Seconds

Expire query parameter, how many seconds the token should be valid by now. Nothing means default value defined in server config.

-> MToken '[]

Authorisation header with token

-> m Unit

Implementation of "touch" method

authToken

Arguments

:: AuthHandler m

=> MToken '[]

Authorisation header with token

-> m RespUserInfo

Implementation of "token" method, return info about user binded to the token

authSignout

Arguments

:: AuthHandler m

=> Maybe (Token '[])

Authorisation header with token

-> m Unit

Implementation of "signout" method

authSignup

Arguments

:: AuthHandler m

=> ReqRegister

Registration info

-> MToken' '["auth-register"]

Authorisation header with token

-> m (OnlyField "user" UserId)

Implementation of "signup" method

authUsersInfo

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

authUserInfo

Arguments

:: AuthHandler m

=> UserId

User id

-> MToken' '["auth-info"]

Authorisation header with token

-> m RespUserInfo

Implementation of get "user" method

authUserPatch

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

authUserPut

Arguments

:: AuthHandler m

=> UserId

User id

-> ReqRegister

New user

-> MToken' '["auth-update"]

Authorisation header with token

-> m Unit

Implementation of put "user" method

authUserDelete

Arguments

:: AuthHandler m

=> UserId

User id

-> MToken' '["auth-delete"]

Authorisation header with token

-> m Unit

Implementation of patch "user" method

authRestore

Arguments

:: AuthHandler m

=> UserId

User id

-> Maybe RestoreCode

-> Maybe Password

-> m Unit

authGetSingleUseCodes

Arguments

:: AuthHandler m

=> UserId

Id of user

-> Maybe Word

Number of codes. Nothing means that server generates some default count of codes. And server can define maximum count of codes that user can have at once.

-> MToken' '["auth-single-codes"]

-> m (OnlyField "codes" [SingleUseCode])

Implementation of AuthGetSingleUseCodes endpoint.

authGroupGet

Arguments

:: AuthHandler m

=> UserGroupId

-> MToken' '["auth-info"]

Authorisation header with token

-> m UserGroup

Getting info about user group, requires authInfoPerm for token

authGroupPost

Arguments

:: AuthHandler m

=> UserGroup

-> MToken' '["auth-update"]

Authorisation header with token

-> m (OnlyId UserGroupId)

Inserting new user group, requires authUpdatePerm for token

authGroupPut

Arguments

:: AuthHandler m

=> UserGroupId

-> UserGroup

-> MToken' '["auth-update"]

Authorisation header with token

-> m Unit

Replace info about given user group, requires authUpdatePerm for token

authGroupPatch

Arguments

:: AuthHandler m

=> UserGroupId

-> PatchUserGroup

-> MToken' '["auth-update"]

Authorisation header with token

-> m Unit

Patch info about given user group, requires authUpdatePerm for token

authGroupDelete

Arguments

:: AuthHandler m

=> UserGroupId

-> MToken' '["auth-delete"]

Authorisation header with token

-> m Unit

Delete all info about given user group, requires authDeletePerm for token

authGroupList

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

Arguments

:: AuthHandler m

=> MToken' '["auth-check"]

Authorisation header with token

-> OnlyField "permissions" [Permission]

Body with permissions to check

-> m Bool

True if all permissions are OK, False if some permissions are not set for token and 401 error if the token doesn't have 'auth-check' permission.

Check that the token has required permissions and return False if it doesn't.

authGetUserIdMethod

Arguments

:: AuthHandler m

=> MToken' '["auth-userid"]

Authorisation header with token

-> m (OnlyId UserId)

Get user ID for the owner of the speified token.

authFindUserByLogin

Arguments

:: AuthHandler m

=> Maybe Login

Login, Nothing will cause 400 error.

-> 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

getAuthToken

Arguments

:: AuthHandler m

=> UserImplId

User for whom we want token

-> Maybe Seconds

Expiration duration, Nothing means default

-> 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

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 ()

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 ()

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.

signinByHashUnsafe

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!