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
148
Issues
148
List
Board
Labels
Milestones
Merge Requests
8
Merge Requests
8
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
gargantext
haskell-gargantext
Commits
cad95a4c
Commit
cad95a4c
authored
1 year ago
by
Alfredo Di Napoli
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add more tests
parent
7093c642
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
181 additions
and
88 deletions
+181
-88
Main.hs
bin/gargantext-server/Main.hs
+0
-1
gargantext.cabal
gargantext.cabal
+2
-0
Types.hs
src/Gargantext/API/Admin/Auth/Types.hs
+5
-1
Routes.hs
src/Gargantext/API/Routes.hs
+4
-3
API.hs
test/Test/API.hs
+3
-1
Authentication.hs
test/Test/API/Authentication.hs
+17
-82
Private.hs
test/Test/API/Private.hs
+67
-0
Setup.hs
test/Test/API/Setup.hs
+83
-0
No files found.
bin/gargantext-server/Main.hs
View file @
cad95a4c
...
...
@@ -22,7 +22,6 @@ Script to start gargantext with different modes (Dev, Prod, Mock).
module
Main
where
import
Data.String
(
String
)
import
Data.Text
(
unpack
)
import
Data.Version
(
showVersion
)
import
Gargantext.API
(
startGargantext
)
-- , startGargantextMock)
...
...
This diff is collapsed.
Click to expand it.
gargantext.cabal
View file @
cad95a4c
...
...
@@ -982,6 +982,8 @@ test-suite garg-test-hspec
other-modules:
Test.API
Test.API.Authentication
Test.API.Private
Test.API.Setup
Test.Database.Operations
Test.Database.Operations.DocumentSearch
Test.Database.Setup
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/Admin/Auth/Types.hs
View file @
cad95a4c
...
...
@@ -13,6 +13,7 @@ Portability : POSIX
module
Gargantext.API.Admin.Auth.Types
where
import
Control.Lens
hiding
(
elements
,
to
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Swagger
import
Data.Text
(
Text
)
...
...
@@ -130,4 +131,7 @@ data ForgotPasswordGet = ForgotPasswordGet {_fpGet_password :: Password}
deriving
(
Generic
)
$
(
deriveJSON
(
unPrefix
"_fpGet_"
)
''
F
orgotPasswordGet
)
instance
ToSchema
ForgotPasswordGet
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_fpGet_"
)
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_fpGet_"
)
makeLenses
''
A
uthValid
makeLenses
''
A
uthResponse
This diff is collapsed.
Click to expand it.
src/Gargantext/API/Routes.hs
View file @
cad95a4c
...
...
@@ -59,7 +59,7 @@ import qualified Gargantext.API.Public as Public
type
GargAPI
=
MkGargAPI
(
GargAPIVersion
GargAPI'
)
type
MkGargAPI
sub
=
"api"
:>
Summary
"API "
:>
GargAPIVersion
sub
type
MkGargAPI
sub
=
"api"
:>
Summary
"API "
:>
sub
--- | TODO :<|> Summary "Latest API" :> GargAPI'
type
GargAPIVersion
sub
=
"v1.0"
...
...
@@ -87,8 +87,9 @@ type GargAPI' =
:<|>
"public"
:>
Public
.
API
type
GargPrivateAPI
=
SA
.
Auth
'[
S
A
.
JWT
,
SA
.
Cookie
]
AuthenticatedUser
:>
GargPrivateAPI'
type
MkProtectedAPI
sub
=
SA
.
Auth
'[
S
A
.
JWT
,
SA
.
Cookie
]
AuthenticatedUser
:>
sub
type
GargPrivateAPI
=
MkProtectedAPI
GargPrivateAPI'
type
GargAdminAPI
-- Roots endpoint
...
...
This diff is collapsed.
Click to expand it.
test/Test/API.hs
View file @
cad95a4c
...
...
@@ -4,7 +4,9 @@ module Test.API where
import
Prelude
import
Test.Hspec
import
qualified
Test.API.Authentication
as
Auth
import
qualified
Test.API.Private
as
Private
tests
::
Spec
tests
=
describe
"API"
$
tests
=
describe
"API"
$
do
Auth
.
tests
Private
.
tests
This diff is collapsed.
Click to expand it.
test/Test/API/Authentication.hs
View file @
cad95a4c
...
...
@@ -3,36 +3,18 @@
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE BangPatterns #-}
module
Test.API.Authentication
where
module
Test.API.Authentication
(
tests
,
auth_api
)
where
import
Prelude
import
Data.Proxy
import
Gargantext.API
(
makeApp
)
import
Gargantext.API.Admin.EnvTypes
(
Mode
(
Mock
),
Env
(
..
))
import
Gargantext.API.Admin.Settings
import
Gargantext.API.Routes
import
Gargantext.System.Logging
import
Network.HTTP.Client
hiding
(
Proxy
)
import
Servant.Client
import
Test.Database.Setup
(
withTestDB
,
fakeIniPath
,
testEnvToPgConnectionInfo
)
import
Test.Hspec
import
qualified
Network.Wai.Handler.Warp
as
Warp
import
Test.Database.Types
import
Gargantext.API.Prelude
import
qualified
Gargantext.Utils.Jobs
as
Jobs
import
qualified
Gargantext.Utils.Jobs.Queue
as
Jobs
import
qualified
Gargantext.Utils.Jobs.Settings
as
Jobs
import
qualified
Gargantext.Utils.Jobs.Monad
as
Jobs
import
qualified
Gargantext.Prelude.Mail
as
Mail
import
qualified
Gargantext.Prelude.NLP
as
NLP
import
Network.HTTP.Client.TLS
(
newTlsManager
)
import
Control.Lens
import
Gargantext.API.Admin.Types
import
Gargantext.Prelude.Config
import
Gargantext.Core.NodeStory
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
...
...
@@ -40,58 +22,15 @@ import Control.Monad
import
Control.Monad.Reader
import
Gargantext.Database.Action.User.New
import
Gargantext.Core.Types
import
Test.API.Setup
(
withTestDBAndPort
)
import
qualified
Data.Text
as
T
import
Control.Lens
newTestEnv
::
TestEnv
->
Logger
(
GargM
Env
GargError
)
->
Warp
.
Port
->
IO
Env
newTestEnv
testEnv
logger
port
=
do
file
<-
fakeIniPath
!
manager_env
<-
newTlsManager
!
settings'
<-
devSettings
devJwkFile
<&>
appPort
.~
port
!
config_env
<-
readConfig
file
prios
<-
withLogger
()
$
\
ioLogger
->
Jobs
.
readPrios
ioLogger
(
file
<>
".jobs"
)
let
prios'
=
Jobs
.
applyPrios
prios
Jobs
.
defaultPrios
!
self_url_env
<-
parseBaseUrl
$
"http://0.0.0.0:"
<>
show
port
dbParam
<-
pure
$
testEnvToPgConnectionInfo
testEnv
!
pool
<-
newPool
dbParam
!
nodeStory_env
<-
readNodeStoryEnv
pool
!
scrapers_env
<-
ServantAsync
.
newJobEnv
ServantAsync
.
defaultSettings
manager_env
secret
<-
Jobs
.
genSecret
let
jobs_settings
=
(
Jobs
.
defaultJobSettings
1
secret
)
&
Jobs
.
l_jsJobTimeout
.~
(
fromIntegral
$
config_env
^.
hasConfig
^.
gc_js_job_timeout
)
&
Jobs
.
l_jsIDTimeout
.~
(
fromIntegral
$
config_env
^.
hasConfig
^.
gc_js_id_timeout
)
!
jobs_env
<-
Jobs
.
newJobEnv
jobs_settings
prios'
manager_env
!
config_mail
<-
Mail
.
readConfig
file
!
nlp_env
<-
nlpServerMap
<$>
NLP
.
readConfig
file
pure
$
Env
{
_env_settings
=
settings'
,
_env_logger
=
logger
,
_env_pool
=
pool
,
_env_nodeStory
=
nodeStory_env
,
_env_manager
=
manager_env
,
_env_scrapers
=
scrapers_env
,
_env_jobs
=
jobs_env
,
_env_self_url
=
self_url_env
,
_env_config
=
config_env
,
_env_mail
=
config_mail
,
_env_nlp
=
nlp_env
}
withGargApp
::
TestEnv
->
(
Warp
.
Port
->
IO
()
)
->
IO
()
withGargApp
testEnv
action
=
do
let
createApp
=
do
withLoggerHoisted
Mock
$
\
ioLogger
->
do
env
<-
newTestEnv
testEnv
ioLogger
8080
makeApp
env
Warp
.
testWithApplication
createApp
action
auth_api
::
AuthRequest
->
ClientM
AuthResponse
auth_api
=
client
(
Proxy
::
Proxy
(
MkGargAPI
(
GargAPIVersion
AuthAPI
)))
withTestDBAndPort
::
((
TestEnv
,
Warp
.
Port
)
->
IO
()
)
->
IO
()
withTestDBAndPort
action
=
withTestDB
$
\
testEnv
->
withGargApp
testEnv
$
\
port
->
action
(
testEnv
,
port
)
cannedToken
::
T
.
Text
cannedToken
=
"eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiaWQiOjF9fQ.t49zZSqkPAulEkYEh4pW17H2uwrkyPTdZKwHyG3KUJ0hzU2UUoPBNj8vdv087RCVBJ4tXgxNbP4j0RBv3gxdqg"
tests
::
Spec
tests
=
sequential
$
aroundAll
withTestDBAndPort
$
do
...
...
@@ -108,30 +47,26 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
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.
-- Let's create the Alice user.
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
void
$
new_user
$
mkNewUser
"alice@gargan.text"
(
GargPassword
"alice"
)
let
authPayload
=
AuthRequest
"alice"
(
GargPassword
"alice"
)
result
<-
runClientM
(
auth_api
authPayload
)
(
clientEnv
port
)
result
0
<-
runClientM
(
auth_api
authPayload
)
(
clientEnv
port
)
let
expected
=
AuthResponse
{
_authRes_valid
=
Just
$
AuthValid
{
_authVal_token
=
"eyJhbGciOiJIUzUxMiJ9.eyJkYXQiOnsiaWQiOjF9fQ.t49zZSqkPAulEkYEh4pW17H2uwrkyPTdZKwHyG3KUJ0hzU2UUoPBNj8vdv087RCVBJ4tXgxNbP4j0RBv3gxdqg"
_authVal_token
=
cannedToken
,
_authVal_tree_id
=
NodeId
1
,
_authVal_user_id
=
1
}
,
_authRes_inval
=
Nothing
}
let
result
=
over
(
_Right
.
authRes_valid
.
_Just
.
authVal_token
)
(
const
cannedToken
)
result0
result
`
shouldBe
`
(
Right
expected
)
it
"denies login for user 'alice' if password is invalid"
$
\
(
_testEnv
,
port
)
->
do
...
...
This diff is collapsed.
Click to expand it.
test/Test/API/Private.hs
0 → 100644
View file @
cad95a4c
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module
Test.API.Private
where
import
Control.Monad
import
Control.Monad.Reader
import
Data.Maybe
import
Data.Proxy
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Routes
import
Gargantext.Core.Types.Individu
import
Gargantext.Database.Action.User.New
import
Network.HTTP.Client
hiding
(
Proxy
)
import
Prelude
import
Servant
import
Servant.Auth.Client
()
import
Servant.Client
import
Test.API.Authentication
(
auth_api
)
import
Test.API.Setup
(
withTestDBAndPort
)
import
Test.Database.Types
import
Test.Hspec
import
qualified
Data.Text.Encoding
as
TE
import
qualified
Servant.Auth.Client
as
SA
tests
::
Spec
tests
=
sequential
$
aroundAll
withTestDBAndPort
$
do
describe
"Private API"
$
do
baseUrl
<-
runIO
$
parseBaseUrl
"http://localhost"
manager
<-
runIO
$
newManager
defaultManagerSettings
let
clientEnv
port
=
mkClientEnv
manager
(
baseUrl
{
baseUrlPort
=
port
})
describe
"GET /api/v1.0/user"
$
do
-- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
it
"doesn't allow someone with an invalid token to show the results"
$
\
(
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
(
roots_api
:<|>
_nodes_api
)
=
client
(
Proxy
::
Proxy
(
MkProtectedAPI
GargAdminAPI
))
(
SA
.
Token
"bogus"
)
let
(
admin_user_api_get
:<|>
_
)
=
roots_api
result
<-
runClientM
admin_user_api_get
(
clientEnv
port
)
length
result
`
shouldBe
`
0
-- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
it
"allows 'alice' to see the results"
$
\
(
_testEnv
,
port
)
->
do
let
authPayload
=
AuthRequest
"alice"
(
GargPassword
"alice"
)
Right
result
<-
runClientM
(
auth_api
authPayload
)
(
clientEnv
port
)
let
token
=
_authVal_token
$
fromJust
(
_authRes_valid
result
)
let
(
roots_api
:<|>
_nodes_api
)
=
client
(
Proxy
::
Proxy
(
MkProtectedAPI
GargAdminAPI
))
(
SA
.
Token
$
TE
.
encodeUtf8
$
token
)
let
(
admin_user_api_get
:<|>
_
)
=
roots_api
_nodes
<-
runClientM
admin_user_api_get
(
clientEnv
port
)
pendingWith
"currently useless"
This diff is collapsed.
Click to expand it.
test/Test/API/Setup.hs
0 → 100644
View file @
cad95a4c
{-# LANGUAGE BangPatterns #-}
module
Test.API.Setup
where
import
Prelude
import
Gargantext.API
(
makeApp
)
import
Gargantext.API.Admin.EnvTypes
(
Mode
(
Mock
),
Env
(
..
))
import
Gargantext.API.Admin.Settings
import
Gargantext.System.Logging
import
Servant.Client
import
Test.Database.Setup
(
withTestDB
,
fakeIniPath
,
testEnvToPgConnectionInfo
)
import
qualified
Network.Wai.Handler.Warp
as
Warp
import
Test.Database.Types
import
Gargantext.API.Prelude
import
qualified
Gargantext.Utils.Jobs
as
Jobs
import
qualified
Gargantext.Utils.Jobs.Queue
as
Jobs
import
qualified
Gargantext.Utils.Jobs.Settings
as
Jobs
import
qualified
Gargantext.Utils.Jobs.Monad
as
Jobs
import
qualified
Gargantext.Prelude.Mail
as
Mail
import
qualified
Gargantext.Prelude.NLP
as
NLP
import
Network.HTTP.Client.TLS
(
newTlsManager
)
import
Control.Lens
import
Gargantext.API.Admin.Types
import
Gargantext.Prelude.Config
import
Gargantext.Core.NodeStory
import
Gargantext.Database.Prelude
import
Gargantext.Core.NLP
import
qualified
Servant.Job.Async
as
ServantAsync
import
Servant.Auth.Client
()
newTestEnv
::
TestEnv
->
Logger
(
GargM
Env
GargError
)
->
Warp
.
Port
->
IO
Env
newTestEnv
testEnv
logger
port
=
do
file
<-
fakeIniPath
!
manager_env
<-
newTlsManager
!
settings'
<-
devSettings
devJwkFile
<&>
appPort
.~
port
!
config_env
<-
readConfig
file
prios
<-
withLogger
()
$
\
ioLogger
->
Jobs
.
readPrios
ioLogger
(
file
<>
".jobs"
)
let
prios'
=
Jobs
.
applyPrios
prios
Jobs
.
defaultPrios
!
self_url_env
<-
parseBaseUrl
$
"http://0.0.0.0:"
<>
show
port
dbParam
<-
pure
$
testEnvToPgConnectionInfo
testEnv
!
pool
<-
newPool
dbParam
!
nodeStory_env
<-
readNodeStoryEnv
pool
!
scrapers_env
<-
ServantAsync
.
newJobEnv
ServantAsync
.
defaultSettings
manager_env
secret
<-
Jobs
.
genSecret
let
jobs_settings
=
(
Jobs
.
defaultJobSettings
1
secret
)
&
Jobs
.
l_jsJobTimeout
.~
(
fromIntegral
$
config_env
^.
hasConfig
^.
gc_js_job_timeout
)
&
Jobs
.
l_jsIDTimeout
.~
(
fromIntegral
$
config_env
^.
hasConfig
^.
gc_js_id_timeout
)
!
jobs_env
<-
Jobs
.
newJobEnv
jobs_settings
prios'
manager_env
!
config_mail
<-
Mail
.
readConfig
file
!
nlp_env
<-
nlpServerMap
<$>
NLP
.
readConfig
file
pure
$
Env
{
_env_settings
=
settings'
,
_env_logger
=
logger
,
_env_pool
=
pool
,
_env_nodeStory
=
nodeStory_env
,
_env_manager
=
manager_env
,
_env_scrapers
=
scrapers_env
,
_env_jobs
=
jobs_env
,
_env_self_url
=
self_url_env
,
_env_config
=
config_env
,
_env_mail
=
config_mail
,
_env_nlp
=
nlp_env
}
withGargApp
::
TestEnv
->
(
Warp
.
Port
->
IO
()
)
->
IO
()
withGargApp
testEnv
action
=
do
let
createApp
=
do
withLoggerHoisted
Mock
$
\
ioLogger
->
do
env
<-
newTestEnv
testEnv
ioLogger
8080
makeApp
env
Warp
.
testWithApplication
createApp
action
withTestDBAndPort
::
((
TestEnv
,
Warp
.
Port
)
->
IO
()
)
->
IO
()
withTestDBAndPort
action
=
withTestDB
$
\
testEnv
->
withGargApp
testEnv
$
\
port
->
action
(
testEnv
,
port
)
This diff is collapsed.
Click to expand it.
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