Commit fcb2c87f authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/213-dev-implement-json-errors' into dev

parents aff1578e f3e4c0e0
...@@ -17,7 +17,8 @@ module Gargantext.API.Server where ...@@ -17,7 +17,8 @@ module Gargantext.API.Server where
import Control.Lens ((^.)) import Control.Lens ((^.))
import Control.Monad.Except (withExceptT) import Control.Monad.Except (withExceptT)
import Control.Monad.Reader (runReaderT) import Control.Monad.Reader (runReaderT)
import Data.Text (Text) import qualified Data.Aeson as Aeson
import Data.Text (Text, pack)
import Data.Version (showVersion) import Data.Version (showVersion)
import Servant import Servant
import Servant.Swagger.UI (swaggerSchemaUIServer) import Servant.Swagger.UI (swaggerSchemaUIServer)
...@@ -63,24 +64,35 @@ server env = do ...@@ -63,24 +64,35 @@ server env = do
:<|> hoistServerWithContext :<|> hoistServerWithContext
(Proxy :: Proxy GargAPI) (Proxy :: Proxy GargAPI)
(Proxy :: Proxy AuthContext) (Proxy :: Proxy AuthContext)
transform transformJSON
(serverGargAPI (env ^. hasConfig . gc_url_backend_api)) (serverGargAPI (env ^. hasConfig . gc_url_backend_api))
:<|> hoistServerWithContext :<|> hoistServerWithContext
(Proxy :: Proxy GraphQL.API) (Proxy :: Proxy GraphQL.API)
(Proxy :: Proxy AuthContext) (Proxy :: Proxy AuthContext)
transform transformJSON
GraphQL.api GraphQL.api
:<|> frontEndServer :<|> frontEndServer
where where
transform :: forall a. GargM Env GargError a -> Handler a -- transform :: forall a. GargM Env GargError a -> Handler a
transform = Handler . withExceptT showAsServantErr . (`runReaderT` env) -- transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
transformJSON :: forall a. GargM Env GargError a -> Handler a
transformJSON = Handler . withExceptT showAsServantJSONErr . (`runReaderT` env)
showAsServantErr :: GargError -> ServerError showAsServantErr :: GargError -> ServerError
showAsServantErr (GargNodeError err@NoListFound) = err404 { errBody = BL8.pack $ show err } showAsServantErr (GargNodeError err@(NoListFound {})) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargNodeError err@NoRootFound) = err404 { errBody = BL8.pack $ show err } showAsServantErr (GargNodeError err@NoRootFound) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargNodeError err@NoCorpusFound) = err404 { errBody = BL8.pack $ show err } showAsServantErr (GargNodeError err@NoCorpusFound) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargNodeError err@NoUserFound) = err404 { errBody = BL8.pack $ show err } showAsServantErr (GargNodeError err@NoUserFound) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargNodeError err@(DoesNotExist _)) = err404 { errBody = BL8.pack $ show err } showAsServantErr (GargNodeError err@(DoesNotExist {})) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargServerError err) = err showAsServantErr (GargServerError err) = err
showAsServantErr a = err500 { errBody = BL8.pack $ show a } showAsServantErr a = err500 { errBody = BL8.pack $ show a }
showAsServantJSONErr :: GargError -> ServerError
showAsServantJSONErr (GargNodeError err@(NoListFound {})) = err404 { errBody = Aeson.encode err }
showAsServantJSONErr (GargNodeError err@NoRootFound) = err404 { errBody = Aeson.encode err }
showAsServantJSONErr (GargNodeError err@NoCorpusFound) = err404 { errBody = Aeson.encode err }
showAsServantJSONErr (GargNodeError err@NoUserFound) = err404 { errBody = Aeson.encode err }
showAsServantJSONErr (GargNodeError err@(DoesNotExist {})) = err404 { errBody = Aeson.encode err }
showAsServantJSONErr (GargServerError err) = err
showAsServantJSONErr a = err500 { errBody = Aeson.encode $ Aeson.object [ ( "error", Aeson.String $ pack $ show a ) ] }
...@@ -58,7 +58,6 @@ import Gargantext.Prelude ...@@ -58,7 +58,6 @@ import Gargantext.Prelude
type TableApi = Summary "Table API" type TableApi = Summary "Table API"
:> QueryParam "tabType" TabType :> QueryParam "tabType" TabType
:> QueryParam "list" ListId
:> QueryParam "limit" Limit :> QueryParam "limit" Limit
:> QueryParam "offset" Offset :> QueryParam "offset" Offset
:> QueryParam "orderBy" OrderBy :> QueryParam "orderBy" OrderBy
...@@ -105,14 +104,13 @@ tableApi id' = getTableApi id' ...@@ -105,14 +104,13 @@ tableApi id' = getTableApi id'
getTableApi :: HasNodeError err getTableApi :: HasNodeError err
=> NodeId => NodeId
-> Maybe TabType -> Maybe TabType
-> Maybe ListId
-> Maybe Limit -> Maybe Limit
-> Maybe Offset -> Maybe Offset
-> Maybe OrderBy -> Maybe OrderBy
-> Maybe Text -> Maybe Text
-> Maybe Text -> Maybe Text
-> Cmd err (HashedResponse FacetTableResult) -> Cmd err (HashedResponse FacetTableResult)
getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery mYear = do getTableApi cId tabType mLimit mOffset mOrderBy mQuery mYear = do
-- printDebug "[getTableApi] mQuery" mQuery -- printDebug "[getTableApi] mQuery" mQuery
-- printDebug "[getTableApi] mYear" mYear -- printDebug "[getTableApi] mYear" mYear
t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
...@@ -129,7 +127,7 @@ postTableApi cId (TableQuery o l order ft q) = case ft of ...@@ -129,7 +127,7 @@ postTableApi cId (TableQuery o l order ft q) = case ft of
getTableHashApi :: HasNodeError err getTableHashApi :: HasNodeError err
=> NodeId -> Maybe TabType -> Cmd err Text => NodeId -> Maybe TabType -> Cmd err Text
getTableHashApi cId tabType = do getTableHashApi cId tabType = do
HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing Nothing HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing
pure h pure h
searchInCorpus' :: CorpusId searchInCorpus' :: CorpusId
......
...@@ -419,7 +419,7 @@ getOrMkList pId uId = ...@@ -419,7 +419,7 @@ getOrMkList pId uId =
-- | TODO remove defaultList -- | TODO remove defaultList
defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err ListId defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err ListId
defaultList cId = defaultList cId =
maybe (nodeError NoListFound) (pure . view node_id) . headMay =<< getListsWithParentId cId maybe (nodeError (NoListFound cId)) (pure . view node_id) . headMay =<< getListsWithParentId cId
defaultListMaybe :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err (Maybe NodeId) defaultListMaybe :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err (Maybe NodeId)
defaultListMaybe cId = headMay <$> map (view node_id ) <$> getListsWithParentId cId defaultListMaybe cId = headMay <$> map (view node_id ) <$> getListsWithParentId cId
......
...@@ -12,15 +12,16 @@ module Gargantext.Database.Query.Table.Node.Error where ...@@ -12,15 +12,16 @@ module Gargantext.Database.Query.Table.Node.Error where
import Control.Lens (Prism', (#), (^?)) import Control.Lens (Prism', (#), (^?))
import Control.Monad.Except (MonadError(..)) import Control.Monad.Except (MonadError(..))
import Data.Text (Text) import Data.Aeson
import Data.Text (Text, pack)
import Prelude hiding (null, id, map, sum) import Prelude hiding (null, id, map, sum)
import Gargantext.Database.Admin.Types.Node (NodeId) import Gargantext.Database.Admin.Types.Node (ListId, NodeId(..))
import Gargantext.Prelude hiding (sum, head) import Gargantext.Prelude hiding (sum, head)
------------------------------------------------------------------------ ------------------------------------------------------------------------
data NodeError = NoListFound data NodeError = NoListFound { listId :: ListId }
| NoRootFound | NoRootFound
| NoCorpusFound | NoCorpusFound
| NoUserFound | NoUserFound
...@@ -37,7 +38,7 @@ data NodeError = NoListFound ...@@ -37,7 +38,7 @@ data NodeError = NoListFound
instance Show NodeError instance Show NodeError
where where
show NoListFound = "No list found" show (NoListFound {}) = "No list found"
show NoRootFound = "No Root found" show NoRootFound = "No Root found"
show NoCorpusFound = "No Corpus found" show NoCorpusFound = "No Corpus found"
show NoUserFound = "No user found" show NoUserFound = "No user found"
...@@ -53,6 +54,13 @@ instance Show NodeError ...@@ -53,6 +54,13 @@ instance Show NodeError
show NeedsConfiguration = "Needs configuration" show NeedsConfiguration = "Needs configuration"
show (NodeError e) = "NodeError: " <> cs e show (NodeError e) = "NodeError: " <> cs e
instance ToJSON NodeError where
toJSON (NoListFound { listId = NodeId listId }) =
object [ ( "error", "No list found" )
, ( "listId", Number $ fromIntegral listId ) ]
toJSON err =
object [ ( "error", String $ pack $ show err ) ]
class HasNodeError e where class HasNodeError e where
_NodeError :: Prism' e NodeError _NodeError :: Prism' e NodeError
......
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