1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
{-|
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 IncoherentInstances #-}
module Gargantext.API.Node.New
where
import Control.Lens hiding (elements, Empty)
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser, auth_user_id)
import Gargantext.API.Admin.EnvTypes (Env)
import Gargantext.API.Errors.Types (BackendInternalError)
import Gargantext.API.Node.New.Types (PostNode(..))
import Gargantext.API.Prelude (GargM)
import Gargantext.API.Routes.Named.Node qualified as Named
import Gargantext.API.Worker (serveWorkerAPI)
import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CE
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
import Gargantext.Database.Action.Node (mkNodeWithParent)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (IsDBCmdExtra, DBCmdWithEnv)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Prelude
import Servant.Server.Generic (AsServerT)
------------------------------------------------------------------------
-- postNode :: (CmdM env err m, HasNodeError err, HasSettings env)
postNode :: ( HasMail env
, HasNodeError err
, HasNLPServer env
, CE.HasCentralExchangeNotification env)
=> AuthenticatedUser
-- ^ The logged-in user
-> NodeId
-> PostNode
-- -> m [NodeId]
-> DBCmdWithEnv env err [NodeId]
postNode authenticatedUser nId pn = do
postNode' authenticatedUser nId pn
postNodeAsyncAPI
:: AuthenticatedUser
-- ^ The logged-in user
-> NodeId
-- ^ The target node
-> Named.PostNodeAsyncAPI (AsServerT (GargM Env BackendInternalError))
postNodeAsyncAPI authenticatedUser nId =
Named.PostNodeAsyncAPI {
postNodeAsyncEp = serveWorkerAPI $ \p ->
Jobs.PostNodeAsync { _pna_node_id = nId
, _pna_authenticatedUser = authenticatedUser
, _pna_args = p }
}
------------------------------------------------------------------------
-- postNode' :: (CmdM env err m, HasSettings env, HasNodeError err)
-- => AuthenticatedUser
-- -- ^ The logged-in user
-- -> NodeId
-- -> PostNode
-- -> m [NodeId]
-- postNode' authenticatedUser pId (PostNode nodeName nt) = do
postNode' :: ( IsDBCmdExtra env err m
, HasNodeError err
, HasMail env
, CE.HasCentralExchangeNotification env)
=> AuthenticatedUser
-- ^ The logged in user
-> NodeId
-> PostNode
-> m [NodeId]
postNode' authenticatedUser nId (PostNode nodeName tn) = do
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
return nodeIds
-- postNodeAsync :: (FlowCmdM env err m, MonadJobStatus m, HasSettings 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
-- _ <- mkNodeWithParent tn (Just nId) userId nodeName
-- markComplete jobHandle