Add more tests

bin/gargantext-server/Main.hs

@@ -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)

gargantext.cabal

@@ -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

src/Gargantext/API/Admin/Auth/Types.hs

@@ -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_") ''ForgotPasswordGet)
 instance ToSchema ForgotPasswordGet where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpGet_") 
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpGet_")
+
+makeLenses ''AuthValid
+makeLenses ''AuthResponse

src/Gargantext/API/Routes.hs

@@ -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 '[SA.JWT, SA.Cookie] AuthenticatedUser
-                    :> GargPrivateAPI'
+type MkProtectedAPI sub = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> sub
+
+type GargPrivateAPI = MkProtectedAPI GargPrivateAPI'
 
 type GargAdminAPI
               -- Roots endpoint

test/Test/API.hs

@@ -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

test/Test/API/Authentication.hs

@@ -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)
+        result0 <- 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

test/Test/API/Private.hs

+{-# 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"

test/Test/API/Setup.hs

+{-# 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)
+