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