Commit c62480c7 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Proper support for importing documents

parent 6019587c
Pipeline #7206 passed with stages
in 50 minutes and 56 seconds
...@@ -25,8 +25,8 @@ import Control.Lens ( view, non ) ...@@ -25,8 +25,8 @@ import Control.Lens ( view, non )
import Data.ByteString.Base64 qualified as BSB64 import Data.ByteString.Base64 qualified as BSB64
import Data.Conduit.Internal (zipSources) import Data.Conduit.Internal (zipSources)
import Data.Swagger ( ToSchema(..) ) import Data.Swagger ( ToSchema(..) )
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE import Data.Text.Encoding qualified as TE
import Data.Text qualified as T
import EPO.API.Client.Types qualified as EPO import EPO.API.Client.Types qualified as EPO
import Gargantext.API.Admin.Orchestrator.Types qualified as API import Gargantext.API.Admin.Orchestrator.Types qualified as API
import Gargantext.API.Ngrams (commitStatePatch, Versioned(..)) import Gargantext.API.Ngrams (commitStatePatch, Versioned(..))
...@@ -35,14 +35,14 @@ import Gargantext.API.Node.Corpus.Searx ( triggerSearxSearch ) ...@@ -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.Types ( Datafield(Web), database2origin )
import Gargantext.API.Node.Corpus.Update (addLanguageToCorpus) import Gargantext.API.Node.Corpus.Update (addLanguageToCorpus)
import Gargantext.API.Node.Types import Gargantext.API.Node.Types
import Gargantext.Core (withDefaultLanguage, defaultLanguage)
import Gargantext.Core.Config (gc_jobs, hasConfig) import Gargantext.Core.Config (gc_jobs, hasConfig)
import Gargantext.Core.Config.Types (jc_max_docs_parsers) 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.Parsers qualified as Parser (FileType(..), parseFormatC, _ParseFormatError)
import Gargantext.Core.Text.Corpus.Query qualified as API import Gargantext.Core.Text.Corpus.Query qualified as API
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Utils.Prefix (unPrefix) 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 (flowCorpus, getDataText, flowDataText, TermType(..){-, allDataOrigins-})
import Gargantext.Database.Action.Flow.Types (FlowCmdM) import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Action.Mail (sendMail) import Gargantext.Database.Action.Mail (sendMail)
...@@ -52,6 +52,8 @@ import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument( ...@@ -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.Hyperdata.File ( HyperdataFile(..) )
import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), ParentId) import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), ParentId)
import Gargantext.Database.GargDB qualified as GargDB 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 (getNodeWith, getOrMkList)
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata) import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds)) import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))
...@@ -366,11 +368,15 @@ addToCorpusWithFile user cid nwf@(NewWithFile _d (withDefaultLanguage -> l) fNam ...@@ -366,11 +368,15 @@ addToCorpusWithFile user cid nwf@(NewWithFile _d (withDefaultLanguage -> l) fNam
--- UTILITIES --- UTILITIES
commitCorpus :: ( FlowCmdM env err m commitCorpus :: ( IsDBCmd env err m
, HasNodeStoryEnv env
, HasNodeError err
, HasNodeArchiveStoryImmediateSaver env , HasNodeArchiveStoryImmediateSaver env
, HasNodeStoryImmediateSaver env ) , HasNodeStoryImmediateSaver env )
=> ParentId -> User -> m (Versioned NgramsStatePatch') => ParentId
commitCorpus cid user = do -> User
-> m (Versioned NgramsStatePatch')
commitCorpus cid user = do
userId <- getUserId user userId <- getUserId user
listId <- getOrMkList cid userId listId <- getOrMkList cid userId
v <- currentVersion listId v <- currentVersion listId
......
...@@ -29,13 +29,14 @@ import Gargantext.Utils.Servant (ZIP) ...@@ -29,13 +29,14 @@ import Gargantext.Utils.Servant (ZIP)
import Gargantext.Utils.Zip (zipContentsPureWithLastModified) import Gargantext.Utils.Zip (zipContentsPureWithLastModified)
import Protolude import Protolude
import Servant (MimeRender(..), MimeUnrender(..)) import Servant (MimeRender(..), MimeUnrender(..))
import Prelude (show)
-- | Document Export -- | Document Export
data DocumentExport = data DocumentExport =
DocumentExport { _de_documents :: [Document] DocumentExport { _de_documents :: [Document]
, _de_garg_version :: Text , _de_garg_version :: Text
} deriving (Generic) } deriving (Generic, Show, Eq)
instance Serialise DocumentExport where instance Serialise DocumentExport where
...@@ -44,14 +45,20 @@ data DocumentExportZIP = ...@@ -44,14 +45,20 @@ data DocumentExportZIP =
DocumentExportZIP { _dez_dexp :: DocumentExport DocumentExportZIP { _dez_dexp :: DocumentExport
, _dez_doc_id :: DocId , _dez_doc_id :: DocId
, _dez_last_modified :: Integer } deriving (Generic) , _dez_last_modified :: Integer } deriving (Generic)
data Document = data Document =
Document { _d_document :: Node HyperdataDocument Document { _d_document :: Node HyperdataDocument
, _d_ngrams :: Ngrams , _d_ngrams :: Ngrams
, _d_hash :: Hash , _d_hash :: Hash
} deriving (Generic) } 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 Serialise Document where
--instance Read Document where --instance Read Document where
-- read "" = panic "not implemented" -- read "" = panic "not implemented"
...@@ -119,7 +126,7 @@ $(deriveJSON (unPrefix "_de_") ''DocumentExport) ...@@ -119,7 +126,7 @@ $(deriveJSON (unPrefix "_de_") ''DocumentExport)
-- Needs to be here because of deriveJSON TH above -- Needs to be here because of deriveJSON TH above
dezFileName :: DocumentExportZIP -> Text 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 instance MimeRender ZIP DocumentExportZIP where
mimeRender _ dexpz@(DocumentExportZIP { .. }) = mimeRender _ dexpz@(DocumentExportZIP { .. }) =
......
...@@ -11,33 +11,43 @@ Portability : POSIX ...@@ -11,33 +11,43 @@ Portability : POSIX
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Node.DocumentUpload where module Gargantext.API.Node.DocumentUpload where
import Control.Lens (view) import Control.Lens (view)
import Data.Text qualified as T import Data.Text qualified as T
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
import Gargantext.API.Admin.EnvTypes (Env) 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.Document.Export.Types (DocumentExport(..))
import Gargantext.API.Node.DocumentUpload.Types import Gargantext.API.Node.DocumentUpload.Types
import Gargantext.API.Prelude ( GargM ) import Gargantext.API.Prelude ( GargM )
import Gargantext.API.Routes.Named.Document qualified as Named import Gargantext.API.Routes.Named.Document qualified as Named
import Gargantext.API.Worker (serveWorkerAPI) import Gargantext.API.Worker (serveWorkerAPI)
import Gargantext.Core (Lang(..)) 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.Corpus.Parsers.Date (mDateSplit)
import Gargantext.Core.Text.Terms (TermType(..)) 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 qualified as Jobs
import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus) import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus)
import Gargantext.Database.Action.Flow.Types ( FlowCmdM ) import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataCorpus ) import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataCorpus )
import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..)) 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) )
import Gargantext.Database.Query.Table.Node (getClosestParentIdByType') import Gargantext.Database.Prelude (IsDBCmd)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node (getClosestParentIdByType', getClosestParentIdByType)
import Gargantext.Database.Schema.Node (_node_hyperdata)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.System.Logging (logLocM, LogLevel(..), MonadLogger)
import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..)) import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
import Servant.Server.Generic (AsServerT) import Servant.Server.Generic (AsServerT)
api :: NodeId -> Named.DocumentUploadAPI (AsServerT (GargM Env BackendInternalError)) api :: NodeId -> Named.DocumentUploadAPI (AsServerT (GargM Env BackendInternalError))
api nId = Named.DocumentUploadAPI { api nId = Named.DocumentUploadAPI {
uploadDocAsyncEp = serveWorkerAPI $ \p -> uploadDocAsyncEp = serveWorkerAPI $ \p ->
...@@ -91,3 +101,31 @@ documentUpload nId doc = do ...@@ -91,3 +101,31 @@ documentUpload nId doc = do
let lang = EN let lang = EN
ncs <- view $ nlpServerGet lang ncs <- view $ nlpServerGet lang
addDocumentsToHyperCorpus ncs (Nothing :: Maybe HyperdataCorpus) (Multi lang) cId [hd] 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
-> NodeId
-> DocumentExport
-> m [NodeId]
remoteImportDocuments loggedInUser nodeId (DocumentExport documents _gargVersion) = do
mb_corpusId <- getClosestParentIdByType nodeId NodeCorpus
case mb_corpusId of
Nothing -> panicTrace $ "remoteImportDocuments: impossible, freshly imported doc node without parent corpus"
Just corpusId -> do
let la = Multi EN
nlpServerConfig <- view $ nlpServerGet (_tt_lang la)
$(logLocM) INFO $ "Importing " <> T.pack (show $ length documents) <> " 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 $ length documents) <> " documents for corpus node " <> T.pack (show nodeId)
pure docs
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Gargantext.API.Server.Named.Remote ( module Gargantext.API.Server.Named.Remote (
remoteAPI remoteAPI
...@@ -30,22 +31,24 @@ import Gargantext.API.Errors.Types ...@@ -30,22 +31,24 @@ import Gargantext.API.Errors.Types
import Gargantext.API.Ngrams.Prelude (getNgramsList) import Gargantext.API.Ngrams.Prelude (getNgramsList)
import Gargantext.API.Ngrams.Types (NgramsList) import Gargantext.API.Ngrams.Types (NgramsList)
import Gargantext.API.Node.Document.Export (get_document_json) import Gargantext.API.Node.Document.Export (get_document_json)
import Gargantext.API.Node.Document.Export.Types (DocumentExport) import Gargantext.API.Node.Document.Export.Types
import Gargantext.API.Prelude (IsGargServer) import Gargantext.API.Prelude (IsGargServer)
import Gargantext.API.Routes.Client (remoteImportClient) import Gargantext.API.Routes.Client (remoteImportClient)
import Gargantext.API.Routes.Named.Remote qualified as Named import Gargantext.API.Routes.Named.Remote qualified as Named
import Gargantext.Core.Config import Gargantext.Core.Config
import Gargantext.Core (lookupDBid) import Gargantext.Core (lookupDBid)
import Gargantext.Core.NodeStory.Types (HasNodeStoryEnv) import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.NodeStory.Types (HasNodeStoryEnv, HasNodeArchiveStoryImmediateSaver)
import Gargantext.Core.Types.Main import Gargantext.Core.Types.Main
import Gargantext.Core.Worker.Jobs (sendJob) import Gargantext.Core.Worker.Jobs (sendJob)
import Gargantext.Core.Worker.Jobs.Types qualified as Jobs import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node hiding (INFO)
import Gargantext.Database.Prelude (IsDBCmd) import Gargantext.Database.Prelude (IsDBCmd)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError, nodeError, NodeError (..)) 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 (insertNodeWithHyperdata, getNodes, getUserRootPrivateNode)
import Gargantext.Database.Schema.Node (NodePoly(..)) import Gargantext.Database.Schema.Node (NodePoly(..))
import Gargantext.Orphans () import Gargantext.Orphans ()
import Gargantext.System.Logging (logLocM, LogLevel(..), MonadLogger)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Prelude import Prelude
import Servant.Client.Streaming (mkClientEnv, withClientM, ClientError) import Servant.Client.Streaming (mkClientEnv, withClientM, ClientError)
...@@ -64,7 +67,7 @@ data ExportableNode = ...@@ -64,7 +67,7 @@ data ExportableNode =
instance Serialise ExportableNode where instance Serialise ExportableNode where
remoteAPI :: (MonadIO m, IsGargServer env BackendInternalError m) remoteAPI :: (MonadIO m, IsGargServer env BackendInternalError m, HasNodeArchiveStoryImmediateSaver env)
=> AuthenticatedUser => AuthenticatedUser
-> Named.RemoteAPI (AsServerT m) -> Named.RemoteAPI (AsServerT m)
remoteAPI authenticatedUser = Named.RemoteAPI $ remoteAPI authenticatedUser = Named.RemoteAPI $
...@@ -80,7 +83,10 @@ remoteImportHandler :: forall err env m. ...@@ -80,7 +83,10 @@ remoteImportHandler :: forall err env m.
( HasNodeStoryEnv env ( HasNodeStoryEnv env
, HasNodeError err , HasNodeError err
, HasBackendInternalError err , HasBackendInternalError err
, HasNodeArchiveStoryImmediateSaver env
, IsDBCmd env err m , IsDBCmd env err m
, HasNLPServer env
, MonadLogger m
, MonadIO m) , MonadIO m)
=> AuthenticatedUser => AuthenticatedUser
-> ConduitT () Named.RemoteBinaryData IO () -> ConduitT () Named.RemoteBinaryData IO ()
...@@ -92,25 +98,33 @@ remoteImportHandler loggedInUser c = do ...@@ -92,25 +98,33 @@ remoteImportHandler loggedInUser c = do
case deserialiseOrFail @ExpectedPayload (B.toLazyByteString $ mconcat chunks) of case deserialiseOrFail @ExpectedPayload (B.toLazyByteString $ mconcat chunks) of
Left err -> throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "Deserialization error: " ++ show err) Left err -> throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "Deserialization error: " ++ show err)
Right (TreeN x xs) -> do Right (TreeN x xs) -> do
$(logLocM) INFO $ "Importing " <> T.pack (show $ _node_id $ _en_node $ x)
-- NOTE(adn) By default, we append the imported node(s) to the user's -- NOTE(adn) By default, we append the imported node(s) to the user's
-- private folder. -- private folder.
privateFolderId <- _node_id <$> getUserRootPrivateNode (_auth_user_id loggedInUser) privateFolderId <- _node_id <$> getUserRootPrivateNode (_auth_user_id loggedInUser)
$(logLocM) INFO $ "Attaching " <> T.pack (show $ _node_id $ _en_node $ x) <> " to private folder " <> T.pack (show privateFolderId)
-- Attempts to insert nodes a we go along. -- Attempts to insert nodes a we go along.
rootNode <- insertNode (Just privateFolderId) x rootNode <- insertNode (Just privateFolderId) x
foldlM (insertTrees (Just rootNode)) [rootNode] xs nodes <- foldlM (insertTrees (Just rootNode)) [rootNode] xs
$(logLocM) INFO $ "Successfully imported all the requested nodes."
pure nodes
where where
insertNode :: Maybe NodeId -> ExportableNode -> m NodeId insertNode :: Maybe NodeId -> ExportableNode -> m NodeId
insertNode mb_parent (ExportableNode x _mb_docs mb_terms) = case lookupDBid $ _node_typename x of insertNode mb_parent (ExportableNode x mb_docs mb_terms) = case lookupDBid $ _node_typename x of
Nothing -> throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "remoteImportHandler: impossible, node with invalid type.") Nothing -> throwError $ _BackendInternalError # InternalUnexpectedError (toException $ userError $ "remoteImportHandler: impossible, node with invalid type.")
Just ty -> do Just ty -> do
new_node <- insertNodeWithHyperdata ty (_node_name x) (_node_hyperdata x) mb_parent (_auth_user_id loggedInUser) 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_docs $ \docsList -> do
$(logLocM) INFO $ "Found document list to import..."
let payload = Jobs.ImportRemoteDocumentsPayload loggedInUser new_node docsList
void $ sendJob $ Jobs.ImportRemoteDocuments payload
for_ mb_terms $ \ngramsList -> do for_ mb_terms $ \ngramsList -> do
$(logLocM) INFO $ "Found ngrams list to import..."
void $ sendJob $ Jobs.JSONPost { _jp_list_id = new_node void $ sendJob $ Jobs.JSONPost { _jp_list_id = new_node
, _jp_ngrams_list = ngramsList , _jp_ngrams_list = ngramsList
} }
--for_ mb_docs $ \docsList -> do
-- addToCorpusWithForm user corpusId new_with_form (noJobHandle @m Proxy)
pure new_node pure new_node
insertTrees :: Maybe NodeId -> [NodeId] -> Tree ExportableNode -> m [NodeId] insertTrees :: Maybe NodeId -> [NodeId] -> Tree ExportableNode -> m [NodeId]
...@@ -118,8 +132,6 @@ remoteImportHandler loggedInUser c = do ...@@ -118,8 +132,6 @@ remoteImportHandler loggedInUser c = do
childrenRoot <- insertNode currentParent x childrenRoot <- insertNode currentParent x
(`mappend` acc) <$> foldlM (insertTrees (Just childrenRoot)) [childrenRoot] xs (`mappend` acc) <$> foldlM (insertTrees (Just childrenRoot)) [childrenRoot] xs
remoteExportHandler :: ( MonadIO m, Safe.MonadCatch m remoteExportHandler :: ( MonadIO m, Safe.MonadCatch m
, IsGargServer err env m , IsGargServer err env m
) )
...@@ -142,8 +154,8 @@ makeExportable userNodeId (TreeN x xs) ...@@ -142,8 +154,8 @@ makeExportable userNodeId (TreeN x xs)
| Just nty <- lookupDBid (_node_typename x) | Just nty <- lookupDBid (_node_typename x)
= do = do
mb_docs <- case nty of mb_docs <- case nty of
NodeDocument -> Just <$> get_document_json userNodeId (_node_id x) NodeTexts -> Just <$> get_document_json userNodeId (_node_id x)
_ -> pure Nothing _ -> pure Nothing
mb_ngrams <- case nty of mb_ngrams <- case nty of
NodeList -> Just <$> getNgramsList (_node_id x) NodeList -> Just <$> getNgramsList (_node_id x)
_ -> pure Nothing _ -> pure Nothing
......
...@@ -30,7 +30,7 @@ import Gargantext.API.Node.Corpus.Annuaire qualified as Annuaire ...@@ -30,7 +30,7 @@ import Gargantext.API.Node.Corpus.Annuaire qualified as Annuaire
import Gargantext.API.Node.Contact (addContact) import Gargantext.API.Node.Contact (addContact)
import Gargantext.API.Node.Corpus.New (addToCorpusWithForm, addToCorpusWithQuery) import Gargantext.API.Node.Corpus.New (addToCorpusWithForm, addToCorpusWithQuery)
import Gargantext.API.Node.DocumentsFromWriteNodes (documentsFromWriteNodes) import Gargantext.API.Node.DocumentsFromWriteNodes (documentsFromWriteNodes)
import Gargantext.API.Node.DocumentUpload (documentUploadAsync) import Gargantext.API.Node.DocumentUpload (documentUploadAsync, remoteImportDocuments)
import Gargantext.API.Node.FrameCalcUpload (frameCalcUploadAsync) import Gargantext.API.Node.FrameCalcUpload (frameCalcUploadAsync)
import Gargantext.API.Node.File (addWithFile) import Gargantext.API.Node.File (addWithFile)
import Gargantext.API.Node.New (postNode') import Gargantext.API.Node.New (postNode')
...@@ -45,7 +45,7 @@ import Gargantext.Core.Viz.Graph.API (graphRecompute) ...@@ -45,7 +45,7 @@ import Gargantext.Core.Viz.Graph.API (graphRecompute)
import Gargantext.Core.Worker.Broker (initBrokerWithDBCreate) import Gargantext.Core.Worker.Broker (initBrokerWithDBCreate)
import Gargantext.Core.Worker.Env import Gargantext.Core.Worker.Env
import Gargantext.Core.Worker.PGMQTypes (BrokerMessage, HasWorkerBroker, WState) import Gargantext.Core.Worker.PGMQTypes (BrokerMessage, HasWorkerBroker, WState)
import Gargantext.Core.Worker.Jobs.Types (Job(..), getWorkerMNodeId) import Gargantext.Core.Worker.Jobs.Types (Job(..), getWorkerMNodeId, ImportRemoteDocumentsPayload(..))
import Gargantext.Core.Worker.Types (JobInfo(..)) import Gargantext.Core.Worker.Types (JobInfo(..))
import Gargantext.Database.Query.Table.User (getUsersWithEmail) import Gargantext.Database.Query.Table.User (getUsersWithEmail)
import Gargantext.Prelude hiding (to) import Gargantext.Prelude hiding (to)
...@@ -296,3 +296,8 @@ performAction env _state bm = do ...@@ -296,3 +296,8 @@ performAction env _state bm = do
UploadDocument { .. } -> runWorkerMonad env $ do UploadDocument { .. } -> runWorkerMonad env $ do
$(logLocM) DEBUG $ "[performAction] upload document" $(logLocM) DEBUG $ "[performAction] upload document"
void $ documentUploadAsync _ud_node_id _ud_args jh void $ documentUploadAsync _ud_node_id _ud_args jh
-- | Remotely import documents
ImportRemoteDocuments (ImportRemoteDocumentsPayload loggedInUser corpusId docs) -> runWorkerMonad env $ do
$(logLocM) DEBUG $ "[performAction] import remote documents"
void $ remoteImportDocuments loggedInUser corpusId docs
...@@ -9,26 +9,51 @@ Portability : POSIX ...@@ -9,26 +9,51 @@ Portability : POSIX
-} -}
{-# LANGUAGE TypeApplications #-}
module Gargantext.Core.Worker.Jobs.Types where module Gargantext.Core.Worker.Jobs.Types where
import Data.Aeson ((.:), (.=), object, withObject) import Data.Aeson ((.:), (.=), object, withObject)
import Data.Aeson.Types (prependFailure, typeMismatch) 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.Admin.Auth.Types (AuthenticatedUser, ForgotPasswordAsyncParams)
import Gargantext.API.Ngrams.Types (NgramsList, UpdateTableNgramsCharts(_utn_list_id)) 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.Contact.Types (AddContactParams)
import Gargantext.API.Node.Corpus.Annuaire (AnnuaireWithForm)
import Gargantext.API.Node.Document.Export.Types (DocumentExport)
import Gargantext.API.Node.DocumentsFromWriteNodes.Types qualified as DFWN import Gargantext.API.Node.DocumentsFromWriteNodes.Types qualified as DFWN
import Gargantext.API.Node.DocumentUpload.Types (DocumentUpload) import Gargantext.API.Node.DocumentUpload.Types (DocumentUpload)
import Gargantext.API.Node.FrameCalcUpload.Types (FrameCalcUpload) import Gargantext.API.Node.FrameCalcUpload.Types (FrameCalcUpload)
import Gargantext.API.Node.New.Types ( PostNode(..) ) 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.Types (NewWithFile, NewWithForm, WithQuery(..))
import Gargantext.API.Node.Update.Types (UpdateNodeParams)
import Gargantext.Core.Types.Individu (User) 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))
import Gargantext.Prelude import Gargantext.Prelude
data ImportRemoteDocumentsPayload
= ImportRemoteDocumentsPayload
{ _irdp_user :: AuthenticatedUser
, _irdp_corpus_id :: NodeId
, _irdp_document_export :: DocumentExport
} deriving (Show, Eq)
instance ToJSON ImportRemoteDocumentsPayload where
toJSON ImportRemoteDocumentsPayload{..} =
object [ "user" .= _irdp_user
, "corpus_id" .= _irdp_corpus_id
, "document_export" .= _irdp_document_export
]
instance FromJSON ImportRemoteDocumentsPayload where
parseJSON = withObject "ImportRemoteDocumentsPayload" $ \o -> do
_irdp_user <- o .: "user"
_irdp_corpus_id <- o .: "corpus_id"
_irdp_document_export <- o .: "document_export"
pure ImportRemoteDocumentsPayload{..}
data Job = data Job =
Ping Ping
...@@ -65,6 +90,7 @@ data Job = ...@@ -65,6 +90,7 @@ data Job =
, _un_args :: UpdateNodeParams } , _un_args :: UpdateNodeParams }
| UploadDocument { _ud_node_id :: NodeId | UploadDocument { _ud_node_id :: NodeId
, _ud_args :: DocumentUpload } , _ud_args :: DocumentUpload }
| ImportRemoteDocuments !ImportRemoteDocumentsPayload
deriving (Show, Eq) deriving (Show, Eq)
instance FromJSON Job where instance FromJSON Job where
parseJSON = withObject "Job" $ \o -> do parseJSON = withObject "Job" $ \o -> do
...@@ -132,6 +158,8 @@ instance FromJSON Job where ...@@ -132,6 +158,8 @@ instance FromJSON Job where
_ud_node_id <- o .: "node_id" _ud_node_id <- o .: "node_id"
_ud_args <- o .: "args" _ud_args <- o .: "args"
return $ UploadDocument { .. } return $ UploadDocument { .. }
"ImportRemoteDocuments" ->
ImportRemoteDocuments <$> parseJSON (JS.Object o)
s -> prependFailure "parsing job type failed, " (typeMismatch "type" s) s -> prependFailure "parsing job type failed, " (typeMismatch "type" s)
instance ToJSON Job where instance ToJSON Job where
toJSON Ping = object [ "type" .= ("Ping" :: Text) ] toJSON Ping = object [ "type" .= ("Ping" :: Text) ]
...@@ -196,10 +224,12 @@ instance ToJSON Job where ...@@ -196,10 +224,12 @@ instance ToJSON Job where
object [ "type" .= ("UploadDocument" :: Text) object [ "type" .= ("UploadDocument" :: Text)
, "node_id" .= _ud_node_id , "node_id" .= _ud_node_id
, "args" .= _ud_args ] , "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."
-- | We want to have a way to specify 'Maybe NodeId' from given worker -- | We want to have a way to specify 'Maybe NodeId' from given worker
-- parameters. The given 'Maybe CorpusId' is an alternative, when -- parameters. The given 'Maybe CorpusId' is an alternative, when
...@@ -223,3 +253,4 @@ getWorkerMNodeId (PostNodeAsync { _pna_node_id }) = Just _pna_node_id ...@@ -223,3 +253,4 @@ getWorkerMNodeId (PostNodeAsync { _pna_node_id }) = Just _pna_node_id
getWorkerMNodeId (RecomputeGraph { _rg_node_id }) = Just _rg_node_id getWorkerMNodeId (RecomputeGraph { _rg_node_id }) = Just _rg_node_id
getWorkerMNodeId (UpdateNode { _un_node_id }) = Just _un_node_id getWorkerMNodeId (UpdateNode { _un_node_id }) = Just _un_node_id
getWorkerMNodeId (UploadDocument { _ud_node_id }) = Just _ud_node_id getWorkerMNodeId (UploadDocument { _ud_node_id }) = Just _ud_node_id
getWorkerMNodeId (ImportRemoteDocuments (ImportRemoteDocumentsPayload _ corpusId _)) = Just corpusId
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment