Routes.hs 2.99 KB
{-|
Module      : Gargantext.API.Routes
Description :
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE KindSignatures       #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE UndecidableInstances #-}

module Gargantext.API.Routes
      where

import Control.Lens (view)
import Data.Validity
import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Errors.Types
import Gargantext.API.Node.Corpus.Annuaire qualified as Annuaire
import Gargantext.API.Node.Corpus.New qualified as New
import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Annuaire qualified as Named
import Gargantext.API.Routes.Named.Corpus qualified as Named
import Gargantext.Core.Config (gc_jobs, HasConfig(..))
import Gargantext.Core.Config.Types (jc_max_docs_scrapers)
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Servant
import Servant.Auth.Swagger ()
import Servant.Server.Generic (AsServerT)

----------------------------------------------------------------------
-- 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: " <> show n
----------------------------------------

addCorpusWithQuery :: User -> Named.AddWithQuery (AsServerT (GargM Env BackendInternalError))
addCorpusWithQuery user = Named.AddWithQuery $ \cid -> AsyncJobs $
  serveJobsAPI AddCorpusQueryJob $ \jHandle q -> do
    limit <- view $ hasConfig . gc_jobs . jc_max_docs_scrapers
    New.addToCorpusWithQuery user cid q (Just $ fromIntegral limit) jHandle
      {- let log' x = do
        printDebug "addToCorpusWithQuery" x
        liftBase $ log x
      -}

addCorpusWithForm :: User -> Named.AddWithForm (AsServerT (GargM Env BackendInternalError))
addCorpusWithForm user = Named.AddWithForm $ \cid -> AsyncJobs $
  serveJobsAPI AddCorpusFormJob $ \jHandle i -> do
    -- /NOTE(adinapoli)/ Track the initial steps outside 'addToCorpusWithForm', because it's
    -- called in a few places, and the job status might be different between invocations.
    markStarted 3 jHandle
    New.addToCorpusWithForm user cid i jHandle

--addCorpusWithFile :: User -> ServerT Named.AddWithFile (GargM Env BackendInternalError)
--addCorpusWithFile user cid =
--  serveJobsAPI AddCorpusFileJob $ \jHandle i ->
--    New.addToCorpusWithFile user cid i jHandle

addAnnuaireWithForm :: Named.AddAnnuaireWithForm (AsServerT (GargM Env BackendInternalError))
addAnnuaireWithForm = Named.AddAnnuaireWithForm $ \cid -> AsyncJobs $
  serveJobsAPI AddAnnuaireFormJob $ \jHandle i ->
    Annuaire.addToAnnuaireWithForm cid i jHandle