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 +5/−0
- LICENSE +1/−1
- example/leveldb/LICENSE +30/−0
- example/leveldb/Setup.hs +2/−0
- example/leveldb/config.yaml +3/−0
- example/leveldb/servant-auth-token-example-leveldb.cabal +70/−0
- example/leveldb/src/API.hs +10/−0
- example/leveldb/src/Config.hs +30/−0
- example/leveldb/src/Main.hs +35/−0
- example/leveldb/src/Monad.hs +98/−0
- example/leveldb/src/Server.hs +49/−0
- servant-auth-token.cabal +13/−3
- src/Servant/Server/Auth/Token/Config.hs +24/−0
- src/Servant/Server/Auth/Token/Model.hs +134/−0
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