[BUG] route with bug simplified.

src/Gargantext/API.hs

@@ -66,7 +66,7 @@ import Gargantext.API.Admin.FrontEnd (frontEndServer)
 import Gargantext.API.Admin.Settings
 import Gargantext.API.Ngrams (HasRepoSaver(..), saveRepo)
 import Gargantext.API.Prelude
-import Gargantext.API.Routes
+import Gargantext.API.BugRoutes
 import Gargantext.Prelude
 import Network.HTTP.Types hiding (Query)
 import Network.Wai

src/Gargantext/API/BugRoutes.hs

+{-|
+Module      : Gargantext.API.Routes
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+
+-}
+
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
+{-# LANGUAGE ConstraintKinds      #-}
+{-# LANGUAGE NoImplicitPrelude    #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE KindSignatures       #-}
+{-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+---------------------------------------------------------------------
+module Gargantext.API.BugRoutes
+      where
+---------------------------------------------------------------------
+import Control.Concurrent (threadDelay)
+import Data.Text (Text)
+import Data.Validity
+import Gargantext.API.Admin.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..))
+import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
+import Gargantext.API.Prelude
+import Gargantext.API.Node
+import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Admin.Types.Node (NodeId)
+import Gargantext.Prelude
+import Servant
+import Servant.Auth as SA
+import Servant.Auth.Swagger ()
+import Servant.Job.Async
+import Servant.Swagger.UI
+import qualified Gargantext.API.Node.Corpus.Annuaire  as Annuaire
+import qualified Gargantext.API.Node.Corpus.New       as New
+
+
+
+type GargAPI = "api" :> Summary "API " :> GargAPIVersion
+-- | TODO          :<|> Summary "Latest API" :> GargAPI'
+
+
+type GargAPIVersion = "v1.0"
+                   :> Summary "Garg API Version "
+                   :> GargAPI'
+
+type GargVersion = "version"
+                 :> Summary "Backend version"
+                 :> Get '[JSON] Text
+
+type GargAPI' =
+           -- Auth endpoint
+                "auth"  :> Summary "AUTH API"
+                        :> ReqBody '[JSON] AuthRequest
+                        :> Post    '[JSON] AuthResponse
+          :<|> GargVersion
+                   -- TODO-ACCESS here we want to request a particular header for
+           -- auth and capabilities.
+          :<|> GargPrivateAPI
+
+
+type GargPrivateAPI = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> GargPrivateAPI'
+
+type GargAdminAPI
+              -- Roots endpoint
+             =  "user"  :> Summary "First user endpoint"
+                        :> Roots
+           :<|> "nodes" :> Summary "Nodes endpoint"
+                        :> ReqBody '[JSON] [NodeId] :> NodesAPI
+
+type GargPrivateAPI' =
+                GargAdminAPI
+
+{-
+           -- Node endpoint
+           :<|> "node"     :> Summary "Node endpoint"
+                           :> Capture "node_id" NodeId
+                           :> NodeAPI HyperdataAny
+
+           -- Corpus endpoints
+           :<|> "corpus"   :> Summary "Corpus endpoint"
+                           :> Capture "corpus_id" CorpusId
+                           :> NodeAPI HyperdataCorpus
+
+           :<|> "corpus"   :> Summary "Corpus endpoint"
+                           :> Capture "node1_id" NodeId
+                           :> "document"
+                           :> Capture "node2_id" NodeId
+                           :> NodeNodeAPI HyperdataAny
+
+           :<|> "corpus"   :> Capture "node_id" CorpusId
+                           :> Export.API
+
+           -- Annuaire endpoint
+           :<|> "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
+
+           -- Document endpoint
+           :<|> "document" :> Summary "Document endpoint"
+                           :> Capture "doc_id" DocId
+                           :> "ngrams" :> TableNgramsApi
+
+        -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
+            -- TODO-SECURITY
+           :<|> "count"    :> Summary "Count endpoint"
+                           :> ReqBody '[JSON] Query
+                           :> CountAPI
+
+           -- Corpus endpoint --> TODO rename s/search/filter/g
+           :<|> "search"   :> Capture "corpus" NodeId
+                           :> SearchPairsAPI
+
+           -- TODO move to NodeAPI?
+           :<|> "graph"    :> Summary "Graph endpoint"
+                           :> Capture "graph_id" NodeId
+                           :> GraphAPI
+
+           -- TODO move to NodeAPI?
+           -- Tree endpoint
+           :<|> "tree"    :> Summary "Tree endpoint"
+                          :> Capture "tree_id" NodeId
+                          :> TreeAPI
+
+           -- :<|> New.Upload
+-} 
+          :<|> New.AddWithQuery
+          :<|> New.AddWithForm
+
+{-
+           -- :<|> "annuaire" :> Annuaire.AddWithForm
+           -- :<|> New.AddWithFile
+       --  :<|> "scraper" :> WithCallbacks ScraperAPI
+       --  :<|> "new"  :> New.Api
+
+           :<|> "lists"  :> Summary "List export API"
+                         :> Capture "listId" ListId
+                         :> List.API
+
+           :<|> "wait"   :> Summary "Wait test"
+                         :> Capture "x" Int
+                         :> WaitAPI -- Get '[JSON] Int
+-}
+-- /mv/<id>/<id>
+-- /merge/<id>/<id>
+-- /rename/<id>
+       -- :<|> "static"
+       -- :<|> "list"     :> Capture "node_id" Int  :> NodeAPI
+       -- :<|> "ngrams"   :> Capture "node_id" Int  :> NodeAPI
+       -- :<|> "auth"     :> Capture "node_id" Int  :> NodeAPI
+---------------------------------------------------------------------
+
+type API = SwaggerAPI
+       :<|> GargAPI
+       :<|> FrontEndAPI
+
+-- | API for serving @swagger.json@
+type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
+
+-- | API for serving main operational routes of @gargantext.org@
+-- TODO
+-- /mv/<id>/<id>
+-- /merge/<id>/<id>
+-- /rename/<id>
+       -- :<|> "static"
+       -- :<|> "list"     :> Capture "node_id" Int  :> NodeAPI
+       -- :<|> "ngrams"   :> Capture "node_id" Int  :> NodeAPI
+       -- :<|> "auth"     :> Capture "node_id" Int  :> NodeAPI
+---------------------------------------------------------------------
+
+---------------------------------------------------------------------
+-- | Server declarations
+
+-- TODO-SECURITY admin only: withAdmin
+-- Question: How do we mark admins?
+serverGargAdminAPI :: GargServer GargAdminAPI
+serverGargAdminAPI =  roots
+                 :<|> nodesAPI
+
+
+serverPrivateGargAPI' :: AuthenticatedUser -> GargServer GargPrivateAPI'
+serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
+       =  serverGargAdminAPI
+{-
+     :<|> nodeAPI     (Proxy :: Proxy HyperdataAny)      uid
+     :<|> nodeAPI     (Proxy :: Proxy HyperdataCorpus)   uid
+     :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny)      uid
+     :<|> Export.getCorpus   -- uid
+     :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) uid
+     :<|> 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
+     -- TODO access
+
+-}
+     :<|> addCorpusWithQuery (RootId   (NodeId uid))
+     :<|> addCorpusWithForm  (UserDBId uid)
+{-
+     -- :<|> addAnnuaireWithForm
+     -- :<|> New.api  uid -- TODO-SECURITY
+     -- :<|> New.info uid -- TODO-SECURITY
+     :<|> List.api
+     :<|> waitAPI
+-}
+
+----------------------------------------------------------------------
+-- For Tests
+type WaitAPI = Get '[JSON] Text
+
+waitAPI ::  Int -> GargServer WaitAPI
+waitAPI n = do
+  let
+    m = (10 :: Int) ^ (6 :: Int)
+  _ <- liftBase $ threadDelay ( m * n)
+  pure $ "Waited: " <> (cs $ show n)
+----------------------------------------
+
+
+addCorpusWithQuery :: User -> GargServer New.AddWithQuery
+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
+addCorpusWithForm user cid =
+  serveJobsAPI $
+    JobFunction (\i log ->
+      let
+        log' x = do
+          printDebug "addToCorpusWithForm" x
+          liftBase $ log x
+      in New.addToCorpusWithForm user cid i log')
+
+addAnnuaireWithForm :: GargServer Annuaire.AddWithForm
+addAnnuaireWithForm cid =
+  serveJobsAPI $
+    JobFunction (\i log -> Annuaire.addToAnnuaireWithForm cid i (liftBase . log))
+

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

@@ -117,6 +117,8 @@ instance Arbitrary ApiInfo where
 deriveJSON (unPrefix "") 'ApiInfo
 
 instance ToSchema ApiInfo
+  where
+    declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "api_")
 
 info :: FlowCmdM env err m => UserId -> m ApiInfo
 info _u = pure $ ApiInfo API.externalAPIs

stack.yaml

@@ -3,7 +3,7 @@ flags: {}
 extra-package-dbs: []
 packages:
 - .
-#- 'deps/servant-job'
+- 'deps/servant-job'
 #- 'deps/clustering-louvain'
 
 docker:
@@ -46,8 +46,8 @@ extra-deps:
   commit: 746b4ce0af8f9e600d555ad7e5b2973a940cdad9
   #- git: https://github.com/delanoe/servant-job.git
   #commit: 7a7b7100e6d132adb4c11b25b2128e6309690ac0
-- git: https://github.com/np/servant-job.git
-  commit: 3b3270532e04887c6b658670e846a5ef07ef90e5
+  #- git: https://github.com/np/servant-job.git
+  #commit: 3b3270532e04887c6b658670e846a5ef07ef90e5
 - git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
   commit: 7d74f96dfea8e51fbab1793cc0429b2fe741f73d
 - git: https://github.com/np/patches-map