From a4129ae5cf79836f3404ea6a7b947935cee5828f Mon Sep 17 00:00:00 2001 From: Mats Rauhala Date: Sun, 5 Aug 2018 21:39:38 +0300 Subject: [PATCH] Finish the password validation --- src/Database/User.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/Database/User.hs b/src/Database/User.hs index cec5341..2d789ca 100644 --- a/src/Database/User.hs +++ b/src/Database/User.hs @@ -8,11 +8,12 @@ import ClassyPrelude import Database import Database.Schema import Database.Selda -import Control.Lens (over, _Just) +import Control.Lens (view, over, _Just) import Data.Generics.Product import Crypto.KDF.BCrypt import Crypto.Random.Types (MonadRandom) import Control.Monad.Logger +import Control.Monad (mfilter) data UserExistsError = UserExistsError @@ -43,7 +44,12 @@ getUser :: (MonadMask m, MonadIO m) => Username -> SeldaT m (Maybe (User NoPassw getUser name = over (_Just . field @"password") (const NoPassword) <$> getUser' name validateUser :: (MonadMask m, MonadIO m) => Username -> PlainPassword -> SeldaT m (Maybe (User NoPassword)) -validateUser name _ = getUser name +validateUser name (PlainPassword password) = + asHidden . mfilter valid <$> getUser' name + where + valid = validatePassword password' . unHashed . view (field @"password") + password' = encodeUtf8 password + asHidden = over (_Just . field @"password") (const NoPassword) getUser' :: (MonadMask m, MonadIO m) => Username -> SeldaT m (Maybe ( User HashedPassword )) getUser' name = listToMaybe . fmap fromRel <$> query q