diff --git a/src/Gargantext/API/Admin/Auth/Types.hs b/src/Gargantext/API/Admin/Auth/Types.hs
index 9350aa0e6effd011b90e313c425d4b9d667283c2..fb5faaebca64ad5ceb96dcfed45cf37ef0c5eefa 100644
--- a/src/Gargantext/API/Admin/Auth/Types.hs
+++ b/src/Gargantext/API/Admin/Auth/Types.hs
@@ -65,6 +65,7 @@ instance FromJWT AuthenticatedUser
data AuthenticationError
= LoginFailed NodeId UserId Jose.Error
| InvalidUsernameOrPassword
+ | UserNotAuthorized UserId Text
deriving (Show, Eq)
-- TODO-SECURITY why is the CookieSettings necessary?
diff --git a/src/Gargantext/API/Errors.hs b/src/Gargantext/API/Errors.hs
index 10d0bc60ac985209bdddd49089295a58996636a4..f0c58686048acc62e84ed332eee0c975838db038 100644
--- a/src/Gargantext/API/Errors.hs
+++ b/src/Gargantext/API/Errors.hs
@@ -12,6 +12,7 @@ module Gargantext.API.Errors (
-- * Conversion functions
, backendErrorToFrontendError
, frontendErrorToServerError
+ , frontendErrorToGQLServerError
-- * Temporary shims
, showAsServantJSONErr
@@ -20,6 +21,10 @@ module Gargantext.API.Errors (
import Prelude
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 Gargantext.API.Admin.Auth.Types
import Gargantext.API.Errors.Class as Class
@@ -28,20 +33,19 @@ import Gargantext.API.Errors.Types as Types
import Gargantext.Database.Query.Table.Node.Error hiding (nodeError)
import Gargantext.Database.Query.Tree hiding (treeError)
import Gargantext.Utils.Jobs.Monad (JobError(..))
+import Network.HTTP.Types.Status qualified as HTTP
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)
data GargErrorScheme
= -- | The old error scheme.
GES_old
- -- | The new error scheme, that returns a 'FrontendError'.
+ -- | The new error scheme, that returns a 'FrontendError'.
| GES_new
+ -- | Error scheme for GraphQL, has to be slightly different
+ -- {errors: [{message, extensions: { ... }}]}
+ -- https://spec.graphql.org/June2018/#sec-Errors
deriving (Show, Eq)
-- | Transforms a backend internal error into something that the frontend
@@ -49,26 +53,56 @@ data GargErrorScheme
-- as we later encode this into a 'ServerError' in the main server handler.
backendErrorToFrontendError :: BackendInternalError -> FrontendError
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
-> authErrorToFrontendError authError
- InternalServerError internalServerError
- -> internalServerErrorToFrontendError internalServerError
+ InternalNodeError nodeError
+ -> nodeErrorToFrontendError nodeError
InternalJobError jobError
-> jobErrorToFrontendError jobError
+ InternalServerError internalServerError
+ -> internalServerErrorToFrontendError internalServerError
+ InternalTreeError treeError
+ -> treeErrorToFrontendError treeError
-- As this carries a 'SomeException' which might exposes sensible
-- information, we do not send to the frontend its content.
InternalUnexpectedError _
-> let msg = T.pack $ "An unexpected error occurred. Please check your server logs."
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 = \case
@@ -86,16 +120,6 @@ jobErrorToFrontendError = \case
UnknownJob jobId -> mkFrontendErrNoDiagnostic $ FE_job_unknown_job jobId
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 ne = case ne of
NoListFound lid
@@ -147,16 +171,6 @@ treeErrorToFrontendError te = case te of
EmptyRoot -> mkFrontendErrShow FE_tree_empty_root
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 (InternalNodeError err@(NoListFound {})) = err404 { errBody = JSON.encode err }
showAsServantJSONErr (InternalNodeError err@NoRootFound{}) = err404 { errBody = JSON.encode err }
diff --git a/src/Gargantext/API/Errors/Types.hs b/src/Gargantext/API/Errors/Types.hs
index 1334985dba97bb58ec0fa600084e46966dc01b14..c8aa1e82ac7bd16ad06eb648eadff597a718a58e 100644
--- a/src/Gargantext/API/Errors/Types.hs
+++ b/src/Gargantext/API/Errors/Types.hs
@@ -20,6 +20,7 @@ module Gargantext.API.Errors.Types (
-- * The internal backend type and an enumeration of all possible backend error types
, BackendErrorCode(..)
, BackendInternalError(..)
+ , GraphQLError(..)
, ToFrontendErrorData(..)
-- * Constructing frontend errors
@@ -37,35 +38,33 @@ module Gargantext.API.Errors.Types (
import Control.Exception
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.List.NonEmpty qualified as NE
import Data.Singletons.TH
-import Data.List.NonEmpty (NonEmpty)
+import Data.Text qualified as T
import Data.Typeable
import Data.Validity (Validation(..), ValidationChain (..), prettyValidation)
import GHC.Generics
import GHC.Stack
+import Gargantext.API.Admin.Auth.Types (AuthenticationError)
import Gargantext.API.Errors.Class
import Gargantext.API.Errors.TH
import Gargantext.API.Errors.Types.Backend
import Gargantext.Core.Types (HasValidationError(..))
+import Gargantext.Core.Types.Individu
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Tree.Error
+import Gargantext.Prelude hiding (Location, WithStacktrace)
import Gargantext.Utils.Dict
-import Prelude
+import Gargantext.Utils.Jobs.Monad qualified as Jobs
import Servant (ServerError)
import Servant.Job.Core
+import Servant.Job.Types qualified as SJ
import Test.QuickCheck
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
-- 'CallStack', to be able to print the correct source location
@@ -83,14 +82,18 @@ instance Exception e => Exception (WithStacktrace e) where
-------------------------------------------------------------------
-- | An internal error which can be emitted from the backend and later
-- converted into a 'FrontendError', for later consumption.
+
+
+
+
data BackendInternalError
- = InternalNodeError !NodeError
- | InternalTreeError !TreeError
- | InternalValidationError !Validation
- | InternalAuthenticationError !AuthenticationError
- | InternalServerError !ServerError
+ = InternalAuthenticationError !AuthenticationError
| InternalJobError !Jobs.JobError
+ | InternalNodeError !NodeError
+ | InternalServerError !ServerError
+ | InternalTreeError !TreeError
| InternalUnexpectedError !SomeException
+ | InternalValidationError !Validation
deriving (Show, Typeable)
makePrisms ''BackendInternalError
@@ -265,6 +268,12 @@ data instance ToFrontendErrorData 'EC_403__login_failed_invalid_username_or_pass
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
--
@@ -326,34 +335,29 @@ data instance ToFrontendErrorData 'EC_405__not_allowed =
instance ToJSON (ToFrontendErrorData 'EC_404__node_list_not_found) where
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
parseJSON = withObject "FE_node_list_not_found" $ \o -> do
lnf_list_id <- o .: "list_id"
pure FE_node_list_not_found{..}
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
parseJSON _ = pure FE_node_root_not_found
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
parseJSON _ = pure FE_node_corpus_not_found
-
+
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
parseJSON _ = pure FE_node_not_implemented_yet
-
+
instance ToJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_not_found) where
toJSON (FE_node_lookup_failed_not_found nodeId) = object [ "node_id" .= toJSON nodeId ]
-
instance FromJSON (ToFrontendErrorData 'EC_404__node_lookup_failed_not_found) where
parseJSON = withObject "FE_node_lookup_failed_not_found" $ \o -> do
nenf_node_id <- o .: "node_id"
@@ -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
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
parseJSON = withObject "FE_node_lookup_failed_parent_not_found" $ \o -> do
nepnf_node_id <- o .: "node_id"
@@ -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
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
parseJSON = withObject "FE_node_lookup_failed_user_not_found" $ \o -> do
nenf_user_id <- o .: "user_id"
@@ -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
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
parseJSON = withObject "FE_node_lookup_failed_username_not_found" $ \o -> do
nenf_username <- o .: "username"
@@ -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
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
parseJSON = withObject "FE_node_creation_failed_user_negative_id" $ \o -> do
neuni_user_id <- o .: "user_id"
@@ -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
toJSON (FE_node_lookup_failed_user_too_many_roots userId roots) =
object [ "user_id" .= toJSON userId, "roots" .= toJSON roots ]
-
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
netmr_user_id <- o .: "user_id"
@@ -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
toJSON (FE_node_context_not_found cId) = object [ "context_id" .= toJSON cId ]
-
instance FromJSON (ToFrontendErrorData 'EC_404__node_context_not_found) where
parseJSON = withObject "FE_node_context_not_found" $ \o -> do
necnf_context_id <- o .: "context_id"
@@ -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
toJSON (FE_node_creation_failed_no_parent uId) = object [ "user_id" .= toJSON uId ]
-
instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_no_parent) where
parseJSON = withObject "FE_node_creation_failed_no_parent" $ \o -> do
necnp_user_id <- o .: "user_id"
@@ -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
toJSON FE_node_creation_failed_parent_exists{..} =
object [ "user_id" .= toJSON necpe_user_id, "parent_id" .= toJSON necpe_parent_id ]
-
instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_parent_exists) where
parseJSON = withObject "FE_node_creation_failed_parent_exists" $ \o -> do
necpe_user_id <- o .: "user_id"
@@ -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
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
parseJSON = withObject "FE_node_creation_failed_insert_node" $ \o -> do
necin_user_id <- o .: "user_id"
@@ -439,16 +434,14 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_creation_failed_insert_node
instance ToJSON (ToFrontendErrorData 'EC_500__node_generic_exception) where
toJSON FE_node_generic_exception{..} =
- JSON.object [ "error" .= nege_error ]
-
+ object [ "error" .= nege_error ]
instance FromJSON (ToFrontendErrorData 'EC_500__node_generic_exception) where
parseJSON = withObject "FE_node_generic_exception" $ \o -> do
nege_error <- o .: "error"
pure FE_node_generic_exception{..}
instance ToJSON (ToFrontendErrorData 'EC_400__node_needs_configuration) where
- toJSON _ = JSON.Null
-
+ toJSON _ = Null
instance FromJSON (ToFrontendErrorData 'EC_400__node_needs_configuration) where
parseJSON _ = pure FE_node_needs_configuration
@@ -458,7 +451,6 @@ instance FromJSON (ToFrontendErrorData 'EC_400__node_needs_configuration) where
instance ToJSON (ToFrontendErrorData 'EC_400__validation_error) where
toJSON (FE_validation_error val) = toJSON val
-
instance FromJSON (ToFrontendErrorData 'EC_400__validation_error) where
parseJSON (String txt) = pure $ FE_validation_error txt
parseJSON ty = typeMismatch "FE_validation_error" ty
@@ -470,7 +462,6 @@ instance FromJSON (ToFrontendErrorData 'EC_400__validation_error) where
instance ToJSON (ToFrontendErrorData 'EC_403__login_failed_error) where
toJSON FE_login_failed_error{..} =
object [ "user_id" .= toJSON lfe_user_id, "node_id" .= toJSON lfe_node_id ]
-
instance FromJSON (ToFrontendErrorData 'EC_403__login_failed_error) where
parseJSON = withObject "FE_login_failed_error" $ \o -> do
lfe_user_id <- o .: "user_id"
@@ -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
toJSON FE_login_failed_invalid_username_or_password =
object []
-
instance FromJSON (ToFrontendErrorData 'EC_403__login_failed_invalid_username_or_password) where
parseJSON = withObject "FE_login_failed_invalid_username_or_password" $ \_o -> do
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
--
instance ToJSON (ToFrontendErrorData 'EC_500__internal_server_error) where
toJSON FE_internal_server_error{..} = object [ "error" .= toJSON ise_error ]
-
instance FromJSON (ToFrontendErrorData 'EC_500__internal_server_error) where
parseJSON = withObject "FE_internal_server_error" $ \o -> do
ise_error <- o .: "error"
@@ -500,7 +498,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__internal_server_error) where
instance ToJSON (ToFrontendErrorData 'EC_405__not_allowed) where
toJSON FE_not_allowed{..} = object [ "error" .= toJSON isena_error ]
-
instance FromJSON (ToFrontendErrorData 'EC_405__not_allowed) where
parseJSON = withObject "FE_not_allowed" $ \o -> do
isena_error <- o .: "error"
@@ -512,21 +509,18 @@ instance FromJSON (ToFrontendErrorData 'EC_405__not_allowed) 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
parseJSON _ = pure FE_tree_root_not_found
instance ToJSON (ToFrontendErrorData 'EC_404__tree_empty_root) where
- toJSON _ = JSON.Null
-
+ toJSON _ = Null
instance FromJSON (ToFrontendErrorData 'EC_404__tree_empty_root) where
parseJSON _ = pure FE_tree_empty_root
instance ToJSON (ToFrontendErrorData 'EC_500__tree_too_many_roots) where
toJSON (FE_tree_too_many_roots roots) =
object [ "node_ids" .= NE.toList roots ]
-
instance FromJSON (ToFrontendErrorData 'EC_500__tree_too_many_roots) where
parseJSON = withObject "FE_tree_too_many_roots" $ \o -> do
tmr_roots <- o .: "node_ids"
@@ -539,7 +533,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__tree_too_many_roots) where
instance ToJSON (ToFrontendErrorData 'EC_500__job_invalid_id_type) where
toJSON (FE_job_invalid_id_type idTy) =
object [ "type" .= toJSON idTy ]
-
instance FromJSON (ToFrontendErrorData 'EC_500__job_invalid_id_type) where
parseJSON = withObject "FE_job_invalid_id_type" $ \o -> do
jeiit_type <- o .: "type"
@@ -548,7 +541,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_invalid_id_type) where
instance ToJSON (ToFrontendErrorData 'EC_500__job_expired) where
toJSON (FE_job_expired jobId) =
object [ "job_id" .= toJSON jobId ]
-
instance FromJSON (ToFrontendErrorData 'EC_500__job_expired) where
parseJSON = withObject "FE_job_expired" $ \o -> do
jee_job_id <- o .: "job_id"
@@ -557,7 +549,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_expired) where
instance ToJSON (ToFrontendErrorData 'EC_500__job_invalid_mac) where
toJSON (FE_job_invalid_mac mac) =
object [ "mac" .= toJSON mac ]
-
instance FromJSON (ToFrontendErrorData 'EC_500__job_invalid_mac) where
parseJSON = withObject "FE_job_invalid_mac" $ \o -> do
jeim_mac <- o .: "mac"
@@ -566,7 +557,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_invalid_mac) where
instance ToJSON (ToFrontendErrorData 'EC_500__job_unknown_job) where
toJSON (FE_job_unknown_job jobId) =
object [ "job_id" .= toJSON jobId ]
-
instance FromJSON (ToFrontendErrorData 'EC_500__job_unknown_job) where
parseJSON = withObject "FE_job_unknown_job" $ \o -> do
jeuj_job_id <- o .: "job_id"
@@ -575,7 +565,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_unknown_job) where
instance ToJSON (ToFrontendErrorData 'EC_500__job_generic_exception) where
toJSON (FE_job_generic_exception err) =
object [ "error" .= toJSON err ]
-
instance FromJSON (ToFrontendErrorData 'EC_500__job_generic_exception) where
parseJSON = withObject "FE_job_generic_exception" $ \o -> do
jege_error <- o .: "error"
@@ -656,6 +645,12 @@ genFrontendErr be = do
-> do
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
EC_500__internal_server_error
-> do err <- arbitrary
@@ -692,7 +687,7 @@ genFrontendErr be = do
pure $ mkFrontendErr' txt $ FE_job_generic_exception err
instance ToJSON BackendErrorCode where
- toJSON = JSON.String . T.pack . show
+ toJSON = String . T.pack . show
instance FromJSON BackendErrorCode where
parseJSON (String s) = case readMaybe (T.unpack s) of
@@ -702,10 +697,10 @@ instance FromJSON BackendErrorCode where
instance ToJSON FrontendError where
toJSON (FrontendError diag ty dt) =
- JSON.object [ "diagnostic" .= toJSON diag
- , "type" .= toJSON ty
- , "data" .= toJSON dt
- ]
+ object [ "diagnostic" .= toJSON diag
+ , "type" .= toJSON ty
+ , "data" .= toJSON dt
+ ]
instance FromJSON FrontendError where
parseJSON = withObject "FrontendError" $ \o -> do
@@ -775,6 +770,10 @@ instance FromJSON FrontendError where
(fe_data :: ToFrontendErrorData 'EC_403__login_failed_invalid_username_or_password) <- o .: "data"
pure FrontendError{..}
+ EC_403__user_not_authorized -> do
+ (fe_data :: ToFrontendErrorData 'EC_403__user_not_authorized) <- o .: "data"
+ pure FrontendError{..}
+
-- internal server error
EC_500__internal_server_error -> do
(fe_data :: ToFrontendErrorData 'EC_500__internal_server_error) <- o .: "data"
@@ -810,3 +809,26 @@ instance FromJSON FrontendError where
EC_500__job_generic_exception -> do
(fe_data :: ToFrontendErrorData 'EC_500__job_generic_exception) <- o .: "data"
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
diff --git a/src/Gargantext/API/Errors/Types/Backend.hs b/src/Gargantext/API/Errors/Types/Backend.hs
index 92d7c14f25491acb158b3d1037cb7e9462d6237c..2e00cfd1dc1ba9e45b4e27c959132ed54c6e02d0 100644
--- a/src/Gargantext/API/Errors/Types/Backend.hs
+++ b/src/Gargantext/API/Errors/Types/Backend.hs
@@ -37,6 +37,7 @@ data BackendErrorCode
-- authentication errors
| EC_403__login_failed_error
| EC_403__login_failed_invalid_username_or_password
+ | EC_403__user_not_authorized
-- tree errors
| EC_404__tree_root_not_found
| EC_404__tree_empty_root
diff --git a/src/Gargantext/API/GraphQL/Team.hs b/src/Gargantext/API/GraphQL/Team.hs
index e3d36f870a1e5d7b089c4b07dd038b1e69da3b54..6c834453adae5c4a2c97fde707eaf12ebdc138a7 100644
--- a/src/Gargantext/API/GraphQL/Team.hs
+++ b/src/Gargantext/API/GraphQL/Team.hs
@@ -16,6 +16,7 @@ module Gargantext.API.GraphQL.Team where
import Data.Morpheus.Types (GQLType, ResolverM)
import Data.Text qualified as T
+import Gargantext.API.Admin.Auth.Types (AuthenticationError(..))
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types
import Gargantext.API.GraphQL.Types (GqlM)
@@ -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."
(( _, node_u):_) -> do
testAuthUser <- lift $ authUser (nId node_u) token
- case testAuthUser of
- Invalid -> panicTrace "[deleteTeamMembership] failed to validate user"
+ lift $ case testAuthUser of
+ -- Invalid -> panicTrace "[deleteTeamMembership] failed to validate user"
+ Invalid -> do
+ throwError $ InternalAuthenticationError $ UserNotAuthorized (uId node_u) "This user is not team owner"
Valid -> do
- lift $ deleteMemberShip [(UnsafeMkNodeId shared_folder_id, UnsafeMkNodeId team_node_id)]
+ deleteMemberShip [(UnsafeMkNodeId shared_folder_id, UnsafeMkNodeId team_node_id)]
where
uId Node { _node_user_id } = _node_user_id
nId Node { _node_id } = _node_id
diff --git a/src/Gargantext/API/GraphQL/Utils.hs b/src/Gargantext/API/GraphQL/Utils.hs
index dee31a397a6fd0d87945e92d4c4ee440a89db12e..189ee64b1addf3c15a4f268dd07b86fb8d7e9e7b 100644
--- a/src/Gargantext/API/GraphQL/Utils.hs
+++ b/src/Gargantext/API/GraphQL/Utils.hs
@@ -10,6 +10,7 @@ Portability : POSIX
module Gargantext.API.GraphQL.Utils where
+import Control.Lens ((^.))
import Control.Lens.Getter (view)
import Data.Morpheus.Types (GQLTypeOptions, fieldLabelModifier)
import Data.Text qualified as T
@@ -20,7 +21,6 @@ import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Prelude (Cmd')
import Gargantext.Prelude
import Servant.Auth.Server (verifyJWT, JWTSettings)
-import Control.Lens ((^.))
unPrefix :: T.Text -> GQLTypeOptions -> GQLTypeOptions
unPrefix prefix options = options { fieldLabelModifier = nflm }
diff --git a/src/Gargantext/API/Server.hs b/src/Gargantext/API/Server.hs
index 376993c178f20fb54d314bf05ae9a18b66be7086..7a57b7c48b8a6235221ad2720552833687a53f42 100644
--- a/src/Gargantext/API/Server.hs
+++ b/src/Gargantext/API/Server.hs
@@ -67,13 +67,16 @@ server env = do
:<|> hoistServerWithContext
(Proxy :: Proxy GraphQL.API)
(Proxy :: Proxy AuthContext)
- (transformJSON errScheme)
+ (transformJSONGQL errScheme)
GraphQL.api
:<|> frontEndServer
where
transformJSON :: forall a. GargErrorScheme -> GargM Env BackendInternalError a -> Handler a
transformJSON GES_old = Handler . withExceptT showAsServantJSONErr . (`runReaderT` env) . logPanicErrors
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 h = h `catch` handleSomeException
@@ -104,3 +107,4 @@ logPanicErrors h = h `catch` handleSomeException
= throwError ber -- re-throw the uncaught exception via the 'MonadError' instance
| otherwise
= throwM se -- re-throw the uncaught exception.
+