Commit 4a46abad authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/adinapoli/issue-267-part-2' into dev-new

parents 5bdb077b 6a60ac39
......@@ -1049,6 +1049,7 @@ test-suite garg-test-hspec
, base ^>= 4.14.3.0
, boolexpr ^>= 0.2
, bytestring ^>= 0.10.12.0
, case-insensitive
, conduit ^>= 1.3.4.2
, containers ^>= 0.6.5.1
, crawlerArxiv
......
......@@ -6,6 +6,9 @@ module Gargantext.API.Errors (
module Types
, module Class
-- * Types
, GargErrorScheme(..)
-- * Conversion functions
, backendErrorToFrontendError
, frontendErrorToServerError
......@@ -34,6 +37,13 @@ import qualified Data.Text.Lazy as TL
$(deriveHttpStatusCode ''BackendErrorCode)
data GargErrorScheme
= -- | The old error scheme.
GES_old
-- | The new error scheme, that returns a 'FrontendError'.
| GES_new
deriving (Show, Eq)
-- | Transforms a backend internal error into something that the frontend
-- can consume. This is the only representation we offer to the outside world,
-- as we later encode this into a 'ServerError' in the main server handler.
......
......@@ -640,10 +640,10 @@ genFrontendErr be = do
pure $ mkFrontendErr' txt $ FE_job_generic_exception err
instance ToJSON BackendErrorCode where
toJSON = JSON.String . T.pack . drop 3 . show
toJSON = JSON.String . T.pack . show
instance FromJSON BackendErrorCode where
parseJSON (String s) = case readMaybe (T.unpack $ "EC_" <> s) of
parseJSON (String s) = case readMaybe (T.unpack s) of
Just v -> pure v
Nothing -> fail $ "FromJSON BackendErrorCode unexpected value: " <> T.unpack s
parseJSON ty = typeMismatch "BackendErrorCode" ty
......
......@@ -15,6 +15,7 @@ Portability : POSIX
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module Gargantext.API.Routes
where
......@@ -28,6 +29,7 @@ import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.Context
import Gargantext.API.Count (CountAPI, count, Query)
import Gargantext.API.Errors (GargErrorScheme (..))
import Gargantext.API.Errors.Types
import Gargantext.API.GraphQL qualified as GraphQL
import Gargantext.API.Members (MembersAPI, members)
......@@ -51,11 +53,38 @@ import Gargantext.Database.Prelude (HasConfig(..))
import Gargantext.Prelude
import Gargantext.Prelude.Config (gc_max_docs_scrapers)
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Network.Wai (requestHeaders)
import Servant
import Servant.Auth as SA
import Servant.Auth.Swagger ()
import Servant.Ekg
import Servant.Server.Internal.Delayed
import Servant.Server.Internal.DelayedIO
import Servant.Swagger
import Servant.Swagger.UI
import qualified Data.List as L
data WithCustomErrorScheme a
instance (HasServer subApi ctx) => HasServer (WithCustomErrorScheme subApi) ctx where
type ServerT (WithCustomErrorScheme subApi) m = GargErrorScheme -> ServerT subApi m
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy subApi) pc nt . s
route Proxy ctx d = route (Proxy :: Proxy subApi) ctx (d `addHeaderCheck` getErrorScheme)
where
getErrorScheme :: DelayedIO GargErrorScheme
getErrorScheme = withRequest $ \rq -> do
let hdrs = requestHeaders rq
in case L.lookup "X-Garg-Error-Scheme" hdrs of
Nothing -> pure GES_old
Just "new" -> pure GES_new
Just _ -> pure GES_old
instance HasSwagger (WithCustomErrorScheme GargAPI) where
toSwagger _ = toSwagger (Proxy :: Proxy GargAPI)
instance HasEndpoint sub => HasEndpoint (WithCustomErrorScheme sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
type GargAPI = MkGargAPI (GargAPIVersion GargAPI')
......@@ -207,10 +236,7 @@ type GargPrivateAPI' =
-- :<|> "auth" :> Capture "node_id" Int :> NodeAPI
---------------------------------------------------------------------
type API = SwaggerAPI
:<|> GargAPI
:<|> GraphQL.API
:<|> FrontEndAPI
type API = WithCustomErrorScheme (SwaggerAPI :<|> GargAPI :<|> GraphQL.API :<|> FrontEndAPI)
-- | API for serving @swagger.json@
type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
......
......@@ -53,18 +53,19 @@ serverGargAPI baseUrl -- orchestrator
server :: Env -> IO (Server API)
server env = do
-- orchestrator <- scrapyOrchestrator env
pure $ swaggerSchemaUIServer swaggerDoc
pure $ \errScheme -> swaggerSchemaUIServer swaggerDoc
:<|> hoistServerWithContext
(Proxy :: Proxy GargAPI)
(Proxy :: Proxy AuthContext)
transformJSON
(transformJSON errScheme)
(serverGargAPI (env ^. hasConfig . gc_url_backend_api))
:<|> hoistServerWithContext
(Proxy :: Proxy GraphQL.API)
(Proxy :: Proxy AuthContext)
transformJSON
(transformJSON errScheme)
GraphQL.api
:<|> frontEndServer
where
transformJSON :: forall a. GargM Env BackendInternalError a -> Handler a
transformJSON = Handler . withExceptT showAsServantJSONErr . (`runReaderT` env)
transformJSON :: forall a. GargErrorScheme -> GargM Env BackendInternalError a -> Handler a
transformJSON GES_old = Handler . withExceptT showAsServantJSONErr . (`runReaderT` env)
transformJSON GES_new = Handler . withExceptT (frontendErrorToServerError . backendErrorToFrontendError) . (`runReaderT` env)
......@@ -10,7 +10,7 @@ import Network.Wai.Test
import Servant
import Servant.Auth.Client ()
import Servant.Client
import Test.API.Private (protected, withValidLogin)
import Test.API.Private (protected, withValidLogin, protectedNewError)
import Test.API.Setup (withTestDBAndPort, setupEnvironment, mkUrl, createAliceAndBob)
import Test.Hspec
import Test.Hspec.Wai.Internal (withApplication)
......@@ -48,3 +48,14 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
->liftIO $ do
statusCode `shouldBe` 404
simpleBody `shouldBe` [r|{"error":"Node does not exist (nodeId-99)"}|]
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
res <- protectedNewError token "GET" (mkUrl port "/node/99") ""
case res of
SResponse{..}
| Status{..} <- simpleStatus
->liftIO $ do
statusCode `shouldBe` 404
simpleBody `shouldBe` [r|{"data":{"node_id":99},"diagnostic":"FE_node_lookup_failed_not_found {nenf_node_id = nodeId-99}","type":"EC_404__node_lookup_failed_not_found"}|]
......@@ -10,9 +10,12 @@ module Test.API.Private (
, withValidLogin
, getJSON
, protected
, protectedWith
, protectedNewError
) where
import Data.ByteString.Lazy qualified as L
import Data.CaseInsensitive qualified as CI
import Data.Text.Encoding qualified as TE
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Routes
......@@ -36,11 +39,21 @@ import Test.Utils (jsonFragment, shouldRespondWith')
-- | 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")
protected tkn mth url = protectedWith mempty tkn mth url
protectedWith :: [Network.HTTP.Types.Header]
-> Token
-> Method -> ByteString -> L.ByteString -> WaiSession () SResponse
protectedWith extraHeaders tkn mth url payload =
request mth url ([ (hAccept, "application/json;charset=utf-8")
, (hContentType, "application/json")
, (hAuthorization, "Bearer " <> TE.encodeUtf8 tkn)
] payload
] <> extraHeaders) payload
protectedNewError :: Token -> Method -> ByteString -> L.ByteString -> WaiSession () SResponse
protectedNewError tkn mth url = protectedWith newErrorFormat tkn mth url
where
newErrorFormat = [(CI.mk "X-Garg-Error-Scheme", "new")]
getJSON :: ByteString -> WaiSession () SResponse
getJSON url =
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment