[temp file] implement large object file for list json/tsv upload

src/Gargantext/API/Ngrams/List.hs

@@ -16,6 +16,7 @@ Portability : POSIX
 module Gargantext.API.Ngrams.List
   where
 
+import Data.Aeson qualified as Aeson
 import Data.ByteString.Lazy qualified as BSL
 import Data.Csv qualified as Tsv
 import Data.HashMap.Strict (HashMap)
@@ -24,8 +25,10 @@ import Data.Map.Strict (toList)
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Data.Text (concat, pack, splitOn)
+import Data.Text.Encoding qualified as TE
 import Data.Vector (Vector)
 import Data.Vector qualified as Vec
+import Database.PostgreSQL.Simple.LargeObjects qualified as PSQL
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Errors.Types (BackendInternalError(InternalServerError))
 import Gargantext.API.Ngrams (setListNgrams)
@@ -34,13 +37,14 @@ import Gargantext.API.Ngrams.Prelude (getNgramsList)
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude (GargM, serverError, HasServerError)
 import Gargantext.API.Routes.Named.List qualified as Named
-import Gargantext.API.Worker (serveWorkerAPI, serveWorkerAPIEJob)
+import Gargantext.API.Worker (serveWorkerAPIm)
 import Gargantext.Core.NodeStory.Types ( HasNodeStory )
 import Gargantext.Core.Text.Ngrams (Ngrams, NgramsType(NgramsTerms))
 import Gargantext.Core.Types.Main (ListType(..))
 import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
 import Gargantext.Database.Action.Flow (reIndexWith)
 import Gargantext.Database.Admin.Types.Node ( NodeId(_NodeId), ListId )
+import Gargantext.Database.Prelude (createLargeObject)
 import Gargantext.Database.Query.Table.Node (getNode)
 import Gargantext.Database.Schema.Ngrams ( text2ngrams, NgramsId )
 import Gargantext.Database.Schema.Node (_node_parent_id)
@@ -108,9 +112,11 @@ getTsv lId = do
 ------------------------------------------------------------------------
 jsonPostAsync :: Named.JSONAPI (AsServerT (GargM Env BackendInternalError))
 jsonPostAsync = Named.JSONAPI {
-  updateListJSONEp = \lId -> serveWorkerAPI $ \p ->
-      Jobs.JSONPost { _jp_list_id = lId
-                    , _jp_ngrams_list = _wjf_data p }
+  updateListJSONEp = \lId -> serveWorkerAPIm $ \p -> do
+      (PSQL.Oid oId) <- createLargeObject $ TE.encodeUtf8 $ _wjf_data p
+      pure $ Jobs.JSONPost { _jp_list_id = lId
+                           , _jp_ngrams_oid = fromIntegral oId }
+                           -- , _jp_ngrams_list = _wjf_data p }
   }
 
 ------------------------------------------------------------------------
@@ -152,11 +158,14 @@ tsvAPI = tsvPostAsync
 tsvPostAsync :: Named.TSVAPI (AsServerT (GargM Env BackendInternalError))
 tsvPostAsync =
   Named.TSVAPI {
-    updateListTSVEp = \lId -> serveWorkerAPIEJob $ \p ->
+    updateListTSVEp = \lId -> serveWorkerAPIm $ \p -> do
       case ngramsListFromTSVData (_wtf_data p) of
-        Left err         -> Left $ InternalServerError $ err500 { errReasonPhrase = err }
-        Right ngramsList -> Right $ Jobs.JSONPost { _jp_list_id = lId
-                                                  , _jp_ngrams_list = ngramsList }
+        Left err         -> throwError $ InternalServerError $ err500 { errReasonPhrase = err }
+        Right ngramsList -> do
+          (PSQL.Oid oId) <- createLargeObject $ BSL.toStrict $ Aeson.encode ngramsList
+          pure $ Jobs.JSONPost { _jp_list_id = lId
+                               , _jp_ngrams_oid = fromIntegral oId }
+                               -- , _jp_ngrams_list = ngramsList }
     }
 
 -- | Tries converting a text file into an 'NgramList', so that we can reuse the

src/Gargantext/API/Ngrams/List/Types.hs

@@ -12,10 +12,10 @@ Portability : POSIX
 module Gargantext.API.Ngrams.List.Types where
 
 import Data.Aeson
-import Data.ByteString.Lazy qualified as BSL
+-- import Data.ByteString.Lazy qualified as BSL
 import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema)
 import Data.Text
-import Data.Text.Encoding qualified as E
+-- import Data.Text.Encoding qualified as E
 import Gargantext.API.Ngrams.Types (NgramsList)
 import Gargantext.API.Node.Corpus.New.Types (FileType(..))
 import Gargantext.Core.Utils.Aeson (jsonOptions)
@@ -44,16 +44,18 @@ instance ToSchema WithFile where
 ------------------------------------------------------------------------
 
 data WithJsonFile = WithJsonFile
-  { _wjf_data     :: !NgramsList
+  { -- _wjf_data     :: !NgramsList
+    _wjf_data     :: !Text
   , _wjf_name     :: !Text
   } deriving (Eq, Show, Generic)
 
 instance FromForm WithJsonFile where
   fromForm f = do
-    d' <- parseUnique "_wjf_data" f
-    d <- case eitherDecode' (BSL.fromStrict $ E.encodeUtf8 d') of
-      Left s -> Left $ pack s
-      Right v -> Right v
+    d <- parseUnique "_wjf_data" f
+    -- d' <- parseUnique "_wjf_data" f
+    -- d <- case eitherDecode' (BSL.fromStrict $ E.encodeUtf8 d') of
+    --   Left s -> Left $ pack s
+    --   Right v -> Right v
     n <- parseUnique "_wjf_name" f
     pure $ WithJsonFile { _wjf_data = d
                         , _wjf_name = n }

src/Gargantext/Core/Worker.hs

@@ -21,9 +21,12 @@ module Gargantext.Core.Worker where
 import Async.Worker.Broker.Types (toA, getMessage, messageId)
 import Async.Worker qualified as W
 import Async.Worker.Types qualified as W
--- import Control.Exception.Safe qualified as CES
+import Control.Exception.Safe qualified as CES
 import Control.Lens (to)
+import Data.Aeson qualified as Aeson
+import Data.ByteString.Lazy qualified as BSL
 import Data.Text qualified as T
+import Database.PostgreSQL.Simple.LargeObjects qualified as PSQL
 import Gargantext.API.Admin.Auth (forgotUserPassword)
 import Gargantext.API.Admin.Auth.Types (ForgotPasswordAsyncParams(..))
 import Gargantext.API.Ngrams.List (postAsyncJSON)
@@ -49,7 +52,7 @@ import Gargantext.Core.Worker.Env
 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.Prelude (removeLargeObject)
+import Gargantext.Database.Prelude (readLargeObject, removeLargeObject)
 import Gargantext.Database.Query.Table.User (getUsersWithEmail)
 import Gargantext.Prelude hiding (to)
 import Gargantext.System.Logging ( logLocM, LogLevel(..), logMsg, withLogger )
@@ -230,11 +233,11 @@ performAction env _state bm = do
     AddCorpusTempFileAsync { .. } -> runWorkerMonad env $ do
       -- TODO CES.filnally
       $(logLocM) DEBUG "[performAction] add to corpus with temporary file"
-      addToCorpusWithTempFile _actf_user _actf_cid _actf_args jh
-
+      CES.finally (addToCorpusWithTempFile _actf_user _actf_cid _actf_args jh)
+          (do
              let oId = _wtf_file_oid _actf_args
              $(logLocM) DEBUG $ "[performAction] removing large object: " <> show oId
-      removeLargeObject oId
+             removeLargeObject oId)
       
     -- | Perform external API search query and index documents in corpus
     AddCorpusWithQuery { .. } -> runWorkerMonad env $ do
@@ -273,7 +276,12 @@ performAction env _state bm = do
     -- | Process uploaded JSON file
     JSONPost { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] json post"
-      void $ postAsyncJSON _jp_list_id _jp_ngrams_list jh
+      CES.finally (do
+                      _jp_ngrams_list' <- readLargeObject (PSQL.Oid $ fromIntegral _jp_ngrams_oid)
+                      case Aeson.eitherDecode (BSL.fromStrict _jp_ngrams_list') of
+                        Left err -> CES.throwString err
+                        Right _jp_ngrams_list -> void $ postAsyncJSON _jp_list_id _jp_ngrams_list jh)
+        (removeLargeObject _jp_ngrams_oid)
 
     -- | Task for updating metrics charts
     NgramsPostCharts { .. } -> runWorkerMonad env $ do

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

@@ -16,7 +16,7 @@ module Gargantext.Core.Worker.Jobs.Types where
 import Data.Aeson ((.:), (.=), object, withObject)
 import Data.Aeson.Types (prependFailure, typeMismatch)
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser, ForgotPasswordAsyncParams)
-import Gargantext.API.Ngrams.Types (NgramsList, UpdateTableNgramsCharts(_utn_list_id))
+import Gargantext.API.Ngrams.Types (UpdateTableNgramsCharts(_utn_list_id))
 import Gargantext.API.Node.Contact.Types (AddContactParams)
 import Gargantext.API.Node.Corpus.Annuaire (AnnuaireWithForm)
 import Gargantext.API.Node.DocumentsFromWriteNodes.Types qualified as DFWN
@@ -54,7 +54,8 @@ data Job =
                     , _fca_authenticatedUser :: AuthenticatedUser
                     , _fca_node_id :: NodeId }
   | JSONPost { _jp_list_id :: ListId
-             , _jp_ngrams_list :: NgramsList }
+             , _jp_ngrams_oid :: Int }
+             -- , _jp_ngrams_list :: NgramsList }
   | NgramsPostCharts { _npc_node_id :: NodeId
                      , _npc_args    :: UpdateTableNgramsCharts }
   | PostNodeAsync { _pna_node_id :: NodeId
@@ -110,7 +111,8 @@ instance FromJSON Job where
         return $ FrameCalcUpload { .. }
       "JSONPost" -> do
         _jp_list_id <- o .: "list_id"
-        _jp_ngrams_list <- o .: "ngrams_list"
+        -- _jp_ngrams_list <- o .: "ngrams_list"
+        _jp_ngrams_oid <- o .: "ngrams_oid"
         return $ JSONPost { .. }
       "NgramsPostCharts" -> do
         _npc_node_id <- o .: "node_id"
@@ -175,7 +177,8 @@ instance ToJSON Job where
   toJSON (JSONPost { .. }) =
     object [ "type" .= ("JSONPost" :: Text)
            , "list_id" .= _jp_list_id
-           , "ngrams_list" .= _jp_ngrams_list ]
+           , "ngrams_oid" .= _jp_ngrams_oid ]
+           -- , "ngrams_list" .= _jp_ngrams_list ]
   toJSON (NgramsPostCharts { .. }) =
     object [ "type" .= ("NgramsPostCharts" :: Text)
            , "node_id" .= _npc_node_id

test/Test/API/UpdateList.hs

@@ -29,7 +29,6 @@ import Control.Lens (mapped, over)
 import Control.Monad.Fail (fail)
 import Data.Aeson qualified as JSON
 import Data.Aeson.QQ
-import Data.ByteString.Lazy qualified as BSL
 import Data.Map.Strict qualified as Map
 import Data.Map.Strict.Patch qualified as PM
 import Data.Set qualified as Set
@@ -87,12 +86,12 @@ uploadJSONList port token cId pathToNgrams clientEnv = do
   ([listId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build cId)) [aesonQQ|{"pn_typename":"NodeList","pn_name":"Testing"}|]
   -- Upload the JSON doc
   simpleNgrams' <- liftIO (TIO.readFile =<< getDataFileName pathToNgrams)
-  let (Just simpleNgrams) = JSON.decode $ BSL.fromStrict $ encodeUtf8 simpleNgrams'
+  -- let (Just simpleNgrams) = JSON.decode $ BSL.fromStrict $ encodeUtf8 simpleNgrams'
   -- let jsonFileFormData = [ (T.pack "_wjf_data", simpleNgrams)
   --                        , ("_wjf_filetype", "JSON")
   --                        , ("_wjf_name", "simple_ngrams.json")
   --                        ]
-  let params = WithJsonFile { _wjf_data = simpleNgrams
+  let params = WithJsonFile { _wjf_data = simpleNgrams'
                             , _wjf_name = "simple_ngrams.json" }
   -- let url         = "/lists/"  +|listId|+ "/add/form/async"
   -- let mkPollUrl j = "/corpus/" +|listId|+ "/add/form/async/" +|_jph_id j|+ "/poll?limit=1"