Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Christian Merten
haskell-gargantext
Commits
fd1c5f67
Verified
Commit
fd1c5f67
authored
Jan 19, 2024
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[errors] GraphQL error format
parent
ec271ca6
Changes
7
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
148 additions
and
103 deletions
+148
-103
Types.hs
src/Gargantext/API/Admin/Auth/Types.hs
+1
-0
Errors.hs
src/Gargantext/API/Errors.hs
+51
-37
Types.hs
src/Gargantext/API/Errors/Types.hs
+83
-61
Backend.hs
src/Gargantext/API/Errors/Types/Backend.hs
+1
-0
Team.hs
src/Gargantext/API/GraphQL/Team.hs
+6
-3
Utils.hs
src/Gargantext/API/GraphQL/Utils.hs
+1
-1
Server.hs
src/Gargantext/API/Server.hs
+5
-1
No files found.
src/Gargantext/API/Admin/Auth/Types.hs
View file @
fd1c5f67
...
@@ -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?
...
...
src/Gargantext/API/Errors.hs
View file @
fd1c5f67
...
@@ -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
''
B
ackendErrorCode
)
$
(
deriveHttpStatusCode
''
B
ackendErrorCode
)
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
Internal
ServerError
internalServer
Error
Internal
NodeError
node
Error
->
internalServerErrorToFrontendError
internalServer
Error
->
nodeErrorToFrontendError
node
Error
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
}
...
...
src/Gargantext/API/Errors/Types.hs
View file @
fd1c5f67
...
@@ -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
''
B
ackendInternalError
makePrisms
''
B
ackendInternalError
...
@@ -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
'E
C
_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
'E
C
_404__node_list_not_found
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_404__node_list_not_found
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_404__node_root_not_found
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_404__node_root_not_found
)
where
toJSON
_
=
JSON
.
Null
toJSON
_
=
Null
instance
FromJSON
(
ToFrontendErrorData
'E
C
_404__node_root_not_found
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_404__node_root_not_found
)
where
parseJSON
_
=
pure
FE_node_root_not_found
parseJSON
_
=
pure
FE_node_root_not_found
instance
ToJSON
(
ToFrontendErrorData
'E
C
_404__node_corpus_not_found
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_404__node_corpus_not_found
)
where
toJSON
_
=
JSON
.
Null
toJSON
_
=
Null
instance
FromJSON
(
ToFrontendErrorData
'E
C
_404__node_corpus_not_found
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_404__node_corpus_not_found
)
where
parseJSON
_
=
pure
FE_node_corpus_not_found
parseJSON
_
=
pure
FE_node_corpus_not_found
instance
ToJSON
(
ToFrontendErrorData
'E
C
_500__node_not_implemented_yet
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_500__node_not_implemented_yet
)
where
toJSON
_
=
JSON
.
Null
toJSON
_
=
Null
instance
FromJSON
(
ToFrontendErrorData
'E
C
_500__node_not_implemented_yet
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_500__node_not_implemented_yet
)
where
parseJSON
_
=
pure
FE_node_not_implemented_yet
parseJSON
_
=
pure
FE_node_not_implemented_yet
instance
ToJSON
(
ToFrontendErrorData
'E
C
_404__node_lookup_failed_not_found
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_404__node_lookup_failed_not_found
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_404__node_lookup_failed_parent_not_found
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_404__node_lookup_failed_parent_not_found
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_404__node_lookup_failed_user_not_found
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_404__node_lookup_failed_user_not_found
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_404__node_lookup_failed_username_not_found
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_404__node_lookup_failed_username_not_found
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_400__node_creation_failed_user_negative_id
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_400__node_creation_failed_user_negative_id
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_400__node_lookup_failed_user_too_many_roots
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_400__node_lookup_failed_user_too_many_roots
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_404__node_context_not_found
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_404__node_context_not_found
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_400__node_creation_failed_no_parent
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_400__node_creation_failed_no_parent
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_400__node_creation_failed_parent_exists
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_400__node_creation_failed_parent_exists
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_400__node_creation_failed_insert_node
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_400__node_creation_failed_insert_node
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__node_generic_exception
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__node_generic_exception
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_400__node_needs_configuration
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_400__node_needs_configuration
)
where
toJSON
_
=
JSON
.
Null
toJSON
_
=
Null
instance
FromJSON
(
ToFrontendErrorData
'E
C
_400__node_needs_configuration
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_400__validation_error
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_400__validation_error
)
where
toJSON
(
FE_validation_error
val
)
=
toJSON
val
toJSON
(
FE_validation_error
val
)
=
toJSON
val
instance
FromJSON
(
ToFrontendErrorData
'E
C
_400__validation_error
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_403__login_failed_error
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_403__login_failed_error
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_403__login_failed_invalid_username_or_password
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_403__login_failed_invalid_username_or_password
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_403__user_not_authorized
)
where
toJSON
FE_user_not_authorized
{
..
}
=
object
[
"user_id"
.=
toJSON
una_user_id
,
"msg"
.=
toJSON
una_msg
]
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__internal_server_error
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__internal_server_error
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_405__not_allowed
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_405__not_allowed
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_404__tree_root_not_found
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_404__tree_root_not_found
)
where
toJSON
_
=
JSON
.
Null
toJSON
_
=
Null
instance
FromJSON
(
ToFrontendErrorData
'E
C
_404__tree_root_not_found
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_404__tree_root_not_found
)
where
parseJSON
_
=
pure
FE_tree_root_not_found
parseJSON
_
=
pure
FE_tree_root_not_found
instance
ToJSON
(
ToFrontendErrorData
'E
C
_404__tree_empty_root
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_404__tree_empty_root
)
where
toJSON
_
=
JSON
.
Null
toJSON
_
=
Null
instance
FromJSON
(
ToFrontendErrorData
'E
C
_404__tree_empty_root
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_404__tree_empty_root
)
where
parseJSON
_
=
pure
FE_tree_empty_root
parseJSON
_
=
pure
FE_tree_empty_root
instance
ToJSON
(
ToFrontendErrorData
'E
C
_500__tree_too_many_roots
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__tree_too_many_roots
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__job_invalid_id_type
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__job_invalid_id_type
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__job_expired
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__job_expired
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__job_invalid_mac
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__job_invalid_mac
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__job_unknown_job
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__job_unknown_job
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__job_generic_exception
)
where
instance
ToJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_500__job_generic_exception
)
where
instance
FromJSON
(
ToFrontendErrorData
'E
C
_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
'E
C
_403__login_failed_invalid_username_or_password
)
<-
o
.:
"data"
(
fe_data
::
ToFrontendErrorData
'E
C
_403__login_failed_invalid_username_or_password
)
<-
o
.:
"data"
pure
FrontendError
{
..
}
pure
FrontendError
{
..
}
EC_403__user_not_authorized
->
do
(
fe_data
::
ToFrontendErrorData
'E
C
_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
'E
C
_500__internal_server_error
)
<-
o
.:
"data"
(
fe_data
::
ToFrontendErrorData
'E
C
_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
'E
C
_500__job_generic_exception
)
<-
o
.:
"data"
(
fe_data
::
ToFrontendErrorData
'E
C
_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
src/Gargantext/API/Errors/Types/Backend.hs
View file @
fd1c5f67
...
@@ -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
...
...
src/Gargantext/API/GraphQL/Team.hs
View file @
fd1c5f67
...
@@ -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
src/Gargantext/API/GraphQL/Utils.hs
View file @
fd1c5f67
...
@@ -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
}
...
...
src/Gargantext/API/Server.hs
View file @
fd1c5f67
...
@@ -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
)
(
transformJSON
GQL
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.
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment