[errors] better handling of garg job errors

JSON should now be better so that the UI can handle it in task async
handler.

src/Gargantext/API/Prelude.hs

@@ -48,6 +48,7 @@ import qualified Gargantext.Utils.Jobs.Monad as Jobs
 import Servant
 import Servant.Job.Async
 import Servant.Job.Core (HasServerError(..), serverError)
+import qualified Servant.Job.Types as SJ
 
 class HasJoseError e where
   _JoseError :: Prism' e Jose.Error
@@ -120,6 +121,15 @@ data GargError
 makePrisms ''GargError
 
 instance ToJSON GargError where
+  toJSON (GargJobError s) =
+    object [ ("status", toJSON SJ.IsFailure)
+           , ("log", emptyArray)
+           , ("id", String id)
+           , ("error", String $ Text.pack $ show s) ]
+    where
+      id = case s of
+        Jobs.InvalidMacID i -> i
+        _ -> ""
   toJSON err = object [("error", String $ Text.pack $ show err)]
 
 instance Exception GargError

src/Gargantext/API/Server.hs

@@ -18,7 +18,7 @@ import Control.Lens ((^.))
 import Control.Monad.Except (withExceptT)
 import Control.Monad.Reader (runReaderT)
 import qualified Data.Aeson as Aeson
-import Data.Text (Text, pack)
+import Data.Text (Text)
 import Data.Version (showVersion)
 import Servant
 import Servant.Swagger.UI (swaggerSchemaUIServer)
@@ -95,4 +95,4 @@ showAsServantJSONErr (GargNodeError err@NoCorpusFound) = err404 { errBody = Aeso
 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 ) ] }
+showAsServantJSONErr a = err500 { errBody = Aeson.encode a }

src/Gargantext/Utils/Jobs/Monad.hs

@@ -113,7 +113,7 @@ findJob jid = do
 data JobError
   = InvalidIDType
   | IDExpired
-  | InvalidMacID
+  | InvalidMacID T.Text
   | UnknownJob
   | JobException SomeException
   deriving Show
@@ -127,7 +127,7 @@ checkJID (SJ.PrivateID tn n t d) = do
   js <- getJobsSettings
   if | tn /= "job" -> return (Left InvalidIDType)
      | now > addUTCTime (fromIntegral $ jsIDTimeout js) t -> return (Left IDExpired)
-     | d /= SJ.macID tn (jsSecretKey js) t n -> return (Left InvalidMacID)
+     | d /= SJ.macID tn (jsSecretKey js) t n -> return (Left $ InvalidMacID $ T.pack d)
      | otherwise -> return $ Right (SJ.PrivateID tn n t d)
 
 withJob