Add frontend error for NoListFound

src/Gargantext/API/Errors.hs

@@ -47,12 +47,12 @@ backendErrorToFrontendError = \case
 
 nodeErrorToFrontendError :: NodeError -> FrontendError
 nodeErrorToFrontendError ne = case ne of
-  NoListFound _lid
-    -> undefined
+  NoListFound lid
+    -> mkFrontendErrShow $ FE_node_error_list_not_found lid
   NoRootFound
-    -> mkFrontendErr' renderedError FE_node_error_root_not_found
+    -> mkFrontendErrShow FE_node_error_root_not_found
   NoCorpusFound
-    -> mkFrontendErr' renderedError FE_node_error_corpus_not_found
+    -> mkFrontendErrShow FE_node_error_corpus_not_found
   NoUserFound _ur
     -> undefined
   MkNode
@@ -79,8 +79,6 @@ nodeErrorToFrontendError ne = case ne of
     -> undefined
   QueryNoParse _txt
     -> undefined
-  where
-    renderedError = T.pack (show ne)
 
 -- | Converts a 'FrontendError' into a 'ServerError' that the servant app can
 -- return to the frontend.

src/Gargantext/API/Errors/Types.hs

@@ -22,13 +22,17 @@ module Gargantext.API.Errors.Types (
   , ToFrontendErrorData(..)
 
   -- * Constructing frontend errors
-  , mkFrontendErr
+  , mkFrontendErrNoDiagnostic
+  , mkFrontendErrShow
   , mkFrontendErr'
 
   -- * Evidence carrying
   , Dict(..)
   , IsFrontendErrorData(..)
 
+  -- * Generating test cases
+  , genFrontendErr
+
   -- * Attaching callstacks to exceptions
   , WithStacktrace(..)
   ) where
@@ -120,7 +124,8 @@ instance HasJoseError BackendInternalError where
 data BackendErrorCode
   =
   -- node errors
-    EC_404__node_error_root_not_found
+    EC_404__node_error_list_not_found
+  | EC_404__node_error_root_not_found
   | EC_404__node_error_corpus_not_found
   -- tree errors
   | EC_404__tree_error_root_not_found
@@ -156,6 +161,8 @@ class ( SingI payload
       ) => IsFrontendErrorData payload where
   isFrontendErrorData :: Proxy payload -> Dict IsFrontendErrorData payload
 
+instance IsFrontendErrorData 'EC_404__node_error_list_not_found where
+  isFrontendErrorData _ = Dict
 instance IsFrontendErrorData 'EC_404__node_error_root_not_found where
   isFrontendErrorData _ = Dict
 instance IsFrontendErrorData 'EC_404__node_error_corpus_not_found where
@@ -171,6 +178,10 @@ data NoFrontendErrorData = NoFrontendErrorData
 
 data family ToFrontendErrorData (payload :: BackendErrorCode) :: Type
 
+newtype instance ToFrontendErrorData 'EC_404__node_error_list_not_found =
+  FE_node_error_list_not_found { lnf_list_id :: ListId }
+  deriving (Show, Eq, Generic)
+
 data instance ToFrontendErrorData 'EC_404__node_error_root_not_found =
   FE_node_error_root_not_found
   deriving (Show, Eq, Generic)
@@ -187,6 +198,15 @@ data instance ToFrontendErrorData 'EC_404__tree_error_root_not_found =
 -- JSON instances. It's important to have nice and human readable instances.
 ----------------------------------------------------------------------------
 
+instance ToJSON (ToFrontendErrorData 'EC_404__node_error_list_not_found) where
+  toJSON (FE_node_error_list_not_found lid) =
+    JSON.object [ "list_id" .= toJSON lid ]
+
+instance FromJSON (ToFrontendErrorData 'EC_404__node_error_list_not_found) where
+  parseJSON = withObject "FE_node_error_list_not_found" $ \o -> do
+    lnf_list_id <- o .: "list_id"
+    pure FE_node_error_list_not_found{..}
+
 instance ToJSON (ToFrontendErrorData 'EC_404__node_error_root_not_found) where
   toJSON _ = JSON.Null
 
@@ -207,10 +227,18 @@ instance FromJSON (ToFrontendErrorData 'EC_404__tree_error_root_not_found) where
     _rnf_rootId <- o .: "root_id"
     pure RootNotFound{..}
 
-mkFrontendErr :: IsFrontendErrorData payload
-              => ToFrontendErrorData payload
-              -> FrontendError
-mkFrontendErr et = mkFrontendErr' mempty et
+-- | Creates an error without attaching a diagnostic to it.
+mkFrontendErrNoDiagnostic :: IsFrontendErrorData payload
+                          => ToFrontendErrorData payload
+                          -> FrontendError
+mkFrontendErrNoDiagnostic et = mkFrontendErr' mempty et
+
+-- | Renders the error by using as a diagnostic the string
+-- resulting from 'Show'ing the underlying type.
+mkFrontendErrShow :: IsFrontendErrorData payload
+                  => ToFrontendErrorData payload
+                  -> FrontendError
+mkFrontendErrShow et = mkFrontendErr' (T.pack $ show et) et
 
 mkFrontendErr' :: forall payload. IsFrontendErrorData payload
                => T.Text
@@ -218,24 +246,26 @@ mkFrontendErr' :: forall payload. IsFrontendErrorData payload
                -> FrontendError
 mkFrontendErr' diag pl = FrontendError diag (fromSing $ sing @payload) pl
 
+----------------------------------------------------------------------------
+-- Arbitrary instances and test data generation
+----------------------------------------------------------------------------
+
 instance Arbitrary BackendErrorCode where
   arbitrary = arbitraryBoundedEnum
 
-instance Arbitrary FrontendError where
-  arbitrary = do
-    et  <- arbitrary
-    txt <- arbitrary
-    genFrontendErr txt et
-
-genFrontendErr :: T.Text -> BackendErrorCode -> Gen FrontendError
-genFrontendErr txt be = case be of
-  EC_404__node_error_root_not_found
-    -> pure $ mkFrontendErr' txt FE_node_error_root_not_found
-  EC_404__node_error_corpus_not_found
-    -> pure $ mkFrontendErr' txt FE_node_error_corpus_not_found
-  EC_404__tree_error_root_not_found
-    -> do rootId <- arbitrary
-          pure $ mkFrontendErr' txt (RootNotFound rootId)
+genFrontendErr :: BackendErrorCode -> Gen FrontendError
+genFrontendErr be = do
+  txt <- arbitrary
+  case be of
+    EC_404__node_error_list_not_found
+      -> arbitrary >>= \lid -> pure $ mkFrontendErr' txt $ FE_node_error_list_not_found lid
+    EC_404__node_error_root_not_found
+      -> pure $ mkFrontendErr' txt FE_node_error_root_not_found
+    EC_404__node_error_corpus_not_found
+      -> pure $ mkFrontendErr' txt FE_node_error_corpus_not_found
+    EC_404__tree_error_root_not_found
+      -> do rootId <- arbitrary
+            pure $ mkFrontendErr' txt (RootNotFound rootId)
 
 instance ToJSON BackendErrorCode where
   toJSON = JSON.String . T.pack . drop 3 . show
@@ -258,6 +288,9 @@ instance FromJSON FrontendError where
     (fe_diagnostic :: T.Text)      <- o .: "diagnostic"
     (fe_type :: BackendErrorCode)  <- o .: "type"
     case fe_type of
+      EC_404__node_error_list_not_found         -> do
+        (fe_data :: ToFrontendErrorData 'EC_404__node_error_list_not_found) <- o .: "data"
+        pure FrontendError{..}
       EC_404__node_error_root_not_found         -> do
         (fe_data :: ToFrontendErrorData 'EC_404__node_error_root_not_found) <- o .: "data"
         pure FrontendError{..}

src/Gargantext/Database/Admin/Types/Node.hs

@@ -44,7 +44,7 @@ import Opaleye (DefaultFromField, defaultFromField, SqlInt4, SqlText, SqlTSVecto
 import Opaleye qualified as O
 import Prelude qualified
 import Servant hiding (Context)
-import Test.QuickCheck (elements)
+import Test.QuickCheck (elements, Positive (getPositive))
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck.Instances.Text ()
 import Test.QuickCheck.Instances.Time ()
@@ -304,8 +304,10 @@ instance FromHttpApiData NodeId where
 instance ToHttpApiData NodeId where
   toUrlPiece (UnsafeMkNodeId n) = toUrlPiece n
 instance ToParamSchema NodeId
+
+-- | It makes sense to generate only positive ids.
 instance Arbitrary NodeId where
-  arbitrary = UnsafeMkNodeId <$> arbitrary
+  arbitrary = UnsafeMkNodeId . getPositive <$> arbitrary
 
 type ParentId    = NodeId
 type CorpusId    = NodeId

test/Test/Offline/JSON.hs

@@ -38,13 +38,21 @@ jsonEnumRoundtrip d = case d of
     prop :: Dict EnumBoundedJSON a -> a -> Property
     prop Dict a = counterexample ("Parsed JSON: " <> C8.unpack (encode a)) $ eitherDecode (encode a) === Right a
 
+-- | Tests /all/ the 'BackendErrorCode' and their associated 'FrontendError' payloads.
+jsonFrontendErrorRoundtrip :: Property
+jsonFrontendErrorRoundtrip = conjoin $ map mk_prop [minBound .. maxBound]
+  where
+    mk_prop :: BackendErrorCode -> Property
+    mk_prop code = forAll (genFrontendErr code) $ \a ->
+      counterexample ("Parsed JSON: " <> C8.unpack (encode a)) $ eitherDecode (encode a) === Right a
+
 tests :: TestTree
 tests = testGroup "JSON" [
     testProperty "NodeId roundtrips"        (jsonRoundtrip @NodeId)
   , testProperty "RootId roundtrips"        (jsonRoundtrip @RootId)
   , testProperty "Datafield roundtrips"     (jsonRoundtrip @Datafield)
   , testProperty "WithQuery roundtrips"     (jsonRoundtrip @WithQuery)
-  , testProperty "FrontendError roundtrips" (jsonRoundtrip @FrontendError)
+  , testProperty "FrontendError roundtrips" jsonFrontendErrorRoundtrip
   , testProperty "BackendErrorCode roundtrips" (jsonEnumRoundtrip (Dict @_ @BackendErrorCode))
   , testCase "WithQuery frontend compliance" testWithQueryFrontend
   , testGroup "Phylo" [