[SECURITY] password check implemented (needs tests).

src/Gargantext/API/Admin/Auth.hs

@@ -34,9 +34,8 @@ module Gargantext.API.Admin.Auth
 
 import Control.Lens (view)
 import Data.Aeson.TH (deriveJSON)
-import Data.List (elem)
 import Data.Swagger
-import Data.Text (Text, reverse)
+import Data.Text (Text)
 import Data.Text.Lazy (toStrict)
 import Data.Text.Lazy.Encoding (decodeUtf8)
 import GHC.Generics (Generic)
@@ -50,10 +49,12 @@ import Gargantext.Database.Schema.Node (NodePoly(_node_id))
 import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId, ListId, DocId)
 import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool)
 import Gargantext.Prelude hiding (reverse)
+import Gargantext.Database.Query.Table.User
 import Servant
 import Servant.Auth.Server
 import Test.QuickCheck (elements, oneof)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import qualified Gargantext.Core.Auth as Auth
 
 ---------------------------------------------------
 
@@ -96,17 +97,23 @@ makeTokenForUser uid = do
   -- TODO not sure about the encoding...
 
 checkAuthRequest :: (HasSettings env, HasConnectionPool env, HasJoseError err)
-                 => Username -> Password -> Cmd' env err CheckAuth
-checkAuthRequest u p
-  | not (u `elem` arbitraryUsername) = pure InvalidUser
-  | u /= reverse p = pure InvalidPassword
-  | otherwise = do
-      muId <- head <$> getRoot (UserName u)
-      case _node_id <$> muId of
-        Nothing  -> pure InvalidUser
-        Just uid -> do
-          token <- makeTokenForUser uid
-          pure $ Valid token uid
+                 => Username
+                 -> Password
+                 -> Cmd' env err CheckAuth
+checkAuthRequest u p = do
+  candidate <- head <$> getUsersWith u
+  case candidate of
+    Nothing -> pure InvalidUser
+    Just (UserLight _id _u _email h) ->
+      case Auth.checkPassword (Auth.mkPassword p) (Auth.PasswordHash h) of
+        Auth.PasswordCheckFail    -> pure InvalidPassword
+        Auth.PasswordCheckSuccess -> do
+          muId <- head <$> getRoot (UserName u)
+          case _node_id <$> muId of
+            Nothing  -> pure InvalidUser
+            Just uid -> do
+              token <- makeTokenForUser uid
+              pure $ Valid token uid
 
 auth :: (HasSettings env, HasConnectionPool env, HasJoseError err)
      => AuthRequest -> Cmd' env err AuthResponse

src/Gargantext/Database/Query/Table/User.hs

@@ -33,6 +33,7 @@ module Gargantext.Database.Query.Table.User
   , userWithUsername
   , userWithId
   , userLightWithId
+  , getUsersWith
   , module Gargantext.Database.Schema.User
   )
   where
@@ -76,15 +77,18 @@ gargUserWith u m (Auth.PasswordHash p) = UserDB (Nothing) (pgStrictText p)
                          (pgBool True) Nothing
 
 ------------------------------------------------------------------
+getUsersWith :: Username -> Cmd err [UserLight]
+getUsersWith u = map toUserLight <$> runOpaQuery (selectUsersLightWith u)
+
+selectUsersLightWith :: Username -> Query UserRead
+selectUsersLightWith u = proc () -> do
+      row      <- queryUserTable -< ()
+      restrict -< user_username row .== pgStrictText u
+      returnA  -< row
+
 queryUserTable :: Query UserRead
 queryUserTable = queryTable userTable
 
-selectUsersLightWith :: Query UserRead
-selectUsersLightWith = proc () -> do
-      row@(UserDB i _p _ll _is _un _fn _ln _m _iff _ive _dj) <- queryUserTable -< ()
-      restrict -< i .== 1
-      --returnA -< User i p ll is un fn ln m iff ive dj
-      returnA -< row
 ------------------------------------------------------------------
 -- | Select User with some parameters
 -- Not optimized version

src/Gargantext/Database/Schema/User.hs

@@ -13,6 +13,7 @@ Functions to deal with users, database side.
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 {-# OPTIONS_GHC -fno-warn-orphans        #-}
 
+{-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE TemplateHaskell             #-}
 {-# LANGUAGE FlexibleContexts            #-}
 {-# LANGUAGE FlexibleInstances           #-}
@@ -22,6 +23,7 @@ Functions to deal with users, database side.
 {-# LANGUAGE NoImplicitPrelude           #-}
 {-# LANGUAGE OverloadedStrings           #-}
 {-# LANGUAGE RankNTypes                  #-}
+{-# LANGUAGE TemplateHaskell            #-}
 
 module Gargantext.Database.Schema.User where
 
@@ -30,6 +32,11 @@ import Data.Text (Text)
 import Data.Time (UTCTime)
 import GHC.Show(Show(..))
 import Gargantext.Prelude
+import GHC.Generics (Generic)
+import Database.PostgreSQL.Simple.FromField (FromField, fromField)
+import Data.Aeson.TH (deriveJSON)
+import Gargantext.Database.Prelude (fromField')
+import Gargantext.Core.Utils.Prefix (unPrefix)
 
 -- FIXME PLZ : the import below leads to an error, why ?
 -- import Gargantext.Database.Schema.Prelude hiding (makeLensesWith, abbreviatedFields, makeAdaptorAndInstance)
@@ -37,18 +44,19 @@ import Gargantext.Prelude
 -- When FIXED : Imports to remove:
 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
-import Opaleye
+import Opaleye hiding (FromField)
 
 ------------------------------------------------------------------------
 data UserLight = UserLight { userLight_id       :: !Int
                            , userLight_username :: !Text
                            , userLight_email    :: !Text
-                           , userLigth_password :: !Text
-                           } deriving (Show)
+                           , userLight_password :: !Text
+                           } deriving (Show, Generic)
 
 toUserLight :: UserDB -> UserLight
 toUserLight (UserDB id p _ _ u _ _ e _ _ _ ) = UserLight id u e p
 
+
 data UserPoly id pass llogin suser
               uname fname lname
               mail staff active djoined =
@@ -65,7 +73,8 @@ data UserPoly id pass llogin suser
            , user_isStaff     :: !staff
            , user_isActive    :: !active
            , user_dateJoined  :: !djoined
-           } deriving (Show)
+           } deriving (Show, Generic)
+
 
 type UserWrite = UserPoly (Maybe (Column PGInt4))        (Column PGText)
                           (Maybe (Column PGTimestamptz)) (Column PGBool)
@@ -108,3 +117,12 @@ userTable = Table "auth_user"
                   , user_dateJoined  = optional "date_joined"
                   }
       )
+
+instance FromField UserLight where
+  fromField = fromField'
+
+instance FromField UserDB where
+  fromField = fromField'
+
+$(deriveJSON (unPrefix "userLight_") ''UserLight)
+$(deriveJSON (unPrefix "user_") ''UserPoly)