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 Conduit
  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 Servant
  33 import Test.QuickCheck (elements)
  34 import Test.QuickCheck.Arbitrary
  35
  36 import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
  37 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
  38 import Gargantext.API.Admin.Types (HasSettings)
  39 import Gargantext.API.Node
  40 import Gargantext.API.Prelude (GargError, GargM, simuLogs)
  41 import Gargantext.Core (Lang(..))
  42 import Gargantext.Core.Text.Terms (TermType(..))
  43 import Gargantext.Core.Types.Individu (User(..))
  44 import Gargantext.Database.Action.Flow (flow)
  45 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
  46 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire(..), HyperdataContact)
  47 import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
  48 import Gargantext.Database.Admin.Types.Node
  49 import Gargantext.Prelude (($), {-printDebug,-})
  50 import qualified Gargantext.Utils.Aeson as GUA
  51 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
  52
  53 ------------------------------------------------------------------------
  54 type API = "contact" :> Summary "Contact endpoint"
  55             :> API_Async
  56           :<|> Capture "contact_id" NodeId
  57             :> NodeNodeAPI HyperdataContact
  58
  59
  60 api :: UserId -> CorpusId -> ServerT API (GargM Env GargError)
  61 api uid cid =  (api_async   (RootId (NodeId                   uid)) cid)
  62           :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid   cid)
  63
  64 type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
  65 ------------------------------------------------------------------------
  66 data AddContactParams = AddContactParams         { firstname :: !Text, lastname :: !Text }
  67                       | AddContactParamsAdvanced { firstname :: !Text
  68                                                  , lastname  :: !Text
  69                                                  -- TODO add others fields
  70                                                  }
  71     deriving (Generic)
  72
  73 ----------------------------------------------------------------------
  74 api_async :: User -> NodeId -> ServerT API_Async (GargM Env GargError)
  75 api_async u nId =
  76   serveJobsAPI AddContactJob $ \jHandle p ->
  77     addContact u nId p jHandle
  78
  79 addContact :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m)
  80     => User
  81     -> NodeId
  82     -> AddContactParams
  83     -> JobHandle m
  84     -> m ()
  85 addContact u nId (AddContactParams fn ln) jobHandle = do
  86
  87   markStarted 2 jobHandle
  88   _ <- flow (Nothing :: Maybe HyperdataAnnuaire) u (Right [nId]) (Multi EN) Nothing (Just 1, yield $ hyperdataContact fn ln) jobHandle
  89
  90   markComplete jobHandle
  91 addContact _uId _nId _p jobHandle = do
  92   simuLogs jobHandle 10
  93
  94 ------------------------------------------------------------------------
  95 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
  96 instance FromJSON  AddContactParams where
  97   parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
  98
  99 instance ToJSON    AddContactParams where
 100   toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
 101
 102 instance ToSchema  AddContactParams
 103 instance Arbitrary AddContactParams where
 104   arbitrary = elements [AddContactParams "Pierre" "Dupont"]
 105
 106 ------------------------------------------------------------------------