[errors] GraphQL error format

parent ec271ca6
Pipeline #5514 passed with stages
in 132 minutes and 6 seconds
...@@ -65,6 +65,7 @@ instance FromJWT AuthenticatedUser ...@@ -65,6 +65,7 @@ instance FromJWT AuthenticatedUser
data AuthenticationError data AuthenticationError
= LoginFailed NodeId UserId Jose.Error = LoginFailed NodeId UserId Jose.Error
| InvalidUsernameOrPassword | InvalidUsernameOrPassword
| UserNotAuthorized UserId Text
deriving (Show, Eq) deriving (Show, Eq)
-- TODO-SECURITY why is the CookieSettings necessary? -- TODO-SECURITY why is the CookieSettings necessary?
......
...@@ -12,6 +12,7 @@ module Gargantext.API.Errors ( ...@@ -12,6 +12,7 @@ module Gargantext.API.Errors (
-- * Conversion functions -- * Conversion functions
, backendErrorToFrontendError , backendErrorToFrontendError
, frontendErrorToServerError , frontendErrorToServerError
, frontendErrorToGQLServerError
-- * Temporary shims -- * Temporary shims
, showAsServantJSONErr , showAsServantJSONErr
...@@ -20,6 +21,10 @@ module Gargantext.API.Errors ( ...@@ -20,6 +21,10 @@ module Gargantext.API.Errors (
import Prelude import Prelude
import Control.Exception import Control.Exception
import Data.Aeson qualified as JSON
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding qualified as TE
import Data.Validity ( prettyValidation ) import Data.Validity ( prettyValidation )
import Gargantext.API.Admin.Auth.Types import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Errors.Class as Class import Gargantext.API.Errors.Class as Class
...@@ -28,20 +33,19 @@ import Gargantext.API.Errors.Types as Types ...@@ -28,20 +33,19 @@ import Gargantext.API.Errors.Types as Types
import Gargantext.Database.Query.Table.Node.Error hiding (nodeError) import Gargantext.Database.Query.Table.Node.Error hiding (nodeError)
import Gargantext.Database.Query.Tree hiding (treeError) import Gargantext.Database.Query.Tree hiding (treeError)
import Gargantext.Utils.Jobs.Monad (JobError(..)) import Gargantext.Utils.Jobs.Monad (JobError(..))
import Network.HTTP.Types.Status qualified as HTTP
import Servant.Server import Servant.Server
import qualified Data.Aeson as JSON
import qualified Data.Text as T
import qualified Network.HTTP.Types.Status as HTTP
import qualified Data.Text.Lazy.Encoding as TE
import qualified Data.Text.Lazy as TL
$(deriveHttpStatusCode ''BackendErrorCode) $(deriveHttpStatusCode ''BackendErrorCode)
data GargErrorScheme data GargErrorScheme
= -- | The old error scheme. = -- | The old error scheme.
GES_old GES_old
-- | The new error scheme, that returns a 'FrontendError'. -- | The new error scheme, that returns a 'FrontendError'.
| GES_new | GES_new
-- | Error scheme for GraphQL, has to be slightly different
-- {errors: [{message, extensions: { ... }}]}
-- https://spec.graphql.org/June2018/#sec-Errors
deriving (Show, Eq) deriving (Show, Eq)
-- | Transforms a backend internal error into something that the frontend -- | Transforms a backend internal error into something that the frontend
...@@ -49,26 +53,56 @@ data GargErrorScheme ...@@ -49,26 +53,56 @@ data GargErrorScheme
-- as we later encode this into a 'ServerError' in the main server handler. -- as we later encode this into a 'ServerError' in the main server handler.
backendErrorToFrontendError :: BackendInternalError -> FrontendError backendErrorToFrontendError :: BackendInternalError -> FrontendError
backendErrorToFrontendError = \case backendErrorToFrontendError = \case
InternalNodeError nodeError
-> nodeErrorToFrontendError nodeError
InternalTreeError treeError
-> treeErrorToFrontendError treeError
InternalValidationError validationError
-> mkFrontendErr' "A validation error occurred"
$ FE_validation_error $ case prettyValidation validationError of
Nothing -> "unknown_validation_error"
Just v -> T.pack v
InternalAuthenticationError authError InternalAuthenticationError authError
-> authErrorToFrontendError authError -> authErrorToFrontendError authError
InternalServerError internalServerError InternalNodeError nodeError
-> internalServerErrorToFrontendError internalServerError -> nodeErrorToFrontendError nodeError
InternalJobError jobError InternalJobError jobError
-> jobErrorToFrontendError jobError -> jobErrorToFrontendError jobError
InternalServerError internalServerError
-> internalServerErrorToFrontendError internalServerError
InternalTreeError treeError
-> treeErrorToFrontendError treeError
-- As this carries a 'SomeException' which might exposes sensible -- As this carries a 'SomeException' which might exposes sensible
-- information, we do not send to the frontend its content. -- information, we do not send to the frontend its content.
InternalUnexpectedError _ InternalUnexpectedError _
-> let msg = T.pack $ "An unexpected error occurred. Please check your server logs." -> let msg = T.pack $ "An unexpected error occurred. Please check your server logs."
in mkFrontendErr' msg $ FE_internal_server_error msg in mkFrontendErr' msg $ FE_internal_server_error msg
InternalValidationError validationError
-> mkFrontendErr' "A validation error occurred"
$ FE_validation_error $ case prettyValidation validationError of
Nothing -> "unknown_validation_error"
Just v -> T.pack v
frontendErrorToGQLServerError :: FrontendError -> ServerError
frontendErrorToGQLServerError fe@(FrontendError diag ty _) =
ServerError { errHTTPCode = HTTP.statusCode $ backendErrorTypeToErrStatus ty
, errReasonPhrase = T.unpack diag
, errBody = JSON.encode (GraphQLError fe)
, errHeaders = mempty
}
authErrorToFrontendError :: AuthenticationError -> FrontendError
authErrorToFrontendError = \case
-- For now, we ignore the Jose error, as they are too specific
-- (i.e. they should be logged internally to Sentry rather than shared
-- externally).
LoginFailed nid uid _
-> mkFrontendErr' "Invalid username/password, or invalid session token." $ FE_login_failed_error nid uid
InvalidUsernameOrPassword
-> mkFrontendErr' "Invalid username or password." $ FE_login_failed_invalid_username_or_password
UserNotAuthorized uId msg
-> mkFrontendErr' "User not authorized. " $ FE_user_not_authorized uId msg
-- | Converts a 'FrontendError' into a 'ServerError' that the servant app can
-- return to the frontend.
frontendErrorToServerError :: FrontendError -> ServerError
frontendErrorToServerError fe@(FrontendError diag ty _) =
ServerError { errHTTPCode = HTTP.statusCode $ backendErrorTypeToErrStatus ty
, errReasonPhrase = T.unpack diag
, errBody = JSON.encode fe
, errHeaders = mempty
}
internalServerErrorToFrontendError :: ServerError -> FrontendError internalServerErrorToFrontendError :: ServerError -> FrontendError
internalServerErrorToFrontendError = \case internalServerErrorToFrontendError = \case
...@@ -86,16 +120,6 @@ jobErrorToFrontendError = \case ...@@ -86,16 +120,6 @@ jobErrorToFrontendError = \case
UnknownJob jobId -> mkFrontendErrNoDiagnostic $ FE_job_unknown_job jobId UnknownJob jobId -> mkFrontendErrNoDiagnostic $ FE_job_unknown_job jobId
JobException err -> mkFrontendErrNoDiagnostic $ FE_job_generic_exception (T.pack $ displayException err) JobException err -> mkFrontendErrNoDiagnostic $ FE_job_generic_exception (T.pack $ displayException err)
authErrorToFrontendError :: AuthenticationError -> FrontendError
authErrorToFrontendError = \case
-- For now, we ignore the Jose error, as they are too specific
-- (i.e. they should be logged internally to Sentry rather than shared
-- externally).
LoginFailed nid uid _
-> mkFrontendErr' "Invalid username/password, or invalid session token." $ FE_login_failed_error nid uid
InvalidUsernameOrPassword
-> mkFrontendErr' "Invalid username or password." $ FE_login_failed_invalid_username_or_password
nodeErrorToFrontendError :: NodeError -> FrontendError nodeErrorToFrontendError :: NodeError -> FrontendError
nodeErrorToFrontendError ne = case ne of nodeErrorToFrontendError ne = case ne of
NoListFound lid NoListFound lid
...@@ -147,16 +171,6 @@ treeErrorToFrontendError te = case te of ...@@ -147,16 +171,6 @@ treeErrorToFrontendError te = case te of
EmptyRoot -> mkFrontendErrShow FE_tree_empty_root EmptyRoot -> mkFrontendErrShow FE_tree_empty_root
TooManyRoots roots -> mkFrontendErrShow $ FE_tree_too_many_roots roots TooManyRoots roots -> mkFrontendErrShow $ FE_tree_too_many_roots roots
-- | Converts a 'FrontendError' into a 'ServerError' that the servant app can
-- return to the frontend.
frontendErrorToServerError :: FrontendError -> ServerError
frontendErrorToServerError fe@(FrontendError diag ty _) =
ServerError { errHTTPCode = HTTP.statusCode $ backendErrorTypeToErrStatus ty
, errReasonPhrase = T.unpack diag
, errBody = JSON.encode fe
, errHeaders = mempty
}
showAsServantJSONErr :: BackendInternalError -> ServerError showAsServantJSONErr :: BackendInternalError -> ServerError
showAsServantJSONErr (InternalNodeError err@(NoListFound {})) = err404 { errBody = JSON.encode err } showAsServantJSONErr (InternalNodeError err@(NoListFound {})) = err404 { errBody = JSON.encode err }
showAsServantJSONErr (InternalNodeError err@NoRootFound{}) = err404 { errBody = JSON.encode err } showAsServantJSONErr (InternalNodeError err@NoRootFound{}) = err404 { errBody = JSON.encode err }
......
...@@ -20,6 +20,7 @@ module Gargantext.API.Errors.Types ( ...@@ -20,6 +20,7 @@ module Gargantext.API.Errors.Types (
-- * The internal backend type and an enumeration of all possible backend error types -- * The internal backend type and an enumeration of all possible backend error types
, BackendErrorCode(..) , BackendErrorCode(..)
, BackendInternalError(..) , BackendInternalError(..)
, GraphQLError(..)
, ToFrontendErrorData(..) , ToFrontendErrorData(..)
-- * Constructing frontend errors -- * Constructing frontend errors
...@@ -37,35 +38,33 @@ module Gargantext.API.Errors.Types ( ...@@ -37,35 +38,33 @@ module Gargantext.API.Errors.Types (
import Control.Exception import Control.Exception
import Control.Lens (makePrisms) import Control.Lens (makePrisms)
import Data.Aeson as JSON import Control.Monad.Fail (fail)
import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), (.:), (.=), object, withObject, toJSON)
import Data.Aeson.Types (typeMismatch, emptyArray) import Data.Aeson.Types (typeMismatch, emptyArray)
import Data.List.NonEmpty qualified as NE
import Data.Singletons.TH import Data.Singletons.TH
import Data.List.NonEmpty (NonEmpty) import Data.Text qualified as T
import Data.Typeable import Data.Typeable
import Data.Validity (Validation(..), ValidationChain (..), prettyValidation) import Data.Validity (Validation(..), ValidationChain (..), prettyValidation)
import GHC.Generics import GHC.Generics
import GHC.Stack import GHC.Stack
import Gargantext.API.Admin.Auth.Types (AuthenticationError)
import Gargantext.API.Errors.Class import Gargantext.API.Errors.Class
import Gargantext.API.Errors.TH import Gargantext.API.Errors.TH
import Gargantext.API.Errors.Types.Backend import Gargantext.API.Errors.Types.Backend
import Gargantext.Core.Types (HasValidationError(..)) import Gargantext.Core.Types (HasValidationError(..))
import Gargantext.Core.Types.Individu
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Query.Table.Node.Error import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Tree.Error import Gargantext.Database.Query.Tree.Error
import Gargantext.Prelude hiding (Location, WithStacktrace)
import Gargantext.Utils.Dict import Gargantext.Utils.Dict
import Prelude import Gargantext.Utils.Jobs.Monad qualified as Jobs
import Servant (ServerError) import Servant (ServerError)
import Servant.Job.Core import Servant.Job.Core
import Servant.Job.Types qualified as SJ
import Test.QuickCheck import Test.QuickCheck
import Test.QuickCheck.Instances.Text () import Test.QuickCheck.Instances.Text ()
import qualified Data.Text as T
import qualified Gargantext.Utils.Jobs.Monad as Jobs
import qualified Servant.Job.Types as SJ
import Text.Read (readMaybe)
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Gargantext.API.Admin.Auth.Types (AuthenticationError)
import Gargantext.Core.Types.Individu
-- | A 'WithStacktrace' carries an error alongside its -- | A 'WithStacktrace' carries an error alongside its
-- 'CallStack', to be able to print the correct source location -- 'CallStack', to be able to print the correct source location
...@@ -83,14 +82,18 @@ instance Exception e => Exception (WithStacktrace e) where ...@@ -83,14 +82,18 @@ instance Exception e => Exception (WithStacktrace e) where
------------------------------------------------------------------- -------------------------------------------------------------------
-- | An internal error which can be emitted from the backend and later -- | An internal error which can be emitted from the backend and later
-- converted into a 'FrontendError', for later consumption. -- converted into a 'FrontendError', for later consumption.
data BackendInternalError data BackendInternalError
= InternalNodeError !NodeError = InternalAuthenticationError !AuthenticationError
| InternalTreeError !TreeError
| InternalValidationError !Validation
| InternalAuthenticationError !AuthenticationError
| InternalServerError !ServerError
| InternalJobError !Jobs.JobError | InternalJobError !Jobs.JobError
| InternalNodeError !NodeError
| InternalServerError !ServerError
| InternalTreeError !TreeError
| InternalUnexpectedError !SomeException | InternalUnexpectedError !SomeException
| InternalValidationError !Validation
deriving (Show, Typeable) deriving (Show, Typeable)
makePrisms ''BackendInternalError makePrisms ''BackendInternalError
...@@ -265,6 +268,12 @@ data instance ToFrontendErrorData 'EC_403__login_failed_invalid_username_or_pass ...@@ -265,6 +268,12 @@ data instance ToFrontendErrorData 'EC_403__login_failed_invalid_username_or_pass
deriving (Show, Eq, Generic) deriving (Show, Eq, Generic)
data instance ToFrontendErrorData 'EC_403__user_not_authorized =
FE_user_not_authorized { una_user_id :: UserId
, una_msg :: T.Text }
deriving (Show, Eq, Generic)
-- --
-- Tree errors -- Tree errors
-- --
...@@ -326,34 +335,29 @@ data instance ToFrontendErrorData 'EC_405__not_allowed = ...@@ -326,34 +335,29 @@ data instance ToFrontendErrorData 'EC_405__not_allowed =
instance ToJSON (ToFrontendErrorData 'EC_404__node_list_not_found) where instance ToJSON (ToFrontendErrorData 'EC_404__node_list_not_found) where
toJSON (FE_node_list_not_found lid) = toJSON (FE_node_list_not_found lid) =
JSON.object [ "list_id" .= toJSON lid ] object [ "list_id" .= toJSON lid ]
instance FromJSON (ToFrontendErrorData 'EC_404__node_list_not_found) where instance FromJSON (ToFrontendErrorData 'EC_404__node_list_not_found) where
parseJSON = withObject "FE_node_list_not_found" $ \o -> do parseJSON = withObject "FE_node_list_not_found" $ \o -> do
lnf_list_id <- o .: "list_id" lnf_list_id <- o .: "list_id"
pure FE_node_list_not_found{..} pure FE_node_list_not_found{..}
instance ToJSON (ToFrontendErrorData 'EC_404__node_root_not_found) where instance ToJSON (ToFrontendErrorData 'EC_404__node_root_not_found) where
toJSON _ = JSON.Null toJSON _ = Null
instance FromJSON (ToFrontendErrorData 'EC_404__node_root_not_found) where instance FromJSON (ToFrontendErrorData 'EC_404__node_root_not_found) where
parseJSON _ = pure FE_node_root_not_found parseJSON _ = pure FE_node_root_not_found
instance ToJSON (ToFrontendErrorData 'EC_404__node_corpus_not_found) where instance ToJSON (ToFrontendErrorData 'EC_404__node_corpus_not_found) where
toJSON _ = JSON.Null toJSON _ = Null
instance FromJSON (ToFrontendErrorData 'EC_404__node_corpus_not_found) where instance FromJSON (ToFrontendErrorData 'EC_404__node_corpus_not_found) where
parseJSON _ = pure FE_node_corpus_not_found parseJSON _ = pure FE_node_corpus_not_found
instance ToJSON (ToFrontendErrorData 'EC_500__node_not_implemented_yet) where instance ToJSON (ToFrontendErrorData 'EC_500__node_not_implemented_yet) where
toJSON _ = JSON.Null toJSON _ = Null
instance FromJSON (ToFrontendErrorData 'EC_500__node_not_implemented_yet) where instance FromJSON (ToFrontendErrorData 'EC_500__node_not_implemented_yet) where
parseJSON _ = pure FE_node_not_implemented_yet parseJSON _ = pure FE_node_not_implemented_yet
instance ToJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_not_found) where instance ToJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_not_found) where
toJSON (FE_node_lookup_failed_not_found nodeId) = object [ "node_id" .= toJSON nodeId ] toJSON (FE_node_lookup_failed_not_found nodeId) = object [ "node_id" .= toJSON nodeId ]
instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_not_found) where instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_not_found) where
parseJSON = withObject "FE_node_lookup_failed_not_found" $ \o -> do parseJSON = withObject "FE_node_lookup_failed_not_found" $ \o -> do
nenf_node_id <- o .: "node_id" nenf_node_id <- o .: "node_id"
...@@ -361,7 +365,6 @@ instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_not_found) wh ...@@ -361,7 +365,6 @@ instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_not_found) wh
instance ToJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_parent_not_found) where instance ToJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_parent_not_found) where
toJSON (FE_node_lookup_failed_parent_not_found nodeId) = object [ "node_id" .= toJSON nodeId ] toJSON (FE_node_lookup_failed_parent_not_found nodeId) = object [ "node_id" .= toJSON nodeId ]
instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_parent_not_found) where instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_parent_not_found) where
parseJSON = withObject "FE_node_lookup_failed_parent_not_found" $ \o -> do parseJSON = withObject "FE_node_lookup_failed_parent_not_found" $ \o -> do
nepnf_node_id <- o .: "node_id" nepnf_node_id <- o .: "node_id"
...@@ -369,7 +372,6 @@ instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_parent_not_fo ...@@ -369,7 +372,6 @@ instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_parent_not_fo
instance ToJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_user_not_found) where instance ToJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_user_not_found) where
toJSON (FE_node_lookup_failed_user_not_found userId) = object [ "user_id" .= toJSON userId ] toJSON (FE_node_lookup_failed_user_not_found userId) = object [ "user_id" .= toJSON userId ]
instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_user_not_found) where instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_user_not_found) where
parseJSON = withObject "FE_node_lookup_failed_user_not_found" $ \o -> do parseJSON = withObject "FE_node_lookup_failed_user_not_found" $ \o -> do
nenf_user_id <- o .: "user_id" nenf_user_id <- o .: "user_id"
...@@ -377,7 +379,6 @@ instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_user_not_foun ...@@ -377,7 +379,6 @@ instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_user_not_foun
instance ToJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_username_not_found) where instance ToJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_username_not_found) where
toJSON (FE_node_lookup_failed_username_not_found username) = object [ "username" .= toJSON username ] toJSON (FE_node_lookup_failed_username_not_found username) = object [ "username" .= toJSON username ]
instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_username_not_found) where instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_username_not_found) where
parseJSON = withObject "FE_node_lookup_failed_username_not_found" $ \o -> do parseJSON = withObject "FE_node_lookup_failed_username_not_found" $ \o -> do
nenf_username <- o .: "username" nenf_username <- o .: "username"
...@@ -385,7 +386,6 @@ instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_username_not_ ...@@ -385,7 +386,6 @@ instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_username_not_
instance ToJSON (ToFrontendErrorData 'EC_400__node_creation_failed_user_negative_id) where instance ToJSON (ToFrontendErrorData 'EC_400__node_creation_failed_user_negative_id) where
toJSON (FE_node_creation_failed_user_negative_id userId) = object [ "user_id" .= toJSON userId ] toJSON (FE_node_creation_failed_user_negative_id userId) = object [ "user_id" .= toJSON userId ]
instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_user_negative_id) where instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_user_negative_id) where
parseJSON = withObject "FE_node_creation_failed_user_negative_id" $ \o -> do parseJSON = withObject "FE_node_creation_failed_user_negative_id" $ \o -> do
neuni_user_id <- o .: "user_id" neuni_user_id <- o .: "user_id"
...@@ -394,7 +394,6 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_user_negati ...@@ -394,7 +394,6 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_user_negati
instance ToJSON (ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_roots) where instance ToJSON (ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_roots) where
toJSON (FE_node_lookup_failed_user_too_many_roots userId roots) = toJSON (FE_node_lookup_failed_user_too_many_roots userId roots) =
object [ "user_id" .= toJSON userId, "roots" .= toJSON roots ] object [ "user_id" .= toJSON userId, "roots" .= toJSON roots ]
instance FromJSON (ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_roots) where instance FromJSON (ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many_roots) where
parseJSON = withObject "FE_node_lookup_failed_user_too_many_roots" $ \o -> do parseJSON = withObject "FE_node_lookup_failed_user_too_many_roots" $ \o -> do
netmr_user_id <- o .: "user_id" netmr_user_id <- o .: "user_id"
...@@ -403,7 +402,6 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many ...@@ -403,7 +402,6 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_lookup_failed_user_too_many
instance ToJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where instance ToJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where
toJSON (FE_node_context_not_found cId) = object [ "context_id" .= toJSON cId ] toJSON (FE_node_context_not_found cId) = object [ "context_id" .= toJSON cId ]
instance FromJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where instance FromJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where
parseJSON = withObject "FE_node_context_not_found" $ \o -> do parseJSON = withObject "FE_node_context_not_found" $ \o -> do
necnf_context_id <- o .: "context_id" necnf_context_id <- o .: "context_id"
...@@ -411,7 +409,6 @@ instance FromJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where ...@@ -411,7 +409,6 @@ instance FromJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where
instance ToJSON (ToFrontendErrorData 'EC_400__node_creation_failed_no_parent) where instance ToJSON (ToFrontendErrorData 'EC_400__node_creation_failed_no_parent) where
toJSON (FE_node_creation_failed_no_parent uId) = object [ "user_id" .= toJSON uId ] toJSON (FE_node_creation_failed_no_parent uId) = object [ "user_id" .= toJSON uId ]
instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_no_parent) where instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_no_parent) where
parseJSON = withObject "FE_node_creation_failed_no_parent" $ \o -> do parseJSON = withObject "FE_node_creation_failed_no_parent" $ \o -> do
necnp_user_id <- o .: "user_id" necnp_user_id <- o .: "user_id"
...@@ -420,7 +417,6 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_no_parent) ...@@ -420,7 +417,6 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_no_parent)
instance ToJSON (ToFrontendErrorData 'EC_400__node_creation_failed_parent_exists) where instance ToJSON (ToFrontendErrorData 'EC_400__node_creation_failed_parent_exists) where
toJSON FE_node_creation_failed_parent_exists{..} = toJSON FE_node_creation_failed_parent_exists{..} =
object [ "user_id" .= toJSON necpe_user_id, "parent_id" .= toJSON necpe_parent_id ] object [ "user_id" .= toJSON necpe_user_id, "parent_id" .= toJSON necpe_parent_id ]
instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_parent_exists) where instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_parent_exists) where
parseJSON = withObject "FE_node_creation_failed_parent_exists" $ \o -> do parseJSON = withObject "FE_node_creation_failed_parent_exists" $ \o -> do
necpe_user_id <- o .: "user_id" necpe_user_id <- o .: "user_id"
...@@ -429,8 +425,7 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_parent_exis ...@@ -429,8 +425,7 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_parent_exis
instance ToJSON (ToFrontendErrorData 'EC_400__node_creation_failed_insert_node) where instance ToJSON (ToFrontendErrorData 'EC_400__node_creation_failed_insert_node) where
toJSON FE_node_creation_failed_insert_node{..} = toJSON FE_node_creation_failed_insert_node{..} =
JSON.object [ "user_id" .= toJSON necin_user_id, "parent_id" .= necin_parent_id ] object [ "user_id" .= toJSON necin_user_id, "parent_id" .= necin_parent_id ]
instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_insert_node) where instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_insert_node) where
parseJSON = withObject "FE_node_creation_failed_insert_node" $ \o -> do parseJSON = withObject "FE_node_creation_failed_insert_node" $ \o -> do
necin_user_id <- o .: "user_id" necin_user_id <- o .: "user_id"
...@@ -439,16 +434,14 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_insert_node ...@@ -439,16 +434,14 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_insert_node
instance ToJSON (ToFrontendErrorData 'EC_500__node_generic_exception) where instance ToJSON (ToFrontendErrorData 'EC_500__node_generic_exception) where
toJSON FE_node_generic_exception{..} = toJSON FE_node_generic_exception{..} =
JSON.object [ "error" .= nege_error ] object [ "error" .= nege_error ]
instance FromJSON (ToFrontendErrorData 'EC_500__node_generic_exception) where instance FromJSON (ToFrontendErrorData 'EC_500__node_generic_exception) where
parseJSON = withObject "FE_node_generic_exception" $ \o -> do parseJSON = withObject "FE_node_generic_exception" $ \o -> do
nege_error <- o .: "error" nege_error <- o .: "error"
pure FE_node_generic_exception{..} pure FE_node_generic_exception{..}
instance ToJSON (ToFrontendErrorData 'EC_400__node_needs_configuration) where instance ToJSON (ToFrontendErrorData 'EC_400__node_needs_configuration) where
toJSON _ = JSON.Null toJSON _ = Null
instance FromJSON (ToFrontendErrorData 'EC_400__node_needs_configuration) where instance FromJSON (ToFrontendErrorData 'EC_400__node_needs_configuration) where
parseJSON _ = pure FE_node_needs_configuration parseJSON _ = pure FE_node_needs_configuration
...@@ -458,7 +451,6 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_needs_configuration) where ...@@ -458,7 +451,6 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_needs_configuration) where
instance ToJSON (ToFrontendErrorData 'EC_400__validation_error) where instance ToJSON (ToFrontendErrorData 'EC_400__validation_error) where
toJSON (FE_validation_error val) = toJSON val toJSON (FE_validation_error val) = toJSON val
instance FromJSON (ToFrontendErrorData 'EC_400__validation_error) where instance FromJSON (ToFrontendErrorData 'EC_400__validation_error) where
parseJSON (String txt) = pure $ FE_validation_error txt parseJSON (String txt) = pure $ FE_validation_error txt
parseJSON ty = typeMismatch "FE_validation_error" ty parseJSON ty = typeMismatch "FE_validation_error" ty
...@@ -470,7 +462,6 @@ instance FromJSON (ToFrontendErrorData 'EC_400__validation_error) where ...@@ -470,7 +462,6 @@ instance FromJSON (ToFrontendErrorData 'EC_400__validation_error) where
instance ToJSON (ToFrontendErrorData 'EC_403__login_failed_error) where instance ToJSON (ToFrontendErrorData 'EC_403__login_failed_error) where
toJSON FE_login_failed_error{..} = toJSON FE_login_failed_error{..} =
object [ "user_id" .= toJSON lfe_user_id, "node_id" .= toJSON lfe_node_id ] object [ "user_id" .= toJSON lfe_user_id, "node_id" .= toJSON lfe_node_id ]
instance FromJSON (ToFrontendErrorData 'EC_403__login_failed_error) where instance FromJSON (ToFrontendErrorData 'EC_403__login_failed_error) where
parseJSON = withObject "FE_login_failed_error" $ \o -> do parseJSON = withObject "FE_login_failed_error" $ \o -> do
lfe_user_id <- o .: "user_id" lfe_user_id <- o .: "user_id"
...@@ -481,18 +472,25 @@ instance FromJSON (ToFrontendErrorData 'EC_403__login_failed_error) where ...@@ -481,18 +472,25 @@ instance FromJSON (ToFrontendErrorData 'EC_403__login_failed_error) where
instance ToJSON (ToFrontendErrorData 'EC_403__login_failed_invalid_username_or_password) where instance ToJSON (ToFrontendErrorData 'EC_403__login_failed_invalid_username_or_password) where
toJSON FE_login_failed_invalid_username_or_password = toJSON FE_login_failed_invalid_username_or_password =
object [] object []
instance FromJSON (ToFrontendErrorData 'EC_403__login_failed_invalid_username_or_password) where instance FromJSON (ToFrontendErrorData 'EC_403__login_failed_invalid_username_or_password) where
parseJSON = withObject "FE_login_failed_invalid_username_or_password" $ \_o -> do parseJSON = withObject "FE_login_failed_invalid_username_or_password" $ \_o -> do
pure FE_login_failed_invalid_username_or_password pure FE_login_failed_invalid_username_or_password
instance ToJSON (ToFrontendErrorData 'EC_403__user_not_authorized) where
toJSON FE_user_not_authorized { .. } =
object [ "user_id" .= toJSON una_user_id, "msg" .= toJSON una_msg ]
instance FromJSON (ToFrontendErrorData 'EC_403__user_not_authorized) where
parseJSON = withObject "FE_user_not_authorized" $ \o -> do
una_user_id <- o .: "user_id"
una_msg <- o .: "msg"
pure FE_user_not_authorized { .. }
-- --
-- internal server errors -- internal server errors
-- --
instance ToJSON (ToFrontendErrorData 'EC_500__internal_server_error) where instance ToJSON (ToFrontendErrorData 'EC_500__internal_server_error) where
toJSON FE_internal_server_error{..} = object [ "error" .= toJSON ise_error ] toJSON FE_internal_server_error{..} = object [ "error" .= toJSON ise_error ]
instance FromJSON (ToFrontendErrorData 'EC_500__internal_server_error) where instance FromJSON (ToFrontendErrorData 'EC_500__internal_server_error) where
parseJSON = withObject "FE_internal_server_error" $ \o -> do parseJSON = withObject "FE_internal_server_error" $ \o -> do
ise_error <- o .: "error" ise_error <- o .: "error"
...@@ -500,7 +498,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__internal_server_error) where ...@@ -500,7 +498,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__internal_server_error) where
instance ToJSON (ToFrontendErrorData 'EC_405__not_allowed) where instance ToJSON (ToFrontendErrorData 'EC_405__not_allowed) where
toJSON FE_not_allowed{..} = object [ "error" .= toJSON isena_error ] toJSON FE_not_allowed{..} = object [ "error" .= toJSON isena_error ]
instance FromJSON (ToFrontendErrorData 'EC_405__not_allowed) where instance FromJSON (ToFrontendErrorData 'EC_405__not_allowed) where
parseJSON = withObject "FE_not_allowed" $ \o -> do parseJSON = withObject "FE_not_allowed" $ \o -> do
isena_error <- o .: "error" isena_error <- o .: "error"
...@@ -512,21 +509,18 @@ instance FromJSON (ToFrontendErrorData 'EC_405__not_allowed) where ...@@ -512,21 +509,18 @@ instance FromJSON (ToFrontendErrorData 'EC_405__not_allowed) where
-- --
instance ToJSON (ToFrontendErrorData 'EC_404__tree_root_not_found) where instance ToJSON (ToFrontendErrorData 'EC_404__tree_root_not_found) where
toJSON _ = JSON.Null toJSON _ = Null
instance FromJSON (ToFrontendErrorData 'EC_404__tree_root_not_found) where instance FromJSON (ToFrontendErrorData 'EC_404__tree_root_not_found) where
parseJSON _ = pure FE_tree_root_not_found parseJSON _ = pure FE_tree_root_not_found
instance ToJSON (ToFrontendErrorData 'EC_404__tree_empty_root) where instance ToJSON (ToFrontendErrorData 'EC_404__tree_empty_root) where
toJSON _ = JSON.Null toJSON _ = Null
instance FromJSON (ToFrontendErrorData 'EC_404__tree_empty_root) where instance FromJSON (ToFrontendErrorData 'EC_404__tree_empty_root) where
parseJSON _ = pure FE_tree_empty_root parseJSON _ = pure FE_tree_empty_root
instance ToJSON (ToFrontendErrorData 'EC_500__tree_too_many_roots) where instance ToJSON (ToFrontendErrorData 'EC_500__tree_too_many_roots) where
toJSON (FE_tree_too_many_roots roots) = toJSON (FE_tree_too_many_roots roots) =
object [ "node_ids" .= NE.toList roots ] object [ "node_ids" .= NE.toList roots ]
instance FromJSON (ToFrontendErrorData 'EC_500__tree_too_many_roots) where instance FromJSON (ToFrontendErrorData 'EC_500__tree_too_many_roots) where
parseJSON = withObject "FE_tree_too_many_roots" $ \o -> do parseJSON = withObject "FE_tree_too_many_roots" $ \o -> do
tmr_roots <- o .: "node_ids" tmr_roots <- o .: "node_ids"
...@@ -539,7 +533,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__tree_too_many_roots) where ...@@ -539,7 +533,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__tree_too_many_roots) where
instance ToJSON (ToFrontendErrorData 'EC_500__job_invalid_id_type) where instance ToJSON (ToFrontendErrorData 'EC_500__job_invalid_id_type) where
toJSON (FE_job_invalid_id_type idTy) = toJSON (FE_job_invalid_id_type idTy) =
object [ "type" .= toJSON idTy ] object [ "type" .= toJSON idTy ]
instance FromJSON (ToFrontendErrorData 'EC_500__job_invalid_id_type) where instance FromJSON (ToFrontendErrorData 'EC_500__job_invalid_id_type) where
parseJSON = withObject "FE_job_invalid_id_type" $ \o -> do parseJSON = withObject "FE_job_invalid_id_type" $ \o -> do
jeiit_type <- o .: "type" jeiit_type <- o .: "type"
...@@ -548,7 +541,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_invalid_id_type) where ...@@ -548,7 +541,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_invalid_id_type) where
instance ToJSON (ToFrontendErrorData 'EC_500__job_expired) where instance ToJSON (ToFrontendErrorData 'EC_500__job_expired) where
toJSON (FE_job_expired jobId) = toJSON (FE_job_expired jobId) =
object [ "job_id" .= toJSON jobId ] object [ "job_id" .= toJSON jobId ]
instance FromJSON (ToFrontendErrorData 'EC_500__job_expired) where instance FromJSON (ToFrontendErrorData 'EC_500__job_expired) where
parseJSON = withObject "FE_job_expired" $ \o -> do parseJSON = withObject "FE_job_expired" $ \o -> do
jee_job_id <- o .: "job_id" jee_job_id <- o .: "job_id"
...@@ -557,7 +549,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_expired) where ...@@ -557,7 +549,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_expired) where
instance ToJSON (ToFrontendErrorData 'EC_500__job_invalid_mac) where instance ToJSON (ToFrontendErrorData 'EC_500__job_invalid_mac) where
toJSON (FE_job_invalid_mac mac) = toJSON (FE_job_invalid_mac mac) =
object [ "mac" .= toJSON mac ] object [ "mac" .= toJSON mac ]
instance FromJSON (ToFrontendErrorData 'EC_500__job_invalid_mac) where instance FromJSON (ToFrontendErrorData 'EC_500__job_invalid_mac) where
parseJSON = withObject "FE_job_invalid_mac" $ \o -> do parseJSON = withObject "FE_job_invalid_mac" $ \o -> do
jeim_mac <- o .: "mac" jeim_mac <- o .: "mac"
...@@ -566,7 +557,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_invalid_mac) where ...@@ -566,7 +557,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_invalid_mac) where
instance ToJSON (ToFrontendErrorData 'EC_500__job_unknown_job) where instance ToJSON (ToFrontendErrorData 'EC_500__job_unknown_job) where
toJSON (FE_job_unknown_job jobId) = toJSON (FE_job_unknown_job jobId) =
object [ "job_id" .= toJSON jobId ] object [ "job_id" .= toJSON jobId ]
instance FromJSON (ToFrontendErrorData 'EC_500__job_unknown_job) where instance FromJSON (ToFrontendErrorData 'EC_500__job_unknown_job) where
parseJSON = withObject "FE_job_unknown_job" $ \o -> do parseJSON = withObject "FE_job_unknown_job" $ \o -> do
jeuj_job_id <- o .: "job_id" jeuj_job_id <- o .: "job_id"
...@@ -575,7 +565,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_unknown_job) where ...@@ -575,7 +565,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_unknown_job) where
instance ToJSON (ToFrontendErrorData 'EC_500__job_generic_exception) where instance ToJSON (ToFrontendErrorData 'EC_500__job_generic_exception) where
toJSON (FE_job_generic_exception err) = toJSON (FE_job_generic_exception err) =
object [ "error" .= toJSON err ] object [ "error" .= toJSON err ]
instance FromJSON (ToFrontendErrorData 'EC_500__job_generic_exception) where instance FromJSON (ToFrontendErrorData 'EC_500__job_generic_exception) where
parseJSON = withObject "FE_job_generic_exception" $ \o -> do parseJSON = withObject "FE_job_generic_exception" $ \o -> do
jege_error <- o .: "error" jege_error <- o .: "error"
...@@ -656,6 +645,12 @@ genFrontendErr be = do ...@@ -656,6 +645,12 @@ genFrontendErr be = do
-> do -> do
pure $ mkFrontendErr' txt $ FE_login_failed_invalid_username_or_password pure $ mkFrontendErr' txt $ FE_login_failed_invalid_username_or_password
EC_403__user_not_authorized
-> do
uid <- arbitrary
msg <- arbitrary
pure $ mkFrontendErr' txt $ FE_user_not_authorized uid msg
-- internal error -- internal error
EC_500__internal_server_error EC_500__internal_server_error
-> do err <- arbitrary -> do err <- arbitrary
...@@ -692,7 +687,7 @@ genFrontendErr be = do ...@@ -692,7 +687,7 @@ genFrontendErr be = do
pure $ mkFrontendErr' txt $ FE_job_generic_exception err pure $ mkFrontendErr' txt $ FE_job_generic_exception err
instance ToJSON BackendErrorCode where instance ToJSON BackendErrorCode where
toJSON = JSON.String . T.pack . show toJSON = String . T.pack . show
instance FromJSON BackendErrorCode where instance FromJSON BackendErrorCode where
parseJSON (String s) = case readMaybe (T.unpack s) of parseJSON (String s) = case readMaybe (T.unpack s) of
...@@ -702,10 +697,10 @@ instance FromJSON BackendErrorCode where ...@@ -702,10 +697,10 @@ instance FromJSON BackendErrorCode where
instance ToJSON FrontendError where instance ToJSON FrontendError where
toJSON (FrontendError diag ty dt) = toJSON (FrontendError diag ty dt) =
JSON.object [ "diagnostic" .= toJSON diag object [ "diagnostic" .= toJSON diag
, "type" .= toJSON ty , "type" .= toJSON ty
, "data" .= toJSON dt , "data" .= toJSON dt
] ]
instance FromJSON FrontendError where instance FromJSON FrontendError where
parseJSON = withObject "FrontendError" $ \o -> do parseJSON = withObject "FrontendError" $ \o -> do
...@@ -775,6 +770,10 @@ instance FromJSON FrontendError where ...@@ -775,6 +770,10 @@ instance FromJSON FrontendError where
(fe_data :: ToFrontendErrorData 'EC_403__login_failed_invalid_username_or_password) <- o .: "data" (fe_data :: ToFrontendErrorData 'EC_403__login_failed_invalid_username_or_password) <- o .: "data"
pure FrontendError{..} pure FrontendError{..}
EC_403__user_not_authorized -> do
(fe_data :: ToFrontendErrorData 'EC_403__user_not_authorized) <- o .: "data"
pure FrontendError{..}
-- internal server error -- internal server error
EC_500__internal_server_error -> do EC_500__internal_server_error -> do
(fe_data :: ToFrontendErrorData 'EC_500__internal_server_error) <- o .: "data" (fe_data :: ToFrontendErrorData 'EC_500__internal_server_error) <- o .: "data"
...@@ -810,3 +809,26 @@ instance FromJSON FrontendError where ...@@ -810,3 +809,26 @@ instance FromJSON FrontendError where
EC_500__job_generic_exception -> do EC_500__job_generic_exception -> do
(fe_data :: ToFrontendErrorData 'EC_500__job_generic_exception) <- o .: "data" (fe_data :: ToFrontendErrorData 'EC_500__job_generic_exception) <- o .: "data"
pure FrontendError{..} pure FrontendError{..}
----------------
--- GraphQL Errors are just FrontendError wrapped in
-- { error: { message, extensions: { ... } } }
-- (see https://spec.graphql.org/June2018/#sec-Errors)
newtype GraphQLError = GraphQLError FrontendError
deriving instance Show GraphQLError
deriving instance Eq GraphQLError
instance ToJSON GraphQLError where
toJSON (GraphQLError fe@(FrontendError diag _ty _dt)) =
object [ "errors" .= toJSON [ object [ "message" .= toJSON diag
, "extensions" .= toJSON fe ] ] ]
instance FromJSON GraphQLError where
parseJSON = withObject "GraphQLError" $ \o -> do
errors <- o .: "errors"
fe <- case errors of
[] -> fail "No errors provided"
(x:_) -> withObject "FrontendError" (\fo -> fo .: "extensions") x
pure $ GraphQLError fe
...@@ -37,6 +37,7 @@ data BackendErrorCode ...@@ -37,6 +37,7 @@ data BackendErrorCode
-- authentication errors -- authentication errors
| EC_403__login_failed_error | EC_403__login_failed_error
| EC_403__login_failed_invalid_username_or_password | EC_403__login_failed_invalid_username_or_password
| EC_403__user_not_authorized
-- tree errors -- tree errors
| EC_404__tree_root_not_found | EC_404__tree_root_not_found
| EC_404__tree_empty_root | EC_404__tree_empty_root
......
...@@ -16,6 +16,7 @@ module Gargantext.API.GraphQL.Team where ...@@ -16,6 +16,7 @@ module Gargantext.API.GraphQL.Team where
import Data.Morpheus.Types (GQLType, ResolverM) import Data.Morpheus.Types (GQLType, ResolverM)
import Data.Text qualified as T import Data.Text qualified as T
import Gargantext.API.Admin.Auth.Types (AuthenticationError(..))
import Gargantext.API.Admin.Types (HasSettings) import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types import Gargantext.API.Errors.Types
import Gargantext.API.GraphQL.Types (GqlM) import Gargantext.API.GraphQL.Types (GqlM)
...@@ -86,10 +87,12 @@ deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } = ...@@ -86,10 +87,12 @@ deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } =
[] -> panicTrace $ "[deleteTeamMembership] User with id " <> T.pack (show $ uId teamNode) <> " doesn't exist." [] -> panicTrace $ "[deleteTeamMembership] User with id " <> T.pack (show $ uId teamNode) <> " doesn't exist."
(( _, node_u):_) -> do (( _, node_u):_) -> do
testAuthUser <- lift $ authUser (nId node_u) token testAuthUser <- lift $ authUser (nId node_u) token
case testAuthUser of lift $ case testAuthUser of
Invalid -> panicTrace "[deleteTeamMembership] failed to validate user" -- Invalid -> panicTrace "[deleteTeamMembership] failed to validate user"
Invalid -> do
throwError $ InternalAuthenticationError $ UserNotAuthorized (uId node_u) "This user is not team owner"
Valid -> do Valid -> do
lift $ deleteMemberShip [(UnsafeMkNodeId shared_folder_id, UnsafeMkNodeId team_node_id)] deleteMemberShip [(UnsafeMkNodeId shared_folder_id, UnsafeMkNodeId team_node_id)]
where where
uId Node { _node_user_id } = _node_user_id uId Node { _node_user_id } = _node_user_id
nId Node { _node_id } = _node_id nId Node { _node_id } = _node_id
...@@ -10,6 +10,7 @@ Portability : POSIX ...@@ -10,6 +10,7 @@ Portability : POSIX
module Gargantext.API.GraphQL.Utils where module Gargantext.API.GraphQL.Utils where
import Control.Lens ((^.))
import Control.Lens.Getter (view) import Control.Lens.Getter (view)
import Data.Morpheus.Types (GQLTypeOptions, fieldLabelModifier) import Data.Morpheus.Types (GQLTypeOptions, fieldLabelModifier)
import Data.Text qualified as T import Data.Text qualified as T
...@@ -20,7 +21,6 @@ import Gargantext.Database.Admin.Types.Node (NodeId) ...@@ -20,7 +21,6 @@ import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Prelude (Cmd') import Gargantext.Database.Prelude (Cmd')
import Gargantext.Prelude import Gargantext.Prelude
import Servant.Auth.Server (verifyJWT, JWTSettings) import Servant.Auth.Server (verifyJWT, JWTSettings)
import Control.Lens ((^.))
unPrefix :: T.Text -> GQLTypeOptions -> GQLTypeOptions unPrefix :: T.Text -> GQLTypeOptions -> GQLTypeOptions
unPrefix prefix options = options { fieldLabelModifier = nflm } unPrefix prefix options = options { fieldLabelModifier = nflm }
......
...@@ -67,13 +67,16 @@ server env = do ...@@ -67,13 +67,16 @@ server env = do
:<|> hoistServerWithContext :<|> hoistServerWithContext
(Proxy :: Proxy GraphQL.API) (Proxy :: Proxy GraphQL.API)
(Proxy :: Proxy AuthContext) (Proxy :: Proxy AuthContext)
(transformJSON errScheme) (transformJSONGQL errScheme)
GraphQL.api GraphQL.api
:<|> frontEndServer :<|> frontEndServer
where where
transformJSON :: forall a. GargErrorScheme -> GargM Env BackendInternalError a -> Handler a transformJSON :: forall a. GargErrorScheme -> GargM Env BackendInternalError a -> Handler a
transformJSON GES_old = Handler . withExceptT showAsServantJSONErr . (`runReaderT` env) . logPanicErrors transformJSON GES_old = Handler . withExceptT showAsServantJSONErr . (`runReaderT` env) . logPanicErrors
transformJSON GES_new = Handler . withExceptT (frontendErrorToServerError . backendErrorToFrontendError) . (`runReaderT` env) . handlePanicErrors transformJSON GES_new = Handler . withExceptT (frontendErrorToServerError . backendErrorToFrontendError) . (`runReaderT` env) . handlePanicErrors
transformJSONGQL :: forall a. GargErrorScheme -> GargM Env BackendInternalError a -> Handler a
transformJSONGQL GES_old = Handler . withExceptT showAsServantJSONErr . (`runReaderT` env) . logPanicErrors
transformJSONGQL GES_new = Handler . withExceptT (frontendErrorToGQLServerError . backendErrorToFrontendError) . (`runReaderT` env) . handlePanicErrors
handlePanicErrors :: GargM Env BackendInternalError a -> GargM Env BackendInternalError a handlePanicErrors :: GargM Env BackendInternalError a -> GargM Env BackendInternalError a
handlePanicErrors h = h `catch` handleSomeException handlePanicErrors h = h `catch` handleSomeException
...@@ -104,3 +107,4 @@ logPanicErrors h = h `catch` handleSomeException ...@@ -104,3 +107,4 @@ logPanicErrors h = h `catch` handleSomeException
= throwError ber -- re-throw the uncaught exception via the 'MonadError' instance = throwError ber -- re-throw the uncaught exception via the 'MonadError' instance
| otherwise | otherwise
= throwM se -- re-throw the uncaught exception. = throwM se -- re-throw the uncaught exception.
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