Merge remote-tracking branch 'origin/adinapoli/issue-273' into dev

gargantext.cabal

@@ -992,6 +992,7 @@ test-suite garg-test-hspec
   other-modules:
       Test.API
       Test.API.Authentication
+      Test.API.GraphQL
       Test.API.Private
       Test.API.Setup
       Test.Database.Operations

src/Gargantext/API/GraphQL/User.hs

@@ -50,7 +50,8 @@ resolveUsers
   -> UserArgs
   -> GqlM e env [User (GqlM e env)]
 resolveUsers autUser mgr UserArgs { user_id } = do
-  withPolicy autUser mgr (nodeChecks (NodeId user_id)) $ dbUsers user_id
+  -- FIXME(adn) we should use a proper policy, not 'alwaysAllow'.
+  withPolicy autUser mgr alwaysAllow $ dbUsers user_id
 
 -- | Inner function to fetch the user from DB.
 dbUsers

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -108,7 +108,8 @@ resolveUserInfos
   -> AccessPolicyManager
   -> UserInfoArgs -> GqlM e env [UserInfo]
 resolveUserInfos autUser mgr UserInfoArgs { user_id } =
-  withPolicy autUser mgr (nodeChecks (NodeId user_id)) $ dbUsers user_id
+  -- FIXME(adn) we should use a proper policy, not 'alwaysAllow'.
+  withPolicy autUser mgr alwaysAllow $ dbUsers user_id
 
 -- | Mutation for user info
 updateUserInfo

test/Test/API.hs

@@ -5,8 +5,10 @@ import Prelude
 import Test.Hspec
 import qualified Test.API.Authentication as Auth
 import qualified Test.API.Private as Private
+import qualified Test.API.GraphQL as GraphQL
 
 tests :: Spec
 tests = describe "API" $ do
   Auth.tests
   Private.tests
+  GraphQL.tests

test/Test/API/Authentication.hs

@@ -47,7 +47,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ 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.8")
+        case result of
+          Left err -> fail (show err)
+          Right r  -> r `shouldSatisfy` ((>= 1) . T.length) -- we got something back
 
     describe "POST /api/v1.0/auth" $ do
 

test/Test/API/GraphQL.hs

+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies     #-}
+{-# LANGUAGE QuasiQuotes      #-}
+{-# OPTIONS_GHC -Wno-orphans  #-}
+
+module Test.API.GraphQL (
+    tests
+  ) where
+
+import Gargantext.Core.Types.Individu
+import Prelude
+import Servant.Auth.Client ()
+import Test.API.Private (withValidLogin, protected)
+import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob)
+import Test.Hspec
+import Test.Hspec.Wai.Internal (withApplication)
+import Test.Utils
+import Text.RawString.QQ (r)
+
+tests :: Spec
+tests = sequential $ aroundAll withTestDBAndPort $ do
+  describe "Prelude" $ do
+    it "setup DB triggers" $ \((testEnv, _), _) -> setupEnvironment testEnv
+  describe "GraphQL" $ do
+
+
+    describe "get_user_infos" $ do
+      it "allows 'alice' to see her own info" $ \((testEnv, port), app) -> do
+        createAliceAndBob testEnv
+
+        withApplication app $ do
+          withValidLogin port "alice" (GargPassword "alice") $ \token -> do
+            protected token "POST" "/gql" [r| {
+               "query": "{ user_infos(user_id: 2) { ui_id, ui_email } }"
+               } |] `shouldRespondWith'` [jsonFragment| {"data":{"user_infos":[{"ui_id":2,"ui_email":"alice@gargan.text"}]}} |]

test/Test/API/Private.hs

@@ -3,7 +3,14 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Test.API.Private where
+module Test.API.Private (
+    tests
+
+  -- * Utility functions
+  , withValidLogin
+  , getJSON
+  , protected
+  ) where
 
 import Control.Exception
 import Control.Monad
@@ -11,11 +18,9 @@ import Control.Monad.Reader
 import Data.ByteString (ByteString)
 import Data.Maybe
 import Data.Proxy
-import Fmt
 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 Network.HTTP.Types
 import Network.Wai.Test (SResponse)
@@ -24,27 +29,16 @@ import Servant
 import Servant.Auth.Client ()
 import Servant.Client
 import Test.API.Authentication (auth_api)
-import Test.API.Setup (withTestDBAndPort, setupEnvironment)
-import Test.Database.Types
+import Test.API.Setup (withTestDBAndPort, setupEnvironment, mkUrl, createAliceAndBob)
 import Test.Hspec
 import Test.Hspec.Wai hiding (pendingWith)
 import Test.Hspec.Wai.Internal (withApplication)
-import Test.Hspec.Wai.JSON (json)
 import Test.Utils (jsonFragment, shouldRespondWith')
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Text.Encoding as TE
 import qualified Network.Wai.Handler.Warp as Wai
 import qualified Servant.Auth.Client as SA
 
-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 =
@@ -57,7 +51,7 @@ 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 :: (MonadFail m, 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
@@ -66,7 +60,11 @@ withValidLogin port ur pwd act = do
   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
+    Right res
+      | Just tkn <- _authRes_valid res
+      -> act (_authVal_token tkn)
+      | otherwise
+      -> fail $ "No token found in " <> show res
 
 
 tests :: Spec
@@ -83,14 +81,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ 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
+        createAliceAndBob testEnv
 
         let ( roots_api :<|> _nodes_api
               ) = client (Proxy :: Proxy (MkProtectedAPI GargAdminAPI)) (SA.Token "bogus")

test/Test/API/Setup.hs

@@ -3,6 +3,9 @@
 module Test.API.Setup where
 
 import Control.Lens
+import Control.Monad.Reader
+import Data.ByteString (ByteString)
+import Fmt (Builder, (+|), (|+))
 import Gargantext.API (makeApp)
 import Gargantext.API.Admin.EnvTypes (Mode(Mock), Env (..))
 import Gargantext.API.Admin.Settings
@@ -10,9 +13,12 @@ import Gargantext.API.Admin.Types
 import Gargantext.API.Prelude
 import Gargantext.Core.NLP
 import Gargantext.Core.NodeStory
+import Gargantext.Core.Types.Individu
 import Gargantext.Database.Action.Flow
+import Gargantext.Database.Action.User.New
 import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Admin.Trigger.Init
+import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Prelude.Config
@@ -31,11 +37,8 @@ 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 Network.Wai.Handler.Warp         as Warp
+import qualified Network.Wai.Handler.Warp as Wai
 import qualified Servant.Job.Async as ServantAsync
-import Gargantext.Database.Admin.Types.Hyperdata
-import Control.Monad.Reader
-import Gargantext.Core.Types.Individu
-import Gargantext.Database.Action.User.New
 
 
 newTestEnv :: TestEnv -> Logger (GargM Env GargError) -> Warp.Port -> IO Env
@@ -99,3 +102,21 @@ setupEnvironment env = flip runReaderT env $ runTestMonad $ do
                                         (Nothing :: Maybe HyperdataCorpus)
   masterListId <- getOrMkList masterCorpusId masterUserId
   void $ initLastTriggers masterListId
+
+-- | Creates two users, Alice & Bob. Alice shouldn't be able to see
+-- Bob's private data and vice-versa.
+createAliceAndBob :: TestEnv -> IO ()
+createAliceAndBob testEnv = do
+  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
+
+curApi :: Builder
+curApi = "v1.0"
+
+mkUrl :: Wai.Port -> Builder -> ByteString
+mkUrl _port urlPiece =
+  "/api/" +| curApi |+ urlPiece