corpus: node upload file endpoint

/api/v1.0/node/<id>/upload

README.md

@@ -33,3 +33,21 @@ curl -sSL https://gitlab.iscpif.fr/gargantext/haskell-gargantext/raw/master/devo
 
 stack --docker exec gargantext-cli -- CorpusFromGarg.csv ListFromGarg.csv Ouput.json
 
+```sql
+INSERT INTO auth_user (password, is_superuser, username, first_name, last_name, email, is_staff, is_active)
+  VALUES ('1resu', true, 'user1', 'user', '1', 'a@localhost', true, true);
+
+-- nodetype NodeUser has id 1
+-- inserted user_id = 3
+INSERT INTO nodes (typename, user_id, name)
+  VALUES (1, 3, 'user1');
+  
+-- same for master user -- 'gargantua'
+INSERT INTO auth_user (password, is_superuser, username, first_name, last_name, email, is_staff, is_active)
+  VALUES ('autnagrag, true, 'gargantua, 'gargantua, '1', 'g@localhost', true, true);
+
+-- nodetype NodeUser has id 1
+-- inserted user_id = 5
+INSERT INTO nodes (typename, user_id, name)
+  VALUES (1, 5, 'gargantua);
+```

devops/docker-postgres

 set -eu
 docker stop dbgarg || :
 docker rm --volumes dbgarg || :
-docker run --name dbgarg -e POSTGRES_USER=gargantua -e POSTGRES_DB=gargandbV5 -e POSTGRES_PASSWORD=C8kdcUrAQy66U -d postgres
-sleep 3
 export PGPASSWORD="$(grep DB_PASS gargantext.ini | \awk '{print $3}')"
+docker run --name dbgarg -e POSTGRES_USER=gargantua -e POSTGRES_DB=gargandbV5 -e POSTGRES_PASSWORD=${PGPASSWORD} -d postgres
+sleep 3
 docker run -e PGPASSWORD -i --rm --link dbgarg:postgres postgres psql -h postgres  -U gargantua -d gargandbV5 < src/Gargantext/Database/Schema/schema.sql
 #docker run -e PGPASSWORD -i --rm --link dbgarg:postgres postgres psql -h postgres  -U gargantua  -d gargandbV5 < gargantext.dump
 #docker run -e PGPASSWORD -i --rm --link dbgarg:postgres postgres dropdb -h postgres  -U gargantua gargandbV5

src/Gargantext/API.hs

@@ -75,7 +75,6 @@ import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo, TableNgra
 import Gargantext.API.Node
 import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
 import Gargantext.API.Types
-import Gargantext.API.Upload
 import qualified Gargantext.API.Corpus.New as New
 import Gargantext.Core.Types (HasInvalidError(..))
 import Gargantext.Database.Facet
@@ -280,8 +279,6 @@ type GargAPI' =
            :<|> "tree" :> Summary "Tree endpoint"
                        :> Capture "id" NodeId        :> TreeAPI
 
-           :<|> "upload" :> ApiUpload
-           
            :<|> "new"  :> New.Api
 
 
@@ -326,7 +323,6 @@ serverGargAPI -- orchestrator
      :<|> search
      :<|> graphAPI -- TODO: mock
      :<|> treeAPI
-     :<|> upload
      :<|> New.api
   --   :<|> orchestrator
   where

src/Gargantext/API/Node.hs

@@ -24,29 +24,32 @@ Node API
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-{-# LANGUAGE DataKinds          #-}
-{-# LANGUAGE DeriveGeneric      #-}
-{-# LANGUAGE FlexibleContexts   #-}
-{-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE OverloadedStrings  #-}
-{-# LANGUAGE RankNTypes         #-}
-{-# LANGUAGE TemplateHaskell    #-}
-{-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE NoImplicitPrelude    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TypeOperators        #-}
 
 module Gargantext.API.Node
   where
 
-import Control.Lens (prism')
-import Control.Monad ((>>))
+import Control.Lens (prism', (.~), (?~))
+import Control.Monad ((>>), forM)
 import Control.Monad.IO.Class (liftIO)
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Maybe
+import Data.Monoid (mempty)
 import Data.Swagger
 import Data.Text (Text())
 import Data.Time (UTCTime)
 import GHC.Generics (Generic)
 import Gargantext.API.Metrics
-import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR)
+import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR, TODO)
 import Gargantext.API.Ngrams.NTree (MyTree)
 import Gargantext.API.Search ( SearchAPI, searchIn, SearchInQuery)
 import Gargantext.API.Types
@@ -61,10 +64,14 @@ import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
 import Gargantext.Database.Types.Node
 import Gargantext.Database.Utils -- (Cmd, CmdM)
 import Gargantext.Prelude
+import Gargantext.Prelude.Utils (hash)
 import Gargantext.Text.Metrics (Scored(..))
 import Gargantext.Viz.Chart
 import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI)
 import Servant
+import Servant.Multipart
+import Servant.Swagger (HasSwagger(toSwagger))
+import Servant.Swagger.Internal
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 import qualified Data.Map as Map
@@ -135,13 +142,14 @@ type NodeAPI a = Get '[JSON] (Node a)
                         :> QueryParam "limit"  Int
                         :> QueryParam "order"  OrderBy
                         :> SearchAPI
-             
+
              -- VIZ
              :<|> "metrics" :> MetricsAPI
              :<|> "chart"     :> ChartApi
              :<|> "pie"       :> PieApi
              :<|> "tree"      :> TreeApi
              :<|> "phylo"     :> PhyloAPI
+             :<|> "upload"    :> UploadAPI
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
@@ -184,6 +192,7 @@ nodeAPI p uId id
            :<|> getPie   id
            :<|> getTree  id
            :<|> phyloAPI id
+           :<|> postUpload id
   where
     deleteNodeApi id' = do
       node <- getNode' id'
@@ -383,7 +392,47 @@ getMetrics cId maybeListId tabType maybeLimit = do
     log' n x     = 1 + (if x <= 0 then 0 else (log $ (10^(n::Int)) * x))
     listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
     errorMsg     = "API.Node.metrics: key absent"
-  
+
   pure $ Metrics metrics
 
 
+-------------------------------------------------------------
+type Hash = Text
+
+instance ToParamSchema (MultipartData Mem) where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+
+instance (ToParamSchema a, HasSwagger sub) =>
+         HasSwagger (MultipartForm tag a :> sub) where
+  -- TODO
+  toSwagger _ = toSwagger (Proxy :: Proxy sub)
+    & addParam param
+    where
+      param = mempty
+        & required ?~ True
+        & schema   .~ ParamOther sch
+      sch = mempty
+        & in_         .~ ParamFormData
+        & paramSchema .~ toParamSchema (Proxy :: Proxy a)
+
+type UploadAPI = Summary "Upload file(s) to a corpus"
+                :> MultipartForm Mem (MultipartData Mem)
+                :> Post '[JSON] [Hash]
+
+postUpload :: NodeId -> GargServer UploadAPI
+postUpload _ multipartData = do
+  is <- liftIO $ do
+    putStrLn ("Inputs:" :: Text)
+    forM (inputs multipartData) $ \input -> do
+      putStrLn $ ("iName  " :: Text) <> (iName input)
+            <> ("iValue " :: Text) <> (iValue input)
+      pure $ iName input
+
+  _ <- forM (files multipartData) $ \file -> do
+    let content = fdPayload file
+    putStrLn $ ("XXX " :: Text) <> (fdFileName file)
+    putStrLn $ ("YYY " :: Text) <>  cs content
+    --pure $ cs content
+  -- is <- inputs multipartData
+
+  pure $ map (hash . cs) is

src/Gargantext/API/Upload.hs

-{-|
-Module      : Gargantext.API.Upload
-Description : Server API
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
--}
-
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE DeriveGeneric         #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE RankNTypes            #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeOperators         #-}
-
-module Gargantext.API.Upload
-  where
-
-import Control.Lens ((.~), (?~))
-import Gargantext.Prelude
-import Data.Text (Text)
-import Data.Monoid
-import Servant
-import Servant.Multipart
---import Servant.Mock (HasMock(mock))
-import Servant.Swagger (HasSwagger(toSwagger))
-import Servant.Swagger.Internal
--- import qualified Data.ByteString.Lazy as LBS
-import Control.Monad
-import Control.Monad.IO.Class
-import Gargantext.API.Types
---import Servant.CSV.Cassava (CSV'(..))
---import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-import Data.Swagger
-import Gargantext.API.Ngrams (TODO)
-import Gargantext.Prelude.Utils (hash)
-
--- | Upload files
--- TODO Is it possible to adapt the function according to iValue input ?
---type API = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] Integer
-
--- instance Generic Mem
-
---instance ToSchema Mem
---instance Arbitrary Mem
-
-instance ToParamSchema (MultipartData Mem) where
-  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
-
---instance Arbitrary ( MultipartData Mem)
-
-instance (ToParamSchema a, HasSwagger sub) =>
-         HasSwagger (MultipartForm tag a :> sub) where
-  -- TODO
-  toSwagger _ = toSwagger (Proxy :: Proxy sub)
-    & addParam param
-    where
-      param = mempty
-        & required ?~ True
-        & schema   .~ ParamOther sch
-      sch = mempty
-        & in_         .~ ParamFormData
-        & paramSchema .~ toParamSchema (Proxy :: Proxy a)
---declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
---instance Arbitrary (MultipartForm Mem (MultipartData Mem))
-
-{-
-instance (FromMultipart tag a, MultipartBackend tag, Servant.Multipart.LookupContext context (MultipartOptions tag))
-      => HasMock (MultipartForm tag a :> sub) context where
-  mock _ _ = undefined
-
-instance HasMock (MultipartForm Mem (MultipartData Mem) :> sub) context where
-  mock _ _ = undefined
--}
-
-type Hash = Text
-
-type ApiUpload = MultipartForm Mem (MultipartData Mem) :> Post '[JSON] [Hash]
--- MultipartData consists in textual inputs,
--- accessible through its "inputs" field, as well
--- as files, accessible through its "files" field.
-upload :: GargServer ApiUpload
-upload multipartData = do
-
---{-
-  is <- liftIO $ do
-    putStrLn ("Inputs:" :: Text)
-    forM (inputs multipartData) $ \input -> do
-      putStrLn $ ("iName  " :: Text) <> (iName input)
-            <> ("iValue " :: Text) <> (iValue input)
-      pure $ iName input
-
---{-
-  _ <- forM (files multipartData) $ \file -> do
-    let content = fdPayload file
-    putStrLn $ ("XXX " :: Text) <> (fdFileName file)
-    putStrLn $ ("YYY " :: Text) <>  cs content
-    --pure $ cs content
-  -- is <- inputs multipartData
---}
-
-  pure $ map (hash . cs) is
--------------------------------------------------------------------------------
-
-

stack.yaml

@@ -4,6 +4,10 @@ extra-package-dbs: []
 packages:
 - .
 
+docker:
+  enable: true
+  repo: 'cgenie/stack-build:lts-12.26'
+
 allow-newer: true
 extra-deps:
 - git: https://github.com/delanoe/data-time-segment.git