servant-auth-token 0.1.0.0 → 0.1.1.0

raw patch · 8 files changed

+40/−15 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +2/−0
• servant-auth-token.cabal +1/−1
• src/Servant/Server/Auth/Token.hs +2/−1
• src/Servant/Server/Auth/Token/Config.hs +18/−6
• src/Servant/Server/Auth/Token/Error.hs +1/−0
• src/Servant/Server/Auth/Token/Model.hs +8/−2
• src/Servant/Server/Auth/Token/Restore.hs +3/−5

@@ -1,3 +1,8 @@+0.1.1.0+=======++* Added `restoreCodeGenerator` to configuration+ 0.1.0.0 ======= 

@@ -1,5 +1,7 @@ # servant-auth-token +[![Build Status](https://travis-ci.org/NCrashed/servant-auth-token.svg?branch=master)](https://travis-ci.org/NCrashed/servant-auth-token)+ The repo contains server implementation of [servant-auth-toke-api](https://github.com/NCrashed/servant-auth-token-api).  # How to add to your server

@@ -1,5 +1,5 @@ name:                servant-auth-token-version:             0.1.0.0+version:             0.1.1.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

@@ -337,7 +337,8 @@     Nothing -> do        dt <- getsConfig restoreExpire       t <- liftIO getCurrentTime-      rc <- runDB $ getRestoreCode uid $ addUTCTime dt t +      AuthConfig{..} <- getConfig+      rc <- runDB $ getRestoreCode restoreCodeGenerator uid $ addUTCTime dt t        uinfo <- runDB404 "user" $ readUserInfo uid'       sendRestoreCode uinfo rc      Just code -> do 

@@ -12,8 +12,11 @@   , defaultAuthConfig   ) where  +import Control.Monad.IO.Class  import Data.Text (Text) import Data.Time +import Data.UUID+import Data.UUID.V4 import Database.Persist.Sql  import Servant.Server  @@ -29,13 +32,20 @@   -- | For password restore, defines amounts of seconds   -- when restore code becomes invalid.   , restoreExpire :: !NominalDiffTime+  -- | User specified implementation of restore code sending. It could+  -- be a email sender or SMS message or mobile application method, whatever+  -- the implementation needs.+  , restoreCodeSender :: !(RespUserInfo -> RestoreCode -> IO ())+  -- | User specified generator for restore codes. By default the server+  -- generates UUID that can be unacceptable for SMS restoration routine.+  , restoreCodeGenerator :: !(IO RestoreCode)   -- | Upper bound of expiration time that user can request   -- for a token.   , maximumExpire :: !(Maybe NominalDiffTime)   -- | For authorisation, defines amount of hashing   -- of new user passwords (should be greater or equal 14).   -- The passwords hashed 2^strength times. It is needed to -  -- prevent almost all kinds of bruteforce attacks, rainbow+  -- prevent almost all kinds of brute force attacks, rainbow   -- tables and dictionary attacks.   , passwordsStrength :: !Int   -- | Validates user password at registration / password change.@@ -49,21 +59,23 @@   , servantErrorFormer :: !(ServantErr -> ServantErr)   -- | Default size of page for pagination   , defaultPageSize :: !Word -  -- | User specified implementation of restore code sending. It could-  -- be a email sender or sms message or mobile application method, whatever-  -- the implementation needs.-  , restoreCodeSender :: !(RespUserInfo -> RestoreCode -> IO ())   } +-- | Default configuration for authorisation server defaultAuthConfig :: ConnectionPool -> AuthConfig  defaultAuthConfig pool = AuthConfig {     getPool = pool   , defaultExpire = fromIntegral (600 :: Int)   , restoreExpire = fromIntegral (3*24*3600 :: Int) -- 3 days+  , restoreCodeSender = const $ const $ return ()+  , restoreCodeGenerator = uuidCodeGenerate   , maximumExpire = Nothing   , passwordsStrength = 17   , passwordValidator = const Nothing   , servantErrorFormer = id   , defaultPageSize = 50-  , restoreCodeSender = const $ const $ return ()   }++-- | Default generator of restore codes+uuidCodeGenerate :: IO RestoreCode+uuidCodeGenerate = toText <$> liftIO nextRandom

@@ -29,6 +29,7 @@   f <- asks servantErrorFormer   return $ f e +-- | Wrappers to throw corresponding servant errors throw400, throw401, throw404, throw409, throw500    :: (MonadError ServantErr m, MonadReader AuthConfig m)    => BS.ByteString -> m a

@@ -131,9 +131,11 @@   pool <- asks getPool   liftIO $ runSqlPool query pool +-- | Convert password to bytestring passToByteString :: Password -> BS.ByteString passToByteString = TE.encodeUtf8 +-- | Convert bytestring into password byteStringToPass :: BS.ByteString -> Password byteStringToPass = TE.decodeUtf8 @@ -208,7 +210,9 @@   madmin <- selectFirst [UserPermPermission ==. adminPerm] []   whenNothing madmin $ void $ createAdmin strength login pass email  -patchUser :: Int -> PatchUser -> Entity UserImpl -> SqlPersistT IO (Entity UserImpl)+-- | Apply patches for user+patchUser :: Int -- ^ Password strength+  -> PatchUser -> Entity UserImpl -> SqlPersistT IO (Entity UserImpl) patchUser strength PatchUser{..} =           withPatch patchUserLogin (\l (Entity i u) -> pure $ Entity i u { userImplLogin = l })     >=> withPatch patchUserPassword patchPassword@@ -224,7 +228,9 @@         setUserGroups i gs         return $ Entity i u -setUserPassword' :: MonadIO m => Int -> Password -> UserImpl -> m UserImpl+-- | Update password of user +setUserPassword' :: MonadIO m => Int -- ^ Password strength+  -> Password -> UserImpl -> m UserImpl setUserPassword' strength pass user = do   pass' <- liftIO $ makePassword (passToByteString pass) strength   return $ user { userImplPassword = byteStringToPass pass' }

@@ -16,8 +16,6 @@ import Control.Monad  import Control.Monad.IO.Class  import Data.Time.Clock-import Data.UUID-import Data.UUID.V4 import Database.Persist.Postgresql  import Servant.API.Auth.Token@@ -26,13 +24,13 @@ import Servant.Server.Auth.Token.Monad   -- | Get current restore code for user or generate new-getRestoreCode :: UserImplId -> UTCTime -> SqlPersistT IO RestoreCode-getRestoreCode uid expire = do +getRestoreCode :: IO RestoreCode -> UserImplId -> UTCTime -> SqlPersistT IO RestoreCode+getRestoreCode generator uid expire = do    t <- liftIO getCurrentTime   mcode <- selectFirst [UserRestoreUser ==. uid, UserRestoreExpire >. t] [Desc UserRestoreExpire]   case mcode of      Nothing -> do -      code <- toText <$> liftIO nextRandom+      code <- liftIO generator       void $ insert UserRestore {           userRestoreValue = code          , userRestoreUser = uid