Merge branch '362-dev-sqlite' into 'dev'

Resolve "Import/export in SQLite format"

See merge request !393

gargantext.cabal

@@ -136,6 +136,8 @@ library
       Gargantext.API.Node
       Gargantext.API.Node.Contact.Types
       Gargantext.API.Node.Corpus.Annuaire
+      Gargantext.API.Node.Corpus.Export.Types
+      Gargantext.API.Node.Corpus.Export.Utils
       Gargantext.API.Node.Corpus.New
       Gargantext.API.Node.Corpus.New.Types
       Gargantext.API.Node.Corpus.Types
@@ -347,7 +349,6 @@ library
       Gargantext.API.Ngrams.NgramsTree
       Gargantext.API.Node.Contact
       Gargantext.API.Node.Corpus.Export
-      Gargantext.API.Node.Corpus.Export.Types
       Gargantext.API.Node.Corpus.Searx
       Gargantext.API.Node.Corpus.Subcorpus
       Gargantext.API.Node.Document.Export
@@ -624,6 +625,7 @@ library
     , singletons-th >= 3.1 && < 3.3
     , smtp-mail >= 0.3.0.0
     , split >= 0.2.3.4
+    , sqlite-simple >= 0.4.19 && < 0.5
     , stemmer == 0.5.2
     , stm >= 2.5.1.0 && < 2.6
     , stm-containers >= 1.2.0.3 && < 1.3
@@ -762,6 +764,7 @@ common commonTestDependencies
     , servant-client >= 0.20 && < 0.21
     , servant-client-core >= 0.20 && < 0.21
     , servant-conduit >= 0.15 && < 0.17
+    , servant-server >= 0.20.1 && < 0.21
     , shelly >= 1.9 && < 2
     , stm >= 2.5.1.0 && < 2.6
     , streaming-commons
@@ -872,12 +875,15 @@ test-suite garg-test-hspec
   main-is: drivers/hspec/Main.hs
   build-depends:
       process ^>= 1.6.18.0
+    , servant >= 0.20.1 && < 0.21
+    , sqlite-simple >= 0.4.19 && < 0.5
     , unix >= 2.7.3 && < 2.9
   other-modules:
       Paths_gargantext
       Test.API
       Test.API.Authentication
       Test.API.Errors
+      Test.API.Export
       Test.API.GraphQL
       Test.API.Notifications
       Test.API.Private

src/Gargantext/API/Ngrams/NgramsTree.hs

@@ -34,7 +34,7 @@ data NgramsTree = NgramsTree { mt_label :: Text
                              , mt_value :: Double
                              , mt_children :: [NgramsTree]
                              }
-    deriving (Generic, Show)
+    deriving (Generic, Show, Eq)
 
 toNgramsTree :: Tree (NgramsTerm,Double) -> NgramsTree
 toNgramsTree (Node (NgramsTerm l,v) xs) = NgramsTree l v (map toNgramsTree xs)

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

-{-# LANGUAGE TypeOperators #-}
 {-|
 Module      : Gargantext.API.Node.Corpus.Export
 Description : Corpus export
@@ -17,27 +16,22 @@ Main exports of Gargantext:
 module Gargantext.API.Node.Corpus.Export
   where
 
-import Data.HashMap.Strict qualified as HashMap
+import Control.Exception.Safe qualified as CES
 import Data.List qualified as List
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Data.Text (pack)
-import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo)
+import Gargantext.API.Ngrams.Tools (getRepo)
 import Gargantext.API.Ngrams.Types ( NgramsTerm(unNgramsTerm) )
-import Gargantext.API.Node.Corpus.Export.Types ( Corpus(..) )
+import Gargantext.API.Node.Corpus.Export.Types ( Corpus(..), CorpusSQLite(..) )
+import Gargantext.API.Node.Corpus.Export.Utils (getContextNgrams, mkCorpusSQLite, mkCorpusSQLiteData)
 import Gargantext.API.Node.Document.Export.Types qualified as DocumentExport
 import Gargantext.API.Prelude (IsGargServer)
-import Gargantext.Core.NodeStory.Types ( NodeListStory )
 import Gargantext.Core.Text.Ngrams (NgramsType(..))
 import Gargantext.Core.Types.Main ( ListType(MapTerm) )
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Action.Metrics.NgramsByContext (getNgramsByContextOnlyUser)
-import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument(..) )
-import Gargantext.Database.Prelude (DBCmdExtra)
 import Gargantext.Database.Query.Table.Node ( defaultList )
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
-import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
 import Gargantext.Database.Query.Table.NodeContext (selectDocNodes)
 import Gargantext.Database.Schema.Context (_context_id)
 import Gargantext.Prelude hiding (hash)
@@ -48,10 +42,13 @@ import qualified Gargantext.API.Routes.Named.Corpus as Named
 
 --------------------------------------------------
 -- | Hashes are ordered by Set
-getCorpus :: forall env err m. IsGargServer env err m
+getCorpus :: (CES.MonadMask m, IsGargServer env err m)
           => CorpusId
           -> Named.CorpusExportAPI (AsServerT m)
-getCorpus cId = Named.CorpusExportAPI $ \lId nt' -> get_corpus lId nt'
+getCorpus cId = Named.CorpusExportAPI {
+    Named.corpusExportEp = get_corpus
+  , Named.corpusSQLiteEp = getCorpusSQLite cId
+  }
 
   where
     get_corpus :: IsGargServer env err m
@@ -89,23 +86,17 @@ getCorpus cId = Named.CorpusExportAPI $ \lId nt' -> get_corpus lId nt'
         $ Corpus { _c_corpus = Map.elems r
                  , _c_hash = hash $ List.map DocumentExport._d_hash $ Map.elems r }
 
-getContextNgrams :: HasNodeError err
-        => CorpusId
-        -> ListId
-        -> ListType
-        -> NgramsType
-        -> NodeListStory
-        -> DBCmdExtra err (Map ContextId (Set NgramsTerm))
-getContextNgrams cId lId listType nt repo = do
---  lId <- case lId' of
---    Nothing -> defaultList cId
---    Just  l -> pure l
 
-  lIds <- selectNodesWithUsername NodeList userMaster
-  let ngs = filterListWithRoot [listType] $ mapTermListRoot [lId] nt repo
-  -- TODO HashMap
-  r <- getNgramsByContextOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
-  pure r
+getCorpusSQLite :: ( CES.MonadMask m
+                   , IsGargServer env err m)
+                  => CorpusId
+                  -> Maybe ListId
+                  -> m (Headers '[Header "Content-Disposition" Text] CorpusSQLite)
+getCorpusSQLite cId lId = do
+  corpusSQLiteData <- mkCorpusSQLiteData cId lId
+  corpusSQLite <- mkCorpusSQLite corpusSQLiteData
+  pure $ addHeader ("attachment; filename=GarganText_corpus-" <> pack (show cId) <> ".sqlite")
+    $ corpusSQLite
 
 -- TODO
 -- Exports List

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

@@ -13,14 +13,21 @@ Portability : POSIX
 
 module Gargantext.API.Node.Corpus.Export.Types where
 
-import Data.Aeson.TH (deriveJSON)
-import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema, ToParamSchema(..) )
-import Data.Text (Text)
-import GHC.Generics (Generic)
+import Data.ByteString.Lazy qualified as BSL
+import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema, ToParamSchema(..), NamedSchema(..), binarySchema )
+import Data.Time.Clock (UTCTime)
+import Data.Version (Version)
 import Gargantext.API.Node.Document.Export.Types qualified as DocumentExport
-import Gargantext.Core.Types ( TODO )
+import Gargantext.API.Ngrams.Types (NgramsTerm)
+import Gargantext.Core.Types ( CorpusId, ListId, TODO )
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Servant
+import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus)
+import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument)
+import Gargantext.Database.Admin.Types.Hyperdata.List (HyperdataList)
+import Gargantext.Database.Admin.Types.Node (ContextId, NodeId)
+import Gargantext.Prelude
+import Gargantext.Prelude.Crypto.Hash qualified as H
+import Servant (Accept(..), MimeRender(mimeRender), MimeUnrender(mimeUnrender), OctetStream)
 
 
 -- Corpus Export
@@ -37,3 +44,46 @@ instance ToSchema Corpus where
 instance ToParamSchema Corpus where
   toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
 $(deriveJSON (unPrefix "_c_") ''Corpus)
+
+
+
+
+-- | Wrapper around 'ByteString' to return an SQLite db containing
+-- corpus
+newtype CorpusSQLite =
+  CorpusSQLite { _cs_bs :: BSL.ByteString }
+  deriving (Generic, NFData)
+instance Accept CorpusSQLite where
+  contentType _ = contentType (Proxy :: Proxy OctetStream)
+instance MimeRender OctetStream CorpusSQLite where
+  mimeRender _ (CorpusSQLite bs) = bs
+-- | Needed for tests
+instance MimeUnrender OctetStream CorpusSQLite where
+  mimeUnrender _ bs = Right $ CorpusSQLite { _cs_bs = bs }
+instance ToSchema CorpusSQLite where
+  declareNamedSchema _ = pure $ NamedSchema (Just "CorpusSQLite") binarySchema
+
+                         
+-- | Contents of the SQLite export DB
+-- (having such datatype makes it easier to coherently implement import/export)
+data CorpusSQLiteData =
+  CorpusSQLiteData { _csd_version                  :: Version
+                   , _csd_cId                      :: CorpusId
+                   , _csd_lId                      :: ListId
+                   , _csd_created                  :: UTCTime
+                                                  
+                   , _csd_corpus_name              :: Text
+                   , _csd_corpus_hash              :: Maybe H.Hash
+                   , _csd_corpus_parent            :: Maybe NodeId
+                   , _csd_corpus_hyperdata         :: HyperdataCorpus
+                                                  
+                   , _csd_list_name                :: Text
+                   , _csd_list_parent              :: Maybe NodeId
+                   , _csd_list_hyperdata           :: HyperdataList
+                                                  
+                   , _csd_contexts                 :: [(NodeId, Text, UTCTime, HyperdataDocument)]
+
+                   , _csd_map_context_ngrams       :: Map ContextId (Set NgramsTerm)
+                   , _csd_stop_context_ngrams      :: Map ContextId (Set NgramsTerm)
+                   , _csd_candidate_context_ngrams :: Map ContextId (Set NgramsTerm)
+                   } deriving (Show, Eq, Generic)

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

@@ -23,7 +23,7 @@ import Data.Tuple.Select (sel1, sel2, sel3)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Config (GargConfig(..), hasConfig)
 import Gargantext.Core.Config.Types (FramesConfig(..))
-import Gargantext.Core.NLP (HasNLPServer, nlpServerGet)
+import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.NodeStory.Types ( HasNodeStory )
 import Gargantext.Core.Text.Corpus.Query qualified as Query
 import Gargantext.Core.Text.Terms (TermType(..))
@@ -126,7 +126,6 @@ insertSearxResponse :: ( MonadBase IO m
                     -> m ()
 insertSearxResponse _ _ _ _ (Left _) = pure ()
 insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) = do
-  server <- view (nlpServerGet l)
   -- docs :: [Either Text HyperdataDocument]
   let docs = hyperdataDocumentFromSearxResult l <$> _srs_results
   --printDebug "[triggerSearxSearch] docs" docs
@@ -141,7 +140,7 @@ insertSearxResponse user cId listId l (Right (SearxResponse { _srs_results })) =
     -}
   --_ <- flowDataText user (DataNew [docs']) (Multi l) cId Nothing logStatus
   let mCorpus = Nothing :: Maybe HyperdataCorpus
-  void $ addDocumentsToHyperCorpus server mCorpus (Multi l) cId docs'
+  void $ addDocumentsToHyperCorpus mCorpus (Multi l) cId docs'
 
   _ <- buildSocialList l user cId listId mCorpus Nothing
 

src/Gargantext/API/Node/DocumentUpload.hs

@@ -27,7 +27,7 @@ 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, HasNLPServer)
+import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.NodeStory.Types (HasNodeStoryEnv, HasNodeArchiveStoryImmediateSaver)
 import Gargantext.Core.Text.Corpus.Parsers.Date (mDateSplit)
 import Gargantext.Core.Text.Terms (TermType(..))
@@ -99,8 +99,7 @@ documentUpload nId doc = do
                              , _hd_institutes_tree = Nothing }
 
   let lang = EN
-  ncs <- view $ nlpServerGet lang
-  addDocumentsToHyperCorpus ncs (Nothing :: Maybe HyperdataCorpus) (Multi lang) cId [hd]
+  addDocumentsToHyperCorpus (Nothing :: Maybe HyperdataCorpus) (Multi lang) cId [hd]
 
 -- | Imports the documents contained into this 'DocumentExport' into this (local) version
 -- of the running node.
@@ -122,9 +121,8 @@ remoteImportDocuments :: ( HasNodeError err
                       -> 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)
+  docs <- addDocumentsToHyperCorpus (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/Routes/Named/Corpus.hs

@@ -25,7 +25,7 @@ import Data.Aeson.TH (deriveJSON)
 import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
 import Data.Text (Text)
 import GHC.Generics
-import Gargantext.API.Node.Corpus.Export.Types (Corpus)
+import Gargantext.API.Node.Corpus.Export.Types (Corpus, CorpusSQLite)
 import Gargantext.API.Node.Types (NewWithForm, WithQuery)
 import Gargantext.API.Worker (WorkerAPI)
 import Gargantext.Core.Text.Ngrams (NgramsType(..))
@@ -35,12 +35,16 @@ import Gargantext.Prelude (Bool)
 import Servant
 
 --------------------------------------------------
-newtype CorpusExportAPI mode = CorpusExportAPI
+data CorpusExportAPI mode = CorpusExportAPI
   { corpusExportEp :: mode :- Summary "Corpus Export"
                            :> "export"
                            :> QueryParam "listId"     ListId
                            :> QueryParam "ngramsType" NgramsType
                            :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Corpus)
+  , corpusSQLiteEp :: mode :- Summary "Corpus SQLite export"
+                           :> "sqlite"
+                           :> QueryParam "listId" ListId
+                           :> Get '[OctetStream] (Headers '[Servant.Header "Content-Disposition" Text] CorpusSQLite)
   } deriving Generic
 
 

src/Gargantext/Core/Text/Corpus/API/Arxiv.hs

@@ -9,8 +9,8 @@ Portability : POSIX
 
 -}
 
-{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
 
 module Gargantext.Core.Text.Corpus.API.Arxiv
     ( get
@@ -18,7 +18,7 @@ module Gargantext.Core.Text.Corpus.API.Arxiv
     , convertQuery
     ) where
 
-import Arxiv qualified as Arxiv
+import Arxiv qualified
 import Conduit
 import Data.Text qualified as Text
 import Gargantext.Core (Lang(..))

src/Gargantext/Core/Viz/Types.hs

@@ -22,7 +22,7 @@ data Chart = ChartHisto | ChartScatter | ChartPie
 data Histo = Histo { histo_dates :: !(Vector Text)
                    , histo_count :: !(Vector Int)
                    }
-  deriving (Show, Generic)
+  deriving (Show, Generic, Eq)
 
 instance ToSchema Histo where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "histo_")

src/Gargantext/Database/Action/Flow.hs

@@ -64,7 +64,7 @@ import Data.Set qualified as Set
 import Data.Text qualified as T
 import Gargantext.API.Ngrams.Tools (getTermsWith)
 import Gargantext.API.Ngrams.Types (NgramsTerm)
-import Gargantext.Core (Lang(..), NLPServerConfig, withDefaultLanguage)
+import Gargantext.Core (Lang(..), withDefaultLanguage)
 import Gargantext.Core.Notifications.CentralExchange.Types (HasCentralExchangeNotification(ce_notify), CEMessage(..))
 import Gargantext.Core.Config (GargConfig(..), hasConfig)
 import Gargantext.Core.Config.Types (APIsConfig(..))
@@ -274,10 +274,9 @@ flow :: forall env err m a c.
 flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
   (_userId, userCorpusId, listId) <- createNodes mkCorpusUser c
   -- TODO if public insertMasterDocs else insertUserDocs
-  nlpServer <- view $ nlpServerGet (_tt_lang la)
   runConduit $ zipSources (yieldMany ([1..] :: [Int])) docsC
     .| CList.chunksOf 5
-    .| mapM_C (addDocumentsWithProgress nlpServer userCorpusId)
+    .| mapM_C (addDocumentsWithProgress userCorpusId)
     .| sinkNull
 
   let u = userFromMkCorpusUser mkCorpusUser
@@ -286,10 +285,10 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
   flowCorpusUser (la ^. tt_lang) u userCorpusId listId c mfslw
 
   where
-    addDocumentsWithProgress :: NLPServerConfig -> CorpusId -> [(Int, a)] -> m ()
-    addDocumentsWithProgress nlpServer userCorpusId docsChunk = do
+    addDocumentsWithProgress :: CorpusId -> [(Int, a)] -> m ()
+    addDocumentsWithProgress userCorpusId docsChunk = do
       $(logLocM) DEBUG $ T.pack $ "calling insertDoc, ([idx], mLength) = " <> show (fst <$> docsChunk, count)
-      docs <- addDocumentsToHyperCorpus nlpServer c la userCorpusId (map snd docsChunk)
+      docs <- addDocumentsToHyperCorpus c la userCorpusId (map snd docsChunk)
       markProgress (length docs) jobHandle
 
 
@@ -297,17 +296,17 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
 -- the given documents to the corpus. Returns the Ids of the inserted documents.
 addDocumentsToHyperCorpus :: ( IsDBCmd env err m
                              , HasNodeError err
+                             , HasNLPServer env
                              , FlowCorpus document
                              , MkCorpus corpus
                              )
-                             => NLPServerConfig
-                             -> Maybe corpus
+                             => Maybe corpus
                              -> TermType Lang
                              -> CorpusId
                              -> [document]
                              -> m [DocId]
-addDocumentsToHyperCorpus ncs mb_hyper la corpusId docs = do
-  ids <- insertMasterDocs ncs mb_hyper la docs
+addDocumentsToHyperCorpus mb_hyper la corpusId docs = do
+  ids <- insertMasterDocs mb_hyper la docs
   void $ Doc.add corpusId (map nodeId2ContextId ids)
   pure ids
 
@@ -401,15 +400,16 @@ buildSocialList l user userCorpusId listId ctype mfslw = do
 
 insertMasterDocs :: ( IsDBCmd env err m
                     , HasNodeError err
+                    , HasNLPServer env
                     , FlowCorpus a
                     , MkCorpus   c
                     )
-                 => NLPServerConfig
-                 -> Maybe c
+                 => Maybe c
                  -> TermType Lang
                  -> [a]
                  -> m [DocId]
-insertMasterDocs ncs c lang hs  =  do
+insertMasterDocs c lang hs  =  do
+  nlpServer <- view $ nlpServerGet (_tt_lang lang)
   (masterUserId, _, masterCorpusId) <- getOrMkRootWithCorpus MkCorpusUserMaster c
   (ids', documentsWithId) <- insertDocs masterUserId masterCorpusId (map (toNode masterUserId Nothing) hs )
   _ <- Doc.add masterCorpusId ids'
@@ -421,7 +421,7 @@ insertMasterDocs ncs c lang hs  =  do
   mapNgramsDocs' :: HashMap.HashMap ExtractedNgrams (Map NgramsType (Map NodeId (TermsWeight, TermsCount)))
                 <- mapNodeIdNgrams
                 <$> documentIdWithNgrams
-                      (extractNgramsT ncs $ withLang lang documentsWithId)
+                      (extractNgramsT nlpServer $ withLang lang documentsWithId)
                       (map (B.first contextId2NodeId) documentsWithId)
 
   lId <- getOrMkList masterCorpusId masterUserId

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

@@ -28,7 +28,7 @@ data HyperdataCorpus =
                   -- 'defaultLanguage' if we don't know which language it is.
                   , _hc_lang           :: Maybe Lang
                   }
-    deriving (Generic, Show)
+    deriving (Generic, Eq, Show)
 
 defaultHyperdataCorpus :: HyperdataCorpus
 defaultHyperdataCorpus =

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

@@ -34,7 +34,7 @@ data CorpusField = MarkdownField { _cf_text    :: !Text }
                                  , _cf_authors :: !Text
                                  -- , _cf_resources :: ![Resource]
                                  }
-                  deriving (Show, Generic)
+                  deriving (Show, Generic, Eq)
 
 defaultCorpusField :: CorpusField
 defaultCorpusField = MarkdownField "# Title"
@@ -56,7 +56,7 @@ data HyperdataField a =
   HyperdataField { _hf_type :: !CodeType
                  , _hf_name :: !Text
                  , _hf_data :: !a
-                 } deriving (Generic, Show)
+                 } deriving (Generic, Show, Eq)
 defaultHyperdataField :: HyperdataField CorpusField
 defaultHyperdataField = HyperdataField Markdown "name" defaultCorpusField
 

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

@@ -34,7 +34,7 @@ data HyperdataList =
                 , _hl_pie     :: !(HashMap TabType (ChartMetrics Histo))
                 , _hl_scatter :: !(HashMap TabType Metrics)
                 , _hl_tree    :: !(HashMap TabType (ChartMetrics (Vector NgramsTree)))
-                } deriving (Show, Generic)
+                } deriving (Show, Generic, Eq)
   -- HyperdataList { _hl_chart   :: !(Maybe (ChartMetrics Histo))
   --               , _hl_list    :: !(Maybe Text)
   --               , _hl_pie     :: !(Maybe (ChartMetrics Histo))

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

@@ -25,7 +25,7 @@ import Test.QuickCheck.Arbitrary
 
 newtype Metrics = Metrics
   { metrics_data :: Vector Metric}
-  deriving (Generic, Show)
+  deriving (Generic, Show, Eq)
 
 instance ToSchema Metrics where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "metrics_")
@@ -38,7 +38,7 @@ data Metric = Metric
   , m_x     :: !Double
   , m_y     :: !Double
   , m_cat   :: !ListType
-  } deriving (Generic, Show)
+  } deriving (Generic, Show, Eq)
 
 instance ToSchema Metric where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "m_")
@@ -54,7 +54,7 @@ deriveJSON (unPrefix "metrics_") ''Metrics
 
 
 newtype ChartMetrics a = ChartMetrics { chartMetrics_data :: a }
-  deriving (Generic, Show)
+  deriving (Generic, Show, Eq)
 
 instance (Typeable a, ToSchema a) => ToSchema (ChartMetrics a) where
   declareNamedSchema = wellNamedSchema "chartMetrics_"

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

@@ -308,6 +308,7 @@ selectNodesIdWithType nt = proc () -> do
     restrict -< tn .== (sqlInt4 $ toDBid nt)
     returnA -< _node_id row
 
+-- | Get node, Hyperdata is 'Aeson.Value'
 getNode :: HasNodeError err => NodeId -> DBCmd err (Node Value)
 getNode nId = do
   maybeNode <- headMay <$> runOpaQuery (selectNode (pgNodeId nId))

stack.yaml

@@ -273,6 +273,10 @@ flags:
     tagged: true
   bitvec:
     simd: true
+  "blaze-textual":
+    developer: false
+    "integer-simple": false
+    native: true
   boring:
     tagged: true
   "bytestring-builder":
@@ -338,6 +342,14 @@ flags:
     have_strong_getauxval: false
     have_weak_getauxval: false
     "pkg-config": true
+  "direct-sqlite":
+    dbstat: true
+    fulltextsearch: true
+    haveusleep: true
+    json1: true
+    mathfunctions: false
+    systemlib: false
+    urifilenames: true
   distributive:
     semigroups: true
     tagged: true

test/Test/API.hs

@@ -5,6 +5,7 @@ import Prelude
 import Test.Hspec
 import qualified Test.API.Authentication as Auth
 import qualified Test.API.Errors as Errors
+import qualified Test.API.Export as Export
 import qualified Test.API.GraphQL as GraphQL
 import qualified Test.API.Notifications as Notifications
 import qualified Test.API.Private as Private
@@ -17,6 +18,7 @@ tests = describe "Gargantext API" $ do
   Private.tests
   GraphQL.tests
   Errors.tests
+  Export.tests
   UpdateList.tests
   Notifications.tests
   Worker.tests

test/Test/API/Export.hs

+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+
+module Test.API.Export (tests) where
+
+import Data.ByteString.Lazy qualified as BSL
+import Data.Version (showVersion)
+import Database.SQLite.Simple qualified as S
+-- import Fmt (build)
+import Gargantext.API.Node.Corpus.Export.Types (CorpusSQLite(..), CorpusSQLiteData(..))
+import Gargantext.API.Node.Corpus.Export.Utils (withTempSQLiteDir, mkCorpusSQLiteData)
+import Gargantext.Core (Lang(EN))
+import Gargantext.Core.Text.Terms (TermType(Multi))
+import Gargantext.Core.Types (unNodeId)
+import Gargantext.Core.Types.Individu
+import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus)
+import Gargantext.Database.Action.User (getUserId)
+import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus)
+import Gargantext.Database.Admin.Types.Node (NodeType(NodeFolder, NodeCorpus, NodeFolderPrivate))
+import Gargantext.Database.Query.Table.Node (getOrMkList, getNodeWith, insertDefaultNode, insertNode)
+import Gargantext.Database.Query.Tree.Root (getRootId)
+import Gargantext.Database.Schema.Node (node_hyperdata)
+import Gargantext.Prelude hiding (get)
+import Paths_gargantext qualified as PG -- cabal magic build module
+import Servant.API.ResponseHeaders (Headers(getResponse))
+import Servant.Auth.Client ()
+import Servant.Client.Streaming (runClientM)
+import Test.API.Prelude (checkEither)
+import Test.API.Routes (get_corpus_sqlite_export)
+import Test.API.Setup (withTestDBAndPort, dbEnvSetup, SpecContext (..))
+import Test.API.UpdateList (createFortranDocsList)
+import Test.Database.Operations.DocumentSearch (exampleDocument_01, exampleDocument_02)
+import Test.Database.Types (runTestMonad)
+import Test.Hspec
+import Test.Hspec.Wai.Internal (withApplication)
+import Test.Utils (withValidLogin)
+
+
+tests :: Spec
+tests = sequential $ around withTestDBAndPort $ beforeWith dbEnvSetup $ do
+  describe "Export API" $ do
+    describe "Check CorpusSQLiteData creation" $ do
+      it "correctly creates CorpusSQLiteData" $ \ctx -> do
+        flip runReaderT (_sctx_env ctx) $ runTestMonad $ do
+          aliceUserId    <- getUserId (UserName "alice")
+          aliceRootId    <- getRootId (UserName "alice")
+          alicePrivateFolderId <- insertNode NodeFolderPrivate (Just "NodeFolderPrivate") Nothing aliceRootId aliceUserId
+          aliceFolderId  <- insertDefaultNode NodeFolder alicePrivateFolderId aliceUserId
+          corpusId       <- insertDefaultNode NodeCorpus aliceFolderId aliceUserId
+          aliceListId    <- getOrMkList corpusId aliceUserId
+          corpus <- getNodeWith corpusId (Proxy @HyperdataCorpus)
+  
+          let docs = [ exampleDocument_01, exampleDocument_02 ]
+          
+          let lang = EN
+          _ <- addDocumentsToHyperCorpus (Just $ corpus ^. node_hyperdata) (Multi lang) corpusId docs
+  
+          (CorpusSQLiteData { .. }) <- mkCorpusSQLiteData corpusId Nothing
+
+          liftIO $ do
+            _csd_version `shouldBe` PG.version
+            _csd_cId `shouldBe` corpusId
+            _csd_lId `shouldBe` aliceListId
+            length _csd_contexts `shouldBe` 2
+            length _csd_map_context_ngrams `shouldBe` 0
+            length _csd_stop_context_ngrams `shouldBe` 0
+            length _csd_candidate_context_ngrams `shouldBe` 0
+    
+    describe "GET /api/v1.0/corpus/cId/sqlite" $ do
+      it "returns correct SQLite db" $ \ctx -> do
+        let port = _sctx_port ctx
+        withApplication (_sctx_app ctx) $ do
+          withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
+            cId <- createFortranDocsList (_sctx_env ctx) port clientEnv token
+            void $ liftIO $ do
+              (CorpusSQLite { _cs_bs }) <-
+                (checkEither $ runClientM (get_corpus_sqlite_export token cId) clientEnv) >>= (pure . getResponse)
+              withTempSQLiteDir $ \(_fp, _fname, fpath) -> do
+                BSL.writeFile fpath _cs_bs
+                S.withConnection fpath $ \conn -> do
+                  [S.Only cId'] <- S.query_ conn "SELECT value FROM info WHERE key = 'corpusId'"
+                  cId' `shouldBe` unNodeId cId
+                  -- [S.Only lId'] <- S.query_ conn "SELECT value FROM info WHERE key = 'listId'"
+                  -- lId' `shouldBe` unNodeId listId
+                  [S.Only version] <- S.query_ conn "SELECT value FROM info WHERE key = 'gargVersion'"
+                  version `shouldBe` showVersion PG.version
+                  [S.Only corpoLen] <- S.query conn "SELECT COUNT(*) FROM corpus WHERE id = ?" (S.Only $ unNodeId cId)
+                  corpoLen `shouldBe` (1 :: Int)
+                  -- [S.Only listLen] <- S.query conn "SELECT COUNT(*) FROM lists WHERE id = ?" (S.Only $ unNodeId listId)
+                  -- listLen `shouldBe` (1 :: Int)
+
+                  [S.Only ngramsLen] <- S.query_ conn "SELECT COUNT(*) FROM ngrams"
+                  ngramsLen `shouldBe` (0 :: Int)
+                  [S.Only docsLen] <- S.query_ conn "SELECT COUNT(*) FROM documents"
+                  docsLen `shouldBe` (2 :: Int)

test/Test/API/Prelude.hs

@@ -28,9 +28,9 @@ import Gargantext.Core.Types (NodeId, NodeType(..), ParentId)
 import Gargantext.Core.Worker.Env ()  -- instance HasNodeError
 import Gargantext.Database.Action.User
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus
-import Gargantext.Database.Prelude
-import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.Error
+import Gargantext.Database.Prelude (DBCmd)
+import Gargantext.Database.Query.Table.Node (insertNode, mk, getUserRootPublicNode, getUserRootPrivateNode, getUserRootShareNode)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.User (getUserByName)
 import Gargantext.Database.Query.Tree.Root
 import Gargantext.Database.Schema.Node (_node_id)

test/Test/API/Routes.hs

@@ -28,6 +28,7 @@ module Test.API.Routes (
   , delete_node
   , add_form_to_list
   , add_tsv_to_list
+  , get_corpus_sqlite_export
   , addTeamMember
   ) where
 
@@ -38,14 +39,15 @@ 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.Node.Corpus.Export.Types (CorpusSQLite)
 import Gargantext.API.Node.Share.Types (ShareNodeParams(..))
 import Gargantext.API.Routes.Client
 import Gargantext.API.Routes.Named
+import Gargantext.API.Routes.Named.Corpus (CorpusExportAPI(corpusSQLiteEp))
 import Gargantext.API.Routes.Named.List (updateListJSONEp, updateListTSVEp)
 import Gargantext.API.Routes.Named.Node hiding (treeAPI)
 import Gargantext.API.Routes.Named.Private hiding (tableNgramsAPI)
-import Gargantext.API.Routes.Named.Publish (PublishAPI(..))
-import Gargantext.API.Routes.Named.Publish (PublishRequest(..))
+import Gargantext.API.Routes.Named.Publish (PublishAPI(..), PublishRequest(..))
 import Gargantext.API.Routes.Named.Share (shareNodeEp)
 import Gargantext.API.Routes.Named.Table
 import Gargantext.API.Routes.Named.Tree (nodeTreeEp)
@@ -60,6 +62,7 @@ import Gargantext.Database.Query.Facet qualified as Facet
 import Gargantext.Database.Query.Table.NodeNode (SourceId(..), TargetId(..))
 import Gargantext.Prelude
 import Network.Wai.Handler.Warp (Port)
+import Servant (Headers, Header)
 import Servant.Auth.Client qualified as S
 import Servant.Client.Streaming
 import Servant.Conduit ()
@@ -341,6 +344,26 @@ publish_node (toServantToken -> token) sourceId policy = fmap UnsafeMkNodeId $
                & publishEp
                & ($ PublishRequest policy)
 
+
+get_corpus_sqlite_export :: Token
+                         -> CorpusId
+                         -> ClientM (Headers '[Header "Content-Disposition" Text] CorpusSQLite)
+get_corpus_sqlite_export (toServantToken -> token) cId =
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & corpusExportAPI
+               & ($ cId)
+               & corpusSQLiteEp
+               & ($ Nothing)  -- Maybe ListId
+
+
 addTeamMember :: Token -> NodeId -> ShareNodeParams -> ClientM NodeId
 addTeamMember (toServantToken -> token) nodeId params = fmap UnsafeMkNodeId $
   clientRoutes & apiWithCustomErrorScheme

test/Test/API/UpdateList.hs

@@ -23,6 +23,7 @@ module Test.API.UpdateList (
   , JobPollHandle(..)
   , updateNode
   , createDocsList
+  , createFortranDocsList
   ) where
 
 import Control.Lens (mapped, over)

test/Test/Database/Operations/DocumentSearch.hs

@@ -12,15 +12,11 @@ Portability : POSIX
 
 module Test.Database.Operations.DocumentSearch where
 
--- import Gargantext.API.Node.Update (updateDocs)
--- import Network.URI (parseURI)
-import Control.Lens (view)
 import Control.Monad.Reader
 import Data.Aeson.QQ.Simple
 import Data.Aeson.Types
 import Data.Text qualified as T
 import Gargantext.Core
-import Gargantext.Core.NLP (nlpServerGet)
 import Gargantext.Core.Text.Corpus.Query qualified as API
 import Gargantext.Core.Text.Terms.Mono.Stem
 import Gargantext.Core.Types.Individu
@@ -122,9 +118,7 @@ addCorpusDocuments env = flip runReaderT env $ runTestMonad $ do
 
   let lang = EN
   let docs = [exampleDocument_01, exampleDocument_02, exampleDocument_03, exampleDocument_04]
-  server <- view (nlpServerGet lang)
-  _ <- addDocumentsToHyperCorpus server
-                                 (Just $ _node_hyperdata $ corpus)
+  _ <- addDocumentsToHyperCorpus (Just $ _node_hyperdata $ corpus)
                                  (Multi lang)
                                  corpusId
                                  docs

test/Test/Database/Operations/PublishNode.hs

@@ -8,9 +8,6 @@ Stability   : experimental
 Portability : POSIX
 -}
 
-{-# LANGUAGE QuasiQuotes   #-}
-{-# LANGUAGE TupleSections #-}
-
 module Test.Database.Operations.PublishNode where
 
 import Prelude

test/Test/Database/Types.hs

@@ -69,6 +69,9 @@ newtype TestMonad a = TestMonad { runTestMonad :: ReaderT TestEnv IO a }
            , MonadBaseControl IO
            , MonadFail
            , MonadIO
+           , MonadMask
+           , MonadCatch
+           , MonadThrow
            )
 
 data TestJobHandle = TestNoJobHandle