Merge branch 'dev' into 151-dev-pubmed-api-key
[gargantext.git] / src / Gargantext / API / Routes.hs
index 034aeeaa6cf89009959dc4659a2cb4c8470500d6..7251f95dbef3b2cb2c98c2873b318a73d3d2746d 100644 (file)
@@ -7,55 +7,58 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-
 {-# LANGUAGE ConstraintKinds      #-}
-{-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeOperators        #-}
 {-# LANGUAGE KindSignatures       #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TypeFamilies         #-}
-{-# LANGUAGE UndecidableInstances #-}
 
----------------------------------------------------------------------
 module Gargantext.API.Routes
       where
----------------------------------------------------------------------
 
 import Control.Concurrent (threadDelay)
+import Control.Lens (view)
 import Data.Text (Text)
 import Data.Validity
-import Gargantext.API.Admin.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), withAccess, PathId(..))
+import Servant
+import Servant.Auth as SA
+import Servant.Auth.Swagger ()
+import Servant.Swagger.UI
+
+import Gargantext.API.Admin.Auth (ForgotPasswordAPI, ForgotPasswordAsyncAPI, withAccess)
+import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, AuthenticatedUser(..), PathId(..))
+import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
 import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
+import Gargantext.API.Context
 import Gargantext.API.Count  (CountAPI, count, Query)
+import Gargantext.API.Job (jobLogInit)
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableDoc)
 import Gargantext.API.Node
 import Gargantext.API.Prelude
-import Gargantext.API.Search (SearchPairsAPI, searchPairs)
 import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Core.Viz.Graph.API
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Admin.Types.Node (NodeId, CorpusId, AnnuaireId)
+import Gargantext.Database.Prelude (HasConfig(..))
 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 Gargantext.Prelude.Config (gc_max_docs_scrapers)
+import Gargantext.Utils.Jobs (serveJobsAPI)
+import qualified Gargantext.API.GraphQL                    as GraphQL
+import qualified Gargantext.API.Ngrams.List                as List
+import qualified Gargantext.API.Node.Contact               as Contact
+import qualified Gargantext.API.Node.Corpus.Annuaire       as Annuaire
+import qualified Gargantext.API.Node.Corpus.Export         as CorpusExport
+import qualified Gargantext.API.Node.Corpus.Export.Types   as CorpusExport
+import qualified Gargantext.API.Node.Corpus.New            as New
+import qualified Gargantext.API.Node.Document.Export       as DocumentExport
+import qualified Gargantext.API.Node.Document.Export.Types as DocumentExport
+import qualified Gargantext.API.Public                     as Public
 
 
 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
--- | TODO          :<|> Summary "Latest API" :> GargAPI'
-
+--- | TODO          :<|> Summary "Latest API" :> GargAPI'
 
 type GargAPIVersion = "v1.0"
                    :> Summary "Garg API Version "
@@ -70,11 +73,13 @@ type GargAPI' =
                 "auth"  :> Summary "AUTH API"
                         :> ReqBody '[JSON] AuthRequest
                         :> Post    '[JSON] AuthResponse
+          :<|> "forgot-password" :> ForgotPasswordAPI
+          :<|> "async" :> "forgot-password" :> ForgotPasswordAsyncAPI
           :<|> GargVersion
                    -- TODO-ACCESS here we want to request a particular header for
            -- auth and capabilities.
           :<|> GargPrivateAPI
-          :<|> "public" :> Public.API
+          :<|> "public"      :> Public.API
 
 
 type GargPrivateAPI = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
@@ -95,6 +100,11 @@ type GargPrivateAPI' =
                            :> Capture "node_id" NodeId
                            :> NodeAPI HyperdataAny
 
+           -- Context endpoint
+           :<|> "context"  :> Summary "Node endpoint"
+                           :> Capture "node_id" ContextId
+                           :> ContextAPI HyperdataAny
+
            -- Corpus endpoints
            :<|> "corpus"   :> Summary "Corpus endpoint"
                            :> Capture "corpus_id" CorpusId
@@ -107,23 +117,30 @@ type GargPrivateAPI' =
                            :> NodeNodeAPI HyperdataAny
 
            :<|> "corpus"   :> Capture "node_id" CorpusId
-                           :> Export.API
+                           :> CorpusExport.API
 
            -- Annuaire endpoint
+{-
+           :<|> "contact"  :> Summary "Contact endpoint"
+                           :> Capture "contact_id" ContactId
+                           :> NodeAPI HyperdataContact
+--}
+
            :<|> "annuaire" :> Summary "Annuaire endpoint"
                            :> Capture "annuaire_id" AnnuaireId
                            :> NodeAPI HyperdataAnnuaire
 
            :<|> "annuaire" :> Summary "Contact endpoint"
                            :> Capture "annuaire_id" NodeId
-                           :> "contact"
-                           :> Capture "contact_id" NodeId
-                           :> NodeNodeAPI HyperdataContact
-
+                           :> Contact.API
            -- Document endpoint
            :<|> "document" :> Summary "Document endpoint"
                            :> Capture "doc_id" DocId
-                           :> "ngrams" :> TableNgramsApi
+                           :> "ngrams"
+                           :> TableNgramsApi
+
+           :<|> "texts" :> Capture "node_id" DocId
+                           :> DocumentExport.API
 
         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
             -- TODO-SECURITY
@@ -132,8 +149,8 @@ type GargPrivateAPI' =
                            :> CountAPI
 
            -- Corpus endpoint --> TODO rename s/search/filter/g
-           :<|> "search"   :> Capture "corpus" NodeId
-                           :> SearchPairsAPI
+           -- :<|> "search"   :> Capture "corpus" NodeId
+           --                 :> (Search.API Search.SearchResult)
 
            -- TODO move to NodeAPI?
            :<|> "graph"    :> Summary "Graph endpoint"
@@ -147,7 +164,8 @@ type GargPrivateAPI' =
                           :> TreeAPI
 
            -- :<|> New.Upload
-           :<|> New.AddWithForm 
+           :<|> New.AddWithForm
+--           :<|> New.AddWithFile
            :<|> New.AddWithQuery
 
            -- :<|> "annuaire" :> Annuaire.AddWithForm
@@ -155,14 +173,15 @@ type GargPrivateAPI' =
        --  :<|> "scraper" :> WithCallbacks ScraperAPI
        --  :<|> "new"  :> New.Api
 
-           :<|> "lists"  :> Summary "List export API"
-                         :> Capture "listId" ListId
-                         :> List.API
-
+      -- TODO refactor the 3 routes below
+           :<|> List.GETAPI
+           :<|> List.JSONAPI
+           :<|> List.CSVAPI
+{-
            :<|> "wait"   :> Summary "Wait test"
                          :> Capture "x" Int
                          :> WaitAPI -- Get '[JSON] Int
-
+-}
 -- /mv/<id>/<id>
 -- /merge/<id>/<id>
 -- /rename/<id>
@@ -174,6 +193,7 @@ type GargPrivateAPI' =
 
 type API = SwaggerAPI
        :<|> GargAPI
+       :<|> GraphQL.API
        :<|> FrontEndAPI
 
 -- | API for serving @swagger.json@
@@ -200,23 +220,28 @@ serverGargAdminAPI =  roots
                  :<|> nodesAPI
 
 
-serverPrivateGargAPI' :: AuthenticatedUser -> GargServer GargPrivateAPI'
+serverPrivateGargAPI'
+  :: AuthenticatedUser -> ServerT GargPrivateAPI' (GargM Env GargError)
 serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
        =  serverGargAdminAPI
      :<|> nodeAPI     (Proxy :: Proxy HyperdataAny)      uid
+     :<|> contextAPI  (Proxy :: Proxy HyperdataAny)      uid
      :<|> nodeAPI     (Proxy :: Proxy HyperdataCorpus)   uid
      :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny)      uid
-     :<|> Export.getCorpus   -- uid
+     :<|> CorpusExport.getCorpus   -- uid
+ --    :<|> nodeAPI     (Proxy :: Proxy HyperdataContact)  uid
      :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) uid
-     :<|> nodeNodeAPI (Proxy :: Proxy HyperdataContact)  uid
+     :<|> Contact.api uid
 
      :<|> withAccess  (Proxy :: Proxy TableNgramsApi) Proxy uid
           <$> PathNode <*> apiNgramsTableDoc
 
+     :<|> DocumentExport.api uid
+
      :<|> count -- TODO: undefined
 
-     :<|> withAccess (Proxy :: Proxy SearchPairsAPI) Proxy uid
-          <$> PathNode <*> searchPairs -- TODO: move elsewhere
+     -- :<|> withAccess (Proxy :: Proxy (Search.API Search.SearchResult)) Proxy uid
+     --     <$> PathNode <*> Search.api -- TODO: move elsewhere
 
      :<|> withAccess (Proxy :: Proxy GraphAPI)       Proxy uid
           <$> PathNode <*> graphAPI uid -- TODO: mock
@@ -225,13 +250,16 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
           <$> PathNode <*> treeAPI
      -- TODO access
      :<|> addCorpusWithForm  (RootId (NodeId uid))
+    -- :<|> addCorpusWithFile  (RootId (NodeId uid))
      :<|> addCorpusWithQuery (RootId (NodeId uid))
 
      -- :<|> addAnnuaireWithForm
      -- :<|> New.api  uid -- TODO-SECURITY
      -- :<|> New.info uid -- TODO-SECURITY
-     :<|> List.api
-     :<|> waitAPI
+     :<|> List.getApi
+     :<|> List.jsonApi
+     :<|> List.csvApi
+--     :<|> waitAPI
 
 
 ----------------------------------------------------------------------
@@ -246,37 +274,35 @@ waitAPI n = do
   pure $ "Waited: " <> (cs $ show n)
 ----------------------------------------
 
-
-addCorpusWithQuery :: User -> GargServer New.AddWithQuery
+addCorpusWithQuery :: User -> ServerT New.AddWithQuery (GargM Env GargError)
 addCorpusWithQuery user cid =
-  serveJobsAPI $
-    JobFunction (\q log ->
-      let
-        log' x = do
-          printDebug "addToCorpusWithQuery" x
-          liftBase $ log x
-      in New.addToCorpusWithQuery user cid q log'
-      )
-
-{-
-addWithFile :: GargServer New.AddWithFile
-addWithFile cid i f =
-  serveJobsAPI $
-    JobFunction (\_i log -> New.addToCorpusWithFile cid i f (liftBase . log))
--}
-
-addCorpusWithForm :: User -> GargServer New.AddWithForm
+  serveJobsAPI AddCorpusQueryJob $ \q log' -> do
+    limit <- view $ hasConfig . gc_max_docs_scrapers
+    New.addToCorpusWithQuery user cid q (Just limit) (liftBase . log')
+      {- let log' x = do
+        printDebug "addToCorpusWithQuery" x
+        liftBase $ log x
+      -}
+
+addCorpusWithForm :: User -> ServerT New.AddWithForm (GargM Env GargError)
 addCorpusWithForm user cid =
-  serveJobsAPI $
-    JobFunction (\i log ->
+  serveJobsAPI AddCorpusFormJob $ \i log' ->
       let
-        log' x = do
-          printDebug "addToCorpusWithForm" x
-          liftBase $ log x
-      in New.addToCorpusWithForm user cid i log')
+        log'' x = do
+          --printDebug "[addToCorpusWithForm] " x
+          liftBase $ log' x
+      in New.addToCorpusWithForm user cid i log'' (jobLogInit 3)
+
+addCorpusWithFile :: User -> ServerT New.AddWithFile (GargM Env GargError)
+addCorpusWithFile user cid =
+  serveJobsAPI AddCorpusFileJob $ \i log' ->
+      let
+        log'' x = do
+          printDebug "[addToCorpusWithFile]" x
+          liftBase $ log' x
+      in New.addToCorpusWithFile user cid i log''
 
-addAnnuaireWithForm :: GargServer Annuaire.AddWithForm
+addAnnuaireWithForm :: ServerT Annuaire.AddWithForm (GargM Env GargError)
 addAnnuaireWithForm cid =
-  serveJobsAPI $
-    JobFunction (\i log -> Annuaire.addToAnnuaireWithForm cid i (liftBase . log))
-
+  serveJobsAPI AddAnnuaireFormJob $ \i log' ->
+    Annuaire.addToAnnuaireWithForm cid i (liftBase . log')