{-| Module : Gargantext.API.Node.Post Description : Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX New = Post maybe change the name Async new node feature -} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE IncoherentInstances #-} module Gargantext.API.Node.New where import Control.Lens hiding (elements, Empty) import Gargantext.API.Admin.Auth.Types import Gargantext.API.Admin.EnvTypes (GargJob(..), Env) import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs (..)) import Gargantext.API.Errors.Types import Gargantext.API.Node.New.Types import Gargantext.API.Prelude import Gargantext.API.Routes.Named.Node qualified as Named import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CE import Gargantext.Database.Action.Flow.Types import Gargantext.Database.Action.Node import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Prelude (DBCmd') import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..)) import Gargantext.Prelude import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..)) import Servant.Server.Generic (AsServerT) ------------------------------------------------------------------------ postNode :: (HasNodeError err, CE.HasCentralExchangeNotification env) => AuthenticatedUser -- ^ The logged-in user -> NodeId -> PostNode -> DBCmd' env err [NodeId] postNode authenticatedUser pId (PostNode nodeName nt) = do let userId = authenticatedUser ^. auth_user_id nodeIds <- mkNodeWithParent nt (Just pId) userId nodeName -- mapM_ (CE.ce_notify . CE.UpdateTreeFirstLevel) nodeIds CE.ce_notify $ CE.UpdateTreeFirstLevel pId return nodeIds postNodeAsyncAPI :: AuthenticatedUser -- ^ The logged-in user -> NodeId -- ^ The target node -> Named.PostNodeAsyncAPI (AsServerT (GargM Env BackendInternalError)) postNodeAsyncAPI authenticatedUser nId = Named.PostNodeAsyncAPI $ AsyncJobs $ serveJobsAPI NewNodeJob $ \jHandle p -> postNodeAsync authenticatedUser nId p jHandle ------------------------------------------------------------------------ postNodeAsync :: (FlowCmdM env err m, MonadJobStatus m, CE.HasCentralExchangeNotification env) => AuthenticatedUser -- ^ The logged in user -> NodeId -> PostNode -> JobHandle m -> m () postNodeAsync authenticatedUser nId (PostNode nodeName tn) jobHandle = do -- printDebug "postNodeAsync" nId markStarted 3 jobHandle markProgress 1 jobHandle -- _ <- threadDelay 1000 markProgress 1 jobHandle let userId = authenticatedUser ^. auth_user_id _nodeIds <- mkNodeWithParent tn (Just nId) userId nodeName -- mapM_ (CE.ce_notify . CE.UpdateTreeFirstLevel) nodeIds CE.ce_notify $ CE.UpdateTreeFirstLevel nId markComplete jobHandle