[test] tests for graphql errors, some fixes as well

src/Gargantext/API/Errors.hs

@@ -79,7 +79,7 @@ frontendErrorToGQLServerError fe@(FrontendError diag ty _) =
   ServerError { errHTTPCode     = HTTP.statusCode $ backendErrorTypeToErrStatus ty
               , errReasonPhrase = T.unpack diag
               , errBody         = JSON.encode (GraphQLError fe)
-              , errHeaders      = mempty
+              , errHeaders      = [("Content-Type", "application/json")]
               }
 
 authErrorToFrontendError :: AuthenticationError -> FrontendError

test/Test/API/GraphQL.hs

@@ -10,10 +10,11 @@ module Test.API.GraphQL (
 import Gargantext.Core.Types.Individu
 import Prelude
 import Servant.Auth.Client ()
-import Test.API.Private (withValidLogin, protected)
+import Test.API.Private (withValidLogin, protected, protectedNewError)
 import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob)
 import Test.Hspec
 import Test.Hspec.Wai.Internal (withApplication)
+import Test.Hspec.Wai.JSON (json)
 import Test.Utils
 import Text.RawString.QQ (r)
 
@@ -30,6 +31,31 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
 
         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 } }"
-               } |] `shouldRespondWithFragment` [jsonFragment| {"data":{"user_infos":[{"ui_id":2,"ui_email":"alice@gargan.text"}]}} |]
+            let query = [r| { "query": "{ user_infos(user_id: 2) { ui_id, ui_email } }" } |]
+            let expected = [json| {"data":{"user_infos":[{"ui_id":2,"ui_email":"alice@gargan.text"}]}} |]
+            protected token "POST" "/gql" query `shouldRespondWithFragment` expected
+
+
+    describe "check error format" $ do
+      it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do
+        withApplication app $ do
+          withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do
+            let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |]
+            let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |]
+            protectedNewError token "POST" "/gql" query `shouldRespondWithFragment` expected
+
+      it "returns the old error (though this is deprecated)" $ \((_testEnv, port), app) -> do
+        withApplication app $ do
+          withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do
+            let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |]
+            let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |]
+            protected token "POST" "/gql" query `shouldRespondWithFragment` expected
+
+      it "check new errors with 'type'" $ \((_testEnv, port), app) -> do
+        withApplication app $ do
+          withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do
+            let query = [r| { "query": "mutation { delete_team_membership(shared_folder_id:1, team_node_id:1, token:\"abc\") }" } |]
+            let expected = [json| {"errors":[{"extensions":{"data":{"msg":"This user is not team owner","user_id":1},"diagnostic":"User not authorized. ","type":"EC_403__user_not_authorized"},"message":"User not authorized. "}]} |]
+            shouldRespondWithFragmentCustomStatus 403
+              (protectedNewError token "POST" "/gql" query)
+              expected

test/Test/API/Private.hs

@@ -18,7 +18,9 @@ module Test.API.Private (
 
 import Data.Aeson qualified as JSON
 import Data.ByteString.Lazy qualified as L
+import Data.ByteString.Lazy.Char8 qualified as C8L
 import Data.CaseInsensitive qualified as CI
+import Data.Map.Strict qualified as Map
 import Data.Text.Encoding qualified as TE
 import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Routes
@@ -38,9 +40,8 @@ import Test.API.Setup (withTestDBAndPort, setupEnvironment, mkUrl, createAliceAn
 import Test.Hspec
 import Test.Hspec.Wai hiding (pendingWith)
 import Test.Hspec.Wai.Internal (withApplication)
-import Test.Utils (jsonFragment, shouldRespondWithFragment)
-import qualified Data.Map.Strict as Map
-import qualified Data.ByteString.Lazy.Char8 as C8L
+import Test.Hspec.Wai.JSON (json)
+import Test.Utils (shouldRespondWithFragment)
 
 -- | Issue a request with a valid 'Authorization: Bearer' inside.
 protected :: HasCallStack
@@ -161,7 +162,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
         withApplication app $ do
           withValidLogin port "alice" (GargPassword "alice") $ \token -> do
             protected token "GET" (mkUrl port "/node/8") ""
-              `shouldRespondWithFragment` [jsonFragment| {"id":8,"user_id":2,"name":"alice" } |]
+              `shouldRespondWithFragment` [json| {"id":8,"user_id":2,"name":"alice" } |]
 
       it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do
         withApplication app $ do
@@ -177,7 +178,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
         withApplication app $ do
           withValidLogin port "alice" (GargPassword "alice") $ \token -> do
             protected token "GET" (mkUrl port "/tree/8") ""
-              `shouldRespondWithFragment` [jsonFragment| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |]
+              `shouldRespondWithFragment` [json| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |]
 
       it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do
         withApplication app $ do

test/Test/Utils.hs

@@ -7,18 +7,16 @@ module Test.Utils where
 import Control.Exception
 import Control.Monad
 import Data.Aeson
-import Data.Aeson.QQ.Simple (aesonQQ)
+import Data.Aeson qualified as JSON
+import Data.Aeson.KeyMap qualified as KM
+import Data.ByteString.Char8 qualified as B
 import Data.Char (isSpace)
-import Language.Haskell.TH.Quote
 import Network.HTTP.Types
 import Network.Wai.Test
 import Prelude
-import qualified Data.Aeson as JSON
-import qualified Data.Aeson.KeyMap as KM
-import qualified Data.ByteString.Char8 as B
 import Test.Hspec.Expectations
 import Test.Hspec.Wai
-import Test.Hspec.Wai.JSON
+import Test.Hspec.Wai.JSON (FromValue(..))
 import Test.Hspec.Wai.Matcher
 import Test.Tasty.HUnit
 
@@ -29,15 +27,6 @@ pending reason act = act `catch` (\(e :: SomeException) -> do
   putStrLn $ "PENDING: " <> reason
   putStrLn (displayException e))
 
--- | Similar to 'json' from the 'Test.Hspec.Wai.JSON' package,
--- but allows matching on a /fragment/ of the body.
-jsonFragment :: QuasiQuoter
-jsonFragment = QuasiQuoter {
-  quoteExp = \input -> [|fromValue $(quoteExp aesonQQ input)|]
-, quotePat = const $ error "No quotePat defined for jsonFragment"
-, quoteType = const $ error "No quoteType defined for jsonFragment"
-, quoteDec = const $ error "No quoteDec defined for jsonFragment"
-}
 
 newtype JsonFragmentResponseMatcher = JsonFragmentResponseMatcher { getJsonMatcher :: ResponseMatcher }
 
@@ -52,6 +41,18 @@ shouldRespondWithFragment action matcher = do
   r <- action
   forM_ (match r (getJsonMatcher matcher)) (liftIO . expectationFailure)
 
+-- | Same as above, but with custom status code
+shouldRespondWithFragmentCustomStatus :: HasCallStack
+                                      => Int
+                                      -> WaiSession st SResponse
+                                      -> JsonFragmentResponseMatcher
+                                      -> WaiExpectation st
+shouldRespondWithFragmentCustomStatus status action matcher = do
+  let m = (getJsonMatcher matcher) { matchStatus = status }
+  r <- action
+  forM_ (match r (getJsonMatcher $ JsonFragmentResponseMatcher m)) (liftIO . expectationFailure)
+
+
 instance FromValue JsonFragmentResponseMatcher where
   fromValue = JsonFragmentResponseMatcher . ResponseMatcher 200 [matchHeader] . containsJSON
     where