[refactor] support for more REST errors

Also, refactored node/settings as there were lots of duplications.

packages.dhall

@@ -104,7 +104,23 @@ let overrides =
       }
 
 let additions =
-      { sequences =
+      { convertable-options =
+        { dependencies = [ "console", "effect", "maybe", "record" ]
+        , repo = "https://github.com/natefaubion/purescript-convertable-options"
+        , version = "v1.0.0"
+        }
+      , data-default =
+        { dependencies =
+          [ "assert", "lists", "maybe", "record", "effect", "prelude" ]
+        , repo = "https://github.com/thought2/purescript-data-default"
+        , version = "350e600a5a022c9599865a2dd14196b442f59bcc"
+        }
+      , dom-filereader =
+        { dependencies = [ "aff", "arraybuffer-types", "web-file", "web-html" ]
+        , repo = "https://github.com/nwolverson/purescript-dom-filereader"
+        , version = "v5.0.0"
+        }
+      , sequences =
         { dependencies =
           [ "arrays"
           , "assert"
@@ -126,6 +142,28 @@ let additions =
         , repo = "https://github.com/garganscript/purescript-sequences.git"
         , version = "recursion-fix"
         }
+      , read =
+        { dependencies = [ "prelude", "maybe", "strings" ]
+        , repo = "https://github.com/truqu/purescript-read"
+        , version = "v1.0.1"
+        }
+      , simple-json-generics =
+        { dependencies =
+          [ "assert"
+          , "control"
+          , "effect"
+          , "either"
+          , "foreign"
+          , "partial"
+          , "prelude"
+          , "simple-json"
+          , "transformers"
+          , "typelevel-prelude"
+          ]
+        , repo =
+            "https://github.com/garganscript/purescript-simple-json-generics"
+        , version = "master"
+        }
       , spec-discovery =
         { dependencies = [ "prelude", "effect", "arrays", "spec", "node-fs" ]
         , repo = "https://github.com/purescript-spec/purescript-spec-discovery"
@@ -156,28 +194,6 @@ let additions =
             "https://gitlab.iscpif.fr/gargantext/purescript-string-search.git"
         , version = "v0.1.6"
         }
-      , dom-filereader =
-        { dependencies = [ "aff", "arraybuffer-types", "web-file", "web-html" ]
-        , repo = "https://github.com/nwolverson/purescript-dom-filereader"
-        , version = "v5.0.0"
-        }
-      , simple-json-generics =
-        { dependencies =
-          [ "assert"
-          , "control"
-          , "effect"
-          , "either"
-          , "foreign"
-          , "partial"
-          , "prelude"
-          , "simple-json"
-          , "transformers"
-          , "typelevel-prelude"
-          ]
-        , repo =
-            "https://github.com/garganscript/purescript-simple-json-generics"
-        , version = "master"
-        }
       , tuples-native =
         { dependencies =
           [ "console"
@@ -191,11 +207,6 @@ let additions =
         , repo = "https://github.com/garganscript/purescript-tuples-native"
         , version = "v2.3.0"
         }
-      , read =
-        { dependencies = [ "prelude", "maybe", "strings" ]
-        , repo = "https://github.com/truqu/purescript-read"
-        , version = "v1.0.1"
-        }
       , versions =
         { dependencies = [ "prelude" ]
         , repo = "https://github.com/hdgarrood/purescript-versions.git"
@@ -206,11 +217,6 @@ let additions =
         , repo = "https://github.com/mjepronk/purescript-web-url"
         , version = "v2.0.0"
         }
-      , convertable-options =
-        { dependencies = [ "console", "effect", "maybe", "record" ]
-        , repo = "https://github.com/natefaubion/purescript-convertable-options"
-        , version = "v1.0.0"
-        }
       }
 
 in  upstream // overrides // additions

spago.dhall

@@ -28,6 +28,7 @@ to generate this file without the comments in this block.
   , "convertable-options"
   , "css"
   , "d3"
+  , "data-default"
   , "datetime"
   , "debug"
   , "dom-filereader"

src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs

@@ -43,9 +43,7 @@ addNodeAsync :: Session
              -> AffRESTError GT.AsyncTaskWithType
 addNodeAsync session parentId q = do
   eTask :: Either RESTError GT.AsyncTask <- post session p q
-  case eTask of
-    Left err -> pure $ Left err
-    Right task -> pure $ Right $ GT.AsyncTaskWithType { task, typ: GT.AddNode }
+  pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.AddNode }) <$> eTask
   where
     p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
 
@@ -91,33 +89,37 @@ addNodeViewCpt = here.component "addNodeView" cpt where
         setNodeType' nt = do
           T.write_ (GT.prettyNodeType nt) nodeName
           T.write_ nt nodeType
-        (maybeChoose /\ nt') = if length nodeTypes > 1
-                         then ([ Tools.formChoice { items: nodeTypes
-                                                  , default: nodeType'
-                                                  , callback: setNodeType'
-                                                  , print: print hasChromeAgent' } [] ] /\ nodeType')
-                         else ([H.div {} [H.text $ "Creating a node of type "
-                                                <> show defaultNt
-                                                <> " with name:"
-                                         ]
-                                ] /\ defaultNt
-                               )
-                            where
-                              defaultNt = (fromMaybe Error $ head nodeTypes)
-        maybeEdit   = if edit then
-                        [ inputWithEnterWithKey {
-                               onBlur: \val -> T.write_ val nodeName
-                             , onEnter: \_ -> launchAff_ $ dispatch (AddNode nodeName' nt')
-                             , onValueChanged: \val -> T.write_ val nodeName
-                             , autoFocus: true
-                             , className: "form-control"
-                             , defaultValue: nodeName' -- (prettyNodeType nt')
-                             , placeholder: nodeName'  -- (prettyNodeType nt')
-                             , type: "text"
-                             , key: show nodeType'
-                             , required: false
-                             } ]
-                      else []
+        (maybeChoose /\ nt') =
+          if length nodeTypes > 1 then
+            [ Tools.formChoice { items: nodeTypes
+                               , default: nodeType'
+                               , callback: setNodeType'
+                               , print: print hasChromeAgent' } []
+            ] /\ nodeType'
+          else
+            [ H.div {}
+              [H.text $ "Creating a node of type "
+               <> show defaultNt
+               <> " with name:"
+              ]
+            ] /\ defaultNt
+          where
+            defaultNt = fromMaybe Error $ head nodeTypes
+        maybeEdit =
+          if edit then
+            [ inputWithEnterWithKey {
+                 onBlur: \val -> T.write_ val nodeName
+                 , onEnter: \_ -> launchAff_ $ dispatch (AddNode nodeName' nt')
+                 , onValueChanged: \val -> T.write_ val nodeName
+                 , autoFocus: true
+                 , className: "form-control"
+                 , defaultValue: nodeName' -- (prettyNodeType nt')
+                 , placeholder: nodeName'  -- (prettyNodeType nt')
+                 , type: "text"
+                 , key: show nodeType'
+                 , required: false
+                 } ]
+          else []
 
     pure $ Tools.panelWithSubmitButton { action: AddNode nodeName' nt'
                                        , dispatch

src/Gargantext/Components/Forest/Tree/Node/Box.purs

@@ -332,31 +332,39 @@ panelAction = R2.leaf panelActionCpt
 panelActionCpt :: R.Component PanelActionProps
 panelActionCpt = here.component "panelAction" cpt
   where
-    cpt { action: Documentation nodeType}                  _ = pure $ actionDoc { nodeType } []
-    cpt { action: Download, id, nodeType, session}         _ = pure $ actionDownload { id, nodeType, session } []
-    cpt { action: Upload, dispatch, id, nodeType, session} _ = pure $ actionUpload { dispatch, id, nodeType, session } []
-    cpt { action: Delete, nodeType, dispatch}              _ = pure $ actionDelete { dispatch, nodeType } []
-    cpt { action: ManageTeam, nodeType, id, session}       _ = pure $ actionManageTeam { id, nodeType, session } []
     cpt { action: Add xs, dispatch, id, name, nodeType} _ =
       pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs} []
-    cpt { action: Refresh , dispatch, nodeType } _ = pure $ update { dispatch, nodeType } []
-    cpt { action: ReloadWithSettings , dispatch, nodeType } _ = pure $ update { dispatch, nodeType } []
+    cpt { action : AddingContact, dispatch, id } _ =
+      pure $ Contact.actionAddContact { dispatch, id } []
     cpt { action: Config, nodeType } _ =
       pure $ fragmentPT $ "Config " <> show nodeType
-    -- Functions using SubTree
-    cpt { action: Reconstruct , dispatch, nodeType } _ = pure $ update { dispatch, nodeType } []
+    cpt { action: Delete, nodeType, dispatch} _ =
+      pure $ actionDelete { dispatch, nodeType } []
+    cpt { action: Documentation nodeType} _ =
+      pure $ actionDoc { nodeType } []
+    cpt { action: Download, id, nodeType, session} _ =
+      pure $ actionDownload { id, nodeType, session } []
+    cpt { action: Link {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
+      pure $ linkNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
+    cpt { action: ManageTeam, nodeType, id, session} _ =
+      pure $ actionManageTeam { id, nodeType, session } []
     cpt { action: Merge {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
       pure $ mergeNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
     cpt { action: Move {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
       pure $ moveNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
-    cpt { action: Link {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
-      pure $ linkNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
-    cpt { action : Share, id, session } _ = pure $ Share.shareNode { id, session } []
-    cpt { action : AddingContact, dispatch, id } _ = pure $ Contact.actionAddContact { dispatch, id } []
     cpt { action : Publish {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
       pure $ Share.publishNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
+    cpt { action: Reconstruct , dispatch, nodeType } _ =
+      pure $ update { dispatch, nodeType } []
+    cpt { action: Refresh , dispatch, nodeType } _ =
+      pure $ update { dispatch, nodeType } []
+    cpt { action: ReloadWithSettings , dispatch, nodeType } _ =
+      pure $ update { dispatch, nodeType } []
     cpt { action: SearchBox, boxes, dispatch, id, session } _ =
       pure $ actionSearch { boxes, dispatch, id: Just id, session } []
+    cpt { action : Share, id, session } _ = pure $ Share.shareNode { id, session } []
+    cpt { action: Upload, dispatch, id, nodeType, session} _ =
+      pure $ actionUpload { dispatch, id, nodeType, session } []
     cpt { action: WriteNodesDocuments, boxes, dispatch, id, session } _ =
       pure $ actionWriteNodesDocuments { boxes, dispatch, id, session } []
     cpt _ _ = pure $ H.div {} []

src/Gargantext/Config/REST.purs

@@ -79,9 +79,35 @@ data FrontendError =
   | EC_500__node_not_implemented_yet
 derive instance Generic FrontendError _
 instance Show FrontendError where
-  show EC_403__login_failed_invalid_username_or_password = "Invalid username or password"
-  show (EC_404__node_lookup_failed_username_not_found { username }) = "User '" <> username <> "' not found"
-  show a = genericShow a
+  show (EC_400__node_creation_failed_insert_node { user_id, parent_id }) =
+    "Failed to insert node for user " <> show user_id <> ", parent " <> show parent_id
+  show (EC_400__node_creation_failed_no_parent { user_id }) =
+    "Failed to insert node for user " <> show user_id <> ": no parent"
+  show (EC_400__node_creation_failed_parent_exists { user_id, parent_id }) =
+    "Failed to insert node for user " <> show user_id <> ", parent " <> show parent_id <> " exists"
+  show (EC_400__node_creation_failed_user_negative_id { user_id }) =
+    "Failed to insert node for use " <> show user_id <> " (negative user_id)"
+  show (EC_400__node_lookup_failed_user_too_many_roots { user_id, roots }) =
+    "Failed to lookup node for user " <> show user_id <> ": too many roots (" <> show roots <> ")"
+  show EC_400__node_needs_configuration = "Node needs configuration"
+  show (EC_403__login_failed_error { node_id, user_id }) =
+    "Login failed for node_id " <> show node_id <> ", user id " <> show user_id
+  show EC_403__login_failed_invalid_username_or_password =
+    "Invalid username or password"
+  show (EC_404__node_context_not_found { context_id }) =
+    "Context not found with id " <> show context_id
+  show (EC_404__node_lookup_failed_not_found { node_id }) =
+    "Node not found with id " <> show node_id
+  show (EC_404__node_lookup_failed_parent_not_found { node_id }) =
+    "Node parent not found for id " <> show node_id
+  show (EC_404__node_lookup_failed_username_not_found { username }) =
+    "User '" <> username <> "' not found"
+  show (EC_404__node_list_not_found { list_id }) =
+    "Node list not found for id " <> show list_id
+  show EC_404__node_root_not_found = "Node root not found"
+  show (EC_500__node_generic_exception { error }) =
+    "Node exception: " <> error
+  show EC_500__node_not_implemented_yet = "Node not implemented yet"
 instance JSON.ReadForeign FrontendError where
   readImpl f = do
     { type: type_ } <- JSON.readImpl f :: Foreign.F { type :: String }
@@ -167,17 +193,6 @@ readJSON affResp =
         _ -> case (JSON.readJSON $ AC.stringify resp.body :: JSON.E FrontendError) of
           Right err -> Left $ FE err
           Left _    -> Left $ UnknownServerError $ AC.stringify resp.body
-        -- _ -> Left $ parseServerError resp
-
-parseServerError :: Affjax.Response AC.Json -> RESTError
-parseServerError { body } =
-  case (JSON.readJSON $ AC.stringify body :: JSON.E { type :: String }) of
-    Right { type: "EC_404__node_lookup_failed_username_not_found" } ->
-      ServerError "username not found"
-    -- TODO Add more errors for the frontend
-    Right { type: type_ } ->
-      UnknownServerError $ "Server error of type '" <> type_ <> "' not supported"
-    Left _ -> UnknownServerError $ AC.stringify body
 
 
 -- TODO too much duplicate code in `postWwwUrlencoded`