Send serialised nodes instead of dummy strings

gargantext.cabal

@@ -504,6 +504,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

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

@@ -14,20 +14,22 @@ import Control.Exception.Safe qualified as Safe
 import Control.Exception (toException)
 import Control.Lens (view, (#))
 import Control.Monad.Except (throwError)
+import Data.Aeson qualified as JSON
 import Data.ByteString.Builder qualified as B
-import Data.ByteString.Char8 qualified as C8
 import Data.ByteString.Lazy qualified as BL
 import Data.Conduit.Combinators qualified as C
 import Data.Conduit.List qualified as CL
-import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
 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.Prelude (IsGargServer)
 import Gargantext.API.Routes.Client (remoteImportClient)
 import Gargantext.API.Routes.Named.Remote qualified as Named
 import Gargantext.Core.Config
+import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (IsDBCmd)
+import Gargantext.Database.Query.Table.Node (getNode)
 import Prelude
 import Servant.Client.Streaming (mkClientEnv, withClientM, ClientError)
 import Servant.Server.Generic (AsServerT)
@@ -42,7 +44,7 @@ remoteAPI authenticatedUser = Named.RemoteAPI $
     , remoteImportEp = remoteImportHandler
     }
 
-type ExpectedPayload = C8.ByteString -- FIXME(adn)
+type ExpectedPayload = [Node JSON.Value]
 
 remoteImportHandler :: (HasBackendInternalError err, IsDBCmd env err m, MonadIO m)
                     => ConduitT () Named.RemoteBinaryData IO ()
@@ -60,8 +62,9 @@ remoteExportHandler :: ( MonadIO m, Safe.MonadCatch m
                     -> m ()
 remoteExportHandler Named.RemoteExportRequest{..} = do
   mgr  <- view gargHttpManager
-  -- FIXME(adn) eventually we want to be sending nodes here.
-  let node = C8.pack "hello world"
+  -- FIXME(adn) Here I should somehow need to get all the children of the
+  -- node so that I can recostruct proper semantic context.
+  node <- (:[]) <$> getNode _rer_node_id
   liftIO (withClientM (remoteImportClient _rer_instance_auth (streamEncoder node)) (mkClientEnv mgr _rer_instance_url) streamDecode)
               `Safe.catch` \(e :: BackendInternalError) -> throwError $ _BackendInternalError # e
 

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

@@ -70,6 +70,7 @@ newtype UserId = UnsafeMkUserId { _UserId :: Int }
   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

src/Gargantext/Database/Schema/Node.hs

@@ -16,10 +16,13 @@ Portability : POSIX
 
 module Gargantext.Database.Schema.Node where
 
+import Codec.Serialise
+import Codec.CBOR.JSON qualified as CBOR
 import Control.Lens hiding (elements, (&))
+import Data.Aeson qualified as JSON
 import Gargantext.Database.Schema.Prelude
-import Prelude hiding (null, id, map, sum)
 import Gargantext.Prelude (NFData(..))
+import Prelude hiding (null, id, map, sum)
 
 ------------------------------------------------------------------------
 -- Main polymorphic Node definition
@@ -47,6 +50,34 @@ data NodePoly id
 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
+         ) => Serialise (NodePoly i h t u p n d JSON.Value) 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 _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
+   _node_hyperdata <- CBOR.decodeValue False
+   pure Node{..}
+
 ------------------------------------------------------------------------
 -- Automatic instances derivation
 $(deriveJSON (unPrefix "_node_") ''NodePoly)