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