]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Node/Contact.hs
Merge branch 'dev-doc-annotation-issue' of ssh://gitlab.iscpif.fr:20022/gargantext...
[gargantext.git] / src / Gargantext / API / Node / Contact.hs
1 {-|
2 Module : Gargantext.API.Node.Contact
3 Description :
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 -}
11
12 {-# OPTIONS_GHC -fno-warn-orphans #-}
13
14 {-# LANGUAGE ConstraintKinds #-}
15 {-# LANGUAGE KindSignatures #-}
16 {-# LANGUAGE ScopedTypeVariables #-}
17 {-# LANGUAGE TemplateHaskell #-}
18 {-# LANGUAGE TypeFamilies #-}
19 {-# LANGUAGE TypeOperators #-}
20 {-# LANGUAGE UndecidableInstances #-}
21
22
23 module Gargantext.API.Node.Contact
24 where
25
26 import Data.Aeson
27 import Data.Either (Either(Right))
28 import Data.Maybe (Maybe(..))
29 import Data.Swagger
30 import Data.Text (Text)
31 import GHC.Generics (Generic)
32 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
33 import Gargantext.API.Admin.Settings (HasSettings)
34 import Gargantext.API.Node
35 import Gargantext.API.Node.Corpus.New (AsyncJobs)
36 import Gargantext.API.Prelude (GargServer, simuLogs)
37 import Gargantext.Core (Lang(..))
38 import Gargantext.Core.Types.Individu (User(..))
39 import Gargantext.Database.Action.Flow (flow)
40 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
41 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire(..), HyperdataContact)
42 import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
43 import Gargantext.Database.Admin.Types.Node
44 import Gargantext.Prelude (($), liftBase, (.), printDebug, pure)
45 import Gargantext.Core.Text.Terms (TermType(..))
46 import Servant
47 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
48 import Test.QuickCheck (elements)
49 import Test.QuickCheck.Arbitrary
50
51 ------------------------------------------------------------------------
52 type API = "contact" :> Summary "Contact endpoint"
53 :> API_Async
54 :<|> Capture "contact_id" NodeId
55 :> NodeNodeAPI HyperdataContact
56
57
58 api :: UserId -> CorpusId -> GargServer API
59 api uid cid = (api_async (RootId (NodeId uid)) cid)
60 :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid cid)
61
62 type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
63 ------------------------------------------------------------------------
64 data AddContactParams = AddContactParams { firstname :: !Text, lastname :: !Text }
65 | AddContactParamsAdvanced { firstname :: !Text
66 , lastname :: !Text
67 -- TODO add others fields
68 }
69 deriving (Generic)
70
71 ----------------------------------------------------------------------
72 api_async :: User -> NodeId -> GargServer API_Async
73 api_async u nId =
74 serveJobsAPI $
75 JobFunction (\p log ->
76 let
77 log' x = do
78 printDebug "addContact" x
79 liftBase $ log x
80 in addContact u nId p (liftBase . log')
81 )
82
83 addContact :: (HasSettings env, FlowCmdM env err m)
84 => User
85 -> NodeId
86 -> AddContactParams
87 -> (JobLog -> m ())
88 -> m JobLog
89 addContact u nId (AddContactParams fn ln) logStatus = do
90
91 logStatus JobLog { _scst_succeeded = Just 1
92 , _scst_failed = Just 0
93 , _scst_remaining = Just 1
94 , _scst_events = Just []
95 }
96 _ <- flow (Nothing :: Maybe HyperdataAnnuaire) u (Right [nId]) (Multi EN) [[hyperdataContact fn ln]]
97
98 pure JobLog { _scst_succeeded = Just 2
99 , _scst_failed = Just 0
100 , _scst_remaining = Just 0
101 , _scst_events = Just []
102 }
103
104
105 addContact _uId _nId _p logStatus = do
106 simuLogs logStatus 10
107
108 ------------------------------------------------------------------------
109 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
110 instance FromJSON AddContactParams where
111 parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
112
113 instance ToJSON AddContactParams where
114 toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
115
116 instance ToSchema AddContactParams
117 instance Arbitrary AddContactParams where
118 arbitrary = elements [AddContactParams "Pierre" "Dupont"]
119
120 ------------------------------------------------------------------------