Merge branch 'master' into stable

src/Gargantext/API.hs

@@ -283,9 +283,10 @@ type GargPrivateAPI' =
                        :> Capture "tree_id" NodeId
                        :> TreeAPI
 
-           :<|> New.API_v2
+           :<|> New.AddWithQuery
+           :<|> New.AddWithFile
        --  :<|> "scraper" :> WithCallbacks ScraperAPI
-           :<|> "new"  :> New.Api
+       --  :<|> "new"  :> New.Api
 
 -- /mv/<id>/<id>
 -- /merge/<id>/<id>
@@ -347,26 +348,43 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      :<|> nodeAPI     (Proxy :: Proxy HyperdataCorpus)   uid
      :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny)      uid
      :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) uid
-     :<|> nodeNodeAPI (Proxy :: Proxy HyperdataContact)      uid
-     :<|> withAccess  (Proxy :: Proxy TableNgramsApi) Proxy uid <$> PathNode <*> apiNgramsTableDoc
+     :<|> nodeNodeAPI (Proxy :: Proxy HyperdataContact)  uid
+
+     :<|> withAccess  (Proxy :: Proxy TableNgramsApi) Proxy uid
+          <$> PathNode <*> apiNgramsTableDoc
+
      :<|> count -- TODO: undefined
-     :<|> withAccess (Proxy :: Proxy SearchPairsAPI) Proxy uid <$> PathNode <*> searchPairs -- TODO: move elsewhere
-     :<|> withAccess (Proxy :: Proxy GraphAPI)       Proxy uid <$> PathNode <*> graphAPI uid -- TODO: mock
-     :<|> withAccess (Proxy :: Proxy TreeAPI)        Proxy uid <$> PathNode <*> treeAPI
-     :<|> addToCorpus
-     :<|> New.api -- TODO-SECURITY
-     :<|> New.info uid -- TODO-SECURITY
-
-addToCorpus :: GargServer New.API_v2
-addToCorpus cid =
+
+     :<|> withAccess (Proxy :: Proxy SearchPairsAPI) Proxy uid
+          <$> PathNode <*> searchPairs -- TODO: move elsewhere
+
+     :<|> withAccess (Proxy :: Proxy GraphAPI)       Proxy uid
+          <$> PathNode <*> graphAPI uid -- TODO: mock
+
+     :<|> withAccess (Proxy :: Proxy TreeAPI)        Proxy uid
+          <$> PathNode <*> treeAPI
+     -- TODO access
+     :<|> addWithQuery
+     :<|> addWithFile
+     -- :<|> addToCorpus
+     -- :<|> New.api  uid -- TODO-SECURITY
+     -- :<|> New.info uid -- TODO-SECURITY
+
+addWithQuery :: GargServer New.AddWithQuery
+addWithQuery cid =
   serveJobsAPI $
     JobFunction (\i log -> New.addToCorpusJobFunction cid i (liftIO . log))
 
+addWithFile :: GargServer New.AddWithFile
+addWithFile cid i f =
+  serveJobsAPI $
+    JobFunction (\_i log -> New.addToCorpusWithFile cid i f (liftIO . log))
+
 serverStatic :: Server (Get '[HTML] Html)
 serverStatic = $(do
-                let path = "purescript-gargantext/dist/index.html"
-                Just s <- liftIO (fileTypeToFileTree (FileTypeFile path))
-                fileTreeToServer s
+                  let path = "purescript-gargantext/dist/index.html"
+                  Just s <- liftIO (fileTypeToFileTree (FileTypeFile path))
+                  fileTreeToServer s
                 )
 
 ---------------------------------------------------------------------

src/Gargantext/API/Corpus/New.hs

@@ -27,9 +27,14 @@ module Gargantext.API.Corpus.New
 import Data.Either
 import Control.Monad.IO.Class (liftIO)
 import Data.Aeson.TH (deriveJSON)
+import Data.Aeson
+import Servant.Job.Utils (jsonOptions)
+import Control.Lens hiding (elements)
+import Servant.Multipart
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
+import Servant.Job.Types
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Flow (flowCorpusSearchInDatabase)
 import Gargantext.Database.Types.Node (CorpusId)
@@ -44,6 +49,7 @@ import Gargantext.Core (Lang(..))
 import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
 import qualified Gargantext.Text.Corpus.API as API
 import Gargantext.Database.Types.Node (UserId)
+import Gargantext.API.Corpus.New.File
 
 data Query = Query { query_query      :: Text
                    , query_corpus_id  :: Int
@@ -72,8 +78,8 @@ type Api = Summary "New Corpus endpoint"
 -- | TODO manage several apis
 -- TODO-ACCESS
 -- TODO this is only the POST
-api :: (FlowCmdM env err m) => Query -> m CorpusId
-api (Query q _ as) = do
+api :: (FlowCmdM env err m) => UserId -> Query -> m CorpusId
+api _uId (Query q _ as) = do
   cId <- case head as of
     Nothing      -> flowCorpusSearchInDatabase "user1" EN q
     Just API.All -> flowCorpusSearchInDatabase "user1" EN q
@@ -130,15 +136,53 @@ data ScraperStatus = ScraperStatus
 deriveJSON (unPrefix "_scst_") 'ScraperStatus
 -}
 
-type API_v2 =
-  Summary "Add to corpus endpoint" :>
-  "corpus" :>
-  Capture "corpus_id" CorpusId :>
-  "add" :>
-  "async" :> ScraperAPI2
 
-  -- TODO ScraperInput2 also has a corpus id
-addToCorpusJobFunction :: FlowCmdM env err m => CorpusId -> ScraperInput2 -> (ScraperStatus -> m ()) -> m ScraperStatus
+
+------------------------------------------------------------------------
+------------------------------------------------------------------------
+data WithQuery = WithQuery
+  { _wq_query     :: !Text
+  , _wq_databases :: ![ExternalAPIs]
+  }
+  deriving Generic
+
+makeLenses ''WithQuery
+
+instance FromJSON WithQuery where
+  parseJSON = genericParseJSON $ jsonOptions "_wq_"
+
+instance ToSchema WithQuery
+
+------------------------------------------------------------------------
+type
+  AddAPI withInput = AsyncJobsAPI ScraperStatus withInput ScraperStatus
+------------------------------------------------------------------------
+
+type AddWithQuery = Summary "Add to corpus endpoint"
+   :> "corpus"
+   :> Capture "corpus_id" CorpusId
+   :> "add"
+   :> "query"
+   :> "async"
+   :> AddAPI WithQuery
+
+type AddWithFile = Summary "Add to corpus endpoint"
+   :> "corpus"
+   :> Capture "corpus_id" CorpusId
+   :> "add" 
+   :> "file"
+   :> MultipartForm Mem (MultipartData Mem)
+   :> QueryParam "fileType"  FileType
+   :> "async"
+   :> AddAPI ()
+
+------------------------------------------------------------------------
+-- TODO WithQuery also has a corpus id
+addToCorpusJobFunction :: FlowCmdM env err m
+                       => CorpusId
+                       -> WithQuery
+                       -> (ScraperStatus -> m ())
+                       -> m ScraperStatus
 addToCorpusJobFunction _cid _input logStatus = do
   -- TODO ...
   logStatus ScraperStatus { _scst_succeeded = Just 10
@@ -152,3 +196,24 @@ addToCorpusJobFunction _cid _input logStatus = do
                           , _scst_remaining = Just 0
                           , _scst_events    = Just []
                           }
+
+addToCorpusWithFile :: FlowCmdM env err m
+                    => CorpusId
+                    -> MultipartData Mem
+                    -> Maybe FileType
+                    -> (ScraperStatus -> m ())
+                    -> m ScraperStatus
+addToCorpusWithFile cid input filetype logStatus = do
+  logStatus ScraperStatus { _scst_succeeded = Just 10
+                          , _scst_failed    = Just 2
+                          , _scst_remaining = Just 138
+                          , _scst_events    = Just []
+                          }
+  _h <- postUpload cid filetype input
+
+  pure      ScraperStatus { _scst_succeeded = Just 137
+                          , _scst_failed    = Just 13
+                          , _scst_remaining = Just 0
+                          , _scst_events    = Just []
+                          }
+

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

+{-|
+Module      : Gargantext.API.Corpus.New.File
+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 OverloadedStrings    #-}
+{-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TypeOperators        #-}
+
+module Gargantext.API.Corpus.New.File
+  where
+
+import Control.Lens ((.~), (?~))
+import Control.Monad (forM)
+import Control.Monad.IO.Class (liftIO)
+import Data.Maybe
+import Data.Aeson
+import Data.Monoid (mempty)
+import Data.Swagger
+import Data.Text (Text())
+import GHC.Generics (Generic)
+import Gargantext.API.Ngrams (TODO)
+import Gargantext.Database.Types.Node
+import Gargantext.Database.Utils -- (Cmd, CmdM)
+import Gargantext.Prelude
+import Gargantext.Prelude.Utils (sha)
+import Servant
+import Servant.Multipart
+import Servant.Swagger (HasSwagger(toSwagger))
+import Servant.Swagger.Internal
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+
+-------------------------------------------------------------
+type Hash = Text
+data FileType = CSV | PresseRIS
+  deriving (Eq, Show, Generic)
+
+instance ToSchema FileType
+instance Arbitrary FileType
+  where
+    arbitrary = elements [CSV, PresseRIS]
+instance ToParamSchema FileType
+
+instance FromJSON FileType
+
+instance ToParamSchema (MultipartData Mem) where
+  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+
+instance FromHttpApiData FileType
+  where
+    parseUrlPiece "CSV"       = pure CSV
+    parseUrlPiece "PresseRis" = pure PresseRIS
+    parseUrlPiece _           = pure CSV -- TODO error here
+
+
+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 WithUpload' = Summary "Upload file(s) to a corpus"
+                :> QueryParam "fileType"  FileType
+                :> MultipartForm Mem (MultipartData Mem)
+                :> Post '[JSON] [Hash]
+
+--postUpload :: NodeId -> Maybe FileType ->  GargServer UploadAPI
+--postUpload :: NodeId -> GargServer UploadAPI
+postUpload :: NodeId
+           -> Maybe FileType
+           -> MultipartData Mem
+           -> Cmd err [Hash]
+postUpload _ Nothing _ = panic "fileType is a required parameter"
+postUpload _ (Just fileType) multipartData = do
+  putStrLn $ "File Type: " <> (show fileType)
+  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 (sha . cs) is
+
+-------------------------------------------------------------------

src/Gargantext/API/Node.hs

@@ -38,19 +38,18 @@ Node API
 module Gargantext.API.Node
   where
 
-import Control.Lens ((.~), (?~), (^.))
-import Control.Monad ((>>), forM)
+import Control.Lens ((^.))
+import Control.Monad ((>>))
 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.Auth (withAccess, PathId(..))
 import Gargantext.API.Metrics
-import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR, TODO)
+import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR)
 import Gargantext.API.Ngrams.NTree (MyTree)
 import Gargantext.API.Search (SearchDocsAPI, searchDocs)
 import Gargantext.API.Table
@@ -66,13 +65,9 @@ import Gargantext.Database.Tree (treeDB)
 import Gargantext.Database.Types.Node
 import Gargantext.Database.Utils -- (Cmd, CmdM)
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils (sha)
 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 Gargantext.Database.Node.Update as U (update, Update(..))
@@ -143,7 +138,7 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "pie"       :> PieApi
              :<|> "tree"      :> TreeApi
              :<|> "phylo"     :> PhyloAPI
-             :<|> "add"       :> NodeAddAPI
+             -- :<|> "add"       :> NodeAddAPI
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
@@ -201,7 +196,7 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i
            :<|> getPie     id
            :<|> getTree    id
            :<|> phyloAPI   id uId
-           :<|> nodeAddAPI id
+           -- :<|> nodeAddAPI id
            -- :<|> postUpload id
 
     deleteNodeApi id' = do
@@ -210,10 +205,6 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i
          then panic "not allowed"  -- TODO add proper Right Management Type
          else deleteNode id'
 
-           -- Annuaire
-           -- :<|> query
-
-
 ------------------------------------------------------------------------
 data RenameNode = RenameNode { r_name :: Text }
   deriving (Generic)
@@ -290,9 +281,6 @@ type TreeApi = Summary " Tree API"
                 -- New documents for a corpus
                 -- New map list terms
              -- :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
-                
-                -- To launch a query and update the corpus
-             -- :<|> "query"    :> Capture "string" Text       :> Get  '[JSON] Text
 
 ------------------------------------------------------------------------
 
@@ -344,72 +332,4 @@ postNode uId pId (PostNode nodeName nt) = do
 putNode :: NodeId -> Cmd err Int
 putNode = undefined -- TODO
 
-query :: Monad m => Text -> m Text
-query s = pure s
-
 -------------------------------------------------------------
-type Hash = Text
-data FileType = CSV | PresseRIS
-  deriving (Eq, Show, Generic)
-
-instance ToSchema FileType
-instance Arbitrary FileType
-  where
-    arbitrary = elements [CSV, PresseRIS]
-instance ToParamSchema FileType
-
-instance ToParamSchema (MultipartData Mem) where
-  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
-
-instance FromHttpApiData FileType
-  where
-    parseUrlPiece "CSV"       = pure CSV
-    parseUrlPiece "PresseRis" = pure PresseRIS
-    parseUrlPiece _           = pure CSV -- TODO error here
-
-
-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 NodeAddAPI = "file" :> Summary "Node add API"
-                         :> UploadAPI
-
-nodeAddAPI :: NodeId -> GargServer NodeAddAPI
-nodeAddAPI id =  postUpload       id
-
-type UploadAPI = Summary "Upload file(s) to a corpus"
-                :> MultipartForm Mem (MultipartData Mem)
-                :> QueryParam "fileType"  FileType
-                :> Post '[JSON] [Hash]
-
---postUpload :: NodeId -> Maybe FileType ->  GargServer UploadAPI
---postUpload :: NodeId -> GargServer UploadAPI
-postUpload :: NodeId -> MultipartData Mem -> Maybe FileType -> Cmd err [Hash]
-postUpload _ _ Nothing = panic "fileType is a required parameter"
-postUpload _ multipartData (Just fileType) = do
-  putStrLn $ "File Type: " <> (show fileType)
-  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 (sha . cs) is

src/Gargantext/API/Orchestrator/Types.hs

@@ -23,7 +23,6 @@ import Servant.Job.Utils (jsonOptions)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 import Gargantext.API.Ngrams (TODO(..))
-
 instance Arbitrary a => Arbitrary (JobStatus 'Safe a) where
   arbitrary = panic "TODO"
 
@@ -80,17 +79,6 @@ instance FromJSON ScraperInput where
   parseJSON = genericParseJSON $ jsonOptions "_scin_"
 
 -- Proposal to replace the Corpus.API.Query type which seems to generically named.
-data ScraperInput2 = ScraperInput2
-  { _scin2_query     :: !Text
-  , _scin2_corpus    :: !Int
-  , _scin2_databases :: ![ExternalAPIs]
-  }
-  deriving Generic
-
-makeLenses ''ScraperInput2
-
-instance FromJSON ScraperInput2 where
-  parseJSON = genericParseJSON $ jsonOptions "_scin2_"
 
 data ScraperEvent = ScraperEvent
   { _scev_message :: !(Maybe Text)
@@ -119,7 +107,11 @@ data ScraperStatus = ScraperStatus
   deriving Generic
 
 instance Arbitrary ScraperStatus where
-  arbitrary = ScraperStatus <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+  arbitrary = ScraperStatus
+           <$> arbitrary
+           <*> arbitrary
+           <*> arbitrary
+           <*> arbitrary
 
 instance ToJSON ScraperStatus where
   toJSON = genericToJSON $ jsonOptions "_scst_"
@@ -130,7 +122,6 @@ instance FromJSON ScraperStatus where
 instance ToSchema ScraperStatus -- TODO _scst_ prefix
 
 instance ToSchema ScraperInput  -- TODO _scin_ prefix
-instance ToSchema ScraperInput2 -- TODO _scin2_ prefix
 instance ToSchema ScraperEvent  -- TODO _scev_ prefix
 
 instance ToParamSchema Offset -- where
@@ -142,4 +133,3 @@ instance ToParamSchema Limit -- where
 type ScrapersEnv = JobEnv ScraperStatus ScraperStatus
 
 type ScraperAPI  = AsyncJobsAPI ScraperStatus ScraperInput  ScraperStatus
-type ScraperAPI2 = AsyncJobsAPI ScraperStatus ScraperInput2 ScraperStatus