{-| Module : Gargantext.API.Worker Description : New-style Worker API (no more servant-job) Copyright : (c) CNRS, 2024-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -} {-# LANGUAGE TypeOperators #-} module Gargantext.API.Worker where import Gargantext.API.Prelude (IsGargServer) import Gargantext.Core.Worker.Jobs (sendJob) import Gargantext.Core.Worker.Jobs.Types (Job(..), getWorkerMNodeId) import Gargantext.Core.Worker.Types (JobInfo(..)) import Gargantext.Prelude import Gargantext.System.Logging (logM, LogLevel(..)) import Servant.API ((:>), (:-), JSON, Post, ReqBody) import Servant.Server.Generic (AsServerT) data WorkerAPI contentType input mode = WorkerAPI { workerAPIPost :: mode :- ReqBody contentType input :> Post '[JSON] JobInfo } deriving Generic serveWorkerAPI :: IsGargServer env err m => (input -> Job) -> WorkerAPI contentType input (AsServerT m) serveWorkerAPI f = serveWorkerAPIm (pure . f) serveWorkerAPIEJob :: (MonadError err m, IsGargServer env err m) => (input -> Either err Job) -> WorkerAPI contentType input (AsServerT m) serveWorkerAPIEJob f = WorkerAPI { workerAPIPost } where workerAPIPost i = do let eJob = f i case eJob of Left err -> throwError err Right job -> do mId <- sendJob job pure $ JobInfo { _ji_message_id = mId , _ji_mNode_id = getWorkerMNodeId job } serveWorkerAPIm :: IsGargServer env err m => (input -> m Job) -> WorkerAPI contentType input (AsServerT m) serveWorkerAPIm f = WorkerAPI { workerAPIPost } where workerAPIPost i = do job <- f i logM DEBUG $ "[serveWorkerAPIm] sending job " <> show job mId <- sendJob job pure $ JobInfo { _ji_message_id = mId , _ji_mNode_id = getWorkerMNodeId job }