Copyright | (c) Anton Gushcha, 2016 |
---|---|
License | MIT |
Maintainer | ncrashed@gmail.com |
Stability | experimental |
Portability | Portable |
Safe Haskell | None |
Language | Haskell2010 |
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
- authServer :: AuthConfig -> Server AuthAPI
- migrateAll :: Migration
- class Monad m => AuthMonad m where
- getAuthConfig :: m AuthConfig
- liftAuthAction :: ExceptT ServantErr IO a -> m a
- guardAuthToken :: forall perms m. (PermsList perms, AuthMonad m) => MToken perms -> m ()
- ensureAdmin :: Int -> Login -> Password -> Email -> SqlPersistT IO ()
- authUserByToken :: AuthMonad m => MToken `[]` -> m UserImplId
- authSignin :: AuthMonad m => Maybe Login -> Maybe Password -> Maybe Seconds -> m (OnlyField "token" SimpleToken)
- authSigninGetCode :: AuthMonad m => Maybe Login -> m Unit
- authSigninPostCode :: AuthMonad m => Maybe Login -> Maybe SingleUseCode -> Maybe Seconds -> m (OnlyField "token" SimpleToken)
- authTouch :: AuthMonad m => Maybe Seconds -> MToken `[]` -> m Unit
- authToken :: AuthMonad m => MToken `[]` -> m RespUserInfo
- authSignout :: AuthMonad m => Maybe (Token `[]`) -> m Unit
- authSignup :: AuthMonad m => ReqRegister -> MToken' `["auth-register"]` -> m (OnlyField "user" UserId)
- authUsersInfo :: AuthMonad m => Maybe Page -> Maybe PageSize -> MToken' `["auth-info"]` -> m RespUsersInfo
- authUserInfo :: AuthMonad m => UserId -> MToken' `["auth-info"]` -> m RespUserInfo
- authUserPatch :: AuthMonad m => UserId -> PatchUser -> MToken' `["auth-update"]` -> m Unit
- authUserPut :: AuthMonad m => UserId -> ReqRegister -> MToken' `["auth-update"]` -> m Unit
- authUserDelete :: AuthMonad m => UserId -> MToken' `["auth-delete"]` -> m Unit
- authRestore :: AuthMonad m => UserId -> Maybe RestoreCode -> Maybe Password -> m Unit
- authGetSingleUseCodes :: AuthMonad m => UserId -> Maybe Word -> MToken' `["auth-single-codes"]` -> m (OnlyField "codes" [SingleUseCode])
- authGroupGet :: AuthMonad m => UserGroupId -> MToken' `["auth-info"]` -> m UserGroup
- authGroupPost :: AuthMonad m => UserGroup -> MToken' `["auth-update"]` -> m (OnlyId UserGroupId)
- authGroupPut :: AuthMonad m => UserGroupId -> UserGroup -> MToken' `["auth-update"]` -> m Unit
- authGroupPatch :: AuthMonad m => UserGroupId -> PatchUserGroup -> MToken' `["auth-update"]` -> m Unit
- authGroupDelete :: AuthMonad m => UserGroupId -> MToken' `["auth-delete"]` -> m Unit
- authGroupList :: AuthMonad m => Maybe Page -> Maybe PageSize -> MToken' `["auth-info"]` -> m (PagedList UserGroupId UserGroup)
- getAuthToken :: AuthMonad m => UserImplId -> Maybe Seconds -> m SimpleToken
Implementation
authServer :: AuthConfig -> Server AuthAPI Source
Implementation of AuthAPI
Server API
class Monad m => AuthMonad m where Source
The interface your application should implement to be able to use token authorisation API.
getAuthConfig :: m AuthConfig Source
liftAuthAction :: ExceptT ServantErr IO a -> m a Source
Helpers
guardAuthToken :: forall perms m. (PermsList perms, AuthMonad m) => MToken perms -> m () Source
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 () Source
Ensures that DB has at leas one admin, if not, creates a new one with specified info.
authUserByToken :: AuthMonad m => MToken `[]` -> m UserImplId Source
Getting user id by token
API methods
:: 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 everything is OK, return token |
Implementation of "signin" method
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
:: AuthMonad 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
:: AuthMonad 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
:: AuthMonad m | |
=> MToken `[]` | Authorisation header with token |
-> m RespUserInfo |
Implementation of "token" method, return info about user binded to the token
Implementation of "signout" method
:: AuthMonad m | |
=> ReqRegister | Registration info |
-> MToken' `["auth-register"]` | Authorisation header with token |
-> m (OnlyField "user" UserId) |
Implementation of "signup" method
:: 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
:: AuthMonad m | |
=> UserId | User id |
-> MToken' `["auth-info"]` | Authorisation header with token |
-> m RespUserInfo |
Implementation of get "user" method
:: 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
:: AuthMonad m | |
=> UserId | User id |
-> ReqRegister | New user |
-> MToken' `["auth-update"]` | Authorisation header with token |
-> m Unit |
Implementation of put "user" method
:: AuthMonad m | |
=> UserId | User id |
-> MToken' `["auth-delete"]` | Authorisation header with token |
-> m Unit |
Implementation of patch "user" method
:: AuthMonad m | |
=> UserId | Id of user |
-> Maybe Word | Number of codes. |
-> MToken' `["auth-single-codes"]` | |
-> m (OnlyField "codes" [SingleUseCode]) |
Implementation of AuthGetSingleUseCodes
endpoint.
:: AuthMonad m | |
=> UserGroupId | |
-> MToken' `["auth-info"]` | Authorisation header with token |
-> m UserGroup |
Getting info about user group, requires authInfoPerm
for token
:: AuthMonad m | |
=> UserGroup | |
-> MToken' `["auth-update"]` | Authorisation header with token |
-> m (OnlyId UserGroupId) |
Inserting new user group, requires authUpdatePerm
for token
:: AuthMonad m | |
=> UserGroupId | |
-> UserGroup | |
-> MToken' `["auth-update"]` | Authorisation header with token |
-> m Unit |
Replace info about given user group, requires authUpdatePerm
for token
:: AuthMonad m | |
=> UserGroupId | |
-> PatchUserGroup | |
-> MToken' `["auth-update"]` | Authorisation header with token |
-> m Unit |
Patch info about given user group, requires authUpdatePerm
for token
:: AuthMonad m | |
=> UserGroupId | |
-> MToken' `["auth-delete"]` | Authorisation header with token |
-> m Unit |
Delete all info about given user group, requires authDeletePerm
for token
:: 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
Low-level API
:: AuthMonad 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