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.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 ------------------------------------------------------------------------