[SCRAPER] setup the new version of addToCorpus with servant-job

src/Gargantext/API.hs

@@ -14,6 +14,7 @@ Thanks @yannEsposito for our discussions at the beginning of this project :).
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
+{-# LANGUAGE ConstraintKinds      #-}
 {-# LANGUAGE NoImplicitPrelude    #-}
 {-# LANGUAGE DataKinds            #-}
 {-# LANGUAGE DeriveGeneric        #-}
@@ -61,6 +62,7 @@ import           Servant.Auth.Swagger ()
 import           Servant.HTML.Blaze (HTML)
 --import           Servant.Mock (mock)
 --import           Servant.Job.Server (WithCallbacks)
+import           Servant.Job.Async
 import           Servant.Static.TH.Internal.Server (fileTreeToServer)
 import           Servant.Static.TH.Internal.FileTree (fileTypeToFileTree, FileType(FileTypeFile))
 import           Servant.Swagger
@@ -86,7 +88,7 @@ import Gargantext.Prelude
 import Gargantext.Viz.Graph.API
 
 --import Gargantext.API.Orchestrator
---import Gargantext.API.Orchestrator.Types
+import Gargantext.API.Orchestrator.Types
 
 ---------------------------------------------------------------------
 
@@ -275,10 +277,9 @@ type GargPrivateAPI' =
            :<|> "tree" :> Summary "Tree endpoint"
                        :> Capture "id" NodeId        :> TreeAPI
 
-           :<|> "new"  :> New.Api
-
-
+           :<|> New.API_v2
        --  :<|> "scraper" :> WithCallbacks ScraperAPI
+           :<|> "new"  :> New.Api
 
 -- /mv/<id>/<id>
 -- /merge/<id>/<id>
@@ -296,11 +297,17 @@ type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
 -- instead, prefer GargServer, GargServerT, GargServerC.
 type GargServerM env err = ReaderT env (ExceptT err IO)
 
+type EnvC env =
+  ( HasConnection env
+  , HasRepo env
+  , HasSettings env
+  , HasJobEnv env ScraperStatus ScraperStatus
+  )
+
 ---------------------------------------------------------------------
 -- | Server declarations
 
-server :: forall env. (HasConnection env, HasRepo env, HasSettings env)
-       => env -> IO (Server API)
+server :: forall env. EnvC env => env -> IO (Server API)
 server env = do
   -- orchestrator <- scrapyOrchestrator env
   pure $  swaggerFront
@@ -340,9 +347,15 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      :<|> withAccess (Proxy :: Proxy SearchPairsAPI) Proxy uid <$> PathNode <*> searchPairs -- TODO: move elsewhere
      :<|> withAccess (Proxy :: Proxy GraphAPI)       Proxy uid <$> PathNode <*> graphAPI -- 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 =
+  serveJobsAPI $
+    JobFunction (\i log -> New.addToCorpusJobFunction cid i (liftIO . log))
+
 serverStatic :: Server (Get '[HTML] Html)
 serverStatic = $(do
                 let path = "purescript-gargantext/dist/index.html"
@@ -359,8 +372,7 @@ swaggerFront = schemaUiServer swaggerDoc
 --gargMock = mock apiGarg Proxy
 
 ---------------------------------------------------------------------
-makeApp :: (HasConnection env, HasRepo env, HasSettings env)
-        => env -> IO Application
+makeApp :: EnvC env => env -> IO Application
 makeApp env = serveWithContext api cfg <$> server env
   where
     cfg :: Servant.Context AuthContext
@@ -442,7 +454,3 @@ startGargantextMock port = do
   application <- makeMockApp . MockEnv $ FireWall False
   run port application
 -}
-
-
-
-

src/Gargantext/API/Corpus/New.hs

@@ -25,7 +25,6 @@ module Gargantext.API.Corpus.New
       where
 
 import Data.Either
-import Control.Lens hiding (elements)
 import Control.Monad.IO.Class (liftIO)
 import Data.Aeson.TH (deriveJSON)
 import Data.Swagger
@@ -36,10 +35,8 @@ import Gargantext.Database.Flow (flowCorpusSearchInDatabase)
 import Gargantext.Database.Types.Node (CorpusId)
 import Gargantext.Text.Terms (TermType(..))
 import Gargantext.Prelude
-import Gargantext.API.Settings
 import Gargantext.API.Orchestrator.Types
 import Servant
-import Servant.Job.Async
 -- import Servant.Job.Server
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
@@ -141,7 +138,7 @@ type API_v2 =
   "async" :> ScraperAPI2
 
   -- TODO ScraperInput2 also has a corpus id
-addToCorpusJobFunction :: CorpusId -> ScraperInput2 -> (ScraperStatus -> IO ()) -> IO ScraperStatus
+addToCorpusJobFunction :: FlowCmdM env err m => CorpusId -> ScraperInput2 -> (ScraperStatus -> m ()) -> m ScraperStatus
 addToCorpusJobFunction _cid _input logStatus = do
   -- TODO ...
   logStatus ScraperStatus { _scst_succeeded = Just 10
@@ -155,7 +152,3 @@ addToCorpusJobFunction _cid _input logStatus = do
                           , _scst_remaining = Just 0
                           , _scst_events    = Just []
                           }
-
-addToCorpus :: Env -> Server API_v2
-addToCorpus env cid = do
-  serveJobsAPI (env ^. scrapers) . JobFunction $ addToCorpusJobFunction cid

src/Gargantext/API/Orchestrator.hs

@@ -66,10 +66,14 @@ pipeline scrapyurl client_env input log_status = do
   e <- runJobMLog client_env log_status $ callScraper scrapyurl input
   either (panic . cs . show) pure e -- TODO throwError
 
+-- TODO integrate to ServerT
+--  use:
+--  * serveJobsAPI instead of simpleServeJobsAPI
+--  * JobFunction  instead of simpleJobFunction
 scrapyOrchestrator :: Env -> IO (Server (WithCallbacks ScraperAPI))
 scrapyOrchestrator env = do
   apiWithCallbacksServer (Proxy :: Proxy ScraperAPI)
     defaultSettings (extendBaseUrl ("scraper" :: String) $ env ^. env_self_url)
     (env ^. env_manager) (LogEvent logConsole) $
-    serveJobsAPI (env ^. env_scrapers) .
-      JobFunction . pipeline (URL $ env ^. env_settings . scrapydUrl)
+    simpleServeJobsAPI (env ^. env_scrapers) .
+      simpleJobFunction . pipeline (URL $ env ^. env_settings . scrapydUrl)

src/Gargantext/API/Orchestrator/Types.hs

@@ -41,10 +41,12 @@ instance ToSchema AnyInput where
 instance ToSchema AnyEvent where
   declareNamedSchema = panic "TODO"
 
-instance ToSchema a => ToSchema (JobInput a)
+instance (ToSchema (f URL), ToSchema a) => ToSchema (JobInput f a)
 
 instance ToSchema a => ToSchema (JobOutput a)
 
+instance ToSchema (NoCallbacks a)
+
 -- | Main Types
 data ExternalAPIs = All
                   | PubMed
@@ -142,6 +144,7 @@ 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

src/Gargantext/API/Search.hs

@@ -12,6 +12,7 @@ Count API part of Gargantext.
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
+{-# LANGUAGE FlexibleContexts   #-}
 {-# LANGUAGE NoImplicitPrelude  #-}
 {-# LANGUAGE DataKinds          #-}
 {-# LANGUAGE TemplateHaskell    #-}

src/Gargantext/API/Settings.hs

@@ -16,6 +16,7 @@ TODO-SECURITY: Critical
 {-# LANGUAGE DeriveGeneric       #-}
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NoImplicitPrelude   #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE RankNTypes          #-}
@@ -49,7 +50,8 @@ import qualified Data.ByteString.Lazy as L
 import Servant
 import Servant.Auth.Server (defaultJWTSettings, JWTSettings, CookieSettings, defaultCookieSettings, readKey, writeKey)
 import Servant.Client (BaseUrl, parseBaseUrl)
-import Servant.Job.Async (newJobEnv, defaultSettings)
+import qualified Servant.Job.Core
+import Servant.Job.Async (newJobEnv, defaultSettings, HasJobEnv(..), Job)
 import Web.HttpApiData (parseUrlPiece)
 
 import Control.Concurrent
@@ -90,9 +92,6 @@ makeLenses ''Settings
 class HasSettings env where
   settings :: Getter env Settings
 
-class HasScrapers env where
-  scrapers :: Getter env ScrapersEnv
-
 devSettings :: FilePath -> IO Settings
 devSettings jwkFile = do
   jwkExists <- doesFileExist jwkFile
@@ -165,8 +164,11 @@ instance HasRepo Env where
 instance HasSettings Env where
   settings = env_settings
 
-instance HasScrapers Env where
-  scrapers = env_scrapers
+instance Servant.Job.Core.HasEnv Env (Job ScraperStatus ScraperStatus) where
+  _env = env_scrapers . Servant.Job.Core._env
+
+instance HasJobEnv Env ScraperStatus ScraperStatus where
+  job_env = env_scrapers
 
 data MockEnv = MockEnv
   { _menv_firewall :: !FireWall

src/Gargantext/API/Types.hs

@@ -11,6 +11,7 @@ Portability : POSIX
 
 
 {-# LANGUAGE ConstraintKinds        #-}
+{-# LANGUAGE FlexibleContexts       #-}
 {-# LANGUAGE FlexibleInstances      #-}
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE MultiParamTypeClasses  #-}
@@ -21,28 +22,31 @@ Portability : POSIX
 {-# LANGUAGE UndecidableInstances   #-}
 
 module Gargantext.API.Types
+  ( module Gargantext.API.Types
+  , HasServerError(..)
+  , serverError
+  )
   where
 
+import Control.Exception (Exception)
 import Control.Lens (Prism', (#))
 import Control.Lens.TH (makePrisms)
 import Control.Monad.Error.Class (MonadError(throwError))
 import Crypto.JOSE.Error as Jose
+import Data.Typeable
 import Data.Validity
 import Servant
+import Servant.Job.Core (HasServerError(..), serverError)
+import Servant.Job.Async (HasJobEnv)
 import Gargantext.Prelude
 import Gargantext.API.Settings
+import Gargantext.API.Orchestrator.Types
 import Gargantext.API.Ngrams
 import Gargantext.Database.Tree
 import Gargantext.Core.Types
 import Gargantext.Database.Utils
 import Gargantext.Database.Schema.Node
 
-class HasServerError e where
-  _ServerError :: Prism' e ServerError
-
-serverError :: (MonadError e m, HasServerError e) => ServerError -> m a
-serverError e = throwError $ _ServerError # e
-
 class HasJoseError e where
   _JoseError :: Prism' e Jose.Error
 
@@ -76,8 +80,10 @@ type GargServerC env err m =
     , HasTreeError err
     , HasServerError err
     , HasJoseError err
+    , Exception err
     , HasRepo env
     , HasSettings env
+    , HasJobEnv env ScraperStatus ScraperStatus
     )
 
 type GargServerT env err m api = GargServerC env err m => ServerT api m
@@ -91,10 +97,12 @@ data GargError
   | GargInvalidError Validation
   | GargJoseError Jose.Error
   | GargServerError ServerError
-  deriving (Show)
+  deriving (Show, Typeable)
 
 makePrisms ''GargError
 
+instance Exception GargError
+
 instance HasNodeError GargError where
   _NodeError = _GargNodeError
 

src/Gargantext/Viz/Graph/API.hs

@@ -12,6 +12,8 @@ Portability : POSIX
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}   -- allows to write Text literals

src/Gargantext/Viz/Phylo/API.hs

@@ -17,6 +17,7 @@ Portability : POSIX
 {-# LANGUAGE OverloadedStrings  #-}   -- allows to write Text literals
 {-# LANGUAGE OverloadedLists    #-}   -- allows to write Map and HashMap as lists
 {-# LANGUAGE TypeOperators      #-}
+{-# LANGUAGE FlexibleContexts   #-}
 {-# LANGUAGE FlexibleInstances  #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 

stack.yaml

@@ -36,9 +36,7 @@ extra-deps:
 - git: https://gitlab.iscpif.fr/gargantext/patches-class
   commit: 746b4ce0af8f9e600d555ad7e5b2973a940cdad9
 - git: https://github.com/np/servant-job.git
-  commit: 9a89bad2785ff97845e9028fc0d97c64a19d3686
-  #- git: https://github.com/delanoe/servant-job.git
-  #commit: ea1746d43c7992a953c1eb4ed2614df2630d98ce
+  commit: 096d197704c1f75daedfb87a820a0f495e83c32c
 - git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
   commit: 1c636112b151110408e7c5a28cec39e46657358e
 - git: https://github.com/np/patches-map