Replace panic with InternalServerError in api_node

src/Gargantext/API/Errors.hs

@@ -67,8 +67,11 @@ backendErrorToFrontendError = \case
 
 internalServerErrorToFrontendError :: ServerError -> FrontendError
 internalServerErrorToFrontendError = \case
-  ServerError{..} ->
-    mkFrontendErr' (T.pack errReasonPhrase) $ FE_internal_server_error (TL.toStrict $ TE.decodeUtf8 $ errBody)
+  ServerError{..}
+    | errHTTPCode == 405
+    -> mkFrontendErr' (T.pack errReasonPhrase) $ FE_not_allowed (TL.toStrict $ TE.decodeUtf8 $ errBody)
+    | otherwise
+    -> mkFrontendErr' (T.pack errReasonPhrase) $ FE_internal_server_error (TL.toStrict $ TE.decodeUtf8 $ errBody)
 
 jobErrorToFrontendError :: JobError -> FrontendError
 jobErrorToFrontendError = \case

src/Gargantext/API/Errors/TH.hs

@@ -23,6 +23,7 @@ supported_http_status_map = Map.fromList
   , ("400", TH.varE 'status400)
   , ("403", TH.varE 'status403)
   , ("404", TH.varE 'status404)
+  , ("405", TH.varE 'status405)
   , ("500", TH.varE 'status500)
   ]
 
@@ -36,7 +37,8 @@ deriveHttpStatusCode appliedType = do
            Left ctor   -> error $ "Only enum-like constructors supported: " ++ show ctor
            Right names -> case parse_error_codes names of
              Left n -> error $ "Couldn't extract error code from : " ++ TH.nameBase n
-                             ++ ". Make sure it's in the form XX_<validHttpStatusCode>__<textual_diagnostic>"
+                             ++ ". Make sure it's in the form XX_<validHttpStatusCode>__<textual_diagnostic> "
+                             ++ "and the error code is supported in the supported_http_status_map list."
              Right codes -> do
                let static_matches = flip map codes $ \(n, stE, _txt) ->
                      TH.match (TH.conP n [])

src/Gargantext/API/Errors/Types.hs

@@ -294,14 +294,23 @@ data instance ToFrontendErrorData 'EC_500__job_unknown_job =
   FE_job_unknown_job { jeuj_job_id :: Int }
   deriving (Show, Eq, Generic)
 
+data instance ToFrontendErrorData 'EC_500__job_generic_exception =
+  FE_job_generic_exception { jege_error :: T.Text }
+  deriving (Show, Eq, Generic)
+
+--
+-- server errors
+--
+
 data instance ToFrontendErrorData 'EC_500__internal_server_error =
   FE_internal_server_error { ise_error :: T.Text }
   deriving (Show, Eq, Generic)
 
-data instance ToFrontendErrorData 'EC_500__job_generic_exception =
-  FE_job_generic_exception { jege_error :: T.Text }
+data instance ToFrontendErrorData 'EC_405__not_allowed =
+  FE_not_allowed { isena_error :: T.Text }
   deriving (Show, Eq, Generic)
 
+
 ----------------------------------------------------------------------------
 -- JSON instances. It's important to have nice and human readable instances.
 -- It's also important that they all roundtrips, i.e. that given a 'ToFrontendErrorData'
@@ -465,6 +474,14 @@ instance FromJSON (ToFrontendErrorData 'EC_500__internal_server_error) where
     ise_error <- o .: "error"
     pure FE_internal_server_error{..}
 
+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"
+    pure FE_not_allowed{..}
+
 
 --
 -- tree errors
@@ -613,6 +630,10 @@ genFrontendErr be = do
       -> do err <- arbitrary
             pure $ mkFrontendErr' txt $ FE_internal_server_error err
 
+    EC_405__not_allowed
+      -> do err <- arbitrary
+            pure $ mkFrontendErr' txt $ FE_not_allowed err
+
     -- tree errors
     EC_404__tree_root_not_found
       -> pure $ mkFrontendErr' txt $ FE_tree_root_not_found
@@ -720,6 +741,9 @@ instance FromJSON FrontendError where
       EC_500__internal_server_error -> do
         (fe_data :: ToFrontendErrorData 'EC_500__internal_server_error) <- o .: "data"
         pure FrontendError{..}
+      EC_405__not_allowed -> do
+        (fe_data :: ToFrontendErrorData 'EC_405__not_allowed) <- o .: "data"
+        pure FrontendError{..}
 
       -- tree errors
       EC_404__tree_root_not_found -> do

src/Gargantext/API/Errors/Types/Backend.hs

@@ -41,6 +41,7 @@ data BackendErrorCode
   | EC_500__tree_too_many_roots
   -- internal server errors
   | EC_500__internal_server_error
+  | EC_405__not_allowed
   -- job errors
   | EC_500__job_invalid_id_type
   | EC_500__job_expired

src/Gargantext/API/Public.hs

@@ -65,7 +65,7 @@ api_node nId = do
   pubNodes <- publicNodes
   -- TODO optimize with SQL
   case Set.member nId pubNodes of
-    False -> panic "Not allowed" -- TODO throwErr
+    False -> serverError $ err405 { errBody = "Not allowed" }
     True  -> fileApi nId
 
 -------------------------------------------------------------------------

src/Gargantext/Core/Errors/Types.hs

 module Gargantext.Core.Errors.Types (
   -- * Attaching callstacks to exceptions
     WithStacktrace(..)
+  , withStacktrace
   ) where
 
 import Control.Exception
@@ -19,3 +20,6 @@ data WithStacktrace e =
 instance Exception e => Exception (WithStacktrace e) where
   displayException WithStacktrace{..}
     = displayException ct_error <> "\n" <> prettyCallStack ct_callStack
+
+withStacktrace :: HasCallStack => e -> WithStacktrace e
+withStacktrace = withFrozenCallStack . WithStacktrace callStack

src/Gargantext/Utils/JohnSnowNLP.hs

@@ -21,11 +21,13 @@ import Data.List.Safe qualified as LS
 import Data.Map.Strict qualified as Map
 import Data.Text hiding (map, group, filter, concat, zip)
 import Gargantext.Core (Lang(..))
+import Gargantext.Core.Errors.Types
 import Gargantext.Core.Text.Terms.Multi.PosTagging.Types
 import Gargantext.Core.Types (POS(..))
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Prelude hiding (All)
 import Network.HTTP.Simple (parseRequest, httpJSON, setRequestBodyLBS, getResponseBody, Response)
+import Prelude (userError)
 
 
 data JSSpell = JSPOS Lang | JSLemma Lang
@@ -197,7 +199,7 @@ jsTaskResponse (JSAsyncTask uuid) = do
   result <- httpJSON url
   pure $ getResponseBody result
 
-waitForJsTask :: JSAsyncTask -> IO JSAsyncTaskResponse
+waitForJsTask :: HasCallStack => JSAsyncTask -> IO JSAsyncTaskResponse
 waitForJsTask jsTask = wait' 0
   where
     wait' :: Int -> IO JSAsyncTaskResponse
@@ -207,7 +209,7 @@ waitForJsTask jsTask = wait' 0
         jsTaskResponse jsTask
       else
         if counter > 60 then
-          panic "[waitForJsTask] waited for 1 minute and still no answer from JohnSnow NLP"
+          throwIO $ withStacktrace $ userError "waited for 1 minute and still no answer from JohnSnow NLP"
         else do
           -- printDebug "[waitForJsTask] task not ready, waiting" counter
           _ <- threadDelay $ 1000000*1

src/Gargantext/Utils/SpacyNLP.hs

@@ -122,6 +122,3 @@ spacyDataToPosSentences (SpacyData ds) = PosSentences
 
 nlp :: URI -> Lang -> Text -> IO PosSentences
 nlp uri _lang txt = spacyDataToPosSentences <$> spacyRequest uri txt
--- nlp _ _ _ = panic "Make sure you have the right model for your lang for spacy Server"
--- nlp FR txt  = spacyDataToPosSentences <$> spacyRequest txt
--- nlp _  _ = panic "Make sure you have the right model for your lang for spacy Server"