[WIP] temp file storage, this is still a draft

src/Gargantext/API/Node.hs

@@ -22,7 +22,6 @@ Node API
 -}
 
 {-# LANGUAGE ScopedTypeVariables  #-}
-{-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeOperators        #-}
 
 module Gargantext.API.Node
@@ -37,7 +36,7 @@ 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.File ( fileApi, fileAsyncApi )
+import Gargantext.API.Node.File ( fileApi, fileAsyncApi, tempFileAsyncApi )
 import Gargantext.API.Node.FrameCalcUpload qualified as FrameCalcUpload
 import Gargantext.API.Node.New ( postNode, postNodeAsyncAPI )
 import Gargantext.API.Node.Share qualified as Share
@@ -265,7 +264,7 @@ genericNodeAPI' _ authenticatedUser targetNode =  Named.NodeAPI
   , moveAPI            = Named.MoveAPI $ \parentId ->
                            withPolicy authenticatedUser (moveChecks (SourceId targetNode) (TargetId parentId)) $
                              moveNode loggedInUserId targetNode parentId
-  , fileAPI            = Named.FileAPI $ fileApi targetNode
+  , fileAPI            = Named.FileAPI { fileDownloadEp = fileApi targetNode }
   , fileAsyncAPI       = fileAsyncApi authenticatedUser targetNode
   , dfwnAPI            = DFWN.api authenticatedUser targetNode
   , documentUploadAPI  = DocumentUpload.api targetNode

src/Gargantext/API/Node/File.hs

@@ -11,7 +11,6 @@ Portability : POSIX
 {-# OPTIONS_GHC -fno-warn-unused-matches #-}
 
 {-# LANGUAGE AllowAmbiguousTypes     #-}
-
 {-# LANGUAGE IncoherentInstances #-}
 
 module Gargantext.API.Node.File where
@@ -25,7 +24,6 @@ import Gargantext.API.Node.File.Types
 import Gargantext.API.Node.Types ( NewWithFile(NewWithFile) )
 import Gargantext.API.Prelude ( GargM )
 import Gargantext.API.Routes.Named.File qualified as Named
-import Gargantext.API.Worker (serveWorkerAPI)
 import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
 import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
 import Gargantext.Database.Action.Node (mkNodeWithParent)
@@ -118,3 +116,4 @@ addWithFile authenticatedUser nId nwf@(NewWithFile _d _l fName) jobHandle = do
   markComplete jobHandle
   where
     userId = authenticatedUser ^. auth_user_id
+

src/Gargantext/API/Node/File/Types.hs

+{-|
+Module      : Gargantext.API.Node.File.Types
+Description :
+Copyright   : (c) CNRS, 2017
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
 
 module Gargantext.API.Node.File.Types where
 
@@ -10,27 +19,34 @@ import Gargantext.Prelude
 import Network.HTTP.Media qualified as M
 import Servant
 
+
 data RESPONSE deriving Typeable
 
 instance Accept RESPONSE where
   contentType _ = "text" M.// "*"
-
 instance MimeRender RESPONSE BSResponse where
   mimeRender _ (BSResponse val) = BSL.fromStrict $ val
-
 instance MimeUnrender RESPONSE BSResponse where
   mimeUnrender _ lbs = Right $ BSResponse (BSL.toStrict lbs)
 
 newtype Contents = Contents BS.ByteString
-
 instance GargDB.ReadFile Contents where
   readFile' fp = do
     c <- BS.readFile fp
     pure $ Contents c
+instance ToSchema Contents where
+  declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
+instance MimeUnrender OctetStream Contents where
+  mimeUnrender _ lbs = Right $ Contents (BSL.toStrict lbs)
 
 newtype BSResponse = BSResponse BS.ByteString
   deriving (Generic)
-
 instance ToSchema BSResponse  where
   declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
 
+
+-- | Temporary file, held in database, return it's OID
+newtype DBTempFile = DBTempFile Int
+  deriving (Generic, ToJSON)
+instance ToSchema DBTempFile  where
+  declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)

src/Gargantext/API/Node/Types.hs

@@ -50,6 +50,26 @@ instance ToJSON NewWithForm where
 instance ToSchema NewWithForm where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
 
+-------------------------------------------------------
+data NewTempWithForm = NewTempWithForm
+  { _twf_filetype   :: !FileType
+  , _twf_fileformat :: !FileFormat
+  , _twf_file_oid   :: !Int
+  , _twf_lang       :: !(Maybe Lang)
+  , _twf_name       :: !Text
+  , _twf_selection  :: !FlowSocialListWith
+  } deriving (Eq, Show, Generic)
+
+makeLenses ''NewTempWithForm
+instance FromForm NewTempWithForm
+instance ToForm NewTempWithForm
+instance FromJSON NewTempWithForm where
+  parseJSON = genericParseJSON $ jsonOptions "_twf_"
+instance ToJSON NewTempWithForm where
+  toJSON = genericToJSON $ jsonOptions "_twf_"
+instance ToSchema NewTempWithForm where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_twf_")
+
 -------------------------------------------------------
 
 data NewWithFile = NewWithFile

src/Gargantext/API/Routes.hs

@@ -14,19 +14,24 @@ Portability : POSIX
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Gargantext.API.Routes
-      where
+module Gargantext.API.Routes where
 
+import Database.PostgreSQL.Simple.LargeObjects qualified as PSQL
+import Gargantext.API.Admin.Auth.Types (AuthenticatedUser, auth_user_id)
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Errors.Types (BackendInternalError)
-import Gargantext.API.Prelude (GargServer, GargM)
+import Gargantext.API.Node.Types (NewWithForm(..), NewTempWithForm(..))
+import Gargantext.API.Prelude (GargServer, GargM, IsGargServer)
 import Gargantext.API.Routes.Named.Annuaire qualified as Named
 import Gargantext.API.Routes.Named.Corpus qualified as Named
-import Gargantext.API.Worker (serveWorkerAPI)
+import Gargantext.API.Worker (serveWorkerAPI, serveWorkerAPIm, WorkerAPI)
+import Gargantext.Core (Lang)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
+import Gargantext.Database.Admin.Types.Node (CorpusId)
+import Gargantext.Database.Prelude (mkCmd)
 import Gargantext.Prelude
-import Servant (Get, JSON)
+import Servant (Get, FormUrlEncoded, JSON)
 import Servant.Server.Generic (AsServerT)
 
 ----------------------------------------------------------------------
@@ -76,6 +81,33 @@ addCorpusWithForm user =
                               , Jobs._acf_cid = cId }
     }
 
+-- | Same as 'addCorpusWithForm' but uses temporary file stored in postgres, so that
+addWithTempFileApi :: (IsGargServer env err m)
+                   => AuthenticatedUser
+                   -> CorpusId
+                   -> WorkerAPI '[FormUrlEncoded] NewWithForm (AsServerT m)
+addWithTempFileApi authenticatedUser cId =
+  serveWorkerAPIm $ \(NewWithForm { .. }) -> do
+    (PSQL.Oid oId) <- mkCmd (createLargeObject bs)
+    let args = NewTempWithForm { _twf_filetype = _wf_filetype
+                               , _twf_fileformat = _wf_fileformat
+                               , _twf_file_oid = fromIntegral oid
+                               , _twf_lang = _wf_lang
+                               , _twf_name = _wf_name
+                               , _twf_selection = _wf_selection }
+    pure $ Jobs.AddCorpusTempFileAsync { _actf_args = args
+                                       , _actf_cid = cId
+                                       , _actf_user = userId }
+
+  where
+    userId = authenticatedUser ^. auth_user_id
+    createLargeObject bs c = do
+      oId <- PSQL.loCreat c
+      loFd <- PSQL.loOpen c oId PSQL.WriteMode
+      _ <- PSQL.loWrite c loFd bs
+      PSQL.loClose c loFd
+      pure oId
+
 addAnnuaireWithForm :: Named.AddAnnuaireWithForm (AsServerT (GargM Env BackendInternalError))
 addAnnuaireWithForm =
   Named.AddAnnuaireWithForm {

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

@@ -15,6 +15,7 @@ module Gargantext.API.Routes.Named.Corpus (
   -- * Routes types
     CorpusExportAPI(..)
   , AddWithForm(..)
+  , AddWithTempFile(..)
   , AddWithQuery(..)
   , MakeSubcorpusAPI(..)
   -- * Others
@@ -53,6 +54,17 @@ newtype AddWithForm mode = AddWithForm
                           :> NamedRoutes (WorkerAPI '[FormUrlEncoded] NewWithForm)
   } deriving Generic
 
+
+data AddWithTempFile mode = AddWithTempFile
+  { addWithTempFileEp :: mode :- Summary "Add with form via temp file"
+                          :> "corpus"
+                          :> Capture "corpus_id" CorpusId
+                          :> "add"
+                          :> "temp-file"
+                          :> "async"
+                          :> NamedRoutes (WorkerAPI '[FormUrlEncoded] NewWithForm)
+  } deriving Generic
+
 newtype AddWithQuery mode = AddWithQuery
   { addWithQueryEp :: mode :- Summary "Add with Query to corpus endpoint"
                            :> "corpus"

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

 {-|
-Module      : Gargantext.API.Node.Types
+Module      : Gargantext.API.Routes.Named.File
 Description :
 Copyright   : (c) CNRS, 2017
 License     : AGPL + CECILL v3
@@ -16,6 +16,7 @@ module Gargantext.API.Routes.Named.File (
   , FileAsyncAPI(..)
   ) where
 
+
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Gargantext.API.Node.File.Types (BSResponse, RESPONSE)
@@ -23,6 +24,7 @@ import Gargantext.API.Node.Types (NewWithFile)
 import Gargantext.API.Worker (WorkerAPI)
 import Servant
 
+
 data FileAPI mode = FileAPI
   { fileDownloadEp :: mode :- Summary "File download"
                            :> "download"
@@ -36,4 +38,3 @@ data FileAsyncAPI mode = FileAsyncAPI
                            :> "add"
                            :> NamedRoutes (WorkerAPI '[FormUrlEncoded] NewWithFile)
   } deriving Generic
-

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

@@ -45,7 +45,7 @@ import Gargantext.API.Node.New.Types ( PostNode(..) )
 import Gargantext.API.Node.Types ( RenameNode(..), NodesToScore(..), NodesToCategory(..) )
 import Gargantext.API.Node.Update.Types ( UpdateNodeParams(..), Charts(..), Granularity(..), Method(..) )
 import Gargantext.API.Routes.Named.Document (DocumentsFromWriteNodesAPI, DocumentUploadAPI)
-import Gargantext.API.Routes.Named.File (FileAsyncAPI, FileAPI)
+import Gargantext.API.Routes.Named.File (FileAsyncAPI, FileAPI, TempFileAsyncAPI)
 import Gargantext.API.Routes.Named.FrameCalc (FrameCalcAPI)
 import Gargantext.API.Routes.Named.Metrics (ChartAPI, PieAPI, ScatterAPI, TreeAPI)
 import Gargantext.API.Routes.Named.Publish (PublishAPI)
@@ -93,7 +93,7 @@ data NodeAPI a mode = NodeAPI
   , searchAPI          :: mode :- "search" :> NamedRoutes (SearchAPI SearchResult)
   , shareAPI           :: mode :- "share" :> NamedRoutes ShareNode
   , unshareEp          :: mode :- "unshare" :> NamedRoutes UnshareNode
-  , publishAPI         :: mode :- "publish" :> (PolicyChecked (NamedRoutes PublishAPI))
+  , publishAPI         :: mode :- "publish" :> PolicyChecked (NamedRoutes PublishAPI)
   ---- Pairing utilities
   , pairWithEp         :: mode :- "pairwith" :> NamedRoutes PairWith
   , pairsEp            :: mode :- "pairs"    :> NamedRoutes Pairs

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

@@ -94,6 +94,7 @@ data GargPrivateAPI' mode = GargPrivateAPI'
                                       :> NamedRoutes TreeFlatAPI
   , membersAPI       :: mode :- "members" :> Summary "Team node members" :> NamedRoutes MembersAPI
   , addWithFormAPI   :: mode :- NamedRoutes AddWithForm
+  , addWithTempFile  :: mode :- NamedRoutes AddWithTempFile
   , addWithQueryEp   :: mode :- NamedRoutes AddWithQuery
   , makeSubcorpusAPI :: mode :- NamedRoutes MakeSubcorpusAPI
   , listGetAPI       :: mode :- NamedRoutes GETAPI

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

@@ -18,7 +18,7 @@ import Gargantext.API.Node.Document.Export (documentExportAPI)
 import Gargantext.API.Node.Phylo.Export qualified as PhyloExport
 import Gargantext.API.Node.ShareURL ( shareURL )
 import Gargantext.API.Prelude (GargM)
-import Gargantext.API.Routes (addCorpusWithForm, addCorpusWithQuery)
+import Gargantext.API.Routes (addCorpusWithForm, addCorpusWithQuery, addWithTempFileApi)
 import Gargantext.API.Routes.Named.Private qualified as Named
 import Gargantext.API.Server.Named.Ngrams (apiNgramsTableDoc)
 import Gargantext.API.Server.Named.Viz qualified as Viz
@@ -60,6 +60,7 @@ serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
        , treeFlatAPI       = Tree.treeFlatAPI authenticatedUser
        , membersAPI        = members
        , addWithFormAPI    = addCorpusWithForm (RootId userNodeId)
+       , addWithTempFile   = addWithTempFileApi (RootId userNodeId)
        , addWithQueryEp    = addCorpusWithQuery (RootId userNodeId)
        , makeSubcorpusAPI  = Subcorpus.makeSubcorpus userId
        , listGetAPI        = List.getAPI

src/Gargantext/API/Worker.hs

@@ -55,3 +55,14 @@ serveWorkerAPIEJob f = WorkerAPI { workerAPIPost }
           pure $ JobInfo { _ji_message_id = mId
                          , _ji_mNode_id = getWorkerMNodeId job }
     
+serveWorkerAPIm :: IsGargServer env err m
+                => (input -> m Job)
+                -> WorkerAPI contentType input (AsServerT m)
+serveWorkerAPIm f = WorkerAPI { workerAPIPost }
+  where
+    workerAPIPost i = do
+      job <- f i
+      logM DDEBUG $ "[serveWorkerAPI] sending job " <> show job
+      mId <- sendJob job
+      pure $ JobInfo { _ji_message_id = mId
+                     , _ji_mNode_id = getWorkerMNodeId job }

src/Gargantext/Core.hs

@@ -20,7 +20,7 @@ import Data.Bimap (Bimap)
 import Data.Bimap qualified as Bimap
 import Data.LanguageCodes qualified as ISO639
 import Data.Morpheus.Types (GQLType)
-import Data.Swagger (ToSchema(..), defaultSchemaOptions, genericDeclareNamedSchemaUnrestricted)
+import Data.Swagger (ToParamSchema, ToSchema(..), defaultSchemaOptions, genericDeclareNamedSchemaUnrestricted)
 import Data.Text (pack)
 import Gargantext.Prelude hiding (All)
 import Prelude (userError)
@@ -68,6 +68,7 @@ defaultLanguage = EN
 
 instance ToJSON Lang
 instance FromJSON Lang
+instance ToParamSchema Lang
 instance ToSchema Lang where
   declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
 instance FromHttpApiData Lang

src/Gargantext/Core/Worker.hs

@@ -228,6 +228,11 @@ performAction env _state bm = do
       $(logLocM) DEBUG $ "[performAction] add corpus form"
       addToCorpusWithForm _acf_user _acf_cid _acf_args jh
 
+    -- | Uses temporary file to add documents into corpus
+    AddCorpusTempFileAsync { .. } -> runWorkerMonad env $ do
+      $(logLocM) DEBUG "[performAction] add to corpus with temporary file"
+      addWithFile _awf_authenticatedUser _awf_node_id _awf_args jh
+      
     -- | Perform external API search query and index documents in corpus
     AddCorpusWithQuery { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG "[performAction] add corpus with query"

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

@@ -17,14 +17,14 @@ 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.Node.Corpus.Annuaire (AnnuaireWithForm)
 import Gargantext.API.Node.Contact.Types (AddContactParams)
+import Gargantext.API.Node.Corpus.Annuaire (AnnuaireWithForm)
 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.Types (NewWithFile, NewWithForm, NewTempWithForm, WithQuery(..))
 import Gargantext.Core.Types.Individu (User)
 import Gargantext.Database.Admin.Types.Node (AnnuaireId, CorpusId, ListId, NodeId(UnsafeMkNodeId))
 import Gargantext.Prelude
@@ -38,6 +38,9 @@ data Job =
   | AddCorpusFormAsync { _acf_args :: NewWithForm
                        , _acf_user :: User
                        , _acf_cid  :: CorpusId }
+  | AddCorpusTempFileAsync { _actf_args :: NewTempWithForm
+                           , _actf_user :: User
+                           , _actf_cid  :: CorpusId }  
   | AddCorpusWithQuery { _acq_args :: WithQuery
                        , _acq_user :: User
                        , _acq_cid   :: CorpusId }
@@ -81,6 +84,11 @@ instance FromJSON Job where
         _acf_user <- o .: "user"
         _acf_cid <- o .: "cid"
         return $ AddCorpusFormAsync { .. }
+      "AddCorpusTempFileAsync" -> do
+        _actf_args <- o .: "args"
+        _actf_user <- o .: "user"
+        _actf_cid <- o .: "cid"
+        return $ AddCorpusTempFileAsync { .. }
       "AddCorpusWithQuery" -> do
         _acq_args <- o .: "args"
         _acq_user <- o .: "user"
@@ -145,6 +153,11 @@ instance ToJSON Job where
            , "args" .= _acf_args
            , "user" .= _acf_user
            , "cid" .= _acf_cid ]
+  toJSON (AddCorpusTempFileAsync { .. }) =
+    object [ "type" .= ("AddCorpusTempFileAsync" :: Text)
+           , "args" .= _actf_args
+           , "user" .= _actf_user
+           , "cid" .= _actf_cid ]
   toJSON (AddCorpusWithQuery { .. }) =
     object [ "type" .= ("AddCorpusWithQuery" :: Text)
            , "args" .= _acq_args
@@ -211,6 +224,7 @@ getWorkerMNodeId :: Job -> Maybe NodeId
 getWorkerMNodeId Ping = Nothing
 getWorkerMNodeId (AddContact { _ac_node_id }) = Just _ac_node_id
 getWorkerMNodeId (AddCorpusFormAsync { _acf_args, _acf_cid }) = Just _acf_cid
+getWorkerMNodeId (AddCorpusTempFileAsync { _actf_cid }) = Just _actf_cid
 getWorkerMNodeId (AddCorpusWithQuery { _acq_args = WithQuery { _wq_node_id }}) = Just $ UnsafeMkNodeId _wq_node_id
 getWorkerMNodeId (AddToAnnuaireWithForm { _aawf_annuaire_id }) = Just _aawf_annuaire_id
 getWorkerMNodeId (AddWithFile { _awf_node_id }) = Just _awf_node_id