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 Data.Aeson
  26 import Data.Either (Either(Right))
  27 import Data.Maybe (Maybe(..))
  28 import Data.Swagger
  29 import Data.Text (Text)
  30 import GHC.Generics (Generic)
  31 import Servant
  32 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
  33 import Test.QuickCheck (elements)
  34 import Test.QuickCheck.Arbitrary
  35
  36 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
  37 import Gargantext.API.Admin.Types (HasSettings)
  38 import Gargantext.API.Node
  39 import Gargantext.API.Prelude (GargServer, simuLogs)
  40 import Gargantext.Core (Lang(..))
  41 import Gargantext.Core.Text.Terms (TermType(..))
  42 import Gargantext.Core.Types.Individu (User(..))
  43 import Gargantext.Database.Action.Flow (flow)
  44 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
  45 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire(..), HyperdataContact)
  46 import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
  47 import Gargantext.Database.Admin.Types.Node
  48 import Gargantext.Prelude (($), liftBase, (.), printDebug, pure)
  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) Nothing [[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 addContact _uId _nId _p logStatus = do
 103   simuLogs logStatus 10
 104
 105 ------------------------------------------------------------------------
 106 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
 107 instance FromJSON  AddContactParams where
 108   parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 109
 110 instance ToJSON    AddContactParams where
 111   toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
 112
 113 instance ToSchema  AddContactParams
 114 instance Arbitrary AddContactParams where
 115   arbitrary = elements [AddContactParams "Pierre" "Dupont"]
 116
 117 ------------------------------------------------------------------------