diff --git a/api/src/Api/Auth.hs b/api/src/Api/Auth.hs index fb49415..a8c461e 100644 --- a/api/src/Api/Auth.hs +++ b/api/src/Api/Auth.hs @@ -9,7 +9,7 @@ import Servant import qualified Servant.Auth.Server import Servant.Auth.Server (ThrowAll(throwAll), SetCookie, CookieSettings, JWTSettings, acceptLogin, JWT) import Control.Monad.IO.Class (liftIO) -import Db.User ( User', UserId (UserId), User (User) ) +import Db.User ( User', UserId (UserId), User (User), password ) import GHC.Generics ( Generic ) import Servant.API.Generic ((:-), ToServantApi) import Data.Aeson (ToJSON, FromJSON) @@ -19,7 +19,7 @@ import Servant.Server.Generic (AsServerT) import Api.User import App (AppM) import Data.Text (pack) -import Password (hashPassword'', toPassword) +import Password (hashPassword'', toPassword, validatePassword') data LoginUser = LoginUser { loginUsername :: String @@ -56,13 +56,16 @@ loginHandler :: CookieSettings -> JWTSettings -> LoginUser -> AppM (Headers '[Header "Set-Cookie" SetCookie, Header "Set-Cookie" SetCookie] NoContent) -loginHandler cs jwts (LoginUser username password) = do +loginHandler cs jwts (LoginUser username p) = do users' <- getUserByName' $ pack username let usr = head users' - mApplyCookies <- liftIO $ acceptLogin cs jwts usr - case mApplyCookies of - Nothing -> throwError err401 - Just applyCookies -> return $ applyCookies NoContent + if validatePassword' (toPassword $ pack p) (password usr) then do + mApplyCookies <- liftIO $ acceptLogin cs jwts usr + case mApplyCookies of + Nothing -> throwError err401 + Just applyCookies -> return $ applyCookies NoContent + else + throwError err401 signupHandler :: SignupUser -> AppM NoContent