Commit d4e9ee25 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-userid-in-auth' of...

Merge branch 'dev-userid-in-auth' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantext into dev-merge
parents acb9c992 d51bf06b
...@@ -70,7 +70,7 @@ checkAuthRequest u (GargPassword p) = do ...@@ -70,7 +70,7 @@ checkAuthRequest u (GargPassword p) = do
candidate <- head <$> getUsersWith u candidate <- head <$> getUsersWith u
case candidate of case candidate of
Nothing -> pure InvalidUser Nothing -> pure InvalidUser
Just (UserLight _id _u _email h) -> Just (UserLight id _u _email h) ->
case Auth.checkPassword (Auth.mkPassword p) (Auth.PasswordHash h) of case Auth.checkPassword (Auth.mkPassword p) (Auth.PasswordHash h) of
Auth.PasswordCheckFail -> pure InvalidPassword Auth.PasswordCheckFail -> pure InvalidPassword
Auth.PasswordCheckSuccess -> do Auth.PasswordCheckSuccess -> do
...@@ -79,7 +79,7 @@ checkAuthRequest u (GargPassword p) = do ...@@ -79,7 +79,7 @@ checkAuthRequest u (GargPassword p) = do
Nothing -> pure InvalidUser Nothing -> pure InvalidUser
Just uid -> do Just uid -> do
token <- makeTokenForUser uid token <- makeTokenForUser uid
pure $ Valid token uid pure $ Valid token uid id
auth :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env) auth :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env)
=> AuthRequest -> Cmd' env err AuthResponse => AuthRequest -> Cmd' env err AuthResponse
...@@ -88,7 +88,7 @@ auth (AuthRequest u p) = do ...@@ -88,7 +88,7 @@ auth (AuthRequest u p) = do
case checkAuthRequest' of case checkAuthRequest' of
InvalidUser -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid user") InvalidUser -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid user")
InvalidPassword -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid password") InvalidPassword -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid password")
Valid to trId -> pure $ AuthResponse (Just $ AuthValid to trId) Nothing Valid to trId uId -> pure $ AuthResponse (Just $ AuthValid to trId uId) Nothing
--type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser) --type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser)
......
...@@ -23,7 +23,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) ...@@ -23,7 +23,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import Gargantext.Core.Types.Individu (Username, GargPassword(..), arbitraryUsername, arbitraryPassword) import Gargantext.Core.Types.Individu (Username, GargPassword(..), arbitraryUsername, arbitraryPassword)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Admin.Types.Node (NodeId(..), ListId, DocId) import Gargantext.Database.Admin.Types.Node (NodeId(..), ListId, DocId, UserId)
import Gargantext.Prelude hiding (reverse) import Gargantext.Prelude hiding (reverse)
--------------------------------------------------- ---------------------------------------------------
...@@ -45,13 +45,14 @@ data AuthInvalid = AuthInvalid { _authInv_message :: Text } ...@@ -45,13 +45,14 @@ data AuthInvalid = AuthInvalid { _authInv_message :: Text }
data AuthValid = AuthValid { _authVal_token :: Token data AuthValid = AuthValid { _authVal_token :: Token
, _authVal_tree_id :: TreeId , _authVal_tree_id :: TreeId
, _authVal_user_id :: UserId
} }
deriving (Generic) deriving (Generic)
type Token = Text type Token = Text
type TreeId = NodeId type TreeId = NodeId
data CheckAuth = InvalidUser | InvalidPassword | Valid Token TreeId data CheckAuth = InvalidUser | InvalidPassword | Valid Token TreeId UserId
deriving (Eq) deriving (Eq)
newtype AuthenticatedUser = AuthenticatedUser newtype AuthenticatedUser = AuthenticatedUser
...@@ -99,9 +100,10 @@ $(deriveJSON (unPrefix "_authVal_") ''AuthValid) ...@@ -99,9 +100,10 @@ $(deriveJSON (unPrefix "_authVal_") ''AuthValid)
instance ToSchema AuthValid where instance ToSchema AuthValid where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authVal_") declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authVal_")
instance Arbitrary AuthValid where instance Arbitrary AuthValid where
arbitrary = elements [ AuthValid to tr arbitrary = elements [ AuthValid to tr u
| to <- ["token0", "token1"] | to <- ["token0", "token1"]
, tr <- [1..3] , tr <- [1..3]
, u <- [1..3]
] ]
data PathId = PathNode NodeId | PathNodeNode ListId DocId data PathId = PathNode NodeId | PathNodeNode ListId DocId
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment