diff --git a/cabal.project b/cabal.project
index 0aa86598b3aa331eae2b6c7c065966bd45684d5c..38afd1122a5741f813f086617d6c53d10fd5256a 100644
--- a/cabal.project
+++ b/cabal.project
@@ -79,7 +79,7 @@ source-repository-package
source-repository-package
type: git
location: https://gitlab.iscpif.fr/gargantext/crawlers/arxiv-api.git
- tag: 2d7e5753cbbce248b860b571a0e9885415c846f7
+ tag: eb130c71fa17adaceed6ff66beefbccb13df51ba
source-repository-package
type: git
diff --git a/gargantext.cabal b/gargantext.cabal
index 38bb4cd0a88420bb8cf2362d3b14a927686183da..3cbf4eb17cb7f18dbb0ff7cb937738e882733a27 100644
--- a/gargantext.cabal
+++ b/gargantext.cabal
@@ -935,13 +935,17 @@ test-suite garg-test-tasty
, crawlerArxiv
, duckling ^>= 0.2.0.0
, extra ^>= 1.7.9
+ , fmt
, gargantext
, gargantext-prelude
, hspec ^>= 2.7.10
, hspec-core
, hspec-expectations >= 0.8 && < 0.9
+ , hspec-wai
+ , hspec-wai-json
, http-client ^>= 0.6.4.1
, http-client-tls ^>= 0.3.5.3
+ , http-types
, lens >= 5.2.2 && < 5.3
, monad-control >= 1.0.3 && < 1.1
, mtl ^>= 2.2.2
@@ -973,6 +977,8 @@ test-suite garg-test-tasty
, tmp-postgres >= 1.34.1 && < 1.35
, unordered-containers ^>= 0.2.16.0
, validity ^>= 0.11.0.1
+ , wai
+ , wai-extra
, warp
default-language: Haskell2010
@@ -1029,11 +1035,15 @@ test-suite garg-test-hspec
, crawlerArxiv
, duckling ^>= 0.2.0.0
, extra ^>= 1.7.9
+ , fmt
, gargantext
, gargantext-prelude
, hspec ^>= 2.7.10
, hspec-core
, hspec-expectations >= 0.8 && < 0.9
+ , hspec-wai
+ , hspec-wai-json
+ , http-types
, http-client ^>= 0.6.4.1
, http-client-tls ^>= 0.3.5.3
, lens >= 5.2.2 && < 5.3
@@ -1067,6 +1077,8 @@ test-suite garg-test-hspec
, tmp-postgres >= 1.34.1 && < 1.35
, unordered-containers ^>= 0.2.16.0
, validity ^>= 0.11.0.1
+ , wai
+ , wai-extra
, warp
default-language: Haskell2010
diff --git a/src/Gargantext/API/Routes.hs b/src/Gargantext/API/Routes.hs
index ce40cf1545de3362df1e0bbc71a3eb27d8ef6642..8d6eb8fd4ffa9bb7cede42ad0afab86fb4395002 100644
--- a/src/Gargantext/API/Routes.hs
+++ b/src/Gargantext/API/Routes.hs
@@ -87,7 +87,7 @@ type GargAPI' =
:<|> "public" :> Public.API
-type MkProtectedAPI sub = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> sub
+type MkProtectedAPI private = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> private
type GargPrivateAPI = MkProtectedAPI GargPrivateAPI'
@@ -98,13 +98,16 @@ type GargAdminAPI
:<|> "nodes" :> Summary "Nodes endpoint"
:> ReqBody '[JSON] [NodeId] :> NodesAPI
+-- Node endpoint
+type NodeEndpoint =
+ "node" :> Summary "Node endpoint"
+ :> Capture "node_id" NodeId
+ :> NodeAPI HyperdataAny
+
type GargPrivateAPI' =
GargAdminAPI
- -- Node endpoint
- :<|> "node" :> Summary "Node endpoint"
- :> Capture "node_id" NodeId
- :> NodeAPI HyperdataAny
+ :<|> NodeEndpoint
-- Context endpoint
:<|> "context" :> Summary "Node endpoint"
diff --git a/test/Test/API/Authentication.hs b/test/Test/API/Authentication.hs
index 389bce20cd555bbc56f87051b42344b0d1c96d61..7c6aa9fa3f11d645368ddf29ae312a1e4936df83 100644
--- a/test/Test/API/Authentication.hs
+++ b/test/Test/API/Authentication.hs
@@ -42,13 +42,13 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
-- testing scenarios start here
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
+ 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
- it "requires no auth and authenticates the user 'alice'" $ \(testEnv, port) -> do
+ it "requires no auth and authenticates the user 'alice'" $ \((testEnv, port), _) -> do
-- Let's create the Alice user.
void $ flip runReaderT testEnv $ runTestMonad $ do
@@ -69,7 +69,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
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
+ 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 {
diff --git a/test/Test/API/Private.hs b/test/Test/API/Private.hs
index 601f673d20378df6a968844a918f7dd2c7a04802..f457b8f07fd37a5987675f1c185f921527d0aa42 100644
--- a/test/Test/API/Private.hs
+++ b/test/Test/API/Private.hs
@@ -1,12 +1,16 @@
+{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Test.API.Private where
+import Control.Exception
import Control.Monad
import Control.Monad.Reader
import Data.Maybe
import Data.Proxy
+import Fmt
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Routes
import Gargantext.Core.Types.Individu
@@ -20,8 +24,49 @@ import Test.API.Authentication (auth_api)
import Test.API.Setup (withTestDBAndPort)
import Test.Database.Types
import Test.Hspec
+import Test.Hspec.Wai hiding (pendingWith)
+import Test.Hspec.Wai.Internal (withApplication)
+import Test.Hspec.Wai.JSON
import qualified Data.Text.Encoding as TE
+import qualified Network.Wai.Handler.Warp as Wai
import qualified Servant.Auth.Client as SA
+import Data.ByteString (ByteString)
+import Network.Wai.Test (SResponse)
+import Network.HTTP.Types
+import qualified Data.ByteString.Lazy as L
+
+type Env = ((TestEnv, Wai.Port), Application)
+
+curApi :: Builder
+curApi = "v1.0"
+
+mkUrl :: Wai.Port -> Builder -> ByteString
+mkUrl _port urlPiece =
+ "/api/" +| curApi |+ urlPiece
+
+-- | Issue a request with a valid 'Authorization: Bearer' inside.
+protected :: Token -> Method -> ByteString -> L.ByteString -> WaiSession () SResponse
+protected tkn mth url payload =
+ request mth url [ (hAccept, "application/json;charset=utf-8")
+ , (hContentType, "application/json")
+ , (hAuthorization, TE.encodeUtf8 tkn)
+ ] payload
+
+getJSON :: ByteString -> WaiSession () SResponse
+getJSON url =
+ request "GET" url [(hContentType, "application/json")] ""
+
+withValidLogin :: MonadIO m => Wai.Port -> Username -> GargPassword -> (Token -> m a) -> m a
+withValidLogin port ur pwd act = do
+ baseUrl <- liftIO $ parseBaseUrl "http://localhost"
+ manager <- liftIO $ newManager defaultManagerSettings
+ let clientEnv = mkClientEnv manager (baseUrl { baseUrlPort = port })
+ let authPayload = AuthRequest ur pwd
+ result <- liftIO $ runClientM (auth_api authPayload) clientEnv
+ case result of
+ Left err -> liftIO $ throwIO $ userError (show err)
+ Right res -> let token = _authVal_token $ fromJust (_authRes_valid res) in act token
+
tests :: Spec
tests = sequential $ aroundAll withTestDBAndPort $ do
@@ -33,7 +78,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
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
+ 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.
@@ -52,16 +97,24 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
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
+ it "allows 'alice' to see the results" $ \((_testEnv, port), _) -> do
- let authPayload = AuthRequest "alice" (GargPassword "alice")
- Right result <- runClientM (auth_api authPayload) (clientEnv port)
+ withValidLogin port "alice" (GargPassword "alice") $ \token -> do
+ let ( roots_api :<|> _nodes_api
+ ) = client (Proxy :: Proxy (MkProtectedAPI GargAdminAPI)) (SA.Token $ TE.encodeUtf8 $ token)
+ let ( admin_user_api_get :<|> _) = roots_api
- let token = _authVal_token $ fromJust (_authRes_valid result)
+ _nodes <- runClientM admin_user_api_get (clientEnv port)
+ pendingWith "currently useless"
- let ( roots_api :<|> _nodes_api
- ) = client (Proxy :: Proxy (MkProtectedAPI GargAdminAPI)) (SA.Token $ TE.encodeUtf8 $ token)
- let ( admin_user_api_get :<|> _) = roots_api
+ describe "GET /api/v1.0/node" $ do
+
+ it "unauthorised users shouldn't see anything" $ \((_testEnv, port), app) -> do
+ withApplication app $ do
+ get (mkUrl port "/node/1") `shouldRespondWith` 401
+
+ it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do
+ withApplication app $ do
+ withValidLogin port "alice" (GargPassword "alice") $ \token -> do
+ protected token "GET" (mkUrl port "/node/1") "" `shouldRespondWith` [json| { } |]
- _nodes <- runClientM admin_user_api_get (clientEnv port)
- pendingWith "currently useless"
diff --git a/test/Test/API/Setup.hs b/test/Test/API/Setup.hs
index 668acf2ac1a9011aea8df7d78cb86338cec67114..464cbf23e43a5d28feaa845582e291095abf4f1c 100644
--- a/test/Test/API/Setup.hs
+++ b/test/Test/API/Setup.hs
@@ -2,31 +2,32 @@
module Test.API.Setup where
-import Prelude
+import Control.Lens
import Gargantext.API (makeApp)
import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..))
import Gargantext.API.Admin.Settings
+import Gargantext.API.Admin.Types
+import Gargantext.API.Prelude
+import Gargantext.Core.NLP
+import Gargantext.Core.NodeStory
+import Gargantext.Database.Prelude
+import Gargantext.Prelude.Config
import Gargantext.System.Logging
+import Network.HTTP.Client.TLS (newTlsManager)
+import Network.Wai (Application)
+import Prelude
+import Servant.Auth.Client ()
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.Prelude.Mail as Mail
+import qualified Gargantext.Prelude.NLP as NLP
import qualified Gargantext.Utils.Jobs as Jobs
+import qualified Gargantext.Utils.Jobs.Monad 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 Network.Wai.Handler.Warp as Warp
import qualified Servant.Job.Async as ServantAsync
-import Servant.Auth.Client ()
newTestEnv :: TestEnv -> Logger (GargM Env GargError) -> Warp.Port -> IO Env
@@ -67,17 +68,15 @@ newTestEnv testEnv logger port = do
, _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
+withGargApp :: Application -> (Warp.Port -> IO ()) -> IO ()
+withGargApp app action = do
+ Warp.testWithApplication (pure app) action
-withTestDBAndPort :: ((TestEnv, Warp.Port) -> IO ()) -> IO ()
+withTestDBAndPort :: (((TestEnv, Warp.Port), Application) -> IO ()) -> IO ()
withTestDBAndPort action =
- withTestDB $ \testEnv ->
- withGargApp testEnv $ \port ->
- action (testEnv, port)
-
+ withTestDB $ \testEnv -> do
+ app <- withLoggerHoisted Mock $ \ioLogger -> do
+ env <- newTestEnv testEnv ioLogger 8080
+ makeApp env
+ withGargApp app $ \port ->
+ action ((testEnv, port), app)