Commit a53c3ad2 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[API] AddContact (Post, needs refact)

parent ad4a84da
{-|
Module : Gargantext.API.Node.Contact
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.API.Node.Contact
where
import Data.Aeson
import Data.Either (Either(Right))
import Data.Maybe (Maybe(..))
import Data.Swagger
import Data.Text (Text)
import GHC.Generics (Generic)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
import Gargantext.API.Admin.Settings (HasSettings)
import Gargantext.API.Node.Corpus.New (AsyncJobs)
import Gargantext.API.Prelude (GargServer, simuLogs)
import Gargantext.Core (Lang(..))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow (flow)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire(..))
import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude (($), liftBase, (.), printDebug, pure)
import Gargantext.Text.Terms (TermType(..))
import Servant
import Servant.Job.Async (JobFunction(..), serveJobsAPI)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
type API = Summary " Add Contact to Annuaire"
:> AsyncJobs JobLog '[JSON] AddContactParams JobLog
------------------------------------------------------------------------
data AddContactParams = AddContactParams { firstname :: !Text, lastname :: !Text }
| AddContactParamsAdvanced { firstname :: !Text
, lastname :: !Text
-- TODO add others fields
}
deriving (Generic)
----------------------------------------------------------------------
api :: User -> NodeId -> GargServer API
api u nId =
serveJobsAPI $
JobFunction (\p log ->
let
log' x = do
printDebug "addContact" x
liftBase $ log x
in addContact u nId p (liftBase . log')
)
addContact :: (HasSettings env, FlowCmdM env err m)
=> User
-> NodeId
-> AddContactParams
-> (JobLog -> m ())
-> m JobLog
addContact u nId (AddContactParams fn ln) logStatus = do
logStatus JobLog { _scst_succeeded = Just 1
, _scst_failed = Just 0
, _scst_remaining = Just 1
, _scst_events = Just []
}
_ <- flow (Nothing :: Maybe HyperdataAnnuaire) u (Right [nId]) (Multi EN) [[hyperdataContact fn ln]]
pure JobLog { _scst_succeeded = Just 2
, _scst_failed = Just 0
, _scst_remaining = Just 0
, _scst_events = Just []
}
addContact _uId _nId _p logStatus = do
simuLogs logStatus 10
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON AddContactParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON AddContactParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToSchema AddContactParams
instance Arbitrary AddContactParams where
arbitrary = elements [AddContactParams "Pierre" "Dupont"]
------------------------------------------------------------------------
......@@ -41,10 +41,10 @@ type API = Summary " Update node according to NodeType params"
:> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
------------------------------------------------------------------------
data UpdateNodeParams = UpdateNodeParamsList { methodList :: Method }
| UpdateNodeParamsGraph { methodGraph :: GraphMetric }
| UpdateNodeParamsTexts { methodTexts :: Granularity }
| UpdateNodeParamsBoard { methodBoard :: Charts }
data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
| UpdateNodeParamsGraph { methodGraph :: !GraphMetric }
| UpdateNodeParamsTexts { methodTexts :: !Granularity }
| UpdateNodeParamsBoard { methodBoard :: !Charts }
deriving (Generic)
----------------------------------------------------------------------
......
......@@ -27,6 +27,7 @@ module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
( FlowCmdM
, getDataText
, flowDataText
, flow
, flowCorpusFile
, flowCorpus
......
......@@ -54,6 +54,15 @@ defaultHyperdataContact = HyperdataContact (Just "bdd")
(Just "DO NOT expose this")
(Just "DO NOT expose this")
hyperdataContact :: FirstName -> LastName -> HyperdataContact
hyperdataContact fn ln = HyperdataContact Nothing
(Just (contactWho fn ln))
[]
Nothing
Nothing
Nothing
Nothing
Nothing
-- TOD0 contact metadata (Type is too flat)
data ContactMetaData =
......@@ -78,12 +87,20 @@ data ContactWho =
, _cw_freetags :: [Text]
} deriving (Eq, Show, Generic)
type FirstName = Text
type LastName = Text
defaultContactWho :: ContactWho
defaultContactWho = ContactWho (Just "123123")
(Just "First Name")
(Just "Last Name")
["keyword A"]
["freetag A"]
defaultContactWho = contactWho "Pierre" "Dupont"
contactWho :: FirstName -> LastName -> ContactWho
contactWho fn ln = ContactWho Nothing
(Just fn)
(Just ln)
[]
[]
data ContactWhere =
ContactWhere { _cw_organization :: [Text]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment