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.

To use the server as constituent part, you need to provide customised AuthConfig for authServer function and implement AuthMonad instance for your handler monad.

import Servant.Server.Auth.Token as Auth

-- | Example of user side configuration
data Config = Config {
  -- | Authorisation specific configuration
  authConfig :: AuthConfig
  -- other fields
  -- ...
}

-- | Example of user side handler monad
newtype App a = App { 
    runApp :: ReaderT Config (ExceptT ServantErr IO) a
  } deriving ( Functor, Applicative, Monad, MonadReader Config,
               MonadError ServantErr, MonadIO)

-- | Now you can use authorisation API in your handler
instance AuthMonad App where 
  getAuthConfig = asks authConfig
  liftAuthAction = App . lift

-- | Include auth migrateAll function into your migration code
doMigrations :: SqlPersistT IO ()
doMigrations = runMigrationUnsafe $ do 
  migrateAll -- other user migrations
  Auth.migrateAll -- creation of authorisation entities
  -- optional creation of default admin if db is empty
  ensureAdmin 17 "admin" "123456" "admin@localhost" 

Now you can 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
  -> App Customer -- ^ Customer data
customerGet i token = do
  guardAuthToken token 
  runDB404 "customer" $ getCustomer i 

Implementation

authServer :: AuthConfig -> Server AuthAPI

Implementation of AuthAPI

Server API

migrateAll :: Migration

class Monad m => AuthMonad m where

The interface your application should implement to be able to use token aurhorisation API.

Methods

getAuthConfig :: m AuthConfig

liftAuthAction :: ExceptT ServantErr IO a -> m a

Instances

AuthMonad AuthHandler

Helpers

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

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

ensureAdmin :: Int -> Login -> Password -> Email -> SqlPersistT IO ()

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

authUserByToken :: AuthMonad m => MToken `[]` -> m UserImplId

Getting user id by token

API methods

authSignin

Arguments

:: AuthMonad 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 everthing is OK, return token

Implementation of "signin" method

authTouch

Arguments

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

:: AuthMonad m

=> MToken `[]`

Authorisation header with token

-> m RespUserInfo

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

authSignout

Arguments

:: AuthMonad m

=> Maybe (Token `[]`)

Authorisation header with token

-> m Unit

Implementation of "signout" method

authSignup

Arguments

:: AuthMonad m

=> ReqRegister

Registration info

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

Authorisation header with token

-> m (OnlyField "user" UserId)

Implementation of "signup" method

authUsersInfo

Arguments

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

:: AuthMonad m

=> UserId

User id

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

Authorisation header with token

-> m RespUserInfo

Implementation of get "user" method

authUserPatch

Arguments

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

:: AuthMonad m

=> UserId

User id

-> ReqRegister

New user

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

Authorisation header with token

-> m Unit

Implementation of put "user" method

authUserDelete

Arguments

:: AuthMonad m

=> UserId

User id

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

Authorisation header with token

-> m Unit

Implementation of patch "user" method

authRestore

Arguments

:: AuthMonad m

=> UserId

User id

-> Maybe RestoreCode

-> Maybe Password

-> m Unit

authGroupGet

Arguments

:: AuthMonad m

=> UserGroupId

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

Authorisation header with token

-> m UserGroup

Getting info about user group, requires authInfoPerm for token

authGroupPost

Arguments

:: AuthMonad m

=> UserGroup

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

Authorisation header with token

-> m (OnlyId UserGroupId)

Inserting new user group, requires authUpdatePerm for token

authGroupPut

Arguments

:: AuthMonad m

=> UserGroupId

-> UserGroup

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

Authorisation header with token

-> m Unit

Replace info about given user group, requires authUpdatePerm for token

authGroupPatch

Arguments

:: AuthMonad m

=> UserGroupId

-> PatchUserGroup

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

Authorisation header with token

-> m Unit

Patch info about given user group, requires authUpdatePerm for token

authGroupDelete

Arguments

:: AuthMonad m

=> UserGroupId

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

Authorisation header with token

-> m Unit

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

authGroupList

Arguments

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