{-| 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 #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# 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 qualified as CE 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 (Cmd) 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 => AuthenticatedUser -- ^ The logged-in user -> NodeId -> PostNode -> Cmd err [NodeId] postNode authenticatedUser pId (PostNode nodeName nt) = do let userId = authenticatedUser ^. auth_user_id nodeIds <- mkNodeWithParent nt (Just pId) userId nodeName liftBase $ do -- mapM_ (CE.notify . CE.UpdateTreeFirstLevel) nodeIds 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) => 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 liftBase $ do -- mapM_ (CE.notify . CE.UpdateTreeFirstLevel) nodeIds CE.notify $ CE.UpdateTreeFirstLevel nId markComplete jobHandle