[flow] human friendly servant client error

parent 8e22d2b4
Pipeline #7866 passed with stages
in 58 minutes and 13 seconds
...@@ -113,6 +113,7 @@ import Gargantext.Database.Types ...@@ -113,6 +113,7 @@ import Gargantext.Database.Types
import Gargantext.Prelude hiding (catch, onException, to) import Gargantext.Prelude hiding (catch, onException, to)
import Gargantext.System.Logging ( logLocM, LogLevel(DEBUG, ERROR), MonadLogger ) import Gargantext.System.Logging ( logLocM, LogLevel(DEBUG, ERROR), MonadLogger )
import Gargantext.Utils.Jobs.Monad ( JobHandle, MonadJobStatus(..), markFailureNoErr ) import Gargantext.Utils.Jobs.Monad ( JobHandle, MonadJobStatus(..), markFailureNoErr )
import Servant.Client.Core (ClientError)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Imports for upgrade function -- Imports for upgrade function
...@@ -298,14 +299,21 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do ...@@ -298,14 +299,21 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
(_userId, userCorpusId, listId, msgs) <- runDBTx $ createNodes cfg mkCorpusUser c (_userId, userCorpusId, listId, msgs) <- runDBTx $ createNodes cfg mkCorpusUser c
forM_ msgs ce_notify forM_ msgs ce_notify
-- TODO if public insertMasterDocs else insertUserDocs -- TODO if public insertMasterDocs else insertUserDocs
(runConduit $ zipSources (yieldMany ([1..] :: [Int])) docsC runConduit (zipSources (yieldMany ([1..] :: [Int])) docsC
.| CList.chunksOf 5 .| CList.chunksOf 5
.| mapM_C (addDocumentsWithProgress userCorpusId) .| mapM_C (addDocumentsWithProgress userCorpusId)
.| sinkNull) `CES.catch` (\(e :: SomeException) -> do .| sinkNull) `CES.catches`
$(logLocM) ERROR $ "Exception during API call: " <> show e [ CES.Handler $ \(e :: ClientError) -> do
$(logLocM) ERROR ("Client error: " <> show e :: Text)
markFailure 1 (Just e) jobHandle
-- ignore this and proceed with list generation
pure ()
, CES.Handler $ \(e :: SomeException) -> do
$(logLocM) ERROR ("Exception during API call: " <> show e :: Text)
markFailureNoErr 1 jobHandle markFailureNoErr 1 jobHandle
-- ignore this and proceed with list generation -- ignore this and proceed with list generation
pure ()) pure ()
]
let u = userFromMkCorpusUser mkCorpusUser let u = userFromMkCorpusUser mkCorpusUser
......
...@@ -14,9 +14,9 @@ module Gargantext.Utils.Jobs.Error ...@@ -14,9 +14,9 @@ module Gargantext.Utils.Jobs.Error
, HumanFriendlyErrorText(..) , HumanFriendlyErrorText(..)
) where ) where
import Prelude import Gargantext.Prelude
import Data.Void import Data.Text qualified as T
import qualified Data.Text as T import Servant.Client.Core (ClientError(..))
-- | This class represents the concept of \"human friendly strings\", by which we mean -- | This class represents the concept of \"human friendly strings\", by which we mean
-- error messages and/or diagnostics which needs to be displayed to the end users, and, as such: -- error messages and/or diagnostics which needs to be displayed to the end users, and, as such:
...@@ -43,3 +43,10 @@ instance ToHumanFriendlyError HumanFriendlyErrorText where ...@@ -43,3 +43,10 @@ instance ToHumanFriendlyError HumanFriendlyErrorText where
-- /N.B/ Don't get fooled by this instance, it's just to help inference in case we use \"markFailed Nothing\". -- /N.B/ Don't get fooled by this instance, it's just to help inference in case we use \"markFailed Nothing\".
instance ToHumanFriendlyError Void where instance ToHumanFriendlyError Void where
mkHumanFriendly = absurd mkHumanFriendly = absurd
instance ToHumanFriendlyError ClientError where
mkHumanFriendly (FailureResponse _ _) = "Server returned an error response"
mkHumanFriendly (DecodeFailure d _) = "Decode failure: " <> d
mkHumanFriendly (UnsupportedContentType mt _) = "Unsupported content type: " <> show mt
mkHumanFriendly (InvalidContentTypeHeader _) = "Invalid content type header"
mkHumanFriendly (ConnectionError _) = "Connection error"
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