Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
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
Grégoire Locqueville
haskell-gargantext
Commits
7093c642
Commit
7093c642
authored
Sep 18, 2023
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Test AuthAPI endpoint
parent
c7f15cf2
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
53 additions
and
8 deletions
+53
-8
Types.hs
src/Gargantext/API/Admin/Auth/Types.hs
+4
-4
Routes.hs
src/Gargantext/API/Routes.hs
+4
-1
Authentication.hs
test/Test/API/Authentication.hs
+45
-3
No files found.
src/Gargantext/API/Admin/Auth/Types.hs
View file @
7093c642
...
...
@@ -38,16 +38,16 @@ data AuthRequest = AuthRequest { _authReq_username :: Username
data
AuthResponse
=
AuthResponse
{
_authRes_valid
::
Maybe
AuthValid
,
_authRes_inval
::
Maybe
AuthInvalid
}
deriving
(
Generic
)
deriving
(
Generic
,
Eq
,
Show
)
data
AuthInvalid
=
AuthInvalid
{
_authInv_message
::
Text
}
deriving
(
Generic
)
deriving
(
Generic
,
Eq
,
Show
)
data
AuthValid
=
AuthValid
{
_authVal_token
::
Token
,
_authVal_tree_id
::
TreeId
,
_authVal_user_id
::
UserId
}
deriving
(
Generic
)
deriving
(
Generic
,
Eq
,
Show
)
type
Token
=
Text
type
TreeId
=
NodeId
...
...
@@ -130,4 +130,4 @@ data ForgotPasswordGet = ForgotPasswordGet {_fpGet_password :: Password}
deriving
(
Generic
)
$
(
deriveJSON
(
unPrefix
"_fpGet_"
)
''
F
orgotPasswordGet
)
instance
ToSchema
ForgotPasswordGet
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_fpGet_"
)
\ No newline at end of file
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_fpGet_"
)
src/Gargantext/API/Routes.hs
View file @
7093c642
...
...
@@ -70,11 +70,14 @@ type GargVersion = "version"
:>
Summary
"Backend version"
:>
Get
'[
J
SON
]
Text
type
GargAPI'
=
type
AuthAPI
=
-- Auth endpoint
"auth"
:>
Summary
"AUTH API"
:>
ReqBody
'[
J
SON
]
AuthRequest
:>
Post
'[
J
SON
]
AuthResponse
type
GargAPI'
=
AuthAPI
:<|>
"forgot-password"
:>
ForgotPasswordAPI
:<|>
"async"
:>
"forgot-password"
:>
ForgotPasswordAsyncAPI
:<|>
GargVersion
...
...
test/Test/API/Authentication.hs
View file @
7093c642
...
...
@@ -34,6 +34,12 @@ import Gargantext.Database.Prelude
import
Gargantext.Core.NLP
import
qualified
Servant.Job.Async
as
ServantAsync
import
Servant.Auth.Client
()
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.Core.Types.Individu
import
Control.Monad
import
Control.Monad.Reader
import
Gargantext.Database.Action.User.New
import
Gargantext.Core.Types
newTestEnv
::
TestEnv
->
Logger
(
GargM
Env
GargError
)
->
Warp
.
Port
->
IO
Env
newTestEnv
testEnv
logger
port
=
do
...
...
@@ -90,13 +96,49 @@ withTestDBAndPort action =
tests
::
Spec
tests
=
sequential
$
aroundAll
withTestDBAndPort
$
do
describe
"Authentication"
$
do
let
version_api
=
client
(
Proxy
::
Proxy
(
MkGargAPI
(
GargAPIVersion
GargVersion
)))
baseUrl
<-
runIO
$
parseBaseUrl
"http://localhost"
manager
<-
runIO
$
newManager
defaultManagerSettings
let
clientEnv
port
=
mkClientEnv
manager
(
baseUrl
{
baseUrlPort
=
port
})
-- testing scenarios start here
describe
"GET /version"
$
do
it
"requires no auth"
$
\
(
_testEnv
,
port
)
->
do
describe
"GET /api/v1.0/version"
$
do
let
version_api
=
client
(
Proxy
::
Proxy
(
MkGargAPI
(
GargAPIVersion
GargVersion
)))
it
"requires no auth and returns the current version"
$
\
(
_testEnv
,
port
)
->
do
result
<-
runClientM
version_api
(
clientEnv
port
)
result
`
shouldBe
`
(
Right
"0.0.6.9.9.7.7"
)
describe
"POST /api/v1.0/auth"
$
do
let
auth_api
=
client
(
Proxy
::
Proxy
(
MkGargAPI
(
GargAPIVersion
AuthAPI
)))
it
"requires no auth and authenticates the user 'alice'"
$
\
(
testEnv
,
port
)
->
do
-- Let's create two users, Alice & Bob. Alice shouldn't be able to see
-- Bob's private data and vice-versa.
void
$
flip
runReaderT
testEnv
$
runTestMonad
$
do
let
nur1
=
mkNewUser
"alice@gargan.text"
(
GargPassword
"alice"
)
let
nur2
=
mkNewUser
"bob@gargan.text"
(
GargPassword
"bob"
)
void
$
new_user
nur1
void
$
new_user
nur2
let
authPayload
=
AuthRequest
"alice"
(
GargPassword
"alice"
)
result
<-
runClientM
(
auth_api
authPayload
)
(
clientEnv
port
)
let
expected
=
AuthResponse
{
_authRes_valid
=
Just
$
AuthValid
{
_authVal_token
=
"eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiaWQiOjF9fQ.t49zZSqkPAulEkYEh4pW17H2uwrkyPTdZKwHyG3KUJ0hzU2UUoPBNj8vdv087RCVBJ4tXgxNbP4j0RBv3gxdqg"
,
_authVal_tree_id
=
NodeId
1
,
_authVal_user_id
=
1
}
,
_authRes_inval
=
Nothing
}
result
`
shouldBe
`
(
Right
expected
)
it
"denies login for user 'alice' if password is invalid"
$
\
(
_testEnv
,
port
)
->
do
let
authPayload
=
AuthRequest
"alice"
(
GargPassword
"wrong"
)
result
<-
runClientM
(
auth_api
authPayload
)
(
clientEnv
port
)
let
expected
=
AuthResponse
{
_authRes_valid
=
Nothing
,
_authRes_inval
=
Just
$
AuthInvalid
"Invalid password"
}
result
`
shouldBe
`
(
Right
expected
)
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