[file] refactoring of new file endpoint location

This works now for arbitrary nodes, irrespective of their type.

src/Gargantext/API/Admin/Orchestrator/Types.hs

@@ -11,14 +11,16 @@ import Data.Proxy
 import Data.Swagger hiding (URL, url, port)
 import Data.Text (Text)
 import GHC.Generics hiding (to)
-import Gargantext.Core.Types (TODO(..))
-import Gargantext.Prelude
+import Servant
 import Servant.Job.Async
 import Servant.Job.Types
 import Servant.Job.Utils (jsonOptions)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 
+import Gargantext.Core.Types (TODO(..))
+import Gargantext.Prelude
+
 ------------------------------------------------------------------------
 instance Arbitrary a => Arbitrary (JobStatus 'Safe a) where
   arbitrary = panic "TODO"
@@ -126,3 +128,7 @@ instance ToParamSchema Limit -- where
 type ScrapersEnv = JobEnv JobLog JobLog
 
 type ScraperAPI  = AsyncJobsAPI JobLog ScraperInput  JobLog
+
+------------------------------------------------------------------------
+type AsyncJobs event ctI input output =
+  AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output

src/Gargantext/API/Ngrams/List.hs

@@ -22,7 +22,13 @@ import Data.Map (Map, toList, fromList)
 import Data.Swagger (ToSchema, declareNamedSchema, genericDeclareNamedSchema)
 import Data.Text (Text, concat, pack)
 import GHC.Generics (Generic)
-import Gargantext.API.Node.Corpus.New
+import Network.HTTP.Media ((//), (/:))
+import Servant
+import Servant.Job.Async
+import Servant.Job.Utils (jsonOptions)
+import Web.FormUrlEncoded (FromForm)
+
+import Gargantext.Prelude
 import Gargantext.API.Node.Corpus.New.File (FileType(..))
 import Gargantext.API.Ngrams
 import Gargantext.API.Admin.Orchestrator.Types
@@ -31,12 +37,6 @@ import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
 import Gargantext.Database.Action.Flow (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes)
-import Gargantext.Prelude
-import Network.HTTP.Media ((//), (/:))
-import Servant
-import Servant.Job.Async
-import Servant.Job.Utils (jsonOptions)
-import Web.FormUrlEncoded (FromForm)
 
 ------------------------------------------------------------------------
 type NgramsList = (Map NgramsType (Versioned NgramsTableMap))

src/Gargantext/API/Node.hs

@@ -150,6 +150,7 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "unpublish" :> Share.Unpublish
 
              :<|> "file"      :> FileApi
+             :<|> "async"     :> FileAsyncApi
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
@@ -227,6 +228,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> Share.unPublish id'
 
            :<|> fileApi uId id'
+           :<|> fileAsyncApi uId id'
 
 
 ------------------------------------------------------------------------

src/Gargantext/API/Node/Contact.hs

@@ -29,10 +29,14 @@ import Data.Maybe (Maybe(..))
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
+import Servant
+import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Settings (HasSettings)
 import Gargantext.API.Node
-import Gargantext.API.Node.Corpus.New (AsyncJobs)
 import Gargantext.API.Prelude (GargServer, simuLogs)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types.Individu (User(..))
@@ -43,10 +47,6 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude (($), liftBase, (.), printDebug, pure)
 import Gargantext.Text.Terms (TermType(..))
-import Servant
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary
 
 ------------------------------------------------------------------------
 type API = "contact" :> Summary "Contact endpoint"

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

@@ -19,18 +19,19 @@ import Data.Aeson
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.Core (Lang(..))
-import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
-import Gargantext.Database.Action.Flow (FlowCmdM)  -- flowAnnuaire
-import Gargantext.Database.Admin.Types.Node (AnnuaireId)
-import Gargantext.Prelude
 import Servant
 import Servant.Job.Core
 import Servant.Job.Types
 import Servant.Job.Utils (jsonOptions)
 import Web.FormUrlEncoded (FromForm)
+
 import qualified Gargantext.API.Node.Corpus.New.File as NewFile
+import Gargantext.API.Admin.Orchestrator.Types hiding (AsyncJobs)
+import Gargantext.Core (Lang(..))
+import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
+import Gargantext.Database.Action.Flow (FlowCmdM)  -- flowAnnuaire
+import Gargantext.Database.Admin.Types.Node (AnnuaireId)
+import Gargantext.Prelude
 
 
 type Api = Summary "New Annuaire endpoint"

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

@@ -14,7 +14,6 @@ New corpus means either:
 
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE TypeOperators      #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Gargantext.API.Node.Corpus.New
       where
@@ -22,30 +21,25 @@ module Gargantext.API.Node.Corpus.New
 import Control.Lens hiding (elements, Empty)
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Base64 as BSB64
 import Data.Either
 import Data.Maybe (fromMaybe)
 import Data.Swagger
 import Data.Text (Text)
 import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
 import GHC.Generics (Generic)
 import Servant
-import Servant.Job.Core
-import Servant.Job.Types
 import Servant.Job.Utils (jsonOptions)
 -- import Servant.Multipart
 -- import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
-import Web.FormUrlEncoded          (FromForm)
 
 import Gargantext.Prelude
 
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import qualified Gargantext.API.Admin.Orchestrator.Types as T
 import Gargantext.API.Admin.Settings (HasSettings)
 import Gargantext.API.Node.Corpus.New.File
+import Gargantext.API.Node.Types
 import Gargantext.Core (Lang(..){-, allLangs-})
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
@@ -163,49 +157,6 @@ instance FromJSON WithQuery where
 instance ToSchema WithQuery where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wq_")
 
--------------------------------------------------------
-data NewWithForm = NewWithForm
-  { _wf_filetype :: !FileType
-  , _wf_data     :: !Text
-  , _wf_lang     :: !(Maybe Lang)
-  , _wf_name     :: !Text
-  } deriving (Eq, Show, Generic)
-
-makeLenses ''NewWithForm
-instance FromForm NewWithForm
-instance FromJSON NewWithForm where
-  parseJSON = genericParseJSON $ jsonOptions "_wf_"
-instance ToSchema NewWithForm where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
-
--------------------------------------------------------
-data NewWithFile = NewWithFile
-  { _wfi_b64_data :: !Text
-  , _wfi_lang     :: !(Maybe Lang)
-  , _wfi_name     :: !Text
-  } deriving (Eq, Show, Generic)
-
-makeLenses ''NewWithFile
-instance FromForm NewWithFile
-instance FromJSON NewWithFile where
-  parseJSON = genericParseJSON $ jsonOptions "_wfi_"
-instance ToSchema NewWithFile where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wfi_")
-
-instance GPU.SaveFile NewWithFile where
-  saveFile' fp (NewWithFile b64d _ _) = do
-    let eDecoded = BSB64.decode $ TE.encodeUtf8 b64d
-    case eDecoded of
-      Left err -> panic $ T.pack $ "Error decoding: " <> err
-      Right decoded -> BS.writeFile fp decoded
-    -- BS.writeFile fp $ BSB64.decodeLenient $ TE.encodeUtf8 b64d
-
---instance GPU.ReadFile NewWithFile where
---  readFile' = TIO.readFile
-
-------------------------------------------------------------------------
-type AsyncJobs event ctI input output =
-  AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output
 ------------------------------------------------------------------------
 
 type AddWithQuery = Summary "Add with Query to corpus endpoint"

src/Gargantext/API/Node/Corpus/New/File.hs

@@ -26,11 +26,6 @@ import Data.Monoid (mempty)
 import Data.Swagger
 import Data.Text (Text())
 import GHC.Generics (Generic)
-import Gargantext.API.Ngrams (TODO)
-import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude -- (Cmd, CmdM)
-import Gargantext.Prelude
-import Gargantext.Core.Crypto.Hash (hash)
 import Servant
 import Servant.Multipart
 import Servant.Swagger (HasSwagger(toSwagger))
@@ -38,6 +33,12 @@ import Servant.Swagger.Internal
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
+import Gargantext.API.Ngrams (TODO)
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude -- (Cmd, CmdM)
+import Gargantext.Prelude
+import Gargantext.Core.Crypto.Hash (hash)
+
 -------------------------------------------------------------
 type Hash = Text
 data FileType = CSV

src/Gargantext/API/Node/File.hs

@@ -18,17 +18,25 @@ import qualified Network.HTTP.Media as M
 import Network.Wai.Application.Static
 import Servant
 import Servant.API.Raw (Raw)
+import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+import Servant.Job.Core
+import Servant.Job.Types
+import Servant.Job.Utils (jsonOptions)
 import Servant.Server.Internal
 
 import Gargantext.Prelude
 import qualified Gargantext.Prelude.Utils as GPU
 
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Settings (HasSettings)
+import Gargantext.API.Node.Types
 import Gargantext.API.Prelude
 import Gargantext.Database.Action.Flow.Types
+import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Types.Hyperdata.File
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node (getNodeWith)
+import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 
 data RESPONSE deriving Typeable
@@ -89,3 +97,55 @@ fileDownload uId nId = do
   -- let settings = embeddedSettings [("", "hello")]
   -- Tagged $ staticApp settings
 
+type FileAsyncApi = Summary "File Async Api"
+                 :> "file"
+                 :> "add"
+                 :> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
+
+fileAsyncApi :: UserId -> NodeId -> GargServer FileAsyncApi
+fileAsyncApi uId nId =
+  serveJobsAPI $
+    JobFunction (\i l ->
+      let
+        log' x = do
+          printDebug "addWithFile" x
+          liftBase $ l x
+      in addWithFile uId nId i log')
+
+
+addWithFile :: (HasSettings env, FlowCmdM env err m)
+            => UserId
+            -> NodeId
+            -> NewWithFile
+            -> (JobLog -> m ())
+            -> m JobLog
+addWithFile uId nId nwf@(NewWithFile _d _l fName) logStatus = do
+
+  printDebug "[addWithFile] Uploading file: " nId
+  logStatus JobLog { _scst_succeeded = Just 0
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 1
+                   , _scst_events    = Just []
+                   }
+
+  fPath <- GPU.writeFile nwf
+  printDebug "[addWithFile] File saved as: " fPath
+
+  nIds <- mkNodeWithParent NodeFile (Just nId) uId fName
+
+  _ <- case nIds of
+    [nId'] -> do
+        node <- getNodeWith nId' (Proxy :: Proxy HyperdataFile)
+        let hl = node ^. node_hyperdata
+        _ <- updateHyperdata nId' $ hl { _hff_name = fName
+                                       , _hff_path = pack fPath }
+
+        printDebug "[addWithFile] Created node with id: " nId'
+    _     -> pure ()
+
+  printDebug "[addWithFile] File upload finished: " nId
+  pure $ JobLog { _scst_succeeded = Just 1
+                , _scst_failed    = Just 0
+                , _scst_remaining = Just 0
+                , _scst_events    = Just []
+                }

src/Gargantext/API/Node/New.hs

@@ -30,8 +30,7 @@ import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 import Web.FormUrlEncoded          (FromForm)
 
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
-import Gargantext.API.Node.Corpus.New (AsyncJobs)
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Prelude
 import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Action.Node

src/Gargantext/API/Node/Types.hs

+{-# LANGUAGE TemplateHaskell    #-}
+
+module Gargantext.API.Node.Types where
+
+import Control.Lens hiding (elements, Empty)
+import Data.Aeson
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as BSB64
+import Data.Either
+import Data.Swagger
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import GHC.Generics (Generic)
+import Servant.Job.Utils (jsonOptions)
+import Web.FormUrlEncoded          (FromForm)
+
+import Gargantext.Core (Lang(..){-, allLangs-})
+import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
+import Gargantext.Prelude
+import qualified Gargantext.Prelude.Utils as GPU
+import Gargantext.API.Node.Corpus.New.File (FileType)
+
+-------------------------------------------------------
+data NewWithForm = NewWithForm
+  { _wf_filetype :: !FileType
+  , _wf_data     :: !Text
+  , _wf_lang     :: !(Maybe Lang)
+  , _wf_name     :: !Text
+  } deriving (Eq, Show, Generic)
+
+makeLenses ''NewWithForm
+instance FromForm NewWithForm
+instance FromJSON NewWithForm where
+  parseJSON = genericParseJSON $ jsonOptions "_wf_"
+instance ToSchema NewWithForm where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
+
+-------------------------------------------------------
+
+data NewWithFile = NewWithFile
+  { _wfi_b64_data :: !Text
+  , _wfi_lang     :: !(Maybe Lang)
+  , _wfi_name     :: !Text
+  } deriving (Eq, Show, Generic)
+
+makeLenses ''NewWithFile
+instance FromForm NewWithFile
+instance FromJSON NewWithFile where
+  parseJSON = genericParseJSON $ jsonOptions "_wfi_"
+instance ToSchema NewWithFile where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wfi_")
+
+instance GPU.SaveFile NewWithFile where
+  saveFile' fp (NewWithFile b64d _ _) = do
+    let eDecoded = BSB64.decode $ TE.encodeUtf8 b64d
+    case eDecoded of
+      Left err -> panic $ T.pack $ "Error decoding: " <> err
+      Right decoded -> BS.writeFile fp decoded
+    -- BS.writeFile fp $ BSB64.decodeLenient $ TE.encodeUtf8 b64d
+
+--instance GPU.ReadFile NewWithFile where
+--  readFile' = TIO.readFile

src/Gargantext/API/Node/Update.hs

@@ -20,10 +20,15 @@ import Data.Aeson
 import Data.Maybe (Maybe(..))
 import Data.Swagger
 import GHC.Generics (Generic)
+import Prelude (Enum, Bounded, minBound, maxBound)
+import Servant
+import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+
 import Gargantext.Prelude
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Settings (HasSettings)
-import Gargantext.API.Node.Corpus.New (AsyncJobs)
 import Gargantext.API.Prelude (GargServer, simuLogs)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
@@ -31,11 +36,6 @@ import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure)
 import Gargantext.Viz.Graph.API (recomputeGraph)
 import Gargantext.Viz.Graph.Distances (GraphMetric(..), Distance(..))
-import Prelude (Enum, Bounded, minBound, maxBound)
-import Servant
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary
 
 
 ------------------------------------------------------------------------

src/Gargantext/API/Routes.hs

@@ -27,6 +27,19 @@ module Gargantext.API.Routes
 import Control.Concurrent (threadDelay)
 import Data.Text (Text)
 import Data.Validity
+import Servant
+import Servant.Auth as SA
+import Servant.Auth.Swagger ()
+import Servant.Job.Async
+import Servant.Swagger.UI
+
+import qualified Gargantext.API.Ngrams.List           as List
+import qualified Gargantext.API.Node.Corpus.Annuaire  as Annuaire
+import qualified Gargantext.API.Node.Corpus.Export    as Export
+import qualified Gargantext.API.Node.Corpus.New       as New
+import qualified Gargantext.API.Public                as Public
+import qualified Gargantext.API.Node.Contact          as Contact
+
 import Gargantext.API.Admin.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), withAccess, PathId(..))
 import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
 import Gargantext.API.Count  (CountAPI, count, Query)
@@ -40,17 +53,6 @@ import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Admin.Types.Node (NodeId, CorpusId, AnnuaireId)
 import Gargantext.Prelude
 import Gargantext.Viz.Graph.API
-import Servant
-import Servant.Auth as SA
-import Servant.Auth.Swagger ()
-import Servant.Job.Async
-import Servant.Swagger.UI
-import qualified Gargantext.API.Ngrams.List           as List
-import qualified Gargantext.API.Node.Corpus.Annuaire  as Annuaire
-import qualified Gargantext.API.Node.Corpus.Export    as Export
-import qualified Gargantext.API.Node.Corpus.New       as New
-import qualified Gargantext.API.Public                as Public
-import qualified Gargantext.API.Node.Contact          as Contact
 
 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
 -- | TODO          :<|> Summary "Latest API" :> GargAPI'