[SECURITY] implemeting password hash

package.yaml

@@ -87,7 +87,7 @@ library:
   - aeson
   - aeson-lens
   - aeson-pretty
-  - argon2
+  - password
   - array
   - async
   - attoparsec

src/Gargantext/Core/Auth.hs

+{-|
+Module      : Gargantext.API.Admin.Auth.Check
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE OverloadedStrings   #-}
+
+module Gargantext.Core.Auth ( createPasswordHash
+                            , checkPassword
+                            , module Data.Password.Argon2
+                            )
+      where
+
+import Control.Monad.IO.Class (MonadIO)
+import Data.Text (Text)
+import Data.Password.Argon2 hiding (checkPassword)
+import qualified Data.Password.Argon2 as A
+
+
+createPasswordHash :: MonadIO m 
+                   => Text
+                   -> m (PasswordHash Argon2)
+createPasswordHash x = hashPassword (mkPassword x)
+
+
+checkPassword :: Password
+              -> PasswordHash Argon2
+              -> PasswordCheck
+checkPassword = A.checkPassword
+
+{-
+-- Notes to implement Raw Password with argon2 lib
+-- (now using password library, which does not use salt anymore)
+-- import Crypto.Argon2 as Crypto
+-- import Data.ByteString.Base64.URL as URL
+-- import Data.Either
+-- import Data.ByteString (ByteString)
+secret_key :: ByteString
+secret_key = "WRV5ymit8s~ge6%08dLR7Q!gBcpb1MY%7e67db2206"
+
+type SecretKey = ByteString
+
+hashNode :: SecretKey -> NodeToHash -> ByteString
+hashNode sk (NodeToHash nt ni) = case hashResult of
+    Left  e -> panic (cs $ show e)
+    Right h -> URL.encode h
+  where
+    hashResult = Crypto.hash Crypto.defaultHashOptions
+                  sk
+                  (cs $ show nt <> show ni)
+-}

src/Gargantext/Core/Types/Individu.hs

@@ -18,9 +18,11 @@ Individu defintions
 module Gargantext.Core.Types.Individu
   where
 
+import Control.Monad.IO.Class (MonadIO)
 import Data.Text (Text, pack, reverse)
 import Gargantext.Database.Admin.Types.Node (NodeId, UserId)
 import Gargantext.Prelude hiding (reverse)
+import qualified Gargantext.Core.Auth as Auth
 
 -- FIXME UserName used twice
 data User = UserDBId UserId | UserName Text | RootId NodeId
@@ -28,6 +30,7 @@ data User = UserDBId UserId | UserName Text | RootId NodeId
 
 type Username = Text
 type Password = Text
+type Email    = Text
 
 type UsernameMaster = Username
 type UsernameSimple = Username
@@ -42,4 +45,19 @@ arbitraryUsername = ["gargantua"] <> users
 arbitraryPassword :: [Password]
 arbitraryPassword = map reverse arbitraryUsername
 
+-----------------------------------------------------------
+
+arbitraryUsersHash :: MonadIO m
+                  => m [(Username, Email, Auth.PasswordHash Auth.Argon2)]
+arbitraryUsersHash = mapM userHash arbitraryUsers
+
+userHash :: MonadIO m
+                  => (Username, Email, Password)
+                  -> m (Username, Email, Auth.PasswordHash Auth.Argon2)
+userHash (u,m,p) = do
+  h <- Auth.createPasswordHash p
+  pure (u, m, h)
+
+arbitraryUsers :: [(Username, Email, Password)]
+arbitraryUsers = map (\u -> (u, u <> "@gargantext.org", reverse u)) arbitraryUsername
 

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

@@ -27,9 +27,9 @@ module Gargantext.Database.Query.Table.User
   ( insertUsers
   , queryUserTable
   , getUser
-  , gargantextUser
+  , gargUserWith
   , insertUsersDemo
-  , selectUsersLight
+  , selectUsersLightWith
   , userWithUsername
   , userWithId
   , userLightWithId
@@ -44,35 +44,43 @@ import Data.Maybe (Maybe)
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import Gargantext.Core.Types.Individu
+import qualified Gargantext.Core.Auth as Auth
 import Gargantext.Database.Schema.User
 import Gargantext.Database.Prelude
 import Gargantext.Prelude
 import Opaleye
 
 ------------------------------------------------------------------------
+
+
 -- TODO: on conflict, nice message
 insertUsers :: [UserWrite] -> Cmd err Int64
 insertUsers us = mkCmd $ \c -> runInsert_ c insert
   where
     insert = Insert userTable us rCount Nothing
 
-gargantextUser :: Username -> UserWrite
-gargantextUser u = UserDB (Nothing) (pgStrictText "password")
+insertUsersDemo :: Cmd err Int64
+insertUsersDemo = do
+  users <- liftBase arbitraryUsersHash
+  insertUsers $ map (\(u,m,h) -> gargUserWith u m h) users
+
+-----------------------------------------------------------------------
+
+gargUserWith :: Username -> Email -> Auth.PasswordHash Auth.Argon2 -> UserWrite
+gargUserWith u m (Auth.PasswordHash p) = UserDB (Nothing) (pgStrictText p)
                          (Nothing) (pgBool True) (pgStrictText u)
                          (pgStrictText "first_name")
                          (pgStrictText "last_name")
-                         (pgStrictText "e@mail")
-                         (pgBool True) (pgBool True) (Nothing)
-
-insertUsersDemo :: Cmd err Int64
-insertUsersDemo = insertUsers $ map (\u -> gargantextUser u) arbitraryUsername
+                         (pgStrictText m)
+                         (pgBool True) 
+                         (pgBool True) Nothing
 
 ------------------------------------------------------------------
 queryUserTable :: Query UserRead
 queryUserTable = queryTable userTable
 
-selectUsersLight :: Query UserRead
-selectUsersLight = proc () -> do
+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

src/Gargantext/Database/Schema/User.hs

@@ -43,10 +43,11 @@ import Opaleye
 data UserLight = UserLight { userLight_id       :: !Int
                            , userLight_username :: !Text
                            , userLight_email    :: !Text
+                           , userLigth_password :: !Text
                            } deriving (Show)
 
 toUserLight :: UserDB -> UserLight
-toUserLight (UserDB id _ _ _ u _ _ e _ _ _ ) = UserLight id u e
+toUserLight (UserDB id p _ _ u _ _ e _ _ _ ) = UserLight id u e p
 
 data UserPoly id pass llogin suser
               uname fname lname

src/Gargantext/Prelude/Utils.hs

@@ -20,10 +20,6 @@ import Control.Lens (view)
 import Control.Monad.Random.Class (MonadRandom)
 import Control.Monad.Reader (MonadReader)
 import Control.Monad.Reader (ask)
-import Crypto.Argon2 as Crypto
-import Data.ByteString (ByteString)
-import Data.ByteString.Base64.URL as URL
-import Data.Either
 import Data.Text (Text)
 import GHC.IO (FilePath)
 import Gargantext.API.Admin.Settings
@@ -53,24 +49,9 @@ data NodeToHash = NodeToHash { nodeType :: NodeType
                              , nodeId   :: NodeId
                              }
 
-secret_key :: ByteString
-secret_key = "WRV5ymit8s~ge6%08dLR7Q!gBcpb1MY%7e67db2206"
-
-type SecretKey = ByteString
-
 type FolderPath = FilePath
 type FileName   = FilePath
 
-hashNode :: SecretKey -> NodeToHash -> ByteString
-hashNode sk (NodeToHash nt ni) = case hashResult of
-    Left  e -> panic (cs $ show e)
-    Right h -> URL.encode h
-  where
-    hashResult = Crypto.hash Crypto.defaultHashOptions
-                  sk
-                  (cs $ show nt <> show ni)
-
-
 toPath :: Int -> Text -> (FolderPath,FileName)
 toPath n x = (Text.unpack $ Text.intercalate "/" [x1,x2], Text.unpack xs)
   where

stack.yaml

@@ -81,4 +81,6 @@ extra-deps:
 - validity-0.9.0.0 # patches-{map,class}
 - directory-1.3.1.5
 - process-1.6.5.1@sha256:77a9afeb676357f67fe5cf1ad79aca0745fb6f7fb96b786d510af08f622643f6,2468
-- argon2-1.3.0.1@sha256:e7771caf255929453c7cebfed0809617c51428d1c1b22f207c80b8711b792d78,4592
+- password-2.0.1.1
+- base64-0.4.2@sha256:e9523e18bdadc3cab9dc32dfe3ac09c718fe792076326d6d353437b8b255cb5b,2888
+- ghc-byteorder-4.11.0.0.10@sha256:5ee4a907279bfec27b0f9de7b8fba4cecfd34395a0235a7784494de70ad4e98f,1535