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 {-# LANGUAGE TemplateHaskell    #-}
  13 {-# LANGUAGE TypeOperators      #-}
  14 {-# OPTIONS_GHC -fno-warn-orphans #-}
  15
  16 module Gargantext.API.Node.Contact
  17       where
  18
  19 import Data.Aeson
  20 import Data.Either (Either(Right))
  21 import Data.Maybe (Maybe(..))
  22 import Data.Swagger
  23 import Data.Text (Text)
  24 import GHC.Generics (Generic)
  25 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
  26 import Gargantext.API.Admin.Settings (HasSettings)
  27 import Gargantext.API.Node.Corpus.New (AsyncJobs)
  28 import Gargantext.API.Prelude (GargServer, simuLogs)
  29 import Gargantext.Core (Lang(..))
  30 import Gargantext.Core.Types.Individu (User(..))
  31 import Gargantext.Database.Action.Flow (flow)
  32 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
  33 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire(..))
  34 import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
  35 import Gargantext.Database.Admin.Types.Node
  36 import Gargantext.Prelude (($), liftBase, (.), printDebug, pure)
  37 import Gargantext.Text.Terms (TermType(..))
  38 import Servant
  39 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
  40 import Test.QuickCheck (elements)
  41 import Test.QuickCheck.Arbitrary
  42
  43 ------------------------------------------------------------------------
  44 type API = Summary " Add Contact to Annuaire"
  45          :> AsyncJobs JobLog '[JSON] AddContactParams JobLog
  46
  47 ------------------------------------------------------------------------
  48 data AddContactParams = AddContactParams         { firstname :: !Text, lastname :: !Text }
  49                       | AddContactParamsAdvanced { firstname :: !Text
  50                                                  , lastname  :: !Text
  51                                                  -- TODO add others fields
  52                                                  }
  53     deriving (Generic)
  54
  55 ----------------------------------------------------------------------
  56 api :: User -> NodeId -> GargServer API
  57 api u nId =
  58   serveJobsAPI $
  59     JobFunction (\p log ->
  60       let
  61         log' x = do
  62           printDebug "addContact" x
  63           liftBase $ log x
  64       in addContact u nId p (liftBase . log')
  65       )
  66
  67 addContact :: (HasSettings env, FlowCmdM env err m)
  68     => User
  69     -> NodeId
  70     -> AddContactParams
  71     -> (JobLog -> m ())
  72     -> m JobLog
  73 addContact u nId (AddContactParams fn ln) logStatus = do
  74
  75   logStatus JobLog { _scst_succeeded = Just 1
  76                    , _scst_failed    = Just 0
  77                    , _scst_remaining = Just 1
  78                    , _scst_events    = Just []
  79                    }
  80   _ <- flow (Nothing :: Maybe HyperdataAnnuaire) u (Right [nId]) (Multi EN) [[hyperdataContact fn ln]]
  81
  82   pure  JobLog { _scst_succeeded = Just 2
  83                , _scst_failed    = Just 0
  84                , _scst_remaining = Just 0
  85                , _scst_events    = Just []
  86                }
  87
  88
  89 addContact _uId _nId _p logStatus = do
  90   simuLogs logStatus 10
  91
  92 ------------------------------------------------------------------------
  93 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
  94 instance FromJSON  AddContactParams where
  95   parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  96
  97 instance ToJSON    AddContactParams where
  98   toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
  99
 100 instance ToSchema  AddContactParams
 101 instance Arbitrary AddContactParams where
 102   arbitrary = elements [AddContactParams "Pierre" "Dupont"]
 103
 104 ------------------------------------------------------------------------