Barebone (non-streaming) storage of nodes

src/Gargantext/API/Errors/Types.hs

@@ -266,8 +266,8 @@ newtype instance ToFrontendErrorData 'EC_400__node_creation_failed_no_parent =
 
 data instance ToFrontendErrorData 'EC_400__node_creation_failed_insert_node =
   FE_node_creation_failed_insert_node { necin_user_id   :: UserId
-                                            , necin_parent_id :: ParentId
-                                            }
+                                      , necin_parent_id :: Maybe ParentId
+                                      }
   deriving (Show, Eq, Generic)
 
 newtype instance ToFrontendErrorData 'EC_500__node_generic_exception =

src/Gargantext/API/Server/Named/Remote.hs

@@ -13,23 +13,29 @@ import Conduit
 import Control.Exception.Safe qualified as Safe
 import Control.Exception (toException)
 import Control.Lens (view, (#))
+import Control.Monad
 import Control.Monad.Except (throwError)
 import Data.Aeson qualified as JSON
 import Data.ByteString.Builder qualified as B
 import Data.ByteString.Lazy qualified as BL
 import Data.Conduit.Combinators qualified as C
 import Data.Conduit.List qualified as CL
+import Data.Foldable (foldlM)
 import Gargantext.API.Admin.Auth
-import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
+import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
 import Gargantext.API.Auth.PolicyCheck (remoteExportChecks)
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude (IsGargServer)
 import Gargantext.API.Routes.Client (remoteImportClient)
 import Gargantext.API.Routes.Named.Remote qualified as Named
 import Gargantext.Core.Config
+import Gargantext.Core (lookupDBid)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (IsDBCmd)
-import Gargantext.Database.Query.Table.Node (getNode)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Table.Node (getNode, insertNodeWithHyperdata)
+import Gargantext.Database.Schema.Node (NodePoly(..))
+import Gargantext.Orphans ()
 import Prelude
 import Servant.Client.Streaming (mkClientEnv, withClientM, ClientError)
 import Servant.Server.Generic (AsServerT)
@@ -41,19 +47,36 @@ remoteAPI authenticatedUser = Named.RemoteAPI $
   Named.RemoteAPI'
     { remoteExportEp = \payload@Named.RemoteExportRequest{..} mgr ->
         withPolicy authenticatedUser (remoteExportChecks _rer_node_id) (remoteExportHandler payload) mgr
-    , remoteImportEp = remoteImportHandler
+    , remoteImportEp = remoteImportHandler authenticatedUser
     }
 
 type ExpectedPayload = [Node JSON.Value]
 
-remoteImportHandler :: (HasBackendInternalError err, IsDBCmd env err m, MonadIO m)
-                    => ConduitT () Named.RemoteBinaryData IO ()
+remoteImportHandler :: forall err env m.
+                    (HasNodeError err, HasBackendInternalError err, IsDBCmd env err m, MonadIO m)
+                    => AuthenticatedUser
+                    -> ConduitT () Named.RemoteBinaryData IO ()
                     -> m ()
-remoteImportHandler c = do
+remoteImportHandler loggedInUser c = do
   chunks <- liftIO $ sourceToList $ c .| C.map (B.byteString . Named.getRemoteBinaryData)
+  -- FIXME(adn): We have to find a way to deserialise this into a streaming fashion and
+  -- attempt insertion one element of the list at the time.
   case deserialiseOrFail @ExpectedPayload (B.toLazyByteString $ mconcat chunks) of
-    Left err    -> throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "Deserialization error: " ++ show err)
-    Right value -> liftIO $ putStrLn $ "Received from outside: " ++ show value
+    Left err -> throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "Deserialization error: " ++ show err)
+    Right [] -> throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "Deserialization error: empty list")
+    Right (x:xs) -> do
+      -- Attempts to insert nodes a we go along.
+      rootNode <- inserter Nothing x
+      void $ foldlM insert_remote rootNode xs
+  where
+
+    inserter :: Maybe ParentId -> Node JSON.Value -> m NodeId
+    inserter p x = case lookupDBid $ _node_typename x of
+      Nothing -> error "remoteImportHandler: impossible."
+      Just ty -> insertNodeWithHyperdata ty (_node_name x) (_node_hyperdata x) p (_auth_user_id loggedInUser)
+
+    insert_remote :: NodeId -> Node JSON.Value -> m NodeId
+    insert_remote previousNode = inserter (Just previousNode)
 
 remoteExportHandler :: ( MonadIO m, Safe.MonadCatch m
                        , IsGargServer err env m

src/Gargantext/Database/Query/Table/Node.hs

@@ -54,6 +54,7 @@ module Gargantext.Database.Query.Table.Node
   , insertDefaultNodeIfNotExists
   , insertNode
   , insertNodesWithParentR
+  , insertNodeWithHyperdata
 
   -- * Deleting one or more nodes
   , deleteNode
@@ -345,19 +346,24 @@ insertDefaultNodeIfNotExists nt p u = do
 
 insertNode :: (HasDBid NodeType, HasNodeError err)
            => NodeType -> Maybe Name -> Maybe DefaultHyperdata -> ParentId -> UserId -> DBCmd err NodeId
-insertNode nt n h p u = do
-  res <- insertNodesR [nodeW nt n h p u]
-  case res of
-    [x] -> pure x
-    _   -> nodeError $ NodeCreationFailed $ InsertNodeFailed u p
-
-nodeW ::  HasDBid NodeType
-       => NodeType -> Maybe Name -> Maybe DefaultHyperdata -> ParentId -> UserId -> NodeWrite
-nodeW nt n h p u = node nt n' h' (Just p) u
+insertNode nt n h p u = insertNodeWithHyperdata nt n' h' (Just p) u
   where
     n' = fromMaybe (defaultName nt) n
     h' = maybe     (defaultHyperdata nt) identity h
 
+insertNodeWithHyperdata :: (ToJSON h, Hyperdata h, HasDBid NodeType, HasNodeError err)
+                        => NodeType
+                        -> Name
+                        -> h
+                        -> Maybe ParentId
+                        -> UserId
+                        -> DBCmd err NodeId
+insertNodeWithHyperdata nt n h p u = do
+  res <- insertNodesR [node nt n h p u]
+  case res of
+    [x] -> pure x
+    _   -> nodeError $ NodeCreationFailed $ InsertNodeFailed u p
+
 ------------------------------------------------------------------------
 node :: (ToJSON a, Hyperdata a, HasDBid NodeType)
      => NodeType

src/Gargantext/Database/Query/Table/Node/Error.hs

@@ -39,7 +39,7 @@ data NodeCreationError
   = UserParentAlreadyExists UserId ParentId
   | UserParentDoesNotExist  UserId
   | UserHasNegativeId       UserId
-  | InsertNodeFailed        UserId ParentId
+  | InsertNodeFailed        UserId (Maybe ParentId)
   deriving (Show, Eq, Generic)
 
 instance ToJSON NodeCreationError

src/Gargantext/Orphans.hs

+{-# OPTIONS_GHC -Wno-orphans #-}
 module Gargantext.Orphans (
   module Gargantext.Orphans.OpenAPI
   ) where
 
+import Data.Aeson qualified as JSON
+import Gargantext.Database.Admin.Types.Hyperdata (Hyperdata)
 import Gargantext.Orphans.OpenAPI
+
+instance Hyperdata JSON.Value