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 Servant.Job.Async (JobFunction(..), serveJobsAPI)
  34 import Test.QuickCheck (elements)
  35 import Test.QuickCheck.Arbitrary
  36
  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 (GargServer, 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 (($), liftBase, (.), printDebug, pure)
  50 import qualified Gargantext.Utils.Aeson as GUA
  51
  52 ------------------------------------------------------------------------
  53 type API = "contact" :> Summary "Contact endpoint"
  54             :> API_Async
  55           :<|> Capture "contact_id" NodeId
  56             :> NodeNodeAPI HyperdataContact
  57
  58
  59 api :: UserId -> CorpusId -> GargServer API
  60 api uid cid =  (api_async   (RootId (NodeId                   uid)) cid)
  61           :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid   cid)
  62
  63 type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
  64 ------------------------------------------------------------------------
  65 data AddContactParams = AddContactParams         { firstname :: !Text, lastname :: !Text }
  66                       | AddContactParamsAdvanced { firstname :: !Text
  67                                                  , lastname  :: !Text
  68                                                  -- TODO add others fields
  69                                                  }
  70     deriving (Generic)
  71
  72 ----------------------------------------------------------------------
  73 api_async :: User -> NodeId -> GargServer API_Async
  74 api_async u nId =
  75   serveJobsAPI $
  76     JobFunction (\p log ->
  77       let
  78         log' x = do
  79           printDebug "addContact" x
  80           liftBase $ log x
  81       in addContact u nId p (liftBase . log')
  82       )
  83
  84 addContact :: (HasSettings env, FlowCmdM env err m)
  85     => User
  86     -> NodeId
  87     -> AddContactParams
  88     -> (JobLog -> m ())
  89     -> m JobLog
  90 addContact u nId (AddContactParams fn ln) logStatus = do
  91
  92   logStatus JobLog { _scst_succeeded = Just 1
  93                    , _scst_failed    = Just 0
  94                    , _scst_remaining = Just 1
  95                    , _scst_events    = Just []
  96                    }
  97   _ <- flow (Nothing :: Maybe HyperdataAnnuaire) u (Right [nId]) (Multi EN) Nothing (Just 1, yield $ hyperdataContact fn ln) logStatus
  98
  99   pure  JobLog { _scst_succeeded = Just 2
 100                , _scst_failed    = Just 0
 101                , _scst_remaining = Just 0
 102                , _scst_events    = Just []
 103                }
 104 addContact _uId _nId _p logStatus = do
 105   simuLogs logStatus 10
 106
 107 ------------------------------------------------------------------------
 108 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
 109 instance FromJSON  AddContactParams where
 110   parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
 111
 112 instance ToJSON    AddContactParams where
 113   toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
 114
 115 instance ToSchema  AddContactParams
 116 instance Arbitrary AddContactParams where
 117   arbitrary = elements [AddContactParams "Pierre" "Dupont"]
 118
 119 ------------------------------------------------------------------------