packages feed

servant-auth-token 0.4.4.1 → 0.4.5.0

raw patch · 14 files changed

+504/−4 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

+ Servant.Server.Auth.Token.Config: instance (Servant.Server.Auth.Token.Config.HasAuthConfig m, GHC.Base.Monoid w) => Servant.Server.Auth.Token.Config.HasAuthConfig (Control.Monad.Trans.RWS.Lazy.RWST r w s m)
+ Servant.Server.Auth.Token.Config: instance (Servant.Server.Auth.Token.Config.HasAuthConfig m, GHC.Base.Monoid w) => Servant.Server.Auth.Token.Config.HasAuthConfig (Control.Monad.Trans.RWS.Strict.RWST r w s m)
+ Servant.Server.Auth.Token.Config: instance (Servant.Server.Auth.Token.Config.HasAuthConfig m, GHC.Base.Monoid w) => Servant.Server.Auth.Token.Config.HasAuthConfig (Control.Monad.Trans.Writer.Lazy.WriterT w m)
+ Servant.Server.Auth.Token.Config: instance (Servant.Server.Auth.Token.Config.HasAuthConfig m, GHC.Base.Monoid w) => Servant.Server.Auth.Token.Config.HasAuthConfig (Control.Monad.Trans.Writer.Strict.WriterT w m)
+ Servant.Server.Auth.Token.Config: instance Servant.Server.Auth.Token.Config.HasAuthConfig m => Servant.Server.Auth.Token.Config.HasAuthConfig (Control.Monad.Trans.Cont.ContT r m)
+ Servant.Server.Auth.Token.Config: instance Servant.Server.Auth.Token.Config.HasAuthConfig m => Servant.Server.Auth.Token.Config.HasAuthConfig (Control.Monad.Trans.Except.ExceptT e m)
+ Servant.Server.Auth.Token.Config: instance Servant.Server.Auth.Token.Config.HasAuthConfig m => Servant.Server.Auth.Token.Config.HasAuthConfig (Control.Monad.Trans.Reader.ReaderT r m)
+ Servant.Server.Auth.Token.Config: instance Servant.Server.Auth.Token.Config.HasAuthConfig m => Servant.Server.Auth.Token.Config.HasAuthConfig (Control.Monad.Trans.State.Lazy.StateT s m)
+ Servant.Server.Auth.Token.Config: instance Servant.Server.Auth.Token.Config.HasAuthConfig m => Servant.Server.Auth.Token.Config.HasAuthConfig (Control.Monad.Trans.State.Strict.StateT s m)
+ Servant.Server.Auth.Token.Model: instance (Servant.Server.Auth.Token.Model.HasStorage m, GHC.Base.Monoid w) => Servant.Server.Auth.Token.Model.HasStorage (Control.Monad.Trans.RWS.Lazy.RWST r w s m)
+ Servant.Server.Auth.Token.Model: instance (Servant.Server.Auth.Token.Model.HasStorage m, GHC.Base.Monoid w) => Servant.Server.Auth.Token.Model.HasStorage (Control.Monad.Trans.RWS.Strict.RWST r w s m)
+ Servant.Server.Auth.Token.Model: instance (Servant.Server.Auth.Token.Model.HasStorage m, GHC.Base.Monoid w) => Servant.Server.Auth.Token.Model.HasStorage (Control.Monad.Trans.Writer.Lazy.WriterT w m)
+ Servant.Server.Auth.Token.Model: instance (Servant.Server.Auth.Token.Model.HasStorage m, GHC.Base.Monoid w) => Servant.Server.Auth.Token.Model.HasStorage (Control.Monad.Trans.Writer.Strict.WriterT w m)
+ Servant.Server.Auth.Token.Model: instance Servant.Server.Auth.Token.Model.HasStorage m => Servant.Server.Auth.Token.Model.HasStorage (Control.Monad.Trans.Cont.ContT r m)
+ Servant.Server.Auth.Token.Model: instance Servant.Server.Auth.Token.Model.HasStorage m => Servant.Server.Auth.Token.Model.HasStorage (Control.Monad.Trans.Except.ExceptT e m)
+ Servant.Server.Auth.Token.Model: instance Servant.Server.Auth.Token.Model.HasStorage m => Servant.Server.Auth.Token.Model.HasStorage (Control.Monad.Trans.Reader.ReaderT r m)
+ Servant.Server.Auth.Token.Model: instance Servant.Server.Auth.Token.Model.HasStorage m => Servant.Server.Auth.Token.Model.HasStorage (Control.Monad.Trans.State.Lazy.StateT s m)
+ Servant.Server.Auth.Token.Model: instance Servant.Server.Auth.Token.Model.HasStorage m => Servant.Server.Auth.Token.Model.HasStorage (Control.Monad.Trans.State.Strict.StateT s m)
- Servant.Server.Auth.Token: class MonadIO m => HasStorage m
+ Servant.Server.Auth.Token: class MonadIO m => HasStorage m where getUserImpl = lift . getUserImpl getUserImplByLogin = lift . getUserImplByLogin listUsersPaged = (lift .) . listUsersPaged getUserImplPermissions = lift . getUserImplPermissions deleteUserPermissions = lift . deleteUserPermissions insertUserPerm = lift . insertUserPerm insertUserImpl = lift . insertUserImpl replaceUserImpl = (lift .) . replaceUserImpl deleteUserImpl = lift . deleteUserImpl hasPerm = (lift .) . hasPerm getFirstUserByPerm = lift . getFirstUserByPerm selectUserImplGroups = lift . selectUserImplGroups clearUserImplGroups = lift . clearUserImplGroups insertAuthUserGroup = lift . insertAuthUserGroup insertAuthUserGroupUsers = lift . insertAuthUserGroupUsers insertAuthUserGroupPerms = lift . insertAuthUserGroupPerms getAuthUserGroup = lift . getAuthUserGroup listAuthUserGroupPermissions = lift . listAuthUserGroupPermissions listAuthUserGroupUsers = lift . listAuthUserGroupUsers replaceAuthUserGroup = (lift .) . replaceAuthUserGroup clearAuthUserGroupUsers = lift . clearAuthUserGroupUsers clearAuthUserGroupPerms = lift . clearAuthUserGroupPerms deleteAuthUserGroup = lift . deleteAuthUserGroup listGroupsPaged = (lift .) . listGroupsPaged setAuthUserGroupName = (lift .) . setAuthUserGroupName setAuthUserGroupParent = (lift .) . setAuthUserGroupParent insertSingleUseCode = lift . insertSingleUseCode setSingleUseCodeUsed = (lift .) . setSingleUseCodeUsed getUnusedCode suc = (lift .) . getUnusedCode suc invalidatePermamentCodes = (lift .) . invalidatePermamentCodes selectLastRestoreCode = (lift .) . selectLastRestoreCode insertUserRestore = lift . insertUserRestore findRestoreCode uid = (lift .) . findRestoreCode uid replaceRestoreCode = (lift .) . replaceRestoreCode findAuthToken = (lift .) . findAuthToken findAuthTokenByValue = lift . findAuthTokenByValue insertAuthToken = lift . insertAuthToken replaceAuthToken = (lift .) . replaceAuthToken
- Servant.Server.Auth.Token: clearAuthUserGroupPerms :: HasStorage m => AuthUserGroupId -> m ()
+ Servant.Server.Auth.Token: clearAuthUserGroupPerms :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m ()
- Servant.Server.Auth.Token: clearAuthUserGroupUsers :: HasStorage m => AuthUserGroupId -> m ()
+ Servant.Server.Auth.Token: clearAuthUserGroupUsers :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m ()
- Servant.Server.Auth.Token: clearUserImplGroups :: HasStorage m => UserImplId -> m ()
+ Servant.Server.Auth.Token: clearUserImplGroups :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m ()
- Servant.Server.Auth.Token: deleteAuthUserGroup :: HasStorage m => AuthUserGroupId -> m ()
+ Servant.Server.Auth.Token: deleteAuthUserGroup :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m ()
- Servant.Server.Auth.Token: deleteUserImpl :: HasStorage m => UserImplId -> m ()
+ Servant.Server.Auth.Token: deleteUserImpl :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m ()
- Servant.Server.Auth.Token: deleteUserPermissions :: HasStorage m => UserImplId -> m ()
+ Servant.Server.Auth.Token: deleteUserPermissions :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m ()
- Servant.Server.Auth.Token: findAuthToken :: HasStorage m => UserImplId -> UTCTime -> m (Maybe (WithId AuthTokenId AuthToken))
+ Servant.Server.Auth.Token: findAuthToken :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UTCTime -> m (Maybe (WithId AuthTokenId AuthToken))
- Servant.Server.Auth.Token: findAuthTokenByValue :: HasStorage m => SimpleToken -> m (Maybe (WithId AuthTokenId AuthToken))
+ Servant.Server.Auth.Token: findAuthTokenByValue :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => SimpleToken -> m (Maybe (WithId AuthTokenId AuthToken))
- Servant.Server.Auth.Token: findRestoreCode :: HasStorage m => UserImplId -> RestoreCode -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))
+ Servant.Server.Auth.Token: findRestoreCode :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> RestoreCode -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))
- Servant.Server.Auth.Token: getAuthUserGroup :: HasStorage m => AuthUserGroupId -> m (Maybe AuthUserGroup)
+ Servant.Server.Auth.Token: getAuthUserGroup :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m (Maybe AuthUserGroup)
- Servant.Server.Auth.Token: getFirstUserByPerm :: HasStorage m => Permission -> m (Maybe (WithId UserImplId UserImpl))
+ Servant.Server.Auth.Token: getFirstUserByPerm :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => Permission -> m (Maybe (WithId UserImplId UserImpl))
- Servant.Server.Auth.Token: getUnusedCode :: HasStorage m => SingleUseCode -> UserImplId -> UTCTime -> m (Maybe (WithId UserSingleUseCodeId UserSingleUseCode))
+ Servant.Server.Auth.Token: getUnusedCode :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => SingleUseCode -> UserImplId -> UTCTime -> m (Maybe (WithId UserSingleUseCodeId UserSingleUseCode))
- Servant.Server.Auth.Token: getUserImpl :: HasStorage m => UserImplId -> m (Maybe UserImpl)
+ Servant.Server.Auth.Token: getUserImpl :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m (Maybe UserImpl)
- Servant.Server.Auth.Token: getUserImplByLogin :: HasStorage m => Login -> m (Maybe (WithId UserImplId UserImpl))
+ Servant.Server.Auth.Token: getUserImplByLogin :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => Login -> m (Maybe (WithId UserImplId UserImpl))
- Servant.Server.Auth.Token: getUserImplPermissions :: HasStorage m => UserImplId -> m [WithId UserPermId UserPerm]
+ Servant.Server.Auth.Token: getUserImplPermissions :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m [WithId UserPermId UserPerm]
- Servant.Server.Auth.Token: hasPerm :: HasStorage m => UserImplId -> Permission -> m Bool
+ Servant.Server.Auth.Token: hasPerm :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> Permission -> m Bool
- Servant.Server.Auth.Token: insertAuthToken :: HasStorage m => AuthToken -> m AuthTokenId
+ Servant.Server.Auth.Token: insertAuthToken :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthToken -> m AuthTokenId
- Servant.Server.Auth.Token: insertAuthUserGroup :: HasStorage m => AuthUserGroup -> m AuthUserGroupId
+ Servant.Server.Auth.Token: insertAuthUserGroup :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroup -> m AuthUserGroupId
- Servant.Server.Auth.Token: insertAuthUserGroupPerms :: HasStorage m => AuthUserGroupPerms -> m AuthUserGroupPermsId
+ Servant.Server.Auth.Token: insertAuthUserGroupPerms :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupPerms -> m AuthUserGroupPermsId
- Servant.Server.Auth.Token: insertAuthUserGroupUsers :: HasStorage m => AuthUserGroupUsers -> m AuthUserGroupUsersId
+ Servant.Server.Auth.Token: insertAuthUserGroupUsers :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupUsers -> m AuthUserGroupUsersId
- Servant.Server.Auth.Token: insertSingleUseCode :: HasStorage m => UserSingleUseCode -> m UserSingleUseCodeId
+ Servant.Server.Auth.Token: insertSingleUseCode :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserSingleUseCode -> m UserSingleUseCodeId
- Servant.Server.Auth.Token: insertUserImpl :: HasStorage m => UserImpl -> m UserImplId
+ Servant.Server.Auth.Token: insertUserImpl :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImpl -> m UserImplId
- Servant.Server.Auth.Token: insertUserPerm :: HasStorage m => UserPerm -> m UserPermId
+ Servant.Server.Auth.Token: insertUserPerm :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserPerm -> m UserPermId
- Servant.Server.Auth.Token: insertUserRestore :: HasStorage m => UserRestore -> m UserRestoreId
+ Servant.Server.Auth.Token: insertUserRestore :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserRestore -> m UserRestoreId
- Servant.Server.Auth.Token: invalidatePermamentCodes :: HasStorage m => UserImplId -> UTCTime -> m ()
+ Servant.Server.Auth.Token: invalidatePermamentCodes :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UTCTime -> m ()
- Servant.Server.Auth.Token: listAuthUserGroupPermissions :: HasStorage m => AuthUserGroupId -> m [WithId AuthUserGroupPermsId AuthUserGroupPerms]
+ Servant.Server.Auth.Token: listAuthUserGroupPermissions :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m [WithId AuthUserGroupPermsId AuthUserGroupPerms]
- Servant.Server.Auth.Token: listAuthUserGroupUsers :: HasStorage m => AuthUserGroupId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]
+ Servant.Server.Auth.Token: listAuthUserGroupUsers :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]
- Servant.Server.Auth.Token: listGroupsPaged :: HasStorage m => Page -> PageSize -> m ([WithId AuthUserGroupId AuthUserGroup], Word)
+ Servant.Server.Auth.Token: listGroupsPaged :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => Page -> PageSize -> m ([WithId AuthUserGroupId AuthUserGroup], Word)
- Servant.Server.Auth.Token: listUsersPaged :: HasStorage m => Page -> PageSize -> m ([WithId UserImplId UserImpl], Word)
+ Servant.Server.Auth.Token: listUsersPaged :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => Page -> PageSize -> m ([WithId UserImplId UserImpl], Word)
- Servant.Server.Auth.Token: replaceAuthToken :: HasStorage m => AuthTokenId -> AuthToken -> m ()
+ Servant.Server.Auth.Token: replaceAuthToken :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthTokenId -> AuthToken -> m ()
- Servant.Server.Auth.Token: replaceAuthUserGroup :: HasStorage m => AuthUserGroupId -> AuthUserGroup -> m ()
+ Servant.Server.Auth.Token: replaceAuthUserGroup :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> AuthUserGroup -> m ()
- Servant.Server.Auth.Token: replaceRestoreCode :: HasStorage m => UserRestoreId -> UserRestore -> m ()
+ Servant.Server.Auth.Token: replaceRestoreCode :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserRestoreId -> UserRestore -> m ()
- Servant.Server.Auth.Token: replaceUserImpl :: HasStorage m => UserImplId -> UserImpl -> m ()
+ Servant.Server.Auth.Token: replaceUserImpl :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UserImpl -> m ()
- Servant.Server.Auth.Token: selectLastRestoreCode :: HasStorage m => UserImplId -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))
+ Servant.Server.Auth.Token: selectLastRestoreCode :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))
- Servant.Server.Auth.Token: selectUserImplGroups :: HasStorage m => UserImplId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]
+ Servant.Server.Auth.Token: selectUserImplGroups :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]
- Servant.Server.Auth.Token: setAuthUserGroupName :: HasStorage m => AuthUserGroupId -> Text -> m ()
+ Servant.Server.Auth.Token: setAuthUserGroupName :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> Text -> m ()
- Servant.Server.Auth.Token: setAuthUserGroupParent :: HasStorage m => AuthUserGroupId -> Maybe AuthUserGroupId -> m ()
+ Servant.Server.Auth.Token: setAuthUserGroupParent :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> Maybe AuthUserGroupId -> m ()
- Servant.Server.Auth.Token: setSingleUseCodeUsed :: HasStorage m => UserSingleUseCodeId -> Maybe UTCTime -> m ()
+ Servant.Server.Auth.Token: setSingleUseCodeUsed :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserSingleUseCodeId -> Maybe UTCTime -> m ()
- Servant.Server.Auth.Token.Config: class Monad m => HasAuthConfig m
+ Servant.Server.Auth.Token.Config: class Monad m => HasAuthConfig m where getAuthConfig = lift getAuthConfig
- Servant.Server.Auth.Token.Config: getAuthConfig :: HasAuthConfig m => m AuthConfig
+ Servant.Server.Auth.Token.Config: getAuthConfig :: (HasAuthConfig m, m ~ t n, MonadTrans t, HasAuthConfig n) => m AuthConfig
- Servant.Server.Auth.Token.Model: class MonadIO m => HasStorage m
+ Servant.Server.Auth.Token.Model: class MonadIO m => HasStorage m where getUserImpl = lift . getUserImpl getUserImplByLogin = lift . getUserImplByLogin listUsersPaged = (lift .) . listUsersPaged getUserImplPermissions = lift . getUserImplPermissions deleteUserPermissions = lift . deleteUserPermissions insertUserPerm = lift . insertUserPerm insertUserImpl = lift . insertUserImpl replaceUserImpl = (lift .) . replaceUserImpl deleteUserImpl = lift . deleteUserImpl hasPerm = (lift .) . hasPerm getFirstUserByPerm = lift . getFirstUserByPerm selectUserImplGroups = lift . selectUserImplGroups clearUserImplGroups = lift . clearUserImplGroups insertAuthUserGroup = lift . insertAuthUserGroup insertAuthUserGroupUsers = lift . insertAuthUserGroupUsers insertAuthUserGroupPerms = lift . insertAuthUserGroupPerms getAuthUserGroup = lift . getAuthUserGroup listAuthUserGroupPermissions = lift . listAuthUserGroupPermissions listAuthUserGroupUsers = lift . listAuthUserGroupUsers replaceAuthUserGroup = (lift .) . replaceAuthUserGroup clearAuthUserGroupUsers = lift . clearAuthUserGroupUsers clearAuthUserGroupPerms = lift . clearAuthUserGroupPerms deleteAuthUserGroup = lift . deleteAuthUserGroup listGroupsPaged = (lift .) . listGroupsPaged setAuthUserGroupName = (lift .) . setAuthUserGroupName setAuthUserGroupParent = (lift .) . setAuthUserGroupParent insertSingleUseCode = lift . insertSingleUseCode setSingleUseCodeUsed = (lift .) . setSingleUseCodeUsed getUnusedCode suc = (lift .) . getUnusedCode suc invalidatePermamentCodes = (lift .) . invalidatePermamentCodes selectLastRestoreCode = (lift .) . selectLastRestoreCode insertUserRestore = lift . insertUserRestore findRestoreCode uid = (lift .) . findRestoreCode uid replaceRestoreCode = (lift .) . replaceRestoreCode findAuthToken = (lift .) . findAuthToken findAuthTokenByValue = lift . findAuthTokenByValue insertAuthToken = lift . insertAuthToken replaceAuthToken = (lift .) . replaceAuthToken
- Servant.Server.Auth.Token.Model: clearAuthUserGroupPerms :: HasStorage m => AuthUserGroupId -> m ()
+ Servant.Server.Auth.Token.Model: clearAuthUserGroupPerms :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m ()
- Servant.Server.Auth.Token.Model: clearAuthUserGroupUsers :: HasStorage m => AuthUserGroupId -> m ()
+ Servant.Server.Auth.Token.Model: clearAuthUserGroupUsers :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m ()
- Servant.Server.Auth.Token.Model: clearUserImplGroups :: HasStorage m => UserImplId -> m ()
+ Servant.Server.Auth.Token.Model: clearUserImplGroups :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m ()
- Servant.Server.Auth.Token.Model: deleteAuthUserGroup :: HasStorage m => AuthUserGroupId -> m ()
+ Servant.Server.Auth.Token.Model: deleteAuthUserGroup :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m ()
- Servant.Server.Auth.Token.Model: deleteUserImpl :: HasStorage m => UserImplId -> m ()
+ Servant.Server.Auth.Token.Model: deleteUserImpl :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m ()
- Servant.Server.Auth.Token.Model: deleteUserPermissions :: HasStorage m => UserImplId -> m ()
+ Servant.Server.Auth.Token.Model: deleteUserPermissions :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m ()
- Servant.Server.Auth.Token.Model: findAuthToken :: HasStorage m => UserImplId -> UTCTime -> m (Maybe (WithId AuthTokenId AuthToken))
+ Servant.Server.Auth.Token.Model: findAuthToken :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UTCTime -> m (Maybe (WithId AuthTokenId AuthToken))
- Servant.Server.Auth.Token.Model: findAuthTokenByValue :: HasStorage m => SimpleToken -> m (Maybe (WithId AuthTokenId AuthToken))
+ Servant.Server.Auth.Token.Model: findAuthTokenByValue :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => SimpleToken -> m (Maybe (WithId AuthTokenId AuthToken))
- Servant.Server.Auth.Token.Model: findRestoreCode :: HasStorage m => UserImplId -> RestoreCode -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))
+ Servant.Server.Auth.Token.Model: findRestoreCode :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> RestoreCode -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))
- Servant.Server.Auth.Token.Model: getAuthUserGroup :: HasStorage m => AuthUserGroupId -> m (Maybe AuthUserGroup)
+ Servant.Server.Auth.Token.Model: getAuthUserGroup :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m (Maybe AuthUserGroup)
- Servant.Server.Auth.Token.Model: getFirstUserByPerm :: HasStorage m => Permission -> m (Maybe (WithId UserImplId UserImpl))
+ Servant.Server.Auth.Token.Model: getFirstUserByPerm :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => Permission -> m (Maybe (WithId UserImplId UserImpl))
- Servant.Server.Auth.Token.Model: getUnusedCode :: HasStorage m => SingleUseCode -> UserImplId -> UTCTime -> m (Maybe (WithId UserSingleUseCodeId UserSingleUseCode))
+ Servant.Server.Auth.Token.Model: getUnusedCode :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => SingleUseCode -> UserImplId -> UTCTime -> m (Maybe (WithId UserSingleUseCodeId UserSingleUseCode))
- Servant.Server.Auth.Token.Model: getUserImpl :: HasStorage m => UserImplId -> m (Maybe UserImpl)
+ Servant.Server.Auth.Token.Model: getUserImpl :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m (Maybe UserImpl)
- Servant.Server.Auth.Token.Model: getUserImplByLogin :: HasStorage m => Login -> m (Maybe (WithId UserImplId UserImpl))
+ Servant.Server.Auth.Token.Model: getUserImplByLogin :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => Login -> m (Maybe (WithId UserImplId UserImpl))
- Servant.Server.Auth.Token.Model: getUserImplPermissions :: HasStorage m => UserImplId -> m [WithId UserPermId UserPerm]
+ Servant.Server.Auth.Token.Model: getUserImplPermissions :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m [WithId UserPermId UserPerm]
- Servant.Server.Auth.Token.Model: hasPerm :: HasStorage m => UserImplId -> Permission -> m Bool
+ Servant.Server.Auth.Token.Model: hasPerm :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> Permission -> m Bool
- Servant.Server.Auth.Token.Model: insertAuthToken :: HasStorage m => AuthToken -> m AuthTokenId
+ Servant.Server.Auth.Token.Model: insertAuthToken :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthToken -> m AuthTokenId
- Servant.Server.Auth.Token.Model: insertAuthUserGroup :: HasStorage m => AuthUserGroup -> m AuthUserGroupId
+ Servant.Server.Auth.Token.Model: insertAuthUserGroup :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroup -> m AuthUserGroupId
- Servant.Server.Auth.Token.Model: insertAuthUserGroupPerms :: HasStorage m => AuthUserGroupPerms -> m AuthUserGroupPermsId
+ Servant.Server.Auth.Token.Model: insertAuthUserGroupPerms :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupPerms -> m AuthUserGroupPermsId
- Servant.Server.Auth.Token.Model: insertAuthUserGroupUsers :: HasStorage m => AuthUserGroupUsers -> m AuthUserGroupUsersId
+ Servant.Server.Auth.Token.Model: insertAuthUserGroupUsers :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupUsers -> m AuthUserGroupUsersId
- Servant.Server.Auth.Token.Model: insertSingleUseCode :: HasStorage m => UserSingleUseCode -> m UserSingleUseCodeId
+ Servant.Server.Auth.Token.Model: insertSingleUseCode :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserSingleUseCode -> m UserSingleUseCodeId
- Servant.Server.Auth.Token.Model: insertUserImpl :: HasStorage m => UserImpl -> m UserImplId
+ Servant.Server.Auth.Token.Model: insertUserImpl :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImpl -> m UserImplId
- Servant.Server.Auth.Token.Model: insertUserPerm :: HasStorage m => UserPerm -> m UserPermId
+ Servant.Server.Auth.Token.Model: insertUserPerm :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserPerm -> m UserPermId
- Servant.Server.Auth.Token.Model: insertUserRestore :: HasStorage m => UserRestore -> m UserRestoreId
+ Servant.Server.Auth.Token.Model: insertUserRestore :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserRestore -> m UserRestoreId
- Servant.Server.Auth.Token.Model: invalidatePermamentCodes :: HasStorage m => UserImplId -> UTCTime -> m ()
+ Servant.Server.Auth.Token.Model: invalidatePermamentCodes :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UTCTime -> m ()
- Servant.Server.Auth.Token.Model: listAuthUserGroupPermissions :: HasStorage m => AuthUserGroupId -> m [WithId AuthUserGroupPermsId AuthUserGroupPerms]
+ Servant.Server.Auth.Token.Model: listAuthUserGroupPermissions :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m [WithId AuthUserGroupPermsId AuthUserGroupPerms]
- Servant.Server.Auth.Token.Model: listAuthUserGroupUsers :: HasStorage m => AuthUserGroupId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]
+ Servant.Server.Auth.Token.Model: listAuthUserGroupUsers :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]
- Servant.Server.Auth.Token.Model: listGroupsPaged :: HasStorage m => Page -> PageSize -> m ([WithId AuthUserGroupId AuthUserGroup], Word)
+ Servant.Server.Auth.Token.Model: listGroupsPaged :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => Page -> PageSize -> m ([WithId AuthUserGroupId AuthUserGroup], Word)
- Servant.Server.Auth.Token.Model: listUsersPaged :: HasStorage m => Page -> PageSize -> m ([WithId UserImplId UserImpl], Word)
+ Servant.Server.Auth.Token.Model: listUsersPaged :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => Page -> PageSize -> m ([WithId UserImplId UserImpl], Word)
- Servant.Server.Auth.Token.Model: replaceAuthToken :: HasStorage m => AuthTokenId -> AuthToken -> m ()
+ Servant.Server.Auth.Token.Model: replaceAuthToken :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthTokenId -> AuthToken -> m ()
- Servant.Server.Auth.Token.Model: replaceAuthUserGroup :: HasStorage m => AuthUserGroupId -> AuthUserGroup -> m ()
+ Servant.Server.Auth.Token.Model: replaceAuthUserGroup :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> AuthUserGroup -> m ()
- Servant.Server.Auth.Token.Model: replaceRestoreCode :: HasStorage m => UserRestoreId -> UserRestore -> m ()
+ Servant.Server.Auth.Token.Model: replaceRestoreCode :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserRestoreId -> UserRestore -> m ()
- Servant.Server.Auth.Token.Model: replaceUserImpl :: HasStorage m => UserImplId -> UserImpl -> m ()
+ Servant.Server.Auth.Token.Model: replaceUserImpl :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UserImpl -> m ()
- Servant.Server.Auth.Token.Model: selectLastRestoreCode :: HasStorage m => UserImplId -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))
+ Servant.Server.Auth.Token.Model: selectLastRestoreCode :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))
- Servant.Server.Auth.Token.Model: selectUserImplGroups :: HasStorage m => UserImplId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]
+ Servant.Server.Auth.Token.Model: selectUserImplGroups :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]
- Servant.Server.Auth.Token.Model: setAuthUserGroupName :: HasStorage m => AuthUserGroupId -> Text -> m ()
+ Servant.Server.Auth.Token.Model: setAuthUserGroupName :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> Text -> m ()
- Servant.Server.Auth.Token.Model: setAuthUserGroupParent :: HasStorage m => AuthUserGroupId -> Maybe AuthUserGroupId -> m ()
+ Servant.Server.Auth.Token.Model: setAuthUserGroupParent :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> Maybe AuthUserGroupId -> m ()
- Servant.Server.Auth.Token.Model: setSingleUseCodeUsed :: HasStorage m => UserSingleUseCodeId -> Maybe UTCTime -> m ()
+ Servant.Server.Auth.Token.Model: setSingleUseCodeUsed :: (HasStorage m, m ~ t n, MonadTrans t, HasStorage n) => UserSingleUseCodeId -> Maybe UTCTime -> m ()
- Servant.Server.Auth.Token.Monad: class Monad m => HasAuthConfig m
+ Servant.Server.Auth.Token.Monad: class Monad m => HasAuthConfig m where getAuthConfig = lift getAuthConfig
- Servant.Server.Auth.Token.Monad: getAuthConfig :: HasAuthConfig m => m AuthConfig
+ Servant.Server.Auth.Token.Monad: getAuthConfig :: (HasAuthConfig m, m ~ t n, MonadTrans t, HasAuthConfig n) => m AuthConfig

Files

CHANGELOG.md view
@@ -1,3 +1,8 @@+0.4.5.0+=======++* Auto deriving `HasAuthConfig` and `HasStorage` for transformers.+ 0.4.4.1 ======= 
LICENSE view
@@ -1,4 +1,4 @@-Copyright Anton Gushcha (c) 2016+Copyright Anton Gushcha (c) 2016-2017  All rights reserved. 
+ example/leveldb/LICENSE view
@@ -0,0 +1,30 @@+Copyright Anton Gushcha (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of NCrashed nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ example/leveldb/Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/leveldb/config.yaml view
@@ -0,0 +1,3 @@+host: localhost+port: 3000+db: "state"
+ example/leveldb/servant-auth-token-example-leveldb.cabal view
@@ -0,0 +1,70 @@+name:                servant-auth-token-example-leveldb+version:             0.4.0.1+synopsis:            Example server for token auth for leveldb backend+description:         Please see README.md+homepage:            https://github.com/ncrashed/servant-auth-token#readme+license:             BSD3+license-file:        LICENSE+author:              NCrashed+maintainer:          ncrashed@gmail.com+copyright:           2017 Anton Gushcha+category:            Web+build-type:          Simple+cabal-version:       >=1.10++executable servant-auth-token-example-leveldb+  hs-source-dirs:     src+  main-is:            Main.hs+  other-modules:+    API+    Config+    Monad+    Server+  default-language:   Haskell2010+  build-depends:+      base                          >= 4.7      && < 5+    , acid-state                    >= 0.14     && < 0.15+    , aeson                         >= 0.11     && < 1.1+    , aeson-injector                >= 1.0      && < 1.1+    , bytestring                    >= 0.10     && < 0.11+    , exceptions                    >= 0.8      && < 0.9+    , http-types                    >= 0.9      && < 0.10+    , leveldb-haskell               >= 0.6      && < 0.7+    , monad-control                 >= 1.0      && < 1.1+    , monad-logger                  >= 0.3      && < 0.4+    , mtl                           >= 2.2      && < 2.3+    , optparse-applicative          >= 0.12     && < 0.14+    , safecopy-store                >= 0.9      && < 0.10+    , servant                       >= 0.9      && < 0.10+    , servant-auth-token            >= 0.4      && < 0.5+    , servant-auth-token-api        >= 0.4      && < 0.5+    , servant-auth-token-leveldb    >= 0.4      && < 0.5+    , servant-server                >= 0.9      && < 0.10+    , text                          >= 1.2      && < 1.3+    , time                          >= 1.6      && < 1.7+    , transformers-base             >= 0.4      && < 0.5+    , wai                           >= 3.2      && < 3.3+    , wai-extra                     >= 3.0      && < 3.1+    , warp                          >= 3.2      && < 3.3+    , yaml                          >= 0.8      && < 0.9+  default-extensions:+    BangPatterns+    DataKinds+    DeriveFunctor+    DeriveGeneric+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GeneralizedNewtypeDeriving+    MultiParamTypeClasses+    OverloadedStrings+    RecordWildCards+    RecursiveDo+    ScopedTypeVariables+    StandaloneDeriving+    TemplateHaskell+    TypeFamilies+    TypeOperators+    UndecidableInstances++  ghc-options: -threaded
+ example/leveldb/src/API.hs view
@@ -0,0 +1,10 @@+module API(+    ExampleAPI+  ) where++import Servant.API+import Servant.API.Auth.Token++type ExampleAPI = "test"+  :> TokenHeader' '["test-permission"]+  :> Get '[JSON] ()
+ example/leveldb/src/Config.hs view
@@ -0,0 +1,30 @@+module Config(+    ServerConfig(..)+  , readConfig+  ) where++import Control.Monad+import Control.Monad.IO.Class+import Data.Aeson+import Data.Text+import Data.Yaml.Config++-- | Startup configuration of server+data ServerConfig = ServerConfig {+  -- | Server host name+  serverHost   :: !Text+  -- | Server port number+, serverPort   :: !Int+  -- | Server db location+, serverDbPath :: !Text+}++instance FromJSON ServerConfig where+  parseJSON (Object o) = ServerConfig+    <$> o .: "host"+    <*> o .: "port"+    <*> o .: "db"+  parseJSON _ = mzero++readConfig :: MonadIO m => FilePath -> m ServerConfig+readConfig f = liftIO $ loadYamlSettings [f] [] useEnv
+ example/leveldb/src/Main.hs view
@@ -0,0 +1,35 @@+module Main where++import Data.Monoid +import Options.Applicative++import Server++-- | Argument line options+data Options = Options {+  -- | Path to config, if not set, the app will not start+  configPath :: FilePath+}++-- | Command line parser+optionsParser :: Parser Options+optionsParser = Options+  <$> strOption (+         long "conf"+      <> metavar "CONFIG"+      <> help "Path to configuration file"+    )++-- | Execute server with given options+runServer :: Options -> IO ()+runServer Options{..} = do+  cfg <- readConfig configPath+  runExampleServer cfg++main :: IO ()+main = execParser opts >>= runServer+  where+    opts = info (helper <*> optionsParser)+      ( fullDesc+     <> progDesc "Example server for servant-auth-token"+     <> header "servant-auth-token-example-persistent - example of integration of servant token auth library" )
+ example/leveldb/src/Monad.hs view
@@ -0,0 +1,98 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Monad(+    ServerEnv(..)+  , ServerM+  , newServerEnv+  , runServerM+  , runServerMIO+  , serverMtoHandler+  , AuthM(..)+  , runAuth+  ) where++import Control.Monad.Base+import Control.Monad.Catch (MonadCatch, MonadThrow)+import Control.Monad.Except+import Control.Monad.Logger+import Control.Monad.Reader+import Control.Monad.Trans.Control+import Data.Acid+import Data.Monoid+import Data.Text (unpack)+import Database.LevelDB.MonadResource+import Servant.Server+import Servant.Server.Auth.Token.Config+import Servant.Server.Auth.Token.LevelDB+import Servant.Server.Auth.Token.Model++import Config++-- | Server private environment+data ServerEnv = ServerEnv {+  -- | Configuration used to create the server+  envConfig      :: !ServerConfig+  -- | Configuration of auth server+, envAuthConfig  :: !AuthConfig+  -- | DB state+, envDB          :: !LevelDBEnv+}++-- | Create new server environment+newServerEnv :: MonadIO m => ServerConfig -> m ServerEnv+newServerEnv cfg = do+  let authConfig = defaultAuthConfig+  dbEnv <- liftIO . runResourceT $ do+    db <- open (unpack $ serverDbPath cfg) defaultOptions { createIfMissing = True }+    dbEnv <- newLevelDBEnv db defaultReadOptions defaultWriteOptions+    -- ensure default admin if missing one+    _ <- runLevelDBBackendT authConfig dbEnv $ ensureAdmin 17 "admin" "123456" "admin@localhost"+    return dbEnv+  let env = ServerEnv {+        envConfig = cfg+      , envAuthConfig = authConfig+      , envDB = dbEnv+      }+  return env++-- | Server monad that holds internal environment+newtype ServerM a = ServerM { unServerM :: ReaderT ServerEnv (LoggingT Handler) a }+  deriving (Functor, Applicative, Monad, MonadIO, MonadBase IO, MonadReader ServerEnv+    , MonadLogger, MonadLoggerIO, MonadThrow, MonadCatch, MonadError ServantErr)++newtype StMServerM a = StMServerM { unStMServerM :: StM (ReaderT ServerEnv (LoggingT Handler)) a }++instance MonadBaseControl IO ServerM where+    type StM ServerM a = StMServerM a+    liftBaseWith f = ServerM $ liftBaseWith $ \q -> f (fmap StMServerM . q . unServerM)+    restoreM = ServerM . restoreM . unStMServerM++-- | Lift servant monad to server monad+liftHandler :: Handler a -> ServerM a+liftHandler = ServerM . lift . lift++-- | Execution of 'ServerM'+runServerM :: ServerEnv -> ServerM a -> Handler a+runServerM e = runStdoutLoggingT . flip runReaderT e . unServerM++-- | Execution of 'ServerM' in IO monad+runServerMIO :: ServerEnv -> ServerM a -> IO a+runServerMIO env m = do+  ea <- runExceptT $ runServerM env m+  case ea of+    Left e -> fail $ "runServerMIO: " <> show e+    Right a -> return a++-- | Transformation to Servant 'Handler'+serverMtoHandler :: ServerEnv -> ServerM :~> Handler+serverMtoHandler e = Nat (runServerM e)++-- | Special monad for authorisation actions+newtype AuthM a = AuthM { unAuthM :: LevelDBBackendT IO a }+  deriving (Functor, Applicative, Monad, MonadIO, MonadError ServantErr, HasAuthConfig, HasStorage)++-- | Execution of authorisation actions that require 'AuthHandler' context+runAuth :: AuthM a -> ServerM a+runAuth m = do+  cfg <- asks envAuthConfig+  db <- asks envDB+  liftHandler $ ExceptT $ runLevelDBBackendT cfg db $ unAuthM m
+ example/leveldb/src/Server.hs view
@@ -0,0 +1,49 @@+module Server(+  -- * Server config+    ServerConfig(..)+  , readConfig+  -- * Server environment+  , ServerEnv+  , newServerEnv+  -- * Execution of server+  , exampleServerApp+  , runExampleServer+  ) where++import Control.Monad.IO.Class+import Control.Monad.Logger+import Data.Proxy+import Network.Wai+import Network.Wai.Handler.Warp+import Network.Wai.Middleware.RequestLogger+import Servant.API.Auth.Token+import Servant.Server+import Servant.Server.Auth.Token++import API+import Config+import Monad++-- | Enter infinite loop of processing requests for pdf-master-server.+--+-- Starts new Warp server with initialised threads for serving the master server.+runExampleServer :: MonadIO m => ServerConfig -> m ()+runExampleServer config = liftIO $ do+  env <- newServerEnv config+  liftIO $ run (serverPort config) $ logStdoutDev $ exampleServerApp env++-- | WAI application of server+exampleServerApp :: ServerEnv -> Application+exampleServerApp e = serve (Proxy :: Proxy ExampleAPI) apiImpl+  where+    apiImpl = enter (serverMtoHandler e) exampleServer++-- | Implementation of main server API+exampleServer :: ServerT ExampleAPI ServerM+exampleServer = testEndpoint++testEndpoint :: MToken' '["test-permission"] -> ServerM ()+testEndpoint token = do+  runAuth $ guardAuthToken token+  $logInfo "testEndpoint"+  return ()
servant-auth-token.cabal view
@@ -1,13 +1,14 @@ name:                servant-auth-token-version:             0.4.4.1+version:             0.4.5.0 synopsis:            Servant based API and server for token based authorisation description:         Please see README.md homepage:            https://github.com/ncrashed/servant-auth-token#readme license:             BSD3 license-file:        LICENSE-author:              NCrashed+author:               Anton Gushcha <ncrashed@gmail.com>+                    , Ivan Lazar Miljenovic <Ivan.Miljenovic@gmail.com> maintainer:          ncrashed@gmail.com-copyright:           2016 Anton Gushcha+copyright:           2016-2017 Anton Gushcha category:            Web build-type:          Simple extra-source-files:@@ -33,6 +34,15 @@   example/persistent/Setup.hs   example/persistent/config.yaml   example/persistent/servant-auth-token-example-persistent.cabal+  example/leveldb/src/API.hs+  example/leveldb/src/Config.hs+  example/leveldb/src/Main.hs+  example/leveldb/src/Monad.hs+  example/leveldb/src/Server.hs+  example/leveldb/LICENSE+  example/leveldb/Setup.hs+  example/leveldb/config.yaml+  example/leveldb/servant-auth-token-example-leveldb.cabal cabal-version:       >=1.10  library
src/Servant/Server/Auth/Token/Config.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE DefaultSignatures #-}+ {-| Module      : Servant.Server.Auth.Token.Config Description : Configuration of auth server@@ -13,7 +15,17 @@   , defaultAuthConfig   ) where +import Control.Monad.Cont (ContT)+import Control.Monad.Except (ExceptT) import Control.Monad.IO.Class+import Control.Monad.Reader (ReaderT)+import qualified Control.Monad.RWS.Lazy as LRWS+import qualified Control.Monad.RWS.Strict as SRWS+import qualified Control.Monad.State.Lazy as LS+import qualified Control.Monad.State.Strict as SS+import qualified Control.Monad.Writer.Lazy as LW+import qualified Control.Monad.Writer.Strict as SW+import Control.Monad.Trans.Class (MonadTrans(lift)) import Data.Text (Text) import Data.Time import Data.UUID@@ -25,6 +37,18 @@ -- | Monad that can read an auth config class Monad m => HasAuthConfig m where   getAuthConfig :: m AuthConfig+  default getAuthConfig :: (m ~ t n, MonadTrans t, HasAuthConfig n) => m AuthConfig+  getAuthConfig = lift getAuthConfig++instance HasAuthConfig m => HasAuthConfig (ContT r m)+instance HasAuthConfig m => HasAuthConfig (ExceptT e m)+instance HasAuthConfig m => HasAuthConfig (ReaderT r m)+instance (HasAuthConfig m, Monoid w) => HasAuthConfig (LRWS.RWST r w s m)+instance (HasAuthConfig m, Monoid w) => HasAuthConfig (SRWS.RWST r w s m)+instance HasAuthConfig m => HasAuthConfig (LS.StateT s m)+instance HasAuthConfig m => HasAuthConfig (SS.StateT s m)+instance (HasAuthConfig m, Monoid w) => HasAuthConfig (LW.WriterT w m)+instance (HasAuthConfig m, Monoid w) => HasAuthConfig (SW.WriterT w m)  -- | Configuration specific for authorisation system data AuthConfig = AuthConfig {
src/Servant/Server/Auth/Token/Model.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DefaultSignatures #-} {-| Module      : Servant.Server.Auth.Token.Model Description : Internal operations with RDBMS@@ -61,7 +62,17 @@   ) where  import Control.Monad+import Control.Monad.Cont (ContT)+import Control.Monad.Except (ExceptT) import Control.Monad.IO.Class+import Control.Monad.Reader (ReaderT)+import qualified Control.Monad.RWS.Lazy as LRWS+import qualified Control.Monad.RWS.Strict as SRWS+import qualified Control.Monad.State.Lazy as LS+import qualified Control.Monad.State.Strict as SS+import qualified Control.Monad.Writer.Lazy as LW+import qualified Control.Monad.Writer.Strict as SW+import Control.Monad.Trans.Class (MonadTrans(lift)) import Crypto.PasswordStore import Data.Aeson.WithField import Data.Int@@ -220,80 +231,203 @@ class MonadIO m => HasStorage m where   -- | Getting user from storage   getUserImpl :: UserImplId -> m (Maybe UserImpl)+  default getUserImpl :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m (Maybe UserImpl)+  getUserImpl = lift . getUserImpl+   -- | Getting user from storage by login   getUserImplByLogin :: Login -> m (Maybe (WithId UserImplId UserImpl))+  default getUserImplByLogin :: (m ~ t n, MonadTrans t, HasStorage n) => Login -> m (Maybe (WithId UserImplId UserImpl))+  getUserImplByLogin = lift . getUserImplByLogin+   -- | Get paged list of users and total count of users   listUsersPaged :: Page -> PageSize -> m ([WithId UserImplId UserImpl], Word)+  default listUsersPaged :: (m ~ t n, MonadTrans t, HasStorage n) => Page -> PageSize -> m ([WithId UserImplId UserImpl], Word)+  listUsersPaged = (lift .) . listUsersPaged+   -- | Get user permissions, ascending by tag   getUserImplPermissions :: UserImplId -> m [WithId UserPermId UserPerm]+  default getUserImplPermissions :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m [WithId UserPermId UserPerm]+  getUserImplPermissions = lift . getUserImplPermissions+   -- | Delete user permissions   deleteUserPermissions :: UserImplId -> m ()+  default deleteUserPermissions :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m ()+  deleteUserPermissions = lift . deleteUserPermissions+   -- | Insertion of new user permission   insertUserPerm :: UserPerm -> m UserPermId+  default insertUserPerm :: (m ~ t n, MonadTrans t, HasStorage n) => UserPerm -> m UserPermId+  insertUserPerm = lift . insertUserPerm+   -- | Insertion of new user   insertUserImpl :: UserImpl -> m UserImplId+  default insertUserImpl :: (m ~ t n, MonadTrans t, HasStorage n) => UserImpl -> m UserImplId+  insertUserImpl = lift . insertUserImpl+   -- | Replace user with new value   replaceUserImpl :: UserImplId -> UserImpl -> m ()+  default replaceUserImpl :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UserImpl -> m ()+  replaceUserImpl = (lift .) . replaceUserImpl+   -- | Delete user by id   deleteUserImpl :: UserImplId -> m ()+  default deleteUserImpl :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m ()+  deleteUserImpl = lift . deleteUserImpl+   -- | Check whether the user has particular permission   hasPerm :: UserImplId -> Permission -> m Bool+  default hasPerm :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> Permission -> m Bool+  hasPerm = (lift .) . hasPerm+   -- | Get any user with given permission   getFirstUserByPerm :: Permission -> m (Maybe (WithId UserImplId UserImpl))+  default getFirstUserByPerm :: (m ~ t n, MonadTrans t, HasStorage n) => Permission -> m (Maybe (WithId UserImplId UserImpl))+  getFirstUserByPerm = lift . getFirstUserByPerm+   -- | Select user groups and sort them by ascending name   selectUserImplGroups :: UserImplId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]+  default selectUserImplGroups :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]+  selectUserImplGroups = lift . selectUserImplGroups+   -- | Remove user from all groups   clearUserImplGroups :: UserImplId -> m ()+  default clearUserImplGroups :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> m ()+  clearUserImplGroups = lift . clearUserImplGroups+   -- | Add new user group   insertAuthUserGroup :: AuthUserGroup -> m AuthUserGroupId+  default insertAuthUserGroup :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroup -> m AuthUserGroupId+  insertAuthUserGroup = lift . insertAuthUserGroup+   -- | Add user to given group   insertAuthUserGroupUsers :: AuthUserGroupUsers -> m AuthUserGroupUsersId+  default insertAuthUserGroupUsers :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupUsers -> m AuthUserGroupUsersId+  insertAuthUserGroupUsers = lift . insertAuthUserGroupUsers+   -- | Add permission to given group   insertAuthUserGroupPerms :: AuthUserGroupPerms -> m AuthUserGroupPermsId+  default insertAuthUserGroupPerms :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupPerms -> m AuthUserGroupPermsId+  insertAuthUserGroupPerms = lift . insertAuthUserGroupPerms+   -- | Find user group by id   getAuthUserGroup :: AuthUserGroupId -> m (Maybe AuthUserGroup)+  default getAuthUserGroup :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m (Maybe AuthUserGroup)+  getAuthUserGroup = lift . getAuthUserGroup+   -- | Get list of permissions of given group   listAuthUserGroupPermissions :: AuthUserGroupId -> m [WithId AuthUserGroupPermsId AuthUserGroupPerms]+  default listAuthUserGroupPermissions :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m [WithId AuthUserGroupPermsId AuthUserGroupPerms]+  listAuthUserGroupPermissions = lift . listAuthUserGroupPermissions+   -- | Get list of all users of the group   listAuthUserGroupUsers :: AuthUserGroupId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]+  default listAuthUserGroupUsers :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m [WithId AuthUserGroupUsersId AuthUserGroupUsers]+  listAuthUserGroupUsers = lift . listAuthUserGroupUsers+   -- | Replace record of user group   replaceAuthUserGroup :: AuthUserGroupId -> AuthUserGroup -> m ()+  default replaceAuthUserGroup :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> AuthUserGroup -> m ()+  replaceAuthUserGroup = (lift .) . replaceAuthUserGroup+   -- | Remove all users from group   clearAuthUserGroupUsers :: AuthUserGroupId -> m ()+  default clearAuthUserGroupUsers :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m ()+  clearAuthUserGroupUsers = lift . clearAuthUserGroupUsers+   -- | Remove all permissions from group   clearAuthUserGroupPerms :: AuthUserGroupId -> m ()+  default clearAuthUserGroupPerms :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m ()+  clearAuthUserGroupPerms = lift . clearAuthUserGroupPerms+   -- | Delete user group from storage   deleteAuthUserGroup :: AuthUserGroupId -> m ()+  default deleteAuthUserGroup :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> m ()+  deleteAuthUserGroup = lift . deleteAuthUserGroup+   -- | Get paged list of user groups with total count   listGroupsPaged :: Page -> PageSize -> m ([WithId AuthUserGroupId AuthUserGroup], Word)+  default listGroupsPaged :: (m ~ t n, MonadTrans t, HasStorage n) => Page -> PageSize -> m ([WithId AuthUserGroupId AuthUserGroup], Word)+  listGroupsPaged = (lift .) . listGroupsPaged+   -- | Set group name   setAuthUserGroupName :: AuthUserGroupId -> Text -> m ()+  default setAuthUserGroupName :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> Text -> m ()+  setAuthUserGroupName = (lift .) . setAuthUserGroupName+   -- | Set group parent   setAuthUserGroupParent :: AuthUserGroupId -> Maybe AuthUserGroupId -> m ()+  default setAuthUserGroupParent :: (m ~ t n, MonadTrans t, HasStorage n) => AuthUserGroupId -> Maybe AuthUserGroupId -> m ()+  setAuthUserGroupParent = (lift .) . setAuthUserGroupParent+   -- | Add new single use code   insertSingleUseCode :: UserSingleUseCode -> m UserSingleUseCodeId+  default insertSingleUseCode :: (m ~ t n, MonadTrans t, HasStorage n) => UserSingleUseCode -> m UserSingleUseCodeId+  insertSingleUseCode = lift . insertSingleUseCode+   -- | Set usage time of the single use code   setSingleUseCodeUsed :: UserSingleUseCodeId -> Maybe UTCTime -> m ()+  default setSingleUseCodeUsed :: (m ~ t n, MonadTrans t, HasStorage n) => UserSingleUseCodeId -> Maybe UTCTime -> m ()+  setSingleUseCodeUsed = (lift .) . setSingleUseCodeUsed+   -- | Find unused code for the user and expiration time greater than the given time   getUnusedCode :: SingleUseCode -> UserImplId -> UTCTime -> m (Maybe (WithId UserSingleUseCodeId UserSingleUseCode))+  default getUnusedCode :: (m ~ t n, MonadTrans t, HasStorage n) => SingleUseCode -> UserImplId -> UTCTime -> m (Maybe (WithId UserSingleUseCodeId UserSingleUseCode))+  getUnusedCode suc = (lift .) . getUnusedCode suc+   -- | Invalidate all permament codes for user and set use time for them   invalidatePermamentCodes :: UserImplId -> UTCTime -> m ()+  default invalidatePermamentCodes :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UTCTime -> m ()+  invalidatePermamentCodes = (lift .) . invalidatePermamentCodes+   -- | Select last valid restoration code by the given current time   selectLastRestoreCode :: UserImplId -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))+  default selectLastRestoreCode :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))+  selectLastRestoreCode = (lift .) . selectLastRestoreCode+   -- | Insert new restore code   insertUserRestore :: UserRestore -> m UserRestoreId+  default insertUserRestore :: (m ~ t n, MonadTrans t, HasStorage n) => UserRestore -> m UserRestoreId+  insertUserRestore = lift . insertUserRestore+   -- | Find unexpired by the time restore code   findRestoreCode :: UserImplId -> RestoreCode -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))+  default findRestoreCode :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> RestoreCode -> UTCTime -> m (Maybe (WithId UserRestoreId UserRestore))+  findRestoreCode uid = (lift .) . findRestoreCode uid+   -- | Replace restore code with new value   replaceRestoreCode :: UserRestoreId -> UserRestore -> m ()+  default replaceRestoreCode :: (m ~ t n, MonadTrans t, HasStorage n) => UserRestoreId -> UserRestore -> m ()+  replaceRestoreCode = (lift .) . replaceRestoreCode+   -- | Find first non-expired by the time token for user   findAuthToken :: UserImplId -> UTCTime -> m (Maybe (WithId AuthTokenId AuthToken))+  default findAuthToken :: (m ~ t n, MonadTrans t, HasStorage n) => UserImplId -> UTCTime -> m (Maybe (WithId AuthTokenId AuthToken))+  findAuthToken = (lift .) . findAuthToken+   -- | Find token by value   findAuthTokenByValue :: SimpleToken -> m (Maybe (WithId AuthTokenId AuthToken))+  default findAuthTokenByValue :: (m ~ t n, MonadTrans t, HasStorage n) => SimpleToken -> m (Maybe (WithId AuthTokenId AuthToken))+  findAuthTokenByValue = lift . findAuthTokenByValue+   -- | Insert new token   insertAuthToken :: AuthToken -> m AuthTokenId+  default insertAuthToken :: (m ~ t n, MonadTrans t, HasStorage n) => AuthToken -> m AuthTokenId+  insertAuthToken = lift . insertAuthToken+   -- | Replace auth token with new value   replaceAuthToken :: AuthTokenId -> AuthToken -> m ()+  default replaceAuthToken :: (m ~ t n, MonadTrans t, HasStorage n) => AuthTokenId -> AuthToken -> m ()+  replaceAuthToken = (lift .) . replaceAuthToken++instance HasStorage m => HasStorage (ContT r m)+instance HasStorage m => HasStorage (ExceptT e m)+instance HasStorage m => HasStorage (ReaderT r m)+instance (HasStorage m, Monoid w) => HasStorage (LRWS.RWST r w s m)+instance (HasStorage m, Monoid w) => HasStorage (SRWS.RWST r w s m)+instance HasStorage m => HasStorage (LS.StateT s m)+instance HasStorage m => HasStorage (SS.StateT s m)+instance (HasStorage m, Monoid w) => HasStorage (LW.WriterT w m)+instance (HasStorage m, Monoid w) => HasStorage (SW.WriterT w m)  -- | Convert password to bytestring passToByteString :: Password -> BS.ByteString