Squashed commit of the following:

commit b4755ad5
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Wed Jan 29 11:41:32 2025 +0100

    Code review, part II

    This commit splits the /export (renaming it to just remote) and tuck it
    under the /node hierarchy. The import also lives tucked in the /node.

commit 483bd3e5
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Tue Jan 28 09:34:14 2025 +0100

    Code review feedback

    * Rename `exampleS` into `exampleSchema`;
    * Revert commit about the public keys & co;

commit 18d207f0
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Tue Jan 28 09:50:56 2025 +0100

    Revert "Add _env_remote_transfer_keys field"

    This reverts commit 3ea32b50.

commit 9cc5159a
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Jan 20 10:00:53 2025 +0100

    Support transfering of notes

commit 1fe60d75
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Fri Jan 17 08:37:53 2025 +0100

    Refactor exporting and transfering of nodes

commit b39c1805
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Thu Jan 16 09:54:38 2025 +0100

    Preliminary work to transfer notes

commit b2f7a9a8
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Jan 13 15:25:34 2025 +0100

    Chunks the insertion of remote docs

commit 0d4e0554
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Jan 13 14:43:16 2025 +0100

    Move terms updating to separate job as well

commit c62480c7
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Jan 13 12:30:19 2025 +0100

    Proper support for importing documents

commit 6019587c
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Jan 6 15:44:13 2025 +0100

    Initial support for importing ngrams

commit 842b3d36
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Jan 6 15:07:21 2025 +0100

    Support exporting docs and ngrams (but not importing them yet)

commit 98708c2e
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Jan 6 12:32:17 2025 +0100

    Support exporting of tree hierarchies (with proviso)

    Exporting a corpus works, as it also exports its children, but for
    example the docs and terms nodes do not have any associated content.
    This is because those are stored in separate DB tables, and we need
    to find a way to export those as well.

commit c248eaf1
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Jan 6 11:50:14 2025 +0100

    Support trees of export nodes (to be tested)

commit dd2049aa
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Jan 6 11:23:30 2025 +0100

    Add getNodes function to Database.Query.Table.Node

commit c429cbb1
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Jan 6 10:39:37 2025 +0100

    Restrict export of nodes to only a few types

commit c648699e
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Jan 6 09:27:28 2025 +0100

    Update deps again (after rebase)

commit 7337820e
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Dec 16 16:07:49 2024 +0100

    Basic Remote API testing

commit 1eb59c52
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Dec 16 15:31:47 2024 +0100

    Barebone (non-streaming) storage of nodes

commit be5e9faf
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Dec 16 14:20:16 2024 +0100

    Send serialised nodes instead of dummy strings

commit aff15b60
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Dec 16 12:07:49 2024 +0100

    Remove redundant test imports

commit 6d776767
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Dec 16 12:01:55 2024 +0100

    Bolt-on ownership check for /remote/export

commit 58d9fcb0
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Dec 16 11:08:11 2024 +0100

    Proper error handling for remote import and export handlers

commit 23a06d28
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Dec 9 15:37:29 2024 +0100

    Update project deps

commit d5096e40
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Dec 2 17:05:04 2024 +0100

    Make a start on the remote (streaming) endpoints

    It typechecks but it exchange only a very simple string and
    it prints it.

commit 3ea32b50
Author: Alfredo Di Napoli <alfredo.dinapoli@gmail.com>
Date:   Mon Dec 2 11:26:11 2024 +0100

    Add _env_remote_transfer_keys field

    This adds a new randomly-generated pair of (PublicKey, PrivateKey) to be
    later used to send messages between instances.

    It also:

    * Returns a remote transfer pub key inside an AuthResponse
    * Adds pubKey roundtrip test

gargantext.cabal

@@ -149,6 +149,7 @@ library
       Gargantext.API.Prelude
       Gargantext.API.Public.Types
       Gargantext.API.Routes
+      Gargantext.API.Routes.Client
       Gargantext.API.Routes.Named
       Gargantext.API.Routes.Named.Annuaire
       Gargantext.API.Routes.Named.Contact
@@ -165,6 +166,7 @@ library
       Gargantext.API.Routes.Named.Private
       Gargantext.API.Routes.Named.Public
       Gargantext.API.Routes.Named.Publish
+      Gargantext.API.Routes.Named.Remote
       Gargantext.API.Routes.Named.Search
       Gargantext.API.Routes.Named.Share
       Gargantext.API.Routes.Named.Table
@@ -342,6 +344,7 @@ library
       Gargantext.API.Server.Named.Ngrams
       Gargantext.API.Server.Named.Private
       Gargantext.API.Server.Named.Public
+      Gargantext.API.Server.Named.Remote
       Gargantext.API.Server.Named.Viz
       Gargantext.API.Swagger
       Gargantext.API.Table
@@ -499,6 +502,7 @@ library
     , cache >= 0.1.3.0
     , case-insensitive ^>= 1.2.1.0
     , cassava ^>= 0.5.2.0
+    , cborg-json >= 0.2
     , cereal ^>= 0.5.8.2
     , clock >= 0.8
     , conduit ^>= 1.3.4.2
@@ -585,11 +589,13 @@ library
     , serialise ^>= 0.2.4.0
     , servant >= 0.20.1 && < 0.21
     , servant-auth ^>= 0.4.0.0
+    , servant-auth-client
     , servant-auth-server ^>=0.4.6.0
     , servant-auth-swagger ^>= 0.2.10.1
     , servant-blaze ^>= 0.9.1
     , servant-client >= 0.20 && < 0.21
     , servant-client-core >= 0.20 && < 0.21
+    , servant-conduit >= 0.15 && < 0.17
     , servant-ekg ^>= 0.3.1
     , servant-routes < 0.2
     , servant-openapi3 >= 2.0.1.6
@@ -603,6 +609,7 @@ library
     , singletons ^>= 3.0.2
     , singletons-th >= 3.1 && < 3.2
     , smtp-mail >= 0.3.0.0
+    , split >= 0.2.0
     , stemmer == 0.5.2
     , stm >= 2.5.1.0 && < 2.6
     , stm-containers >= 1.2.0.3 && < 1.3
@@ -737,7 +744,7 @@ common testDependencies
     , servant-auth-client
     , servant-client >= 0.20 && < 0.21
     , servant-client-core >= 0.20 && < 0.21
-    , servant-websockets >= 2.0.0 && < 2.1
+    , servant-conduit >= 0.15 && < 0.17
     , shelly >= 1.9 && < 2
     , stm >= 2.5.1.0 && < 2.6
     , streaming-commons
@@ -780,6 +787,7 @@ test-suite garg-test-tasty
       CLI.Phylo.Common
       Paths_gargantext
       Test.API.Private.Move
+      Test.API.Private.Remote
       Test.API.Private.Share
       Test.API.Private.Table
       Test.API.Authentication
@@ -848,6 +856,7 @@ test-suite garg-test-hspec
       Test.API.Notifications
       Test.API.Private
       Test.API.Private.Move
+      Test.API.Private.Remote
       Test.API.Private.Share
       Test.API.Private.Table
       Test.API.Routes

src/Gargantext/API/Admin/Auth/Types.hs

@@ -65,6 +65,8 @@ data AuthResponse = AuthResponse { _authRes_token   :: Token
                                  }
   deriving (Generic, Eq, Show)
 
+instance NFData AuthResponse where
+
 type Token  = Text
 type TreeId = NodeId
 

src/Gargantext/API/Admin/EnvTypes.hs

@@ -43,14 +43,14 @@ import Database.PostgreSQL.Simple (Connection)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog, noJobLog)
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Prelude (GargM, IsGargServer)
+import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..), HasConfig(..), HasManager(..))
+import Gargantext.Core.Mail.Types (HasMail, mailSettings)
+import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap)
+import Gargantext.Core.NodeStory
 import Gargantext.Core.Notifications.CentralExchange qualified as CE
 import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
 import Gargantext.Core.Notifications.Dispatcher (Dispatcher)
 import Gargantext.Core.Notifications.Dispatcher.Types (HasDispatcher(..))
-import Gargantext.Core.Config (GargConfig(..), gc_mail_config, gc_nlp_config, HasJWTSettings(..), HasConfig(..))
-import Gargantext.Core.Mail.Types (HasMail, mailSettings)
-import Gargantext.Core.NLP (HasNLPServer(..), nlpServerMap)
-import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude (HasConnectionPool(..))
 import Gargantext.Prelude hiding (to)
 import Gargantext.System.Logging
@@ -144,6 +144,9 @@ instance CET.HasCentralExchangeNotification Env where
     c <- asks (view env_config)
     liftBase $ CE.notify (_gc_notifications_config c) m
 
+instance HasManager Env where
+  gargHttpManager = env_manager
+
 data FireWall = FireWall { unFireWall :: Bool }
 
 data MockEnv = MockEnv
@@ -176,6 +179,7 @@ instance HasLogger (GargM DevEnv BackendInternalError) where
 
 data DevEnv = DevEnv
   { _dev_env_config    :: !GargConfig
+  , _dev_env_manager   :: ~Manager
   , _dev_env_logger    :: !(Logger (GargM DevEnv BackendInternalError))
   , _dev_env_pool      :: !(Pool Connection)
   , _dev_env_nodeStory :: !NodeStoryEnv
@@ -234,6 +238,9 @@ instance HasNodeArchiveStoryImmediateSaver DevEnv where
 instance HasMail DevEnv where
   mailSettings = dev_env_config . gc_mail_config
 
+instance HasManager DevEnv where
+  gargHttpManager = dev_env_manager
+
 instance HasNLPServer DevEnv where
   nlpServer = dev_env_config . gc_nlp_config . (to nlpServerMap)
 

src/Gargantext/API/Auth/PolicyCheck.hs

@@ -33,6 +33,7 @@ module Gargantext.API.Auth.PolicyCheck (
   , nodePublishedEdit
   , moveChecks
   , publishChecks
+  , remoteExportChecks
   , userMe
   , alwaysAllow
   , alwaysDeny
@@ -211,7 +212,7 @@ nodeNotDescendant :: AccessPolicyErrorReason
 nodeNotDescendant = AccessPolicyErrorReason "Node is not a direct descendant."
 
 invalidUserPermissions :: AccessPolicyErrorReason
-invalidUserPermissions = AccessPolicyErrorReason "User not authorized to perform the operation."
+invalidUserPermissions = AccessPolicyErrorReason "User not authorized to perform the operation (typically due to wrong ownership)."
 
 -------------------------------------------------------------------------------
 -- Smart constructors of access checks
@@ -274,6 +275,11 @@ publishChecks :: NodeId -> BoolExpr AccessCheck
 publishChecks nodeId =
   (nodeUser nodeId `BOr` nodeSuper nodeId)
 
+-- | A user can export a node if he/she owns it, or if that's a super.
+remoteExportChecks :: NodeId -> BoolExpr AccessCheck
+remoteExportChecks nodeId =
+  (nodeUser nodeId `BOr` nodeSuper nodeId)
+
 alwaysAllow :: BoolExpr AccessCheck
 alwaysAllow = BConst . Positive $ AC_always_allow
 

src/Gargantext/API/Dev.hs

@@ -14,19 +14,20 @@ module Gargantext.API.Dev where
 
 import Control.Lens (view)
 import Control.Monad (fail)
-import Data.Pool (withResource)
 import Database.PostgreSQL.Simple qualified as PGS
+import Data.Pool (withResource)
 import Gargantext.API.Admin.EnvTypes ( DevEnv(..), Mode(Dev) )
 import Gargantext.API.Admin.Settings ( newPool )
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Prelude ( GargM )
 import Gargantext.Core.Config (_gc_database_config)
 import Gargantext.Core.Config.Types (SettingsFile(..))
+import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
 import Gargantext.Database.Prelude (Cmd, CmdRandom, connPool, runCmd)
 import Gargantext.Prelude
-import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.System.Logging ( withLoggerHoisted )
+import Network.HTTP.Client.TLS (newTlsManager)
 import Servant ( ServerError )
 
 -------------------------------------------------------------------
@@ -41,8 +42,10 @@ withDevEnv settingsFile k = withLoggerHoisted Dev $ \logger -> do
       --nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg)
       pool    <- newPool (_gc_database_config cfg)
       nodeStory_env <- fromDBNodeStoryEnv pool
+      manager <- newTlsManager
       pure $ DevEnv
         { _dev_env_pool     = pool
+        , _dev_env_manager    = manager
         , _dev_env_logger     = logger
         , _dev_env_nodeStory  = nodeStory_env
         , _dev_env_config   = cfg

src/Gargantext/API/Errors.hs

@@ -176,6 +176,8 @@ nodeErrorToFrontendError ne = case ne of
     -> mkFrontendErrShow $ FE_node_is_read_only nodeId reason
   MoveError sourceId targetId reason
     -> mkFrontendErrShow $ FE_node_move_error sourceId targetId reason
+  NodeNotExportable nodeId reason
+    -> mkFrontendErrShow $ FE_node_export_error nodeId reason
 
   -- backward-compatibility shims, to remove eventually.
   DoesNotExist nid

src/Gargantext/API/Errors/Types.hs

@@ -35,6 +35,7 @@ module Gargantext.API.Errors.Types (
   , GraphQLError(..)
   , ToFrontendErrorData(..)
   , AccessPolicyErrorReason(..)
+  , HasBackendInternalError(..)
 
   -- * Constructing frontend errors
   , mkFrontendErrNoDiagnostic
@@ -48,8 +49,8 @@ module Gargantext.API.Errors.Types (
 
 import Control.Lens ((#), makePrisms, Prism')
 import Control.Monad.Fail (fail)
-import Data.Aeson (Value(..), (.:), (.=), object, withObject)
 import Data.Aeson.Types (typeMismatch, emptyArray)
+import Data.Aeson (Value(..), (.:), (.=), object, withObject)
 import Data.List.NonEmpty qualified as NE
 import Data.Singletons.TH ( SingI(sing), SingKind(fromSing) )
 import Data.Text qualified as T
@@ -67,6 +68,7 @@ import Gargantext.Prelude hiding (Location, WithStacktrace)
 import Gargantext.Utils.Dict (Dict(..))
 import Gargantext.Utils.Jobs.Monad qualified as Jobs
 import Servant (ServerError)
+import Control.Lens.Prism (prism')
 
 -- | A 'WithStacktrace' carries an error alongside its
 -- 'CallStack', to be able to print the correct source location
@@ -121,6 +123,12 @@ data BackendInternalError
 
 makePrisms ''BackendInternalError
 
+class HasBackendInternalError e where
+  _BackendInternalError :: Prism' e BackendInternalError
+
+instance HasBackendInternalError BackendInternalError where
+  _BackendInternalError = prism' identity Just
+
 instance ToJSON BackendInternalError where
   toJSON (InternalJobError s) =
     object [ ("status", toJSON ("IsFailure" :: Text))
@@ -258,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 =
@@ -278,6 +286,10 @@ data instance ToFrontendErrorData 'EC_403__node_move_error =
   FE_node_move_error { nme_source_id :: !NodeId, nme_target_id :: !NodeId, nme_reason :: !T.Text }
   deriving (Show, Eq, Generic)
 
+data instance ToFrontendErrorData 'EC_403__node_export_error =
+  FE_node_export_error { nee_node_id :: !NodeId, nee_reason :: !T.Text }
+  deriving (Show, Eq, Generic)
+
 --
 -- validation errors
 --
@@ -514,6 +526,15 @@ instance FromJSON (ToFrontendErrorData 'EC_403__node_move_error) where
     nme_reason  <- o .: "reason"
     pure FE_node_move_error{..}
 
+instance ToJSON (ToFrontendErrorData 'EC_403__node_export_error) where
+  toJSON FE_node_export_error{..} =
+    object [ "node_id" .= toJSON nee_node_id, "reason" .= toJSON nee_reason ]
+instance FromJSON (ToFrontendErrorData 'EC_403__node_export_error) where
+  parseJSON = withObject "FE_node_move_error" $ \o -> do
+    nee_node_id <- o .: "node_id"
+    nee_reason  <- o .: "reason"
+    pure FE_node_export_error{..}
+
 --
 -- validation errors
 --
@@ -728,6 +749,9 @@ instance FromJSON FrontendError where
       EC_403__node_move_error -> do
         (fe_data :: ToFrontendErrorData 'EC_403__node_move_error) <- o .: "data"
         pure FrontendError{..}
+      EC_403__node_export_error -> do
+        (fe_data :: ToFrontendErrorData 'EC_403__node_export_error) <- o .: "data"
+        pure FrontendError{..}
 
       -- validation error
       EC_400__validation_error -> do

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

@@ -35,6 +35,7 @@ data BackendErrorCode
   | EC_400__node_needs_configuration
   | EC_403__node_is_read_only
   | EC_403__node_move_error
+  | EC_403__node_export_error
   -- validation errors
   | EC_400__validation_error
   -- policy check errors

src/Gargantext/API/HashedResponse.hs

@@ -19,6 +19,8 @@ import Gargantext.Prelude.Crypto.Hash qualified as Crypto (hash)
 data HashedResponse a = HashedResponse { hash :: Text, value :: a }
   deriving (Generic)
 
+instance NFData a => NFData (HashedResponse a) where
+
 instance ToSchema a => ToSchema (HashedResponse a)
 instance ToJSON a => ToJSON (HashedResponse a) where
   toJSON = genericToJSON defaultOptions

src/Gargantext/API/Ngrams/List.hs

@@ -10,6 +10,7 @@ Portability : POSIX
 -}
 
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
 {-# LANGUAGE TypeApplications    #-}
 {-# LANGUAGE ViewPatterns        #-}
 
@@ -20,17 +21,17 @@ import Data.ByteString.Lazy qualified as BSL
 import Data.Csv qualified as Tsv
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HashMap
-import Data.Map.Strict (toList)
 import Data.Map.Strict qualified as Map
+import Data.Map.Strict (toList)
 import Data.Set qualified as Set
 import Data.Text (concat, pack, splitOn)
-import Data.Vector (Vector)
 import Data.Vector qualified as Vec
+import Data.Vector (Vector)
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Errors.Types (BackendInternalError(InternalServerError))
-import Gargantext.API.Ngrams (setListNgrams)
 import Gargantext.API.Ngrams.List.Types (_wjf_data, _wtf_data)
 import Gargantext.API.Ngrams.Prelude (getNgramsList)
+import Gargantext.API.Ngrams (setListNgrams)
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude (GargM, serverError, HasServerError)
 import Gargantext.API.Routes.Named.List qualified as Named
@@ -46,11 +47,13 @@ import Gargantext.Database.Schema.Ngrams ( text2ngrams, NgramsId )
 import Gargantext.Database.Schema.Node (_node_parent_id)
 import Gargantext.Database.Types (Indexed(..))
 import Gargantext.Prelude hiding (concat, toList)
+import Gargantext.System.Logging (logLocM, MonadLogger)
 import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
 import Prelude qualified
 import Protolude qualified as P
 import Servant
 import Servant.Server.Generic (AsServerT)
+import Gargantext.System.Logging (LogLevel(..))
 
 
 getAPI :: Named.GETAPI (AsServerT (GargM Env BackendInternalError))
@@ -114,7 +117,7 @@ jsonPostAsync = Named.JSONAPI {
   }
 
 ------------------------------------------------------------------------
-postAsyncJSON :: (HasNodeStory env err m, MonadJobStatus m)
+postAsyncJSON :: (HasNodeStory env err m, MonadJobStatus m, MonadLogger m)
               => ListId
               -> NgramsList
               -> JobHandle m
@@ -123,13 +126,17 @@ postAsyncJSON l ngramsList jobHandle = do
 
   markStarted 2 jobHandle
 
+  $(logLocM) DEBUG "[postAsyncJSON] Setting the Ngrams list ..."
   setList
+  $(logLocM) DEBUG "[postAsyncJSON] Done."
 
   markProgress 1 jobHandle
 
   corpus_node <- getNode l -- (Proxy :: Proxy HyperdataList)
   let corpus_id = fromMaybe (panicTrace "no parent_id") (_node_parent_id corpus_node)
+  $(logLocM) DEBUG "[postAsyncJSON] Executing re-indexing..."
   _ <- reIndexWith corpus_id l NgramsTerms (Set.fromList [MapTerm, CandidateTerm])
+  $(logLocM) DEBUG "[postAsyncJSON] Re-indexing done."
 
   markComplete jobHandle
 
@@ -205,7 +212,7 @@ tsvToNgramsTableMap record = case Vec.toList record of
 
 
 -- | This is for debugging the TSV parser in the REPL
-importTsvFile :: forall env err m. (HasNodeStory env err m, HasServerError err, MonadJobStatus m)
+importTsvFile :: forall env err m. (HasNodeStory env err m, HasServerError err, MonadJobStatus m, MonadLogger m)
               => ListId -> P.FilePath -> m ()
 importTsvFile lId fp = do
   contents <- liftBase $ P.readFile fp

src/Gargantext/API/Ngrams/Types.hs

@@ -16,6 +16,7 @@ Portability : POSIX
 {-# LANGUAGE TypeOperators        #-}
 {-# LANGUAGE TypeFamilies         #-}
 {-# OPTIONS -fno-warn-orphans     #-}  -- some instances are orphaned here
+{-# LANGUAGE StandaloneDeriving #-}
 
 module Gargantext.API.Ngrams.Types where
 
@@ -98,6 +99,8 @@ newtype MSet a = MSet (Map a ())
   deriving newtype (Semigroup, Monoid)
   deriving anyclass (ToExpr)
 
+instance NFData a => NFData (MSet a) where
+
 instance ToJSON a => ToJSON (MSet a) where
   toJSON     (MSet m) = toJSON     (Map.keys m)
   toEncoding (MSet m) = toEncoding (Map.keys m)
@@ -171,6 +174,7 @@ instance FromField NgramsRepoElement where
   fromField = fromJSONField
 instance ToField NgramsRepoElement where
   toField = toJSONField
+instance NFData NgramsRepoElement where
 
 data NgramsElement =
      NgramsElement { _ne_ngrams      :: NgramsTerm
@@ -201,6 +205,7 @@ newNgramsElement mayList ngrams =
 
 instance ToSchema NgramsElement where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_ne_")
+instance NFData NgramsElement where
 
 ------------------------------------------------------------------------
 newtype NgramsTable = NgramsTable [NgramsElement]
@@ -209,6 +214,7 @@ newtype NgramsTable = NgramsTable [NgramsElement]
   deriving anyclass (ToExpr)
 
 -- type NgramsList = NgramsTable
+instance NFData NgramsTable where
 
 makePrisms ''NgramsTable
 
@@ -379,6 +385,10 @@ newtype PatchMSet a = PatchMSet (PatchMap a AddRem)
   deriving stock (Eq, Show, Generic)
   deriving newtype (Validity, Semigroup, Monoid, Group, Transformable, Composable)
 
+deriving anyclass instance (NFData k, NFData v) => NFData (PatchMap k v)
+deriving anyclass instance NFData a => NFData (Replace a)
+instance NFData a => NFData (PatchMSet a) where
+
 unPatchMSet :: PatchMSet a -> PatchMap a AddRem
 unPatchMSet (PatchMSet a) = a
 
@@ -441,6 +451,8 @@ data NgramsPatch
                    }
       deriving (Eq, Show, Generic)
 
+instance NFData NgramsPatch where
+
 -- The JSON encoding is untagged, this is OK since the field names are disjoints and thus the encoding is unambiguous.
 -- TODO: the empty object should be accepted and treated as mempty.
 deriveJSON (unPrefixUntagged "_") ''NgramsPatch
@@ -532,6 +544,8 @@ newtype NgramsTablePatch = NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
   deriving stock (Eq, Show, Generic)
   deriving newtype (ToJSON, FromJSON, Semigroup, Monoid, Validity, Transformable)
 
+instance NFData NgramsTablePatch
+
 mkNgramsTablePatch :: Map NgramsTerm NgramsPatch -> NgramsTablePatch
 mkNgramsTablePatch = NgramsTablePatch . PM.fromMap
 
@@ -683,6 +697,8 @@ deriveJSON (unPrefix "_v_") ''Versioned
 makeLenses ''Versioned
 instance (Typeable a, ToSchema a) => ToSchema (Versioned a) where
   declareNamedSchema = wellNamedSchema "_v_"
+instance NFData a => NFData (Versioned a) where
+instance Serialise a => Serialise (Versioned a) where
 ------------------------------------------------------------------------
 type Count = Int
 
@@ -697,6 +713,7 @@ deriveJSON (unPrefix "_vc_") ''VersionedWithCount
 makeLenses ''VersionedWithCount
 instance (Typeable a, ToSchema a) => ToSchema (VersionedWithCount a) where
   declareNamedSchema = wellNamedSchema "_vc_"
+instance NFData a => NFData (VersionedWithCount a) where
 
 toVersionedWithCount :: Count -> Versioned a -> VersionedWithCount a
 toVersionedWithCount count (Versioned version data_) = VersionedWithCount version count data_

src/Gargantext/API/Node.hs

@@ -28,15 +28,15 @@ Node API
 module Gargantext.API.Node
   where
 
-import Gargantext.API.Admin.Auth (withNamedAccess, withNamedPolicyT, withPolicy, withPolicy)
 import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser (..), auth_node_id, auth_user_id)
+import Gargantext.API.Admin.Auth (withNamedAccess, withNamedPolicyT, withPolicy, withPolicy)
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Auth.PolicyCheck ( nodeReadChecks, nodeWriteChecks, moveChecks, AccessPolicyManager, publishChecks )
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams.Types (TabType(..))
-import Gargantext.API.Node.DocumentUpload qualified as DocumentUpload
 import Gargantext.API.Node.DocumentsFromWriteNodes qualified as DFWN
+import Gargantext.API.Node.DocumentUpload qualified as DocumentUpload
 import Gargantext.API.Node.File ( fileApi, fileAsyncApi )
 import Gargantext.API.Node.FrameCalcUpload qualified as FrameCalcUpload
 import Gargantext.API.Node.New ( postNode, postNodeAsyncAPI )
@@ -49,8 +49,11 @@ import Gargantext.API.Routes.Named.Node qualified as Named
 import Gargantext.API.Routes.Named.Private qualified as Named
 import Gargantext.API.Routes.Named.Publish qualified as Named
 import Gargantext.API.Routes.Named.Share qualified as Named
+import Gargantext.API.Routes.Named.Tree qualified as Named
 import Gargantext.API.Search qualified as Search
 import Gargantext.API.Server.Named.Ngrams (apiNgramsTableCorpus)
+import Gargantext.API.Server.Named.Remote qualified as Named
+import Gargantext.API.Server.Named.Remote qualified as Remote
 import Gargantext.API.Table ( tableApi, getPair )
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Viz.Phylo.API (phyloAPI)
@@ -62,17 +65,16 @@ import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (DBCmdExtra, JSONB)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Children (getChildren)
-import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
-import Gargantext.Database.Query.Table.Node.Update qualified as U (update, Update(..), publish)
-import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Query.Table.NodeContext (nodeContextsCategory, nodeContextsScore)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.NodeNode
+import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
+import Gargantext.Database.Query.Table.Node.Update qualified as U (update, Update(..), publish)
+import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
 import Gargantext.Database.Query.Tree (tree, tree_flat, TreeMode(..))
 import Gargantext.Prelude
 import Servant
 import Servant.Server.Generic (AsServerT)
-import Gargantext.API.Routes.Named.Tree qualified as Named
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 
 
 -- | Delete Nodes
@@ -216,8 +218,12 @@ corpusNodeAPI authenticatedUser = Named.CorpusAPIEndpoint $ \targetNode ->
 ------------------------------------------------------------------------
 nodeAPI :: AuthenticatedUser
         -> Named.NodeAPIEndpoint (AsServerT (GargM Env BackendInternalError))
-nodeAPI authenticatedUser = Named.NodeAPIEndpoint $ \targetNode ->
-  withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
+nodeAPI authenticatedUser = Named.NodeAPIEndpoint
+  { nodeEndpointAPI = \targetNode ->
+      withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
+  , nodeRemoteImportAPI = Named.remoteImportAPI authenticatedUser
+  }
+
   where
     concreteAPI = genericNodeAPI' (Proxy :: Proxy HyperdataAny) authenticatedUser
 
@@ -269,6 +275,7 @@ genericNodeAPI' _ authenticatedUser targetNode =  Named.NodeAPI
   , fileAsyncAPI       = fileAsyncApi authenticatedUser targetNode
   , dfwnAPI            = DFWN.api authenticatedUser targetNode
   , documentUploadAPI  = DocumentUpload.api targetNode
+  , remoteExportAPI    = Remote.remoteExportAPI targetNode authenticatedUser
   }
   where
     userRootId     = RootId $ authenticatedUser ^. auth_node_id

src/Gargantext/API/Node/Corpus/New.hs

@@ -25,8 +25,8 @@ import Control.Lens ( view, non )
 import Data.ByteString.Base64 qualified as BSB64
 import Data.Conduit.Internal (zipSources)
 import Data.Swagger ( ToSchema(..) )
-import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
+import Data.Text qualified as T
 import EPO.API.Client.Types qualified as EPO
 import Gargantext.API.Admin.Orchestrator.Types qualified as API
 import Gargantext.API.Ngrams (commitStatePatch, Versioned(..))
@@ -35,14 +35,14 @@ import Gargantext.API.Node.Corpus.Searx ( triggerSearxSearch )
 import Gargantext.API.Node.Corpus.Types ( Datafield(Web), database2origin )
 import Gargantext.API.Node.Corpus.Update (addLanguageToCorpus)
 import Gargantext.API.Node.Types
-import Gargantext.Core (withDefaultLanguage, defaultLanguage)
 import Gargantext.Core.Config (gc_jobs, hasConfig)
 import Gargantext.Core.Config.Types (jc_max_docs_parsers)
-import Gargantext.Core.NodeStory (HasNodeStoryImmediateSaver, HasNodeArchiveStoryImmediateSaver, currentVersion, NgramsStatePatch')
+import Gargantext.Core.NodeStory (HasNodeStoryImmediateSaver, HasNodeArchiveStoryImmediateSaver, currentVersion, NgramsStatePatch', HasNodeStoryEnv)
 import Gargantext.Core.Text.Corpus.Parsers qualified as Parser (FileType(..), parseFormatC, _ParseFormatError)
 import Gargantext.Core.Text.Corpus.Query qualified as API
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Core (withDefaultLanguage, defaultLanguage)
 import Gargantext.Database.Action.Flow (flowCorpus, getDataText, flowDataText, TermType(..){-, allDataOrigins-})
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.Mail (sendMail)
@@ -52,6 +52,8 @@ import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument(
 import Gargantext.Database.Admin.Types.Hyperdata.File ( HyperdataFile(..) )
 import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), ParentId)
 import Gargantext.Database.GargDB qualified as GargDB
+import Gargantext.Database.Prelude (IsDBCmd)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node (getNodeWith, getOrMkList)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))
@@ -366,11 +368,15 @@ addToCorpusWithFile user cid nwf@(NewWithFile _d (withDefaultLanguage -> l) fNam
 
 --- UTILITIES
 
-commitCorpus :: ( FlowCmdM env err m
+commitCorpus :: ( IsDBCmd env err m
+                , HasNodeStoryEnv env
+                , HasNodeError err
                 , HasNodeArchiveStoryImmediateSaver env
                 , HasNodeStoryImmediateSaver env )
-             => ParentId -> User -> m (Versioned NgramsStatePatch')
-commitCorpus cid user = do  
+             => ParentId
+             -> User
+             -> m (Versioned NgramsStatePatch')
+commitCorpus cid user = do
   userId <- getUserId user
   listId <- getOrMkList cid userId
   v <- currentVersion listId

src/Gargantext/API/Node/Document/Export.hs

@@ -9,6 +9,10 @@ Portability : POSIX
 -}
 
 module Gargantext.API.Node.Document.Export
+  ( documentExportAPI
+  -- * Internals
+  , get_document_json
+  )
   where
 
 import Control.Lens (view)
@@ -20,7 +24,7 @@ import Data.Time.Clock.System (getSystemTime, systemSeconds)
 import Data.Time.LocalTime (getCurrentTimeZone, TimeZone (timeZoneMinutes))
 import Data.Version (showVersion)
 import Gargantext.API.Node.Document.Export.Types
-import Gargantext.API.Prelude (GargNoServer, IsGargServer)
+import Gargantext.API.Prelude (IsGargServer)
 import Gargantext.API.Routes.Named.Document qualified as Named
 import Gargantext.Core (toDBid)
 import Gargantext.Database.Admin.Types.Node (DocId, NodeId, NodeType(..))
@@ -46,21 +50,26 @@ documentExportAPI userNodeId dId = Named.DocumentExportAPI $ Named.DocumentExpor
 
 --------------------------------------------------
 -- | Hashes are ordered by Set
-getDocumentsJSON :: NodeId
+getDocumentsJSON :: IsGargServer env err m
+                 => NodeId
                  -- ^ The ID of the target user
                  -> DocId
-                 -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] DocumentExport)
+                 -> m (Headers '[Header "Content-Disposition" T.Text] DocumentExport)
 getDocumentsJSON nodeUserId pId = do
-  uId <- view node_user_id <$> getNodeUser nodeUserId
-  mcId <- getClosestParentIdByType pId NodeCorpus
-  let cId = maybe (panicTrace "[G.A.N.D.Export] Node has no parent") identity mcId
-  docs <- runViewDocuments cId False Nothing Nothing Nothing Nothing Nothing
-  let dexp = DocumentExport { _de_documents = mapFacetDoc uId <$> docs
-                            , _de_garg_version = T.pack $ showVersion PG.version }
+  dexp <- get_document_json nodeUserId pId
   pure $ addHeader (T.concat [ "attachment; filename="
                              , "GarganText_DocsList-"
                              , T.pack (show pId)
                              , ".json" ]) dexp
+
+get_document_json :: IsGargServer err env m => NodeId -> DocId -> m DocumentExport
+get_document_json nodeUserId pId = do
+  uId <- view node_user_id <$> getNodeUser nodeUserId
+  mcId <- getClosestParentIdByType pId NodeCorpus
+  let cId = maybe (panicTrace "[G.A.N.D.Export] Node has no parent") identity mcId
+  docs <- runViewDocuments cId False Nothing Nothing Nothing Nothing Nothing
+  pure DocumentExport { _de_documents = mapFacetDoc uId <$> docs
+                      , _de_garg_version = T.pack $ showVersion PG.version }
   where
     mapFacetDoc uId (FacetDoc { .. }) =
       Document { _d_document =
@@ -80,10 +89,11 @@ getDocumentsJSON nodeUserId pId = do
                                                 , _ng_hash = "" }
                          , _d_hash     = ""}
 
-getDocumentsJSONZip :: NodeId
+getDocumentsJSONZip :: IsGargServer env err m
+                    => NodeId
                     -- ^ The Node ID of the target user
                     -> DocId
-                    -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] DocumentExportZIP) -- [Document]
+                    -> m (Headers '[Header "Content-Disposition" T.Text] DocumentExportZIP) -- [Document]
 getDocumentsJSONZip userNodeId pId = do
   dJSON <- getDocumentsJSON userNodeId pId
   systime <- liftBase getSystemTime
@@ -98,10 +108,11 @@ getDocumentsJSONZip userNodeId pId = do
                              , dezFileName dexpz
                              , ".zip" ]) dexpz
 
-getDocumentsTSV :: NodeId
+getDocumentsTSV :: IsGargServer err env m
+                => NodeId
                 -- ^ The Node ID of the target user
                 -> DocId
-                -> GargNoServer (Headers '[Header "Content-Disposition" T.Text] T.Text) -- [Document]
+                -> m (Headers '[Header "Content-Disposition" T.Text] T.Text) -- [Document]
 getDocumentsTSV userNodeId pId = do
   dJSON <- getDocumentsJSON userNodeId pId
   let DocumentExport { _de_documents } = getResponse dJSON

src/Gargantext/API/Node/Document/Export/Types.hs

@@ -13,12 +13,13 @@ Portability : POSIX
 
 module Gargantext.API.Node.Document.Export.Types where
 
+import Codec.Serialise.Class hiding (encode)
 import Data.Aeson (encode)
 import Data.Aeson.TH (deriveJSON)
 import Data.Csv (DefaultOrdered(..), ToNamedRecord(..), (.=), header, namedRecord)
 import Data.Swagger ( genericDeclareNamedSchema, ToParamSchema(..), ToSchema(..) )
-import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
+import Data.Text qualified as T
 import Gargantext.Core.Types ( Node, TODO )
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument(..) )
@@ -28,27 +29,37 @@ import Gargantext.Utils.Servant (ZIP)
 import Gargantext.Utils.Zip (zipContentsPureWithLastModified)
 import Protolude
 import Servant (MimeRender(..), MimeUnrender(..))
+import Prelude (show)
 
 
 -- | Document Export
 data DocumentExport =
   DocumentExport { _de_documents    :: [Document]
                  , _de_garg_version :: Text
-                 } deriving (Generic)
+                 } deriving (Generic, Show, Eq)
+
+instance Serialise DocumentExport where
 
 -- | This is to represent a zipped document export. We want to have doc_id in zipped file name.
 data DocumentExportZIP =
   DocumentExportZIP { _dez_dexp          :: DocumentExport
                     , _dez_doc_id        :: DocId
                     , _dez_last_modified :: Integer } deriving (Generic)
-    
-    
+
+
 data Document =
   Document { _d_document :: Node HyperdataDocument
            , _d_ngrams   :: Ngrams
            , _d_hash     :: Hash
            } deriving (Generic)
 
+instance Eq Document where
+  (Document _ _ h1) == (Document _ _ h2) = h1 == h2 -- compare by their hashes
+
+instance Show Document where
+  show (Document _ _ h1) = "Document " <> Prelude.show h1
+
+instance Serialise Document where
 --instance Read Document where
 --  read "" = panic "not implemented"
 instance DefaultOrdered Document where
@@ -102,6 +113,8 @@ instance ToParamSchema Document where
 instance ToParamSchema Ngrams where
   toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
 
+instance Serialise Ngrams where
+
 $(deriveJSON (unPrefix "_ng_") ''Ngrams)
 $(deriveJSON (unPrefix "_d_") ''Document)
 $(deriveJSON (unPrefix "_de_") ''DocumentExport)
@@ -113,7 +126,7 @@ $(deriveJSON (unPrefix "_de_") ''DocumentExport)
 -- Needs to be here because of deriveJSON TH above
 
 dezFileName :: DocumentExportZIP -> Text
-dezFileName (DocumentExportZIP { .. }) = "GarganText_DocsList-" <> show _dez_doc_id <> ".json"
+dezFileName (DocumentExportZIP { .. }) = "GarganText_DocsList-" <> Protolude.show _dez_doc_id <> ".json"
     
 instance MimeRender ZIP DocumentExportZIP where
   mimeRender _ dexpz@(DocumentExportZIP { .. }) =

src/Gargantext/API/Node/DocumentUpload.hs

@@ -11,33 +11,43 @@ Portability : POSIX
 
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE MonoLocalBinds      #-}
+{-# LANGUAGE TemplateHaskell     #-}
 
 module Gargantext.API.Node.DocumentUpload where
 
 import Control.Lens (view)
 import Data.Text qualified as T
+import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
 import Gargantext.API.Admin.EnvTypes (Env)
-import Gargantext.API.Errors.Types ( BackendInternalError )
+import Gargantext.API.Errors.Types ( BackendInternalError (..) )
+import Gargantext.API.Node.Corpus.New (commitCorpus)
+import Gargantext.API.Node.Document.Export.Types ( Document(..))
 import Gargantext.API.Node.DocumentUpload.Types
 import Gargantext.API.Prelude ( GargM )
 import Gargantext.API.Routes.Named.Document qualified as Named
 import Gargantext.API.Worker (serveWorkerAPI)
 import Gargantext.Core (Lang(..))
-import Gargantext.Core.NLP (nlpServerGet)
+import Gargantext.Core.NLP (nlpServerGet, HasNLPServer)
+import Gargantext.Core.NodeStory.Types (HasNodeStoryEnv, HasNodeArchiveStoryImmediateSaver)
 import Gargantext.Core.Text.Corpus.Parsers.Date (mDateSplit)
 import Gargantext.Core.Text.Terms (TermType(..))
+import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
+import Gargantext.Core.Worker.Jobs.Types (WorkSplit(..))
 import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus)
 import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataCorpus )
 import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
-import Gargantext.Database.Admin.Types.Node ( DocId, NodeId, NodeType(NodeCorpus) )
+import Gargantext.Database.Admin.Types.Node ( DocId, NodeId, NodeType(NodeCorpus), ParentId )
+import Gargantext.Database.Prelude (IsDBCmd)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
+import Gargantext.Database.Schema.Node (_node_hyperdata)
 import Gargantext.Prelude
+import Gargantext.System.Logging (logLocM, LogLevel(..), MonadLogger)
 import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
 import Servant.Server.Generic (AsServerT)
 
-
 api :: NodeId -> Named.DocumentUploadAPI (AsServerT (GargM Env BackendInternalError))
 api nId = Named.DocumentUploadAPI {
     uploadDocAsyncEp = serveWorkerAPI $ \p ->
@@ -91,3 +101,30 @@ documentUpload nId doc = do
   let lang = EN
   ncs <- view $ nlpServerGet lang
   addDocumentsToHyperCorpus ncs (Nothing :: Maybe HyperdataCorpus) (Multi lang) cId [hd]
+
+-- | Imports the documents contained into this 'DocumentExport' into this (local) version
+-- of the running node.
+-- /NOTE(adn)/: We should compare the gargantext version and ensure that we are importing
+-- only compatible versions.
+remoteImportDocuments :: ( HasNodeError err
+                         , HasNLPServer env
+                         , HasNodeArchiveStoryImmediateSaver env
+                         , HasNodeStoryEnv env
+                         , IsDBCmd env err m
+                         , MonadLogger m
+                         , MonadIO m)
+                      => AuthenticatedUser
+                      -> ParentId
+                      -> NodeId
+                      -> WorkSplit
+                      -> [Document]
+                      -- ^ Total docs
+                      -> m [NodeId]
+remoteImportDocuments loggedInUser corpusId nodeId WorkSplit{..} documents = do
+  let la = Multi EN
+  nlpServerConfig <- view $ nlpServerGet (_tt_lang la)
+  $(logLocM) INFO $ "Importing " <> T.pack (show _ws_current) <> "/" <> T.pack (show _ws_total) <> " documents for corpus node " <> T.pack (show nodeId)
+  docs <- addDocumentsToHyperCorpus nlpServerConfig (Nothing :: Maybe HyperdataCorpus) la corpusId (map (_node_hyperdata . _d_document) documents)
+  _versioned <- commitCorpus corpusId (RootId $ _auth_node_id loggedInUser)
+  $(logLocM) INFO $ "Done importing " <> T.pack (show _ws_current) <> "/" <> T.pack (show _ws_total) <> " documents for corpus node " <> T.pack (show nodeId)
+  pure docs

src/Gargantext/API/Prelude.hs

@@ -17,13 +17,14 @@ module Gargantext.API.Prelude
   , HasServerError(..)
   , serverError ) where
 
+import Control.Exception.Safe qualified as Safe
 import Control.Lens ((#))
 import Control.Monad.Random (MonadRandom)
 import Gargantext.API.Admin.Auth.Types (AuthenticationError)
 import Gargantext.API.Errors.Class (HasAuthenticationError, _AuthenticationError)
-import Gargantext.API.Errors.Types (HasServerError(..), serverError)
+import Gargantext.API.Errors.Types (HasServerError(..), serverError, HasBackendInternalError)
 import Gargantext.Core.Notifications.CentralExchange.Types (HasCentralExchangeNotification)
-import Gargantext.Core.Config (HasConfig)
+import Gargantext.Core.Config (HasConfig, HasManager)
 import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.NodeStory (HasNodeStory, HasNodeStoryEnv)
@@ -45,6 +46,7 @@ type EnvC env =
   , HasNodeStoryEnv   env
   , HasMail           env
   , HasNLPServer      env
+  , HasManager        env
   , HasCentralExchangeNotification env
   )
 
@@ -53,6 +55,7 @@ type ErrC err =
   , HasValidationError     err
   , HasTreeError           err
   , HasServerError         err
+  , HasBackendInternalError err
   , HasAuthenticationError err
 --  , ToJSON               err -- TODO this is arguable
   , Exception              err
@@ -62,6 +65,7 @@ type GargServerC env err m =
   ( HasNodeStory env err m
   , HasMail      env
   , MonadRandom          m
+  , Safe.MonadCatch m
   , EnvC         env
   , ErrC             err
   , ToJSON           err

src/Gargantext/API/Routes/Client.hs

+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Gargantext.API.Routes.Client where
+
+import Conduit qualified as C
+import Data.Proxy
+import Data.Text.Encoding qualified as TE
+import Gargantext.API.Admin.Auth.Types qualified as Auth
+import Gargantext.API.Errors (GargErrorScheme(..))
+import Gargantext.API.Routes.Named
+import Gargantext.API.Routes.Named.Node
+import Gargantext.API.Routes.Named.Private
+import Gargantext.API.Routes.Named.Remote qualified as Named
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Prelude
+import Network.HTTP.Types qualified as H
+import Servant.API.WebSocket qualified as WS
+import Servant.Auth.Client qualified as S
+import Servant.Client.Core
+import Servant.Client.Generic (genericClient)
+import Servant.Client.Streaming
+import Servant.Conduit ()
+
+instance RunClient m => HasClient m WS.WebSocketPending where
+  type Client m WS.WebSocketPending = H.Method ->  m ()
+
+  clientWithRoute :: Proxy m -> Proxy WS.WebSocketPending -> Request -> Client m WS.WebSocketPending
+  clientWithRoute _pm Proxy _req _httpMethod = do
+    panicTrace "[WebSocket client] this is not implemented!"
+
+  hoistClientMonad _ _ f cl = \meth -> f (cl meth)
+
+-- | The client for the full API. It also serves as a \"proof\" that our
+-- whole API has all the required instances to be used in a client.
+clientRoutes :: API (AsClientT ClientM)
+clientRoutes = genericClient
+
+remoteImportClient :: Auth.Token
+                   -> C.ConduitT () Named.RemoteBinaryData IO ()
+                   -> ClientM [NodeId]
+remoteImportClient (S.Token . TE.encodeUtf8 -> token) c =
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & nodeEp
+               & nodeRemoteImportAPI
+               & Named.remoteImportEp
+               & ($ c)
+
+remoteExportClient :: Auth.Token
+                   -> NodeId
+                   -> Named.RemoteExportRequest
+                   -> ClientM [NodeId]
+remoteExportClient (S.Token . TE.encodeUtf8 -> token) nodeId r =
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & nodeEp
+               & nodeEndpointAPI
+               & ($ nodeId)
+               & remoteExportAPI
+               & Named.remoteExportEp
+               & ($ r)

src/Gargantext/API/Routes/Named/Node.hs

@@ -50,6 +50,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser )
 import Gargantext.Database.Query.Facet.Types ( FacetDoc, OrderBy(..) )
 import Prelude
 import Servant
+import Gargantext.API.Routes.Named.Remote (RemoteExportAPI)
 
 -------------------------------------------------------------------
 -- | Node API Types management
@@ -99,6 +100,7 @@ data NodeAPI a mode = NodeAPI
   , fileAsyncAPI       :: mode :- "async"     :> NamedRoutes FileAsyncAPI
   , dfwnAPI            :: mode :- "documents-from-write-nodes" :> NamedRoutes DocumentsFromWriteNodesAPI
   , documentUploadAPI  :: mode :- NamedRoutes DocumentUploadAPI
+  , remoteExportAPI    :: mode :- NamedRoutes RemoteExportAPI
   } deriving Generic
 
 

src/Gargantext/API/Routes/Named/Private.hs

@@ -26,23 +26,24 @@ module Gargantext.API.Routes.Named.Private (
 
 
 import Data.Text (Text)
-import GHC.Generics (Generic)
-import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
-import Gargantext.API.Auth.PolicyCheck (PolicyChecked)
-import Gargantext.API.Routes.Named.Contact (ContactAPI)
-import Gargantext.API.Routes.Named.Context (ContextAPI)
-import Gargantext.API.Routes.Named.Corpus (AddWithForm, AddWithQuery, CorpusExportAPI, MakeSubcorpusAPI)
-import Gargantext.API.Routes.Named.Count (CountAPI, Query)
-import Gargantext.API.Routes.Named.Document (DocumentExportAPI)
+import Gargantext.API.Admin.Auth.Types
+import Gargantext.API.Auth.PolicyCheck
+import Gargantext.API.Routes.Named.Contact
+import Gargantext.API.Routes.Named.Context
+import Gargantext.API.Routes.Named.Corpus
+import Gargantext.API.Routes.Named.Count
+import Gargantext.API.Routes.Named.Document
 import Gargantext.API.Routes.Named.List (GETAPI, JSONAPI, TSVAPI)
-import Gargantext.API.Routes.Named.Node (NodeAPI, NodesAPI, NodeNodeAPI, Roots)
-import Gargantext.API.Routes.Named.Share (ShareURL)
-import Gargantext.API.Routes.Named.Table (TableNgramsAPI)
-import Gargantext.API.Routes.Named.Tree (NodeTreeAPI, TreeFlatAPI)
-import Gargantext.API.Routes.Named.Viz (GraphAPI, PhyloExportAPI)
-import Gargantext.Database.Admin.Types.Hyperdata.Any (HyperdataAny)
-import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataAnnuaire, HyperdataCorpus)
-import Gargantext.Database.Admin.Types.Node (ContextId, CorpusId, DocId, NodeId)
+import Gargantext.API.Routes.Named.Node
+import Gargantext.API.Routes.Named.Remote
+import Gargantext.API.Routes.Named.Share
+import Gargantext.API.Routes.Named.Table
+import Gargantext.API.Routes.Named.Tree
+import Gargantext.API.Routes.Named.Viz
+import Gargantext.Database.Admin.Types.Hyperdata.Any
+import Gargantext.Database.Admin.Types.Hyperdata.Corpus
+import Gargantext.Database.Admin.Types.Node
+import GHC.Generics
 import Servant.API
 import Servant.Auth qualified as SA
 
@@ -120,6 +121,7 @@ data NodeAPIEndpoint mode = NodeAPIEndpoint
                             :> Summary "Node endpoint"
                             :> Capture "node_id" NodeId
                             :> NamedRoutes (NodeAPI HyperdataAny)
+  , nodeRemoteImportAPI :: mode :- "node" :> "remote" :> NamedRoutes RemoteImportAPI
   } deriving Generic
 
 newtype AnnuaireAPIEndpoint mode = AnnuaireAPIEndpoint

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

+
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DerivingStrategies #-}
+module Gargantext.API.Routes.Named.Remote (
+  -- * Routes types
+    RemoteExportAPI(..)
+  , RemoteImportAPI(..)
+  , RemoteExportRequest(..)
+  , RemoteBinaryData(..)
+  ) where
+
+import Conduit qualified as C
+import Data.Aeson as JSON
+import Data.ByteString.Lazy qualified as BL
+import Data.ByteString qualified as BS
+import Data.Proxy
+import Data.Swagger hiding (Http)
+import Gargantext.API.Admin.Auth.Types (Token)
+import Gargantext.API.Auth.PolicyCheck (PolicyChecked)
+import Gargantext.Database.Admin.Types.Node ( NodeId (..) )
+import GHC.Generics
+import Prelude
+import Servant.API
+import Servant.Client.Core.BaseUrl
+import Test.QuickCheck
+
+
+data RemoteExportAPI mode = RemoteExportAPI
+  { remoteExportEp :: mode :- "remote" :> ReqBody '[JSON] RemoteExportRequest :> PolicyChecked (Post '[JSON] [NodeId])
+  } deriving Generic
+
+data RemoteImportAPI mode = RemoteImportAPI
+  { remoteImportEp :: mode :- "import" :> StreamBody NoFraming OctetStream (C.ConduitT () RemoteBinaryData IO ())
+                                       :> Post '[JSON] [NodeId]
+  } deriving Generic
+
+data RemoteExportRequest =
+  RemoteExportRequest
+  { -- | The URL of the instance we want to copy data to.
+    _rer_instance_url  :: BaseUrl
+    -- | The JWT token to use for authentication purposes.
+  , _rer_instance_auth :: Token
+  } deriving (Show, Eq, Generic)
+
+instance Arbitrary RemoteExportRequest where
+  arbitrary = RemoteExportRequest <$> (pure (BaseUrl Http "dev.sub.gargantext.org" 8008 "")) <*> arbitrary
+
+instance ToJSON RemoteExportRequest where
+  toJSON RemoteExportRequest{..}
+    = JSON.object [ "instance_url"  .= toJSON _rer_instance_url
+                  , "instance_auth" .= toJSON _rer_instance_auth
+                  ]
+
+instance FromJSON RemoteExportRequest where
+  parseJSON = withObject "RemoteExportRequest" $ \o -> do
+    _rer_instance_url  <- maybe (fail "RemoteExportRequest invalid URL") pure =<< (parseBaseUrl <$> o .: "instance_url")
+    _rer_instance_auth <- o .: "instance_auth"
+    pure RemoteExportRequest{..}
+
+instance ToSchema RemoteExportRequest where
+  declareNamedSchema _ =
+    let exampleSchema = RemoteExportRequest (BaseUrl Http "dev.sub.gargantext.org" 8008 "") ("abcdef")
+    in pure $ NamedSchema (Just "RemoteExportRequest") $ sketchStrictSchema exampleSchema
+
+newtype RemoteBinaryData = RemoteBinaryData { getRemoteBinaryData :: BS.ByteString }
+  deriving (Show, Eq, Ord)
+
+instance Accept RemoteBinaryData where
+  contentType _ = contentType (Proxy :: Proxy OctetStream)
+
+instance MimeRender OctetStream RemoteBinaryData where
+    mimeRender _ (RemoteBinaryData bs) = BL.fromStrict bs
+
+instance MimeUnrender OctetStream RemoteBinaryData where
+    mimeUnrender _ bs = Right (RemoteBinaryData $ BS.toStrict bs)
+
+instance ToSchema RemoteBinaryData where
+  declareNamedSchema _ = pure $ NamedSchema (Just "RemoteExportRequest") binarySchema

src/Gargantext/API/Routes/Named/Share.hs

@@ -13,14 +13,14 @@ module Gargantext.API.Routes.Named.Share (
   , ShareNodeParams(..)
   ) where
 
-import Data.Aeson (FromJSON(..), ToJSON(..), withText)
+import Data.Aeson (withText)
 import Data.Swagger (ToSchema, declareNamedSchema)
 import Data.Text qualified as T
-import GHC.Generics (Generic)
 import Gargantext.API.Node.Share.Types ( ShareNodeParams (..) )
-import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Prelude
 import Network.URI (parseURI)
-import Prelude
+import Prelude (fail)
 import Servant
 
 -- | A shareable link.
@@ -31,6 +31,8 @@ import Servant
 newtype ShareLink = ShareLink { getShareLink :: URI }
   deriving (Show, Eq, Ord, Generic)
 
+instance NFData ShareLink where
+
 renderShareLink :: ShareLink -> T.Text
 renderShareLink = T.pack . show . getShareLink
 

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

@@ -10,17 +10,17 @@ import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Members (members)
 import Gargantext.API.Ngrams.List qualified as List
 import Gargantext.API.Node (annuaireNodeAPI, corpusNodeAPI, nodeAPI, nodeNodeAPI, nodesAPI, roots)
-import Gargantext.API.Node qualified as Tree
 import Gargantext.API.Node.Contact as Contact
 import Gargantext.API.Node.Corpus.Export qualified as CorpusExport
 import Gargantext.API.Node.Corpus.Subcorpus qualified as Subcorpus
 import Gargantext.API.Node.Document.Export (documentExportAPI)
 import Gargantext.API.Node.Phylo.Export qualified as PhyloExport
+import Gargantext.API.Node qualified as Tree
 import Gargantext.API.Node.ShareURL ( shareURL )
 import Gargantext.API.Prelude (GargM)
 import Gargantext.API.Routes (addCorpusWithForm, addCorpusWithQuery)
 import Gargantext.API.Routes.Named.Private qualified as Named
-import Gargantext.API.Server.Named.Ngrams (apiNgramsTableDoc)
+import Gargantext.API.Server.Named.Ngrams
 import Gargantext.API.Server.Named.Viz qualified as Viz
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny)

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

+{-# LANGUAGE BangPatterns        #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE ViewPatterns        #-}
+
+module Gargantext.API.Server.Named.Remote (
+    remoteExportAPI
+  , remoteImportAPI
+  ) where
+
+import Codec.Serialise
+import Conduit
+import Control.Exception.Safe qualified as Safe
+import Control.Exception (toException)
+import Control.Lens (view, (#), (^.))
+import Control.Monad.Except (throwError, MonadError)
+import Control.Monad (void, forM_)
+import Data.Aeson qualified as JSON
+import Data.Aeson.Types qualified as JS
+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 (for_, foldlM)
+import Data.List qualified as List
+import Data.List.Split qualified as Split
+import Data.Monoid
+import Data.String (IsString(..))
+import Data.Text.Encoding  qualified as TE
+import Data.Text qualified as T
+import Gargantext.API.Admin.Auth
+import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
+import Gargantext.API.Auth.PolicyCheck (remoteExportChecks)
+import Gargantext.API.Errors.Types
+import Gargantext.API.Ngrams.Prelude (getNgramsList)
+import Gargantext.API.Ngrams.Types (NgramsList)
+import Gargantext.API.Node.Document.Export (get_document_json)
+import Gargantext.API.Node.Document.Export.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.Config.Types (f_write_url)
+import Gargantext.Core (lookupDBid)
+import Gargantext.Core.NLP (HasNLPServer)
+import Gargantext.Core.NodeStory.Types (HasNodeStoryEnv, HasNodeArchiveStoryImmediateSaver)
+import Gargantext.Core.Types.Main
+import Gargantext.Core.Worker.Jobs (sendJob)
+import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
+import Gargantext.Database.Admin.Types.Hyperdata.Default (DefaultHyperdata(..))
+import Gargantext.Database.Admin.Types.Hyperdata.Frame (HyperdataFrame(..))
+import Gargantext.Database.Admin.Types.Node hiding (ERROR, WARNING, INFO)
+import Gargantext.Database.Prelude (IsDBCmd)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError, nodeError, NodeError (..))
+import Gargantext.Database.Query.Table.Node (insertNodeWithHyperdata, getNodes, getUserRootPrivateNode)
+import Gargantext.Database.Query.Table.Node qualified as DB
+import Gargantext.Database.Schema.Node (NodePoly(..))
+import Gargantext.Orphans ()
+import Gargantext.System.Logging (logLocM, LogLevel(..), MonadLogger)
+import GHC.Generics (Generic)
+import Network.HTTP.Client qualified as HTTP
+import Network.HTTP.Types.Header qualified as HTTP
+import Prelude
+import Servant.Client.Streaming (mkClientEnv, withClientM, ClientError)
+import Servant.Server.Generic (AsServerT)
+
+data ExportableNode =
+    EN_corpus (Node JSON.Value)
+  | EN_graph (Node JSON.Value)
+  | EN_phylo (Node JSON.Value)
+    -- | If this node is a \"docs\" node, remotely export also
+    -- all the associated documents.
+  | EN_document (Node JSON.Value) DocumentExport
+    -- | If this node is a \"terms\" node, remotely export also
+    -- all the associated ngrams
+  | EN_terms    (Node JSON.Value) NgramsList
+  -- | For notes nodes we don't have any node to import
+  -- because all the details about the frame service
+  -- would be different at the destination, and have
+  -- to be recomputed from scratch.
+  | EN_notes T.Text
+  deriving Generic
+
+renderExportableNode :: ExportableNode -> T.Text
+renderExportableNode = \case
+  EN_corpus{}   -> "corpus node"
+  EN_graph{}    -> "graph node"
+  EN_phylo{}    -> "phylo node"
+  EN_document{} -> "document node"
+  EN_terms{}    -> "terms node"
+  EN_notes{}    -> "nodes node"
+
+instance Serialise ExportableNode where
+
+remoteExportAPI :: (MonadIO m, IsGargServer env BackendInternalError m, HasNodeArchiveStoryImmediateSaver env)
+                => NodeId
+                -> AuthenticatedUser
+                -> Named.RemoteExportAPI (AsServerT m)
+remoteExportAPI nodeId authenticatedUser =
+  Named.RemoteExportAPI
+    { remoteExportEp = \payload mgr ->
+        withPolicy authenticatedUser (remoteExportChecks nodeId) (remoteExportHandler nodeId authenticatedUser payload) mgr
+    }
+
+remoteImportAPI :: (MonadIO m, IsGargServer env BackendInternalError m, HasNodeArchiveStoryImmediateSaver env)
+                => AuthenticatedUser
+                -> Named.RemoteImportAPI (AsServerT m)
+remoteImportAPI authenticatedUser =
+  Named.RemoteImportAPI
+    { remoteImportEp = remoteImportHandler authenticatedUser }
+
+type ExpectedPayload = Tree ExportableNode
+
+remoteImportHandler :: forall err env m.
+                    ( HasNodeStoryEnv env
+                    , HasNodeError err
+                    , HasBackendInternalError err
+                    , HasNodeArchiveStoryImmediateSaver env
+                    , IsDBCmd env err m
+                    , HasNLPServer env
+                    , MonadLogger m
+                    , HasConfig env
+                    , HasManager env
+                    , MonadIO m)
+                    => AuthenticatedUser
+                    -> ConduitT () Named.RemoteBinaryData IO ()
+                    -> m [NodeId]
+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 (TreeN x xs) -> do
+      $(logLocM) INFO $ "Importing " <> renderExportableNode x
+      -- NOTE(adn) By default, we append the imported node(s) to the user's
+      -- private folder.
+      privateFolderId <- _node_id <$> getUserRootPrivateNode (_auth_user_id loggedInUser)
+      $(logLocM) INFO $ "Attaching " <> renderExportableNode x <> " to private folder " <> T.pack (show privateFolderId)
+      -- Attempts to insert nodes a we go along.
+      rootNode <- insertNode (Just privateFolderId) x
+      nodes <- foldlM (insertTrees (Just rootNode)) [rootNode] xs
+      $(logLocM) INFO $ "Successfully imported all the requested nodes."
+      pure nodes
+  where
+
+    insertNode :: Maybe NodeId -> ExportableNode -> m NodeId
+    insertNode mb_parent exported_node = case exported_node of
+      EN_corpus x -> insertSimple mb_parent x
+
+      EN_graph x  -> insertSimple mb_parent x
+
+      EN_phylo x  -> insertSimple mb_parent x
+
+      EN_notes noteAsMarkdown -> do
+        case mb_parent of
+          Nothing ->
+            throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "No parent id found, I cannot attach this note.")
+          Just parentId -> do
+            $(logLocM) INFO $ "Found some markdown notes to import..."
+            -- NOTE: Unfortunately we cannot rely on the settings that the hyperdata frame
+            -- is sending us, because both the frame Id and the base URL would be different
+            -- on the target instance.
+            mgr <- view gargHttpManager
+            cfg <- view hasConfig
+            newHyperdataFrame <- importNote mgr noteAsMarkdown cfg
+            -- TODO(adn) Import with the valid name.
+            new_node <- DB.insertNode Notes (Just "Imported note")
+                                            (Just $ DefaultFrameCode newHyperdataFrame) parentId (_auth_user_id loggedInUser)
+            pure new_node
+
+      EN_document x docsList -> case lookupDBid $ _node_typename x of
+        Nothing -> throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "remoteImportHandler: impossible, node with invalid type.")
+        Just ty -> do
+          new_node <- insertNodeWithHyperdata ty (_node_name x) (_node_hyperdata x) mb_parent (_auth_user_id loggedInUser)
+          $(logLocM) INFO $ "Created a new node " <> T.pack (show $ new_node) <> " of type " <> T.pack (show ty)
+          for_ mb_parent $ \parentId -> do
+            $(logLocM) INFO $ "Found document list to import..."
+            let totalDocs = _de_documents docsList
+            let chunks = Split.chunksOf 100 totalDocs
+            forM_ (zip [1..] chunks) $ \(local_ix, chunk) -> do
+              let ws = Jobs.WorkSplit
+                    { Jobs._ws_current = min (length totalDocs) (((local_ix - 1) * length chunk) + length chunk)
+                    , Jobs._ws_total   = length totalDocs
+                    }
+              let payload = Jobs.ImportRemoteDocumentsPayload loggedInUser parentId new_node chunk ws
+              void $ sendJob $ Jobs.ImportRemoteDocuments payload
+          pure new_node
+      EN_terms x ngramsList -> case lookupDBid $ _node_typename x of
+        Nothing -> throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "remoteImportHandler: impossible, node with invalid type.")
+        Just ty -> do
+          new_node <- insertNodeWithHyperdata ty (_node_name x) (_node_hyperdata x) mb_parent (_auth_user_id loggedInUser)
+          $(logLocM) INFO $ "Created a new node " <> T.pack (show $ new_node) <> " of type " <> T.pack (show ty)
+          $(logLocM) INFO $ "Found ngrams list to import..."
+          void $ sendJob $ Jobs.ImportRemoteTerms $ Jobs.ImportRemoteTermsPayload new_node ngramsList
+          pure new_node
+
+    insertSimple :: Maybe ParentId -> Node JSON.Value -> m NodeId
+    insertSimple mb_parent x = case lookupDBid $ _node_typename x of
+      Nothing -> throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "remoteImportHandler: impossible, node with invalid type.")
+      Just ty -> do
+        new_node <- insertNodeWithHyperdata ty (_node_name x) (_node_hyperdata x) mb_parent (_auth_user_id loggedInUser)
+        $(logLocM) INFO $ "Created a new node " <> T.pack (show $ new_node) <> " of type " <> T.pack (show ty)
+        pure new_node
+
+    insertTrees :: Maybe NodeId -> [NodeId] -> Tree ExportableNode -> m [NodeId]
+    insertTrees currentParent !acc (TreeN x xs) = do
+      childrenRoot <- insertNode currentParent x
+      (`mappend` acc) <$> foldlM (insertTrees (Just childrenRoot)) [childrenRoot] xs
+
+remoteExportHandler :: ( MonadIO m, Safe.MonadCatch m
+                       , IsGargServer err env m
+                       )
+                    => NodeId
+                    -> AuthenticatedUser
+                    -> Named.RemoteExportRequest
+                    -> m [NodeId]
+remoteExportHandler _rer_node_id loggedInUser Named.RemoteExportRequest{..} = do
+  mgr  <- view gargHttpManager
+  nodes <- getNodes _rer_node_id
+  checkNodesTypeAllowed nodes
+  exportable <- makeExportable (_auth_node_id loggedInUser) nodes
+  liftIO (withClientM (remoteImportClient _rer_instance_auth (streamEncoder exportable)) (mkClientEnv mgr _rer_instance_url) streamDecode)
+              `Safe.catch` \(e :: BackendInternalError) -> throwError $ _BackendInternalError # e
+
+makeExportable :: (MonadIO m, IsGargServer err env m)
+               => NodeId
+               -> Tree (Node JSON.Value)
+               -> m (Tree ExportableNode)
+makeExportable userNodeId (TreeN x xs)
+  | Just nty <- lookupDBid (_node_typename x)
+  = do
+    exportableRoot <- case nty of
+      NodeCorpus -> EN_corpus   <$> pure x
+      NodeGraph  -> EN_graph    <$> pure x
+      NodePhylo  -> EN_phylo    <$> pure x
+      NodeTexts  -> EN_document <$> pure x <*> get_document_json userNodeId (_node_id x)
+      NodeList   -> EN_terms    <$> pure x <*> getNgramsList (_node_id x)
+      Notes      -> case JS.parseMaybe JS.parseJSON (_node_hyperdata x) of
+        Nothing
+          -> mk_err " invalid HyperdataFrame inside."
+        Just hframe
+          -> do
+            mgr  <- view gargHttpManager
+            exportNote mgr hframe
+      _         -> mk_err $ "invalid (unsupported) note type: " <> show nty
+    children <- mapM (makeExportable userNodeId) xs
+    pure $ TreeN exportableRoot children
+  | otherwise
+  = throwError $ _BackendInternalError
+               # InternalUnexpectedError (toException $ userError $ "remoteImportHandler: impossible, node with invalid type.")
+  where
+   mk_err msg =
+     throwError $ _BackendInternalError
+                # InternalUnexpectedError (toException $ userError $ "remoteImportHandler: impossible, node with " <> msg)
+
+exportNote :: ( IsGargServer err env m, MonadIO m, MonadLogger m)
+           => HTTP.Manager -> HyperdataFrame -> m ExportableNode
+exportNote mgr HyperdataFrame{..} = do
+  let download_url = _hf_base <> "/" <> _hf_frame_id <> "/download"
+  case HTTP.parseRequest (T.unpack download_url) of
+    Left err -> do
+      let msg = "Couldn't extract a valid URL from " <> download_url <> ", " <> T.pack (show err)
+      $(logLocM) ERROR msg
+      mk_err (T.unpack msg)
+    Right rq -> do
+      res <- HTTP.responseBody <$> liftIO (HTTP.httpLbs rq mgr)
+      pure $ EN_notes (TE.decodeUtf8 $ BL.toStrict $ res)
+  where
+   mk_err msg =
+     throwError $ _BackendInternalError
+                # InternalUnexpectedError (toException $ userError $ "exportNote: " <> msg)
+
+importNote :: (MonadIO m, MonadLogger m, HasBackendInternalError err, IsDBCmd env err m)
+           => HTTP.Manager
+           -> T.Text
+           -> GargConfig
+           -> m HyperdataFrame
+importNote mgr rawText cfg = do
+  let _hf_base = cfg ^. gc_frames . f_write_url
+  case HTTP.parseRequest (T.unpack _hf_base `appendPath` "/new") of
+    Left err -> do
+      let msg = "Couldn't extract a valid URL from " <> _hf_base <> ", " <> T.pack (show err)
+      $(logLocM) ERROR msg
+      mk_err (T.unpack msg)
+    Right rq0 -> do
+      let rq = rq0 { HTTP.method = "POST"
+                   , HTTP.requestHeaders = textMarkdown : (HTTP.requestHeaders rq0)
+                   , HTTP.requestBody = HTTP.RequestBodyBS (TE.encodeUtf8 rawText)
+                   }
+      -- The response will contain (in the redirects) the new path to the notes, where the last fragment
+      -- is the frameId
+      res <- liftIO $ HTTP.withResponseHistory rq mgr $ \redirects -> do
+        let allLocations = map (First . List.lookup HTTP.hLocation . HTTP.responseHeaders . snd) (HTTP.hrRedirects redirects)
+        case getFirst $ mconcat allLocations of
+          Nothing -> pure mempty
+          Just x  -> pure x
+      let _hf_frame_id = snd $ T.breakOnEnd "/" (TE.decodeUtf8 res)
+      pure $ HyperdataFrame{..}
+  where
+   mk_err msg =
+     throwError $ _BackendInternalError
+                # InternalUnexpectedError (toException $ userError $ "importNote: " <> msg)
+
+   textMarkdown :: HTTP.Header
+   textMarkdown = (HTTP.hContentType, fromString "text/markdown")
+
+-- | Append two URL paths together. The second argument must be given with an initial '/',
+-- and must be non-null.
+appendPath :: String -> String -> String
+appendPath t r = case List.last t of
+  '/' -> t <> List.tail r
+  _   -> t <> r
+
+checkNodesTypeAllowed :: (MonadError e m, HasNodeError e) => Tree (Node a) -> m ()
+checkNodesTypeAllowed (TreeN r xs) = do
+  checkNodeTypeAllowed r
+  mapM_ checkNodesTypeAllowed xs
+
+checkNodeTypeAllowed :: (MonadError e m, HasNodeError e) => Node a -> m ()
+checkNodeTypeAllowed n
+  | Just nty <- lookupDBid (_node_typename n)
+  , nty `elem` exportableNodeTypes
+  = pure ()
+  | otherwise
+  = let msg = "It's possible to export only the following node of type: " <> T.intercalate "," (map (T.pack . show) exportableNodeTypes)
+    in nodeError $ NodeNotExportable (_node_id n) msg
+
+-- | At the moment we support only export corpus nodes and their children (i.e. "Docs", "Terms", "Graph").
+exportableNodeTypes :: [NodeType]
+exportableNodeTypes = [ NodeCorpus, NodeCorpusV3, NodeTexts, NodeGraph, NodeList, NodePhylo, Notes ]
+
+streamEncoder :: MonadIO m => ExpectedPayload -> ConduitT () Named.RemoteBinaryData m ()
+streamEncoder = CL.sourceList . map Named.RemoteBinaryData . BL.toChunks . serialise
+
+-- | Returns a conduit which can be used to decode
+streamDecode :: Either ClientError [NodeId] -> IO [NodeId]
+streamDecode = \case
+  Left err -> Safe.throwIO $ InternalUnexpectedError (toException $ userError $ show err)
+  Right x  -> pure x

src/Gargantext/API/ThrowAll.hs

@@ -30,6 +30,7 @@ import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Prelude (GargM, _ServerError)
 import Gargantext.API.Routes.Named.Private qualified as Named
+import Gargantext.API.Routes.Named.Remote () -- instance MimeUnrenderer
 import Gargantext.API.Server.Named.Private qualified as Named
 import Gargantext.Database.Admin.Types.Node (UserId (..))
 import Gargantext.Prelude hiding (Handler)
@@ -37,6 +38,7 @@ import Network.HTTP.Types.Status (Status(..))
 import Network.Wai (responseLBS)
 import Servant
 import Servant.Auth.Server (AuthResult(..))
+import Servant.Conduit ()
 import Servant.Server.Generic (AsServerT)
 
 -- | Slightly more general version of the 'ThrowAll' typeclass from Servant,

src/Gargantext/Core.hs

@@ -57,6 +57,8 @@ data Lang = DE
           | ZH
   deriving (Read, Show, Eq, Ord, Enum, Bounded, Generic, GQLType)
 
+instance NFData Lang where
+
 -- | Defaults to 'EN' in all those places where a language is mandatory,
 -- but an optional one has been passed.
 withDefaultLanguage :: Maybe Lang -> Lang

src/Gargantext/Core/Config.hs

@@ -35,6 +35,7 @@ module Gargantext.Core.Config (
 
   , HasJWTSettings(..)
   , HasConfig(..)
+  , HasManager(..)
   ) where
 
 import Control.Lens (Getter)
@@ -46,6 +47,7 @@ import Gargantext.Core.Config.NLP (NLPConfig)
 import Gargantext.Core.Config.Worker (WorkerSettings)
 import Gargantext.Core.Config.Types
 import Gargantext.Prelude
+import Network.HTTP.Client qualified as HTTP
 import Servant.Auth.Server (JWTSettings)
 import Servant.Client (BaseUrl(..), Scheme(Http), parseBaseUrl)
 import Toml.Schema
@@ -134,3 +136,6 @@ instance HasConfig GargConfig where
 
 class HasJWTSettings env where
   jwtSettings :: Getter env JWTSettings
+
+class HasManager env where
+  gargHttpManager :: Getter env HTTP.Manager

src/Gargantext/Core/Text/Ngrams.hs

@@ -88,6 +88,7 @@ data Ngrams = UnsafeNgrams { _ngramsTerms :: Text
   deriving (Generic, Show, Eq, Ord)
 
 instance Hashable Ngrams
+instance Serialise Ngrams where
 
 makeLenses ''Ngrams
 instance PGS.ToRow Ngrams where

src/Gargantext/Core/Types.hs

@@ -185,6 +185,8 @@ $(deriveJSON (unPrefix "tr_") ''TableResult)
 instance (Typeable a, ToSchema a) => ToSchema (TableResult a) where
   declareNamedSchema = wellNamedSchema "tr_"
 
+instance NFData a => NFData (TableResult a) where
+
 ----------------------------------------------------------------------------
 data Typed a b =
   Typed { _withType :: a

src/Gargantext/Core/Types/Individu.hs

@@ -57,7 +57,9 @@ instance Prelude.Show GargPassword where
 instance ToJSON GargPassword
 instance FromJSON GargPassword
 
-instance ToSchema GargPassword
+instance ToSchema GargPassword where
+  declareNamedSchema _ = pure $ NamedSchema (Just "GargPassword") passwordSchema
+
 type Email          = Text
 type UsernameMaster = Username
 type UsernameSimple = Username

src/Gargantext/Core/Types/Main.hs

@@ -13,11 +13,13 @@ Portability : POSIX
 
 {-# LANGUAGE TemplateHaskell     #-}
 {-# LANGUAGE DeriveAnyClass      #-}
+{-# LANGUAGE BangPatterns #-}
 
 -----------------------------------------------------------------------
 module Gargantext.Core.Types.Main where
 ------------------------------------------------------------------------
 
+import Codec.Serialise.Class
 import Data.Bimap (Bimap)
 import Data.Bimap qualified as Bimap
 import Data.Swagger ( ToSchema(..), ToParamSchema, genericDeclareNamedSchema )
@@ -29,8 +31,8 @@ import Gargantext.Core.Utils.Swagger (wellNamedSchema)
 import Gargantext.Database.Admin.Types.Node  -- (NodeType(..), Node, Hyperdata(..))
 import Gargantext.Prelude
 import Servant.API (FromHttpApiData(..), ToHttpApiData(..))
-import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import Test.QuickCheck (elements)
 
 type CorpusName = Text
 ------------------------------------------------------------------------
@@ -40,6 +42,8 @@ data NodeTree = NodeTree { _nt_name           :: Text
                          , _nt_publish_policy :: Maybe NodePublishPolicy
                          } deriving (Show, Read, Generic)
 
+instance NFData NodeTree where
+
 instance Eq NodeTree where
   (==) d1 d2 = _nt_id d1 == _nt_id d2
 
@@ -56,6 +60,7 @@ type TypeId     = Int
 data ListType  =  CandidateTerm | StopTerm | MapTerm
   deriving (Generic, Eq, Ord, Show, Read, Enum, Bounded, ToExpr)
 
+instance NFData ListType where
 instance ToJSON   ListType
 instance FromJSON ListType
 instance ToSchema ListType
@@ -115,6 +120,44 @@ fromListTypeId = flip Bimap.lookupR listTypeIds
 data Tree a = TreeN { _tn_node :: a, _tn_children :: [Tree a] }
   deriving (Show, Read, Eq, Generic, Ord)
 
+instance Serialise a => Serialise (Tree a) where
+
+instance NFData a => NFData (Tree a) where
+
+instance Functor Tree where
+    fmap = fmapTree
+    x <$ TreeN _ ts = TreeN x (map (x <$) ts)
+
+fmapTree :: (a -> b) -> Tree a -> Tree b
+fmapTree f (TreeN x ts) = TreeN (f x) (map (fmapTree f) ts)
+
+instance Traversable Tree where
+  traverse f = go
+    where go (TreeN x ts) = liftA2 TreeN (f x) (traverse go ts)
+  {-# INLINE traverse #-}
+
+instance Foldable Tree where
+    fold = foldMap identity
+    {-# INLINABLE fold #-}
+
+    foldMap = foldMapDefault
+    {-# INLINE foldMap #-}
+
+    foldr f z = \t -> go t z  -- Use a lambda to allow inlining with two arguments
+      where
+        go (TreeN x ts) = f x . foldr (\t k -> go t . k) identity ts
+    {-# INLINE foldr #-}
+
+    foldl' f = go
+      where go !z (TreeN x ts) = foldl' go (f z x) ts
+    {-# INLINE foldl' #-}
+
+    null _ = False
+    {-# INLINE null #-}
+
+    elem = any . (==)
+    {-# INLINABLE elem #-}
+
 $(deriveJSON (unPrefix "_tn_") ''Tree)
 
 instance (Typeable a, ToSchema a) => ToSchema (Tree a) where

src/Gargantext/Core/Worker.hs

@@ -26,14 +26,15 @@ import Data.Text qualified as T
 import Gargantext.API.Admin.Auth (forgotUserPassword)
 import Gargantext.API.Admin.Auth.Types (ForgotPasswordAsyncParams(..))
 import Gargantext.API.Ngrams.List (postAsyncJSON)
-import Gargantext.API.Node.Corpus.Annuaire qualified as Annuaire
 import Gargantext.API.Node.Contact (addContact)
+import Gargantext.API.Node.Corpus.Annuaire qualified as Annuaire
 import Gargantext.API.Node.Corpus.New (addToCorpusWithForm, addToCorpusWithQuery)
 import Gargantext.API.Node.DocumentsFromWriteNodes (documentsFromWriteNodes)
-import Gargantext.API.Node.DocumentUpload (documentUploadAsync)
-import Gargantext.API.Node.FrameCalcUpload (frameCalcUploadAsync)
+import Gargantext.API.Node.DocumentUpload (documentUploadAsync, remoteImportDocuments)
 import Gargantext.API.Node.File (addWithFile)
+import Gargantext.API.Node.FrameCalcUpload (frameCalcUploadAsync)
 import Gargantext.API.Node.New (postNode')
+import Gargantext.API.Node.Update.Types (UpdateNodeParams(..), Granularity (..))
 import Gargantext.API.Node.Update (updateNode)
 import Gargantext.API.Server.Named.Ngrams (tableNgramsPostChartsAsync)
 import Gargantext.Core.Config (hasConfig, gc_database_config, gc_jobs, gc_notifications_config, gc_worker)
@@ -44,8 +45,8 @@ import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
 import Gargantext.Core.Viz.Graph.API (graphRecompute)
 import Gargantext.Core.Worker.Broker (initBrokerWithDBCreate)
 import Gargantext.Core.Worker.Env
+import Gargantext.Core.Worker.Jobs.Types (Job(..), getWorkerMNodeId, ImportRemoteDocumentsPayload(..), ImportRemoteTermsPayload(..))
 import Gargantext.Core.Worker.PGMQTypes (BrokerMessage, HasWorkerBroker, WState)
-import Gargantext.Core.Worker.Jobs.Types (Job(..), getWorkerMNodeId)
 import Gargantext.Core.Worker.Types (JobInfo(..))
 import Gargantext.Database.Query.Table.User (getUsersWithEmail)
 import Gargantext.Prelude hiding (to)
@@ -296,3 +297,19 @@ performAction env _state bm = do
     UploadDocument { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] upload document"
       void $ documentUploadAsync _ud_node_id _ud_args jh
+
+    -- | Remotely import documents
+    ImportRemoteTerms (ImportRemoteTermsPayload list_id ngrams_list)
+      -> runWorkerMonad env $ do
+           $(logLocM) DEBUG $ "[performAction] import remote terms"
+           void $ postAsyncJSON list_id ngrams_list jh
+           -- Trigger an 'UpdateNode' job to update the score(s)
+           $(logLocM) DEBUG $ "Updating node scores for corpus node " <> T.pack (show list_id)
+           void $ updateNode list_id (UpdateNodeParamsTexts Both) jh
+           $(logLocM) DEBUG $ "Done updating node scores for corpus node " <> T.pack (show list_id)
+
+    -- | Remotely import documents
+    ImportRemoteDocuments (ImportRemoteDocumentsPayload loggedInUser parentId corpusId docs workSplit)
+      -> runWorkerMonad env $ do
+           $(logLocM) DEBUG $ "[performAction] import remote documents"
+           void $ remoteImportDocuments loggedInUser parentId corpusId workSplit docs

src/Gargantext/Core/Worker/Jobs.hs

@@ -61,6 +61,8 @@ updateJobData (NgramsPostCharts {}) sj = sj { W.timeout = 3000 }
 updateJobData (RecomputeGraph {}) sj = sj { W.timeout = 3000 }
 updateJobData (UpdateNode {}) sj = sj { W.timeout = 3000 }
 updateJobData (UploadDocument {}) sj = sj { W.timeout = 3000 }
+updateJobData (ImportRemoteDocuments {}) sj = sj { W.timeout = 3000 }
+updateJobData (ImportRemoteTerms {}) sj = sj { W.timeout = 3000 }
 -- | ForgotPasswordAsync, PostNodeAsync
 updateJobData _ sj = sj { W.resendOnKill = False
                         , W.timeout = 60 }

src/Gargantext/Core/Worker/Jobs/Types.hs

@@ -9,26 +9,92 @@ Portability : POSIX
 
 -}
 
+{-# LANGUAGE TypeApplications #-}
 
 module Gargantext.Core.Worker.Jobs.Types where
 
 
 import Data.Aeson ((.:), (.=), object, withObject)
 import Data.Aeson.Types (prependFailure, typeMismatch)
+import Data.Aeson qualified as JS
+import Data.Aeson.KeyMap qualified as KM
+import Data.Text qualified as T
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser, ForgotPasswordAsyncParams)
 import Gargantext.API.Ngrams.Types (NgramsList, UpdateTableNgramsCharts(_utn_list_id))
-import Gargantext.API.Node.Corpus.Annuaire (AnnuaireWithForm)
 import Gargantext.API.Node.Contact.Types (AddContactParams)
+import Gargantext.API.Node.Corpus.Annuaire (AnnuaireWithForm)
+import Gargantext.API.Node.Document.Export.Types (Document)
 import Gargantext.API.Node.DocumentsFromWriteNodes.Types qualified as DFWN
 import Gargantext.API.Node.DocumentUpload.Types (DocumentUpload)
 import Gargantext.API.Node.FrameCalcUpload.Types (FrameCalcUpload)
 import Gargantext.API.Node.New.Types ( PostNode(..) )
-import Gargantext.API.Node.Update.Types (UpdateNodeParams)
 import Gargantext.API.Node.Types (NewWithFile, NewWithForm, WithQuery(..))
+import Gargantext.API.Node.Update.Types (UpdateNodeParams)
 import Gargantext.Core.Types.Individu (User)
-import Gargantext.Database.Admin.Types.Node (AnnuaireId, CorpusId, ListId, NodeId(UnsafeMkNodeId))
+import Gargantext.Database.Admin.Types.Node (AnnuaireId, CorpusId, ListId, NodeId(UnsafeMkNodeId), ParentId)
 import Gargantext.Prelude
 
+data ImportRemoteTermsPayload
+  = ImportRemoteTermsPayload
+  { _irtp_list_id     :: ListId
+  , _irtp_ngrams_list :: NgramsList
+  } deriving (Show, Eq)
+
+instance ToJSON ImportRemoteTermsPayload where
+  toJSON ImportRemoteTermsPayload{..} =
+    object [ "list_id"     .= _irtp_list_id
+           , "ngrams_list" .= _irtp_ngrams_list
+           ]
+
+instance FromJSON ImportRemoteTermsPayload where
+  parseJSON = withObject "ImportRemoteTermsPayload" $ \o -> do
+    _irtp_list_id     <- o .: "list_id"
+    _irtp_ngrams_list <- o .: "ngrams_list"
+    pure ImportRemoteTermsPayload{..}
+
+data WorkSplit
+  = WorkSplit { _ws_current :: Int, _ws_total :: Int }
+  deriving (Show, Eq)
+
+instance ToJSON WorkSplit where
+  toJSON WorkSplit{..} =
+    object [ "current" .= _ws_current
+           , "total"   .= _ws_total
+           ]
+
+instance FromJSON WorkSplit where
+  parseJSON = withObject "WorkSplit" $ \o -> do
+    _ws_current <- o .: "current"
+    _ws_total   <- o .: "total"
+    pure WorkSplit{..}
+
+data ImportRemoteDocumentsPayload
+  = ImportRemoteDocumentsPayload
+  { _irdp_user :: AuthenticatedUser
+  , _irdp_parent_id :: ParentId
+  , _irdp_corpus_id :: NodeId
+  , _irdp_documents :: [Document]
+  -- | Useful to compute total progress in logs.
+  , _irdp_work_split :: WorkSplit
+  } deriving (Show, Eq)
+
+instance ToJSON ImportRemoteDocumentsPayload where
+  toJSON ImportRemoteDocumentsPayload{..} =
+    object [ "user" .= _irdp_user
+           , "corpus_id" .= _irdp_corpus_id
+           , "parent_id" .= _irdp_parent_id
+           , "documents" .= _irdp_documents
+           , "work_split" .= _irdp_work_split
+           ]
+
+instance FromJSON ImportRemoteDocumentsPayload where
+  parseJSON = withObject "ImportRemoteDocumentsPayload" $ \o -> do
+    _irdp_user <- o .: "user"
+    _irdp_parent_id <- o .: "parent_id"
+    _irdp_corpus_id <- o .: "corpus_id"
+    _irdp_documents <- o .: "documents"
+    _irdp_work_split <- o .: "work_split"
+    pure ImportRemoteDocumentsPayload{..}
 
 data Job =
     Ping
@@ -65,6 +131,8 @@ data Job =
                , _un_args    :: UpdateNodeParams }
   | UploadDocument { _ud_node_id :: NodeId
                    , _ud_args    :: DocumentUpload }
+  | ImportRemoteDocuments !ImportRemoteDocumentsPayload
+  | ImportRemoteTerms     !ImportRemoteTermsPayload
   deriving (Show, Eq)
 instance FromJSON Job where
   parseJSON = withObject "Job" $ \o -> do
@@ -132,6 +200,10 @@ instance FromJSON Job where
         _ud_node_id <- o .: "node_id"
         _ud_args <- o .: "args"
         return $ UploadDocument { .. }
+      "ImportRemoteDocuments" ->
+        ImportRemoteDocuments <$> parseJSON (JS.Object o)
+      "ImportRemoteTerms" ->
+        ImportRemoteTerms <$> parseJSON (JS.Object o)
       s -> prependFailure "parsing job type failed, " (typeMismatch "type" s)
 instance ToJSON Job where
   toJSON Ping = object [ "type" .= ("Ping" :: Text) ]
@@ -196,10 +268,18 @@ instance ToJSON Job where
     object [ "type" .= ("UploadDocument" :: Text)
            , "node_id" .= _ud_node_id
            , "args" .= _ud_args ]
-
-
-
-
+  toJSON (ImportRemoteDocuments payload) =
+    case toJSON payload of
+      (JS.Object o) ->
+        let o1 = KM.fromList [ ("type", toJSON @T.Text "ImportRemoteDocuments") ]
+        in JS.Object $ o1 <> o
+      _ -> errorTrace "impossible, toJSON ImportRemoteDocuments did not return an Object."
+  toJSON (ImportRemoteTerms payload) =
+    case toJSON payload of
+      (JS.Object o) ->
+        let o1 = KM.fromList [ ("type", toJSON @T.Text "ImportRemoteTerms") ]
+        in JS.Object $ o1 <> o
+      _ -> errorTrace "impossible, toJSON ImportRemoteTerms did not return an Object."
 
 -- | We want to have a way to specify 'Maybe NodeId' from given worker
 -- parameters. The given 'Maybe CorpusId' is an alternative, when
@@ -223,3 +303,5 @@ getWorkerMNodeId (PostNodeAsync { _pna_node_id }) = Just _pna_node_id
 getWorkerMNodeId (RecomputeGraph { _rg_node_id }) = Just _rg_node_id
 getWorkerMNodeId (UpdateNode { _un_node_id }) = Just _un_node_id
 getWorkerMNodeId (UploadDocument { _ud_node_id }) = Just _ud_node_id
+getWorkerMNodeId (ImportRemoteDocuments (ImportRemoteDocumentsPayload _ _ corpusId _ _)) = Just corpusId
+getWorkerMNodeId (ImportRemoteTerms (ImportRemoteTermsPayload listId _)) = Just listId

src/Gargantext/Core/Worker/Types.hs

+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-|
 Module      : Gargantext.Core.Worker.Types
 Description : Some useful worker types
@@ -36,4 +38,4 @@ instance FromJSON JobInfo where
 instance ToJSON JobInfo where
   toJSON (JobInfo { .. }) = object [ "message_id" .= _ji_message_id 
                                    , "node_id"    .= _ji_mNode_id ]
-
+instance NFData JobInfo

src/Gargantext/Database/Admin/Types/Hyperdata/Any.hs

@@ -21,6 +21,8 @@ import Gargantext.Database.Admin.Types.Hyperdata.Prelude
 newtype HyperdataAny = HyperdataAny Object
   deriving (Show, Generic, ToJSON, FromJSON)
 
+instance NFData HyperdataAny
+
 ------------------------------------------------------------------------
 -- Instances
 ------------------------------------------------------------------------

src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs

@@ -39,6 +39,8 @@ data HyperdataContact =
 instance GQLType HyperdataContact where
   directives _ = typeDirective DropNamespace { dropNamespace = "_hc_" }
 
+instance NFData HyperdataContact where
+
 instance HasText HyperdataContact
   where
     hasText = undefined
@@ -83,7 +85,7 @@ arbitraryHyperdataContact =
     , _hc_lastValidation = Nothing }
 
 
-data ContactWho = 
+data ContactWho =
   ContactWho { _cw_id          :: Maybe Text
              , _cw_firstName   :: Maybe Text
              , _cw_lastName    :: Maybe Text
@@ -95,6 +97,8 @@ data ContactWho =
 instance GQLType ContactWho where
   directives _ = typeDirective DropNamespace { dropNamespace = "_cw_" }
 
+instance NFData ContactWho where
+
 type FirstName = Text
 type LastName  = Text
 
@@ -113,15 +117,11 @@ contactWho fn ln =
 data ContactWhere =
   ContactWhere { _cw_organization :: [Text]
                , _cw_labTeamDepts :: [Text]
-               
                , _cw_role         :: Maybe Text
-               
                , _cw_office       :: Maybe Text
                , _cw_country      :: Maybe Text
                , _cw_city         :: Maybe Text
-               
                , _cw_touch        :: Maybe ContactTouch
-               
                , _cw_entry        :: Maybe NUTCTime
                , _cw_exit         :: Maybe NUTCTime
   } deriving (Eq, Show, Generic)
@@ -129,6 +129,8 @@ data ContactWhere =
 instance GQLType ContactWhere where
   directives _ = typeDirective DropNamespace { dropNamespace = "_cw_" }
 
+instance NFData ContactWhere where
+
 defaultContactWhere :: ContactWhere
 defaultContactWhere =
   ContactWhere
@@ -151,6 +153,8 @@ data ContactTouch =
 instance GQLType ContactTouch where
   directives _ = typeDirective DropNamespace { dropNamespace = "_ct_" }
 
+instance NFData ContactTouch where
+
 defaultContactTouch :: ContactTouch
 defaultContactTouch =
   ContactTouch

src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs

@@ -17,6 +17,7 @@ import Gargantext.Prelude hiding (ByteString)
 import Gargantext.Core.Text (HasText(..))
 import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+import Codec.Serialise.Class hiding (decode)
 
 ------------------------------------------------------------------------
 data HyperdataDocument = HyperdataDocument { _hd_bdd                :: !(Maybe Text)
@@ -40,6 +41,8 @@ data HyperdataDocument = HyperdataDocument { _hd_bdd                :: !(Maybe T
                                            }
   deriving (Show, Generic)
 
+instance NFData HyperdataDocument
+instance Serialise HyperdataDocument
 
 instance HasText HyperdataDocument
   where

src/Gargantext/Database/Admin/Types/Hyperdata/User.hs

@@ -40,6 +40,8 @@ data HyperdataUser =
 instance GQLType HyperdataUser where
   directives _ = typeDirective DropNamespace { dropNamespace = "_hu_" }
 
+instance NFData HyperdataUser where
+
 data HyperdataPrivate =
      HyperdataPrivate { _hpr_password :: !Text
                       , _hpr_lang     :: !Lang
@@ -49,6 +51,8 @@ data HyperdataPrivate =
 instance GQLType HyperdataPrivate where
   directives _ = typeDirective DropNamespace { dropNamespace = "_hpr_" }
 
+instance NFData HyperdataPrivate where
+
 
 data HyperdataPublic =
      HyperdataPublic { _hpu_pseudo       :: !Text
@@ -59,6 +63,8 @@ data HyperdataPublic =
 instance GQLType HyperdataPublic where
   directives _ = typeDirective DropNamespace { dropNamespace = "_hpu_" }
 
+instance NFData HyperdataPublic where
+
 -- | Default
 defaultHyperdataUser :: HyperdataUser
 defaultHyperdataUser =

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

@@ -69,6 +69,9 @@ newtype UserId = UnsafeMkUserId { _UserId :: Int }
   deriving stock (Show, Eq, Ord, Generic)
   deriving newtype (ToSchema, ToJSON, FromJSON, FromField, ToField, Hashable)
 
+instance NFData UserId where
+instance Serialise UserId where
+
 -- The 'UserId' is isomprohic to an 'Int'.
 instance GQLType UserId where
   type KIND UserId = SCALAR
@@ -257,6 +260,8 @@ newtype NodeId = UnsafeMkNodeId { _NodeId :: Int }
   deriving newtype (Num, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON, Hashable, Csv.ToField)
   deriving anyclass (ToExpr)
 
+instance NFData NodeId where
+
 instance ResourceId NodeId where
   isPositive = (> 0) . _NodeId
 
@@ -291,6 +296,7 @@ newtype ContextId = UnsafeMkContextId { _ContextId :: Int }
   deriving FromField via NodeId
 
 instance ToParamSchema ContextId
+instance NFData ContextId
 
 instance Arbitrary ContextId where
   arbitrary = UnsafeMkContextId . getPositive <$> arbitrary
@@ -443,6 +449,7 @@ data NodeType
   deriving (Show, Read, Eq, Ord, Generic, Bounded, Enum)
 
 instance GQLType NodeType
+instance NFData NodeType where
 
 -- /NOTE/ (adn) For backward-compatibility reasons, we keep the format for ToJSON/FromJSON similar
 -- to what 'Show/Read' would generate, but we otherwise generate \"by hand\" the mapping between a
@@ -650,6 +657,8 @@ data NodePublishPolicy
   | NPP_publish_edits_only_owner_or_super
   deriving (Show, Read, Generic, Eq, Ord, Enum, Bounded)
 
+instance NFData NodePublishPolicy where
+
 instance HasDBid NodePublishPolicy where
   toDBid = \case
     NPP_publish_no_edits_allowed

src/Gargantext/Database/Query/Facet/Types.hs

@@ -56,6 +56,8 @@ data Facet id date hyperdata score =
               } deriving (Show, Generic)
 -}
 
+instance (NFData id, NFData created, NFData title, NFData hyper, NFData cat, NFData count, NFData score) =>
+  NFData (Facet id created title hyper cat count score) where
 
 
 data Pair i l = Pair {

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

@@ -28,6 +28,7 @@ module Gargantext.Database.Query.Table.Node
   , getClosestParentIdByType'
   , getCorporaWithParentId
   , getNode
+  , getNodes
   , getParent
   , getNodeWith
   , getNodeWithType
@@ -54,6 +55,7 @@ module Gargantext.Database.Query.Table.Node
   , insertDefaultNodeIfNotExists
   , insertNode
   , insertNodesWithParentR
+  , insertNodeWithHyperdata
 
   -- * Deleting one or more nodes
   , deleteNode
@@ -83,7 +85,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.List ( HyperdataList )
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( Hyperdata )
 import Gargantext.Database.Prelude (DBCmd, JSONB, mkCmd, execPGSQuery, runPGSQuery, runOpaQuery)
 import Gargantext.Database.Query.Filter (limit', offset')
-import Gargantext.Database.Query.Table.Node.Children (getChildrenById)
+import Gargantext.Database.Query.Table.Node.Children (getChildrenByParentId)
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (sum, head)
@@ -312,6 +314,15 @@ getNode nId = do
     Nothing -> nodeError (DoesNotExist nId)
     Just  r -> pure r
 
+-- | Get the nodes recursively, as a hierarchical tree.
+getNodes :: HasNodeError err => NodeId -> DBCmd err (Tree (Node Value))
+getNodes nId = do
+  root     <- getNode nId
+  children <- getChildrenByParentId nId
+  case children of
+    [] -> pure $ TreeN root []
+    xs -> TreeN root <$> forM xs getNodes
+
 -- | Get the parent of a given 'Node', failing if this was called
 -- on a root node.
 getParent :: HasNodeError err => Node a -> DBCmd err (Node Value)
@@ -345,19 +356,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
@@ -488,7 +504,7 @@ copyNode copySubtree smart idToCopy newParentId = if copySubtree
   then do
     -- Non-recursively copy the node itself, then recursively copy its children:
     copiedNode <- copyNode False smart idToCopy newParentId
-    children   <- getChildrenById idToCopy
+    children   <- getChildrenByParentId idToCopy
     for_ children $ \child -> copyNode True smart child copiedNode
     return copiedNode
   -- Single-node (non-recursive) copy:

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

@@ -63,9 +63,9 @@ getChildren a b c d e = getChildrenNode a b c d e
 
 
 -- | Get the list of (IDs of) children of a given node (ID)
-getChildrenById :: NodeId             -- ^ ID of the parent node
-                -> DBCmd err [NodeId] -- ^ List of IDs of the children nodes
-getChildrenById parentId = runPGSQuery
+getChildrenByParentId :: NodeId             -- ^ ID of the parent node
+                      -> DBCmd err [NodeId] -- ^ List of IDs of the children nodes
+getChildrenByParentId parentId = runPGSQuery
     [sql| SELECT id FROM public.nodes WHERE parent_id = ?; |]
     parentId
 

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
@@ -85,6 +85,7 @@ data NodeError = NoListFound ListId
                | DoesNotExist NodeId
                | NodeIsReadOnly NodeId T.Text
                | MoveError NodeId NodeId T.Text
+               | NodeNotExportable NodeId T.Text
 
 instance Prelude.Show NodeError
   where
@@ -101,6 +102,7 @@ instance Prelude.Show NodeError
     show (DoesNotExist n)   = "Node does not exist (" <> show n <> ")"
     show (NodeIsReadOnly n reason) = "Node " <> show n <> " is read only, edits not allowed. Reason: " <> T.unpack reason
     show (MoveError s t reason) = "Moving " <> show s <> " to " <> show t <> " failed: " <> T.unpack reason
+    show (NodeNotExportable nid reason) = "Node " <> show nid <> " is not exportable: " <> show reason
 
 instance ToJSON NodeError where
   toJSON (DoesNotExist n) =

src/Gargantext/Database/Schema/Node.hs

@@ -16,9 +16,14 @@ Portability : POSIX
 
 module Gargantext.Database.Schema.Node where
 
+import Codec.CBOR.JSON qualified as CBOR
+import Codec.Serialise
 import Control.Lens hiding (elements, (&))
+import Data.Aeson (ToJSON, toJSON, parseJSON, FromJSON)
 import Gargantext.Database.Schema.Prelude
+import Gargantext.Prelude (NFData(..))
 import Prelude hiding (null, id, map, sum)
+import Data.Aeson.Types (parseEither)
 
 ------------------------------------------------------------------------
 -- Main polymorphic Node definition
@@ -43,6 +48,41 @@ data NodePoly id
           , _node_hyperdata :: !hyperdata
           } deriving (Show, Generic)
 
+instance (NFData i, NFData h, NFData t, NFData u, NFData p, NFData n, NFData d, NFData hy) =>
+  NFData (NodePoly i h t u p n d hy) where
+
+instance ( Serialise i
+         , Serialise h
+         , Serialise t
+         , Serialise u
+         , Serialise p
+         , Serialise n
+         , Serialise d
+         , ToJSON json
+         , FromJSON json
+         ) => Serialise (NodePoly i h t u p n d json) where
+  encode Node{..} =
+     encode _node_id <>
+     encode _node_hash_id <>
+     encode _node_typename <>
+     encode _node_user_id <>
+     encode _node_parent_id <>
+     encode _node_name      <>
+     encode _node_date      <>
+     CBOR.encodeValue (toJSON _node_hyperdata)
+  decode = do
+   _node_id        <- decode
+   _node_hash_id   <- decode
+   _node_typename  <- decode
+   _node_user_id   <- decode
+   _node_parent_id  <- decode
+   _node_name      <- decode
+   _node_date      <- decode
+   mb_node_hyperdata <- parseEither parseJSON <$> CBOR.decodeValue False
+   case mb_node_hyperdata of
+     Left err -> fail err
+     Right _node_hyperdata -> pure Node{..}
+
 ------------------------------------------------------------------------
 -- Automatic instances derivation
 $(deriveJSON (unPrefix "_node_") ''NodePoly)

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

src/Gargantext/Orphans/OpenAPI.hs

@@ -7,16 +7,17 @@
 {-# LANGUAGE LambdaCase #-}
 module Gargantext.Orphans.OpenAPI where
 
+import Conduit qualified as C
 import Control.Lens
 import Data.HashMap.Strict.InsOrd qualified as HM
 import Data.OpenApi as OpenAPI hiding (Header, Server)
 import Data.OpenApi.Declare
+import Data.Swagger.Declare qualified as SwaggerDeclare
 import Data.Swagger.Internal qualified as Swagger
 import Data.Swagger qualified as Swagger
 import Data.Text qualified as T
 import Data.Typeable
 import Prelude
-import qualified Data.Swagger.Declare as SwaggerDeclare
 import Servant.API
 import Servant.Auth
 import Servant.OpenApi
@@ -85,6 +86,9 @@ class SwaggerConvertible a b where
 -- Instances
 --
 
+instance Typeable b => ToSchema (C.ConduitT () b IO ()) where
+  declareNamedSchema _ = pure $ NamedSchema Nothing binarySchema
+
 instance SwaggerConvertible OpenAPI.Discriminator T.Text where
   swagConv = iso OpenAPI._discriminatorPropertyName convertDiscriminator
     where

src/Gargantext/Utils/UTCTime.hs

@@ -35,6 +35,7 @@ import Test.QuickCheck hiding (label)
 
 newtype NUTCTime = NUTCTime UTCTime
   deriving (Eq, Show, Generic)
+  deriving newtype NFData
 instance DecodeScalar NUTCTime where
   decodeScalar (DMT.String x) = case (readEither $ T.unpack x) of
     Right r  -> pure $ NUTCTime r

stack.yaml

@@ -109,6 +109,7 @@
 - "servant-auth-swagger-0.2.11.0"
 - "servant-client-0.20.2"
 - "servant-client-core-0.20.2"
+- "servant-conduit-0.16.1"
 - "servant-ekg-0.3.1"
 - "servant-server-0.20.2"
 - "servant-swagger-1.2.1"
@@ -439,7 +440,7 @@ flags:
   formatting:
     "no-double-conversion": false
   gargantext:
-    "no-phylo-debug-logs": false
+    "no-phylo-debug-logs": true
     "test-crypto": false
   graphviz:
     "test-parsing": false

test/Test/API/Authentication.hs

@@ -25,7 +25,7 @@ import Network.HTTP.Client hiding (Proxy)
 import Network.HTTP.Types.Status (status403)
 import Prelude qualified
 import Servant.Auth.Client ()
-import Servant.Client
+import Servant.Client.Streaming
 import Servant.Client.Core.Response qualified as SR
 import Servant.Client.Generic (genericClient)
 import Test.API.Routes (auth_api)

test/Test/API/Private.hs

@@ -16,10 +16,11 @@ import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
 import Gargantext.Prelude hiding (get)
 import Network.HTTP.Client hiding (Proxy)
 import Servant.Auth.Client ()
-import Servant.Client
+import Servant.Client.Streaming
 import Servant.Client.Generic (genericClient)
 import Test.API.Prelude
 import Test.API.Private.Move  qualified as Move
+import Test.API.Private.Remote  qualified as Remote
 import Test.API.Private.Share qualified as Share
 import Test.API.Private.Table qualified as Table
 import Test.API.Routes (mkUrl, get_node, get_tree)
@@ -111,3 +112,5 @@ tests = sequential $ do
     Table.tests
   describe "Move API" $ do
     Move.tests
+  describe "Remote API" $ do
+    Remote.tests

test/Test/API/Private/Move.hs

@@ -11,7 +11,7 @@ import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Query.Table.NodeNode (SourceId(..), TargetId(..))
 import Gargantext.Prelude
-import Servant.Client
+import Servant.Client.Streaming
 import Test.API.Prelude
 import Test.API.Routes
 import Test.API.Setup

test/Test/API/Private/Remote.hs

+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Test.API.Private.Remote (
+    tests
+  ) where
+
+import Control.Lens
+import Gargantext.API.Admin.EnvTypes (Mode(..))
+import Gargantext.API.Errors
+import Gargantext.API (makeApp)
+import Gargantext.API.Routes.Client (remoteExportClient)
+import Gargantext.API.Routes.Named.Remote (RemoteExportRequest(..))
+import Gargantext.Core.Types.Individu
+import Gargantext.Core.Types (NodeId(UnsafeMkNodeId))
+import Gargantext.Prelude
+import Gargantext.System.Logging
+import Network.Wai.Handler.Warp qualified as Warp
+import Network.Wai qualified as Wai
+import Servant.Client.Streaming
+import Test.API.Prelude
+import Test.API.Setup
+import Test.Database.Setup
+import Test.Database.Types
+import Test.Hspec (Spec, it, aroundAll, describe, sequential, shouldBe)
+import Test.Hspec.Wai.Internal (withApplication)
+import Test.Utils
+
+-- | Helper to let us test transferring data between two instances.
+withTwoServerInstances :: (SpecContext (TestEnv,Wai.Application,Warp.Port) -> IO ()) -> IO ()
+withTwoServerInstances action =
+  withTestDB $ \testEnv1 -> do
+    withTestDB $ \testEnv2 -> do
+      garg1App <- withLoggerHoisted Mock $ \ioLogger -> do
+                   env <- newTestEnv testEnv1 ioLogger server1Port
+                   makeApp env
+      garg2App <- withLoggerHoisted Mock $ \ioLogger -> do
+                   env <- newTestEnv testEnv2 ioLogger server2Port
+                   makeApp env
+
+      testWithApplicationOnPort (pure garg1App) server1Port $
+        testWithApplicationOnPort (pure garg2App) server2Port $
+          action (SpecContext testEnv1 server1Port garg1App (testEnv2,garg2App,server2Port))
+  where
+    server1Port = 8008
+    server2Port = 9008
+
+tests :: Spec
+tests = sequential $ aroundAll withTwoServerInstances $ do
+  describe "Prelude" $ do
+    it "setup DB triggers" $ \SpecContext{..} -> do
+      forM_ [ _sctx_env, _sctx_data ^. _1 ] $ \e -> do
+        setupEnvironment e
+        void $ createAliceAndBob e
+
+    describe "Copying nodes across instances" $ do
+
+      it "should forbid moving a node the user doesn't own" $ \(SpecContext testEnv1 server1Port app1 (_testEnv2, _app2, server2Port)) -> do
+        withApplication app1 $ do
+          withValidLogin server1Port "alice" (GargPassword "alice") $ \aliceClientEnv aliceToken -> do
+            withValidLogin server2Port "bob" (GargPassword "bob") $ \_bobClientEnv bobToken -> do
+              liftIO $ do
+                bobPublicFolderId <- getRootPublicFolderIdForUser testEnv1 (UserName "bob")
+                let rq = RemoteExportRequest { _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
+                                             , _rer_instance_auth = bobToken
+                                             }
+                res <- runClientM (remoteExportClient aliceToken bobPublicFolderId rq) aliceClientEnv
+                res `shouldFailWith` EC_403__policy_check_error
+
+      it "supports trivial transfer between instances" $ \(SpecContext testEnv1 server1Port app1 (_testEnv2, _app2, server2Port)) -> do
+        withApplication app1 $ do
+          withValidLogin server1Port "alice" (GargPassword "alice") $ \aliceClientEnv aliceToken -> do
+            corpusId <- liftIO $ newCorpusForUser testEnv1 "alice"
+            withValidLogin server2Port "bob" (GargPassword "bob") $ \_bobClientEnv bobToken -> do
+              liftIO $ do
+                let rq = RemoteExportRequest { _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
+                                             , _rer_instance_auth = bobToken
+                                             }
+                res <- checkEither $ runClientM (remoteExportClient aliceToken corpusId rq) aliceClientEnv
+                res `shouldBe` [ UnsafeMkNodeId 16 ]
+
+      -- Certain node types (like private, share, etc) shouldn't be transferred.
+      it "forbids transferring certain node types" $ \(SpecContext testEnv1 server1Port app1 (_testEnv2, _app2, server2Port)) -> do
+        withApplication app1 $ do
+          withValidLogin server1Port "alice" (GargPassword "alice") $ \aliceClientEnv aliceToken -> do
+            folderId <- liftIO $ newPrivateFolderForUser testEnv1 "alice"
+            withValidLogin server2Port "bob" (GargPassword "bob") $ \_bobClientEnv bobToken -> do
+              liftIO $ do
+                let rq = RemoteExportRequest { _rer_instance_url  = fromMaybe (panicTrace "impossible") $ parseBaseUrl "http://localhost:9008"
+                                             , _rer_instance_auth = bobToken
+                                             }
+                res <- runClientM (remoteExportClient aliceToken folderId rq) aliceClientEnv
+                res `shouldFailWith` EC_403__node_export_error

test/Test/API/Private/Share.hs

@@ -18,7 +18,7 @@ import Gargantext.Core.Types.Individu
 import Gargantext.Prelude
 import Prelude (fail)
 import Servant.Auth.Client qualified as SC
-import Servant.Client
+import Servant.Client.Streaming
 import Test.API.Prelude (newCorpusForUser)
 import Test.API.Routes
 import Test.API.Setup (SpecContext(..), dbEnvSetup, withTestDBAndPort)

test/Test/API/Private/Table.hs

@@ -11,7 +11,7 @@ import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Query.Facet qualified as Facet
 import Gargantext.Prelude
-import Servant.Client
+import Servant.Client.Streaming
 import Test.API.Prelude (checkEither)
 import Test.API.Routes
 import Test.API.Setup (SpecContext(..), dbEnvSetup, withTestDBAndPort)

test/Test/API/Routes.hs

@@ -37,6 +37,7 @@ import Gargantext.API.Errors
 import Gargantext.API.HashedResponse (HashedResponse)
 import Gargantext.API.Ngrams.List.Types (WithJsonFile, WithTextFile)
 import Gargantext.API.Ngrams.Types ( NgramsTable, NgramsTablePatch, OrderBy, TabType, Versioned, VersionedWithCount )
+import Gargantext.API.Routes.Client
 import Gargantext.API.Routes.Named
 import Gargantext.API.Routes.Named.List (updateListJSONEp, updateListTSVEp)
 import Gargantext.API.Routes.Named.Node hiding (treeAPI)
@@ -55,23 +56,10 @@ import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Query.Facet qualified as Facet
 import Gargantext.Database.Query.Table.NodeNode (SourceId(..), TargetId(..))
 import Gargantext.Prelude
-import Network.HTTP.Types qualified as H
 import Network.Wai.Handler.Warp (Port)
-import Servant.API.WebSocket qualified as WS
 import Servant.Auth.Client qualified as S
-import Servant.Client (ClientM)
-import Servant.Client.Core (RunClient, HasClient(..), Request)
-import Servant.Client.Generic ( genericClient, AsClientT )
-
-
-instance RunClient m => HasClient m WS.WebSocketPending where
-  type Client m WS.WebSocketPending = H.Method ->  m ()
-
-  clientWithRoute :: Proxy m -> Proxy WS.WebSocketPending -> Request -> Client m WS.WebSocketPending
-  clientWithRoute _pm Proxy _req _httpMethod = do
-    panicTrace "[WebSocket client] this is not implemented!"
-
-  hoistClientMonad _ _ f cl = \meth -> f (cl meth)
+import Servant.Client.Streaming
+import Servant.Conduit ()
 
 
 -- This is for requests made by http.client directly to hand-crafted URLs.
@@ -85,12 +73,6 @@ mkUrl _port urlPiece =
 gqlUrl :: ByteString
 gqlUrl = "/gql"
 
-
--- | The client for the full API. It also serves as a \"proof\" that our
--- whole API has all the required instances to be used in a client.
-clientRoutes :: API (AsClientT ClientM)
-clientRoutes = genericClient
-
 -- This is for Servant.Client requests
 auth_api :: AuthRequest -> ClientM AuthResponse
 auth_api = clientRoutes & apiWithCustomErrorScheme

test/Test/API/Setup.hs

@@ -9,6 +9,7 @@ module Test.API.Setup (
   , setupEnvironment
   , createAliceAndBob
   , dbEnvSetup
+  , newTestEnv
   ) where
 
 import Control.Concurrent.Async qualified as Async

test/Test/API/UpdateList.hs

@@ -62,7 +62,7 @@ import Gargantext.Database.Query.Facet qualified as Facet
 import Gargantext.Prelude hiding (get)
 import Network.Wai.Handler.Warp qualified as Wai
 import Paths_gargantext (getDataFileName)
-import Servant.Client
+import Servant.Client.Streaming
 import System.FilePath
 import Test.API.Prelude (checkEither, newCorpusForUser, newPrivateFolderForUser)
 import Test.API.Routes (mkUrl, gqlUrl, get_table_ngrams, put_table_ngrams, toServantToken, clientRoutes, get_table, update_node, add_form_to_list, add_tsv_to_list)

test/Test/Instances.hs

@@ -479,6 +479,9 @@ genFrontendErr be = do
       -> do sId <- arbitrary
             tId <- arbitrary
             pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_move_error sId tId "generic reason"
+    Errors.EC_403__node_export_error
+      -> do nId <- arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_export_error nId "generic reason"
 
     -- validation error
     Errors.EC_400__validation_error

test/Test/Offline/JSON.hs

@@ -13,6 +13,7 @@ import Gargantext.API.Errors
 import Gargantext.API.Node.Corpus.Types
 import Gargantext.API.Node.Types
 import Gargantext.API.Routes.Named.Publish (PublishRequest)
+import Gargantext.API.Routes.Named.Remote
 import Gargantext.API.Viz.Types
 import Gargantext.Core.Types.Phylo
 import Gargantext.Core.Viz.Phylo qualified as VizPhylo
@@ -56,6 +57,7 @@ tests = testGroup "JSON" [
   , testProperty "Datafield roundtrips"      (jsonRoundtrip @Datafield)
   , testProperty "WithQuery roundtrips"      (jsonRoundtrip @WithQuery)
   , testProperty "PublishRequest roundtrips" (jsonRoundtrip @PublishRequest)
+  , testProperty "RemoteExportRequest roundtrips" (jsonRoundtrip @RemoteExportRequest)
   , testProperty "FrontendError roundtrips" jsonFrontendErrorRoundtrip
   , testProperty "BackendErrorCode roundtrips" (jsonEnumRoundtrip (Dict @_ @BackendErrorCode))
   , testProperty "NodeType roundtrips"      (jsonEnumRoundtrip (Dict @_ @NodeType))

test/Test/Server/ReverseProxy.hs

@@ -8,7 +8,7 @@ import Network.HTTP.Client
 import Network.HTTP.Types.Status
 import Prelude
 import Servant.Auth.Client (Token(..))
-import Servant.Client
+import Servant.Client.Streaming
 import Servant.Client.Generic (genericClient)
 import Test.API.Setup (setupEnvironment, withBackendServerAndProxy, createAliceAndBob)
 import Test.Hspec

test/Test/Utils.hs

@@ -61,7 +61,7 @@ import Network.Wai.Handler.Warp (Port)
 import Network.Wai.Test (SResponse(..))
 import Network.WebSockets qualified as WS
 import Prelude qualified
-import Servant.Client (ClientEnv, baseUrlPort, mkClientEnv, parseBaseUrl, runClientM, makeClientRequest, defaultMakeClientRequest)
+import Servant.Client.Streaming (ClientEnv, baseUrlPort, mkClientEnv, parseBaseUrl, runClientM, makeClientRequest, defaultMakeClientRequest)
 import Servant.Client.Core (BaseUrl)
 import Servant.Client.Core.Request qualified as Client
 import System.Environment (lookupEnv)