Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Przemyslaw Kaminski
haskell-gargantext
Commits
d51bf06b
Commit
d51bf06b
authored
Feb 17, 2022
by
Karen Konou
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Auth] add user_id to auth response
parent
b1a0ce6f
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
8 additions
and
6 deletions
+8
-6
Auth.hs
src/Gargantext/API/Admin/Auth.hs
+3
-3
Types.hs
src/Gargantext/API/Admin/Auth/Types.hs
+5
-3
No files found.
src/Gargantext/API/Admin/Auth.hs
View file @
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
tr
Id
)
Nothing
Valid
to
trId
uId
->
pure
$
AuthResponse
(
Just
$
AuthValid
to
trId
u
Id
)
Nothing
--type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser)
--type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser)
...
...
src/Gargantext/API/Admin/Auth/Types.hs
View file @
d51bf06b
...
@@ -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
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment