[api] implement JSON errors

src/Gargantext/API/Server.hs

@@ -17,7 +17,8 @@ module Gargantext.API.Server where
 import Control.Lens ((^.))
 import Control.Monad.Except (withExceptT)
 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 Servant
 import Servant.Swagger.UI (swaggerSchemaUIServer)
@@ -63,24 +64,35 @@ server env = do
      :<|> hoistServerWithContext
             (Proxy :: Proxy GargAPI)
             (Proxy :: Proxy AuthContext)
-            transform
+            transformJSON
             (serverGargAPI (env ^. hasConfig . gc_url_backend_api))
      :<|> hoistServerWithContext
             (Proxy :: Proxy GraphQL.API)
             (Proxy :: Proxy AuthContext)
-            transform
+            transformJSON
             GraphQL.api
      :<|> frontEndServer
   where
-    transform :: forall a. GargM Env GargError a -> Handler a
-    transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
+    -- transform :: forall a. GargM Env GargError a -> Handler a
+    -- 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 (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@NoCorpusFound) = 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 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 ) ] }

src/Gargantext/Database/Query/Table/Node.hs

@@ -419,7 +419,7 @@ getOrMkList pId uId =
 -- | TODO remove defaultList
 defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err ListId
 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 cId = headMay <$> map (view node_id ) <$> getListsWithParentId cId

src/Gargantext/Database/Query/Table/Node/Error.hs

@@ -12,15 +12,16 @@ module Gargantext.Database.Query.Table.Node.Error where
 
 import Control.Lens (Prism', (#), (^?))
 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 Gargantext.Database.Admin.Types.Node (NodeId)
+import Gargantext.Database.Admin.Types.Node (ListId, NodeId(..))
 import Gargantext.Prelude hiding (sum, head)
 
 ------------------------------------------------------------------------
-data NodeError = NoListFound
+data NodeError = NoListFound { listId :: ListId }
                | NoRootFound
                | NoCorpusFound
                | NoUserFound
@@ -37,7 +38,7 @@ data NodeError = NoListFound
 
 instance Show NodeError
   where
-    show NoListFound   = "No list   found"
+    show (NoListFound {})   = "No list   found"
     show NoRootFound   = "No Root   found"
     show NoCorpusFound = "No Corpus found"
     show NoUserFound   = "No user   found"
@@ -53,6 +54,13 @@ instance Show NodeError
     show NeedsConfiguration = "Needs configuration"
     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
   _NodeError :: Prism' e NodeError