[pubmed] implement pubmed api key in hyperdata user

src/Gargantext/API/GraphQL.hs

@@ -87,6 +87,7 @@ data Query m
 data Mutation m
   = Mutation
     { update_user_info       :: GQLUserInfo.UserInfoMArgs -> m Int
+    , update_user_pubmed_api_key :: GQLUser.UserPubmedAPIKeyMArgs -> m Int
     , delete_team_membership :: GQLTeam.TeamDeleteMArgs -> m [Int]
     , update_node_context_category :: GQLCTX.NodeContextCategoryMArgs -> m [Int]
     } deriving (Generic, GQLType)
@@ -128,6 +129,7 @@ rootResolver =
                             , tree                = GQLTree.resolveTree
                             , team                = GQLTeam.resolveTeam }
     , mutationResolver = Mutation { update_user_info       = GQLUserInfo.updateUserInfo
+                                  , update_user_pubmed_api_key = GQLUser.updateUserPubmedAPIKey
                                   , delete_team_membership = GQLTeam.deleteTeamMembership
                                   , update_node_context_category = GQLCTX.updateNodeContextCategory }
     , subscriptionResolver = Undefined }

src/Gargantext/API/GraphQL/Node.hs

@@ -30,7 +30,6 @@ data Corpus = Corpus
   { id           :: Int
   , name         :: Text
   , parent_id    :: Maybe Int
-  , pubmedAPIKey :: Maybe PUBMED.APIKey
   , type_id      :: Int
   } deriving (Show, Generic, GQLType)
 
@@ -116,7 +115,6 @@ toCorpus :: NN.Node Value -> Corpus
 toCorpus N.Node { .. } = Corpus { id = NN.unNodeId _node_id
                                 , name = _node_name
                                 , parent_id = NN.unNodeId <$> _node_parent_id
-                                , pubmedAPIKey = pubmedAPIKeyFromValue _node_hyperdata
                                 , type_id = _node_typename }
 
 pubmedAPIKeyFromValue :: Value -> Maybe PUBMED.APIKey

src/Gargantext/API/GraphQL/Team.hs

@@ -11,6 +11,7 @@ import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.GraphQL.Utils (authUser, AuthStatus (Invalid, Valid))
 import Gargantext.API.Prelude (GargM, GargError)
 import Gargantext.Core.Types (NodeId(..), unNodeId)
+import qualified Gargantext.Core.Types.Individu as Individu
 import Gargantext.Database.Action.Share (membersOf, deleteMemberShip)
 import Gargantext.Database.Prelude (CmdCommon)
 import Gargantext.Database.Query.Table.Node (getNode)
@@ -52,7 +53,7 @@ dbTeam nodeId = do
   let nId = NodeId nodeId
   res <- lift $ membersOf nId
   teamNode <- lift $ getNode nId
-  userNodes <- lift $ getUsersWithNodeHyperdata $ uId teamNode
+  userNodes <- lift $ getUsersWithNodeHyperdata $ Individu.UserDBId $ uId teamNode
   let username = getUsername userNodes
   pure $ Team { team_owner_username = username
               , team_members = map toTeamMember res
@@ -72,7 +73,7 @@ deleteTeamMembership :: (CmdCommon env, HasSettings env) =>
                         TeamDeleteMArgs -> GqlM' e env [Int]
 deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } = do
   teamNode <- lift $ getNode $ NodeId team_node_id
-  userNodes <- lift (getUsersWithNodeHyperdata $ uId teamNode)
+  userNodes <- lift (getUsersWithNodeHyperdata $ Individu.UserDBId $ uId teamNode)
   case userNodes of
     [] -> panic $ "[deleteTeamMembership] User with id " <> T.pack (show $ uId teamNode) <> " doesn't exist."
     (( _, node_u):_) -> do

src/Gargantext/API/GraphQL/User.hs

 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 
 module Gargantext.API.GraphQL.User where
 
 import Data.Maybe (listToMaybe)
 import Data.Morpheus.Types
   ( GQLType
-  , Resolver, QUERY
+  , Resolver, ResolverM, QUERY
   , lift
   )
 import Data.Text (Text)
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Prelude (GargM, GargError)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..))
+import Gargantext.Database.Admin.Types.Node (NodeId(..))
 import Gargantext.Database.Prelude (CmdCommon)
-import Gargantext.Database.Query.Table.User (getUsersWithId, getUserHyperdata)
+import qualified Gargantext.Database.Query.Table.User as DBUser
 import Gargantext.Database.Schema.User (UserLight(..))
 import Gargantext.Prelude
 import GHC.Generics (Generic)
+import qualified Gargantext.Core.Types.Individu as Individu
 
 data User m = User
   { u_email     :: Text
@@ -30,7 +34,14 @@ data UserArgs
     { user_id :: Int
     } deriving (Generic, GQLType)
 
+data UserPubmedAPIKeyMArgs
+  = UserPubmedAPIKeyMArgs
+    { user_id :: Int
+    , api_key  :: Text }
+    deriving (Generic, GQLType)
+
 type GqlM e env = Resolver QUERY e (GargM env GargError)
+type GqlM' e env a = ResolverM e (GargM env GargError) a
 
 -- | Function to resolve user from a query.
 resolveUsers
@@ -42,7 +53,7 @@ resolveUsers UserArgs { user_id } = dbUsers user_id
 dbUsers
   :: (CmdCommon env)
   => Int -> GqlM e env [User (GqlM e env)]
-dbUsers user_id = lift (map toUser <$> getUsersWithId user_id)
+dbUsers user_id = lift (map toUser <$> DBUser.getUsersWithId (Individu.RootId $ NodeId user_id))
 
 toUser
   :: (CmdCommon env)
@@ -55,4 +66,11 @@ toUser (UserLight { .. }) = User { u_email = userLight_email
 resolveHyperdata
   :: (CmdCommon env)
   => Int -> GqlM e env (Maybe HyperdataUser)
-resolveHyperdata userid = lift (listToMaybe <$> getUserHyperdata userid)
+resolveHyperdata userid = lift (listToMaybe <$> DBUser.getUserHyperdata (Individu.UserDBId userid))
+
+updateUserPubmedAPIKey :: ( CmdCommon env, HasSettings env) =>
+                          UserPubmedAPIKeyMArgs -> GqlM' e env Int
+updateUserPubmedAPIKey UserPubmedAPIKeyMArgs { user_id, api_key } = do
+  _ <- lift $ DBUser.updateUserPubmedAPIKey (Individu.RootId $ NodeId user_id) api_key
+
+  pure 1

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -48,6 +48,7 @@ import Gargantext.Prelude
 import GHC.Generics (Generic)
 import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser)
 import Gargantext.API.Admin.Types (HasSettings)
+import qualified Gargantext.Core.Types.Individu as Individu
 
 data UserInfo = UserInfo
   { ui_id             :: Int
@@ -115,7 +116,7 @@ updateUserInfo
   => UserInfoMArgs -> GqlM' e env err
 updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
   -- lift $ printDebug "[updateUserInfo] ui_id" ui_id
-  users <- lift (getUsersWithNodeHyperdata ui_id)
+  users <- lift (getUsersWithNodeHyperdata (Individu.UserDBId ui_id))
   case users of
     [] -> panic $ "[updateUserInfo] User with id " <> (T.pack $ show ui_id) <> " doesn't exist."
     ((UserLight { .. }, node_u):_) -> do
@@ -166,7 +167,7 @@ dbUsers user_id = do
 --  user <- getUsersWithId user_id
 --  hyperdata <- getUserHyperdata user_id
 --  lift (map toUser <$> zip user hyperdata)
-  lift (map toUser <$> (getUsersWithHyperdata user_id))
+  lift (map toUser <$> getUsersWithHyperdata (Individu.UserDBId user_id))
 
 toUser :: (UserLight, HyperdataUser) -> UserInfo
 toUser (UserLight { .. }, u_hyperdata) =

src/Gargantext/API/Node/Corpus/New.hs

@@ -56,11 +56,12 @@ import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..))
 import Gargantext.Database.Prelude (hasConfig)
-import Gargantext.Database.Query.Table.Node (getNodeWith, updateCorpusPubmedAPIKey)
+import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
+import Gargantext.Database.Query.Table.User (getUserPubmedAPIKey)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (gc_max_docs_parsers, gc_pubmed_api_key)
+import Gargantext.Prelude.Config (gc_max_docs_parsers)
 import Gargantext.Utils.Jobs (JobHandle, MonadJobStatus(..))
 import qualified Gargantext.Core.Text.Corpus.API as API
 import qualified Gargantext.Core.Text.Corpus.Parsers as Parser (FileType(..), parseFormatC)
@@ -215,13 +216,6 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
       markComplete jobHandle
 
     _ -> do
-      case datafield of
-         Just (External PubMed) -> do
-           _api_key <- view $ hasConfig . gc_pubmed_api_key
-           printDebug "[addToCorpusWithQuery] pubmed api key" _api_key
-           _ <- updateCorpusPubmedAPIKey cid _api_key
-           pure ()
-         _ -> pure ()
       markStarted 3 jobHandle
 
       -- TODO add cid
@@ -230,7 +224,9 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
       --      if cid is root   -> create corpus in Private
       -- printDebug "[G.A.N.C.New] getDataText with query" q
       let db = database2origin dbs
-      eTxt <- getDataText db (Multi l) q maybeLimit
+      mPubmedAPIKey <- getUserPubmedAPIKey user
+      -- printDebug "[addToCorpusWithQuery] mPubmedAPIKey" mPubmedAPIKey
+      eTxt <- getDataText db (Multi l) q mPubmedAPIKey maybeLimit
 
       -- printDebug "[G.A.N.C.New] lTxts" lTxts
       case eTxt of

src/Gargantext/Core/Text/Corpus/API.hs

@@ -19,7 +19,6 @@ module Gargantext.Core.Text.Corpus.API
   ) where
 
 import Conduit
-import Control.Lens ((^.))
 import Data.Bifunctor
 import Data.Either (Either(..))
 import Data.Maybe
@@ -28,13 +27,13 @@ import Gargantext.API.Admin.Orchestrator.Types (ExternalAPIs(..), externalAPIs)
 import Gargantext.Core (Lang(..))
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (GargConfig, gc_pubmed_api_key)
 import qualified Gargantext.Core.Text.Corpus.API.Arxiv   as Arxiv
 import qualified Gargantext.Core.Text.Corpus.API.Hal     as HAL
 import qualified Gargantext.Core.Text.Corpus.API.Isidore as ISIDORE
 import qualified Gargantext.Core.Text.Corpus.API.Istex   as ISTEX
 import qualified Gargantext.Core.Text.Corpus.API.Pubmed  as PUBMED
 import qualified Gargantext.Core.Text.Corpus.Query as Corpus
+import qualified PUBMED.Types as PUBMED
 import Servant.Client (ClientError)
 
 data GetCorpusError
@@ -45,19 +44,19 @@ data GetCorpusError
   deriving (Show, Eq)
 
 -- | Get External API metadata main function
-get :: GargConfig
-    -> ExternalAPIs
+get :: ExternalAPIs
     -> Lang
     -> Corpus.RawQuery
+    -> Maybe PUBMED.APIKey
     -> Maybe Corpus.Limit
     -- -> IO [HyperdataDocument]
     -> IO (Either GetCorpusError (Maybe Integer, ConduitT () HyperdataDocument IO ()))
-get cfg externalAPI la q limit = do
+get externalAPI la q mPubmedAPIKey limit = do
   case Corpus.parseQuery q of
     Left err -> pure $ Left $ InvalidInputQuery q (T.pack err)
     Right corpusQuery -> case externalAPI of
       PubMed -> first ExternalAPIError <$>
-                  PUBMED.get (cfg ^. gc_pubmed_api_key) corpusQuery limit
+                  PUBMED.get (fromMaybe "" mPubmedAPIKey) corpusQuery limit
       --docs <- PUBMED.get   q default_limit -- EN only by default
       --pure (Just $ fromIntegral $ length docs, yieldMany docs)
       Arxiv   -> Right <$> Arxiv.get la corpusQuery limit

src/Gargantext/Database/Action/Flow.hs

@@ -112,6 +112,7 @@ import Gargantext.Prelude.Crypto.Hash (Hash)
 import Gargantext.Utils.Jobs (JobHandle, MonadJobStatus(..))
 import qualified Gargantext.Core.Text.Corpus.API as API
 import qualified Gargantext.Database.Query.Table.Node.Document.Add  as Doc  (add)
+import qualified PUBMED.Types as PUBMED
 --import qualified Prelude
 
 ------------------------------------------------------------------------
@@ -151,14 +152,13 @@ getDataText :: FlowCmdM env err m
             => DataOrigin
             -> TermType Lang
             -> API.RawQuery
+            -> Maybe PUBMED.APIKey
             -> Maybe API.Limit
             -> m (Either API.GetCorpusError DataText)
-getDataText (ExternalOrigin api) la q li = do
-  cfg  <- view $ hasConfig
-  eRes <- liftBase $ API.get cfg api (_tt_lang la) q li
+getDataText (ExternalOrigin api) la q mPubmedAPIKey li = do
+  eRes <- liftBase $ API.get api (_tt_lang la) q mPubmedAPIKey li
   pure $ DataNew <$> eRes
-
-getDataText (InternalOrigin _) _la q _li = do
+getDataText (InternalOrigin _) _la q _ _li = do
   (_masterUserId, _masterRootId, cId) <- getOrMk_RootWithCorpus
                                            (UserName userMaster)
                                            (Left "")
@@ -173,7 +173,7 @@ getDataText_Debug :: FlowCmdM env err m
             -> Maybe API.Limit
             -> m ()
 getDataText_Debug a l q li = do
-  result <- getDataText a l q li
+  result <- getDataText a l q Nothing li
   case result of
     Left  err -> liftBase $ putStrLn $ show err
     Right res -> liftBase $ printDataText res

src/Gargantext/Database/Action/User.hs

@@ -26,7 +26,7 @@ import Gargantext.Prelude
 ------------------------------------------------------------------------
 getUserLightWithId :: HasNodeError err => Int -> Cmd err UserLight
 getUserLightWithId i = do
-  candidates <- head <$> getUsersWithId i
+  candidates <- head <$> getUsersWithId (UserDBId i)
   case candidates of
     Nothing -> nodeError NoUserFound
     Just u  -> pure u
@@ -70,8 +70,8 @@ getUsername :: HasNodeError err
             => User
             -> Cmd err Username
 getUsername (UserName u) = pure u
-getUsername (UserDBId i) = do
-  users <- getUsersWithId i
+getUsername user@(UserDBId _) = do
+  users <- getUsersWithId user
   case head users of
     Just u  -> pure $ userLight_username u
     Nothing -> nodeError $ NodeError "G.D.A.U.getUserName: User not found with that id"
@@ -82,4 +82,3 @@ getUsername UserPublic = pure "UserPublic"
 
 --------------------------------------------------------------------------
 -- getRootId is in Gargantext.Database.Query.Tree.Root
-

src/Gargantext/Database/Admin/Types/Hyperdata/User.hs

@@ -31,13 +31,15 @@ import Gargantext.Database.Admin.Types.Hyperdata.Prelude
 import Gargantext.Database.Admin.Types.Hyperdata.Contact
 import Gargantext.Database.Admin.Types.Node (DocumentId)
 import Gargantext.Prelude
+import qualified PUBMED.Types as PUBMED
 
 -- import Gargantext.Database.Schema.Node -- (Node(..))
 
 data HyperdataUser =
-     HyperdataUser { _hu_private   :: !(Maybe HyperdataPrivate)
-                   , _hu_shared    :: !(Maybe HyperdataContact)
-                   , _hu_public    :: !(Maybe HyperdataPublic)
+     HyperdataUser { _hu_private        :: !(Maybe HyperdataPrivate)
+                   , _hu_shared         :: !(Maybe HyperdataContact)
+                   , _hu_public         :: !(Maybe HyperdataPublic)
+                   , _hu_pubmed_api_key :: !(Maybe PUBMED.APIKey)
                    } deriving (Eq, Show, Generic)
 
 instance GQLType HyperdataUser where
@@ -66,9 +68,10 @@ instance GQLType HyperdataPublic where
 defaultHyperdataUser :: HyperdataUser
 defaultHyperdataUser =
   HyperdataUser
-    { _hu_private = Just defaultHyperdataPrivate
-    , _hu_shared = Just defaultHyperdataContact
-    , _hu_public = Just defaultHyperdataPublic }
+    { _hu_private        = Just defaultHyperdataPrivate
+    , _hu_shared         = Just defaultHyperdataContact
+    , _hu_public         = Just defaultHyperdataPublic
+    , _hu_pubmed_api_key = Nothing }
 
 defaultHyperdataPublic :: HyperdataPublic
 defaultHyperdataPublic = HyperdataPublic "pseudo" [1..10]
@@ -97,7 +100,7 @@ $(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic)
 
 -- | Arbitrary instances
 instance Arbitrary HyperdataUser where
-  arbitrary = HyperdataUser <$> arbitrary <*> arbitrary <*> arbitrary
+  arbitrary = HyperdataUser <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 
 instance Arbitrary HyperdataPrivate where
   arbitrary = pure defaultHyperdataPrivate
@@ -143,4 +146,3 @@ instance DefaultFromField SqlJsonb HyperdataPrivate   where
 
 instance DefaultFromField SqlJsonb HyperdataPublic   where
   defaultFromField = fromPGSFromField
-

src/Gargantext/Database/Query/Table/Node.hs

@@ -29,7 +29,6 @@ import Data.Text (Text)
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Opaleye hiding (FromField)
 import Prelude hiding (null, id, map, sum)
-import qualified PUBMED.Types as PUBMED
 
 import Gargantext.Core
 import Gargantext.Core.Types
@@ -203,7 +202,7 @@ getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus)
 selectNodesWithParentID :: NodeId -> Select NodeRead
 selectNodesWithParentID n = proc () -> do
     row@(Node _ _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
-    restrict -< parent_id .== (pgNodeId n)
+    restrict -< parent_id .== pgNodeId n
     returnA -< row
 
 
@@ -217,7 +216,22 @@ getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
                          => NodeType -> Select NodeRead
     selectNodesWithType nt' = proc () -> do
         row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
-        restrict -< tn .== (sqlInt4 $ toDBid nt')
+        restrict -< tn .== sqlInt4 (toDBid nt')
+        returnA -< row
+
+getNodeWithType :: (HasNodeError err, JSONB a, HasDBid NodeType)
+                => NodeId
+                -> NodeType
+                -> proxy a
+                -> Cmd err [Node a]
+getNodeWithType nId nt _ = runOpaQuery $ selectNodeWithType nId nt
+  where
+    selectNodeWithType ::  HasDBid NodeType
+                        => NodeId -> NodeType -> Select NodeRead
+    selectNodeWithType (NodeId nId') nt' = proc () -> do
+        row@(Node ti _ tn _ _ _ _ _) <- queryNodeTable -< ()
+        restrict -< ti .== sqlInt4 nId'
+        restrict -< tn .== sqlInt4 (toDBid nt')
         returnA -< row
 
 getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [NodeId]
@@ -328,31 +342,6 @@ insertNodesWithParent pid ns = insertNodes (set node_parent_id (pgNodeId <$> pid
 
 insertNodesWithParentR :: Maybe ParentId -> [NodeWrite] -> Cmd err [NodeId]
 insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> pid) <$> ns)
-
-getCorpusPubmedAPIKey :: NodeId -> Cmd err (Maybe PUBMED.APIKey)
-getCorpusPubmedAPIKey cId = do
-  res <- runPGSQuery query params
-  pure $ (\(PGS.Only apiKey) -> apiKey) <$> head res
-  where
-    query :: PGS.Query
-    query = [sql|
-                SELECT hyperdata -> 'pubmed_api_key'
-                FROM nodes
-                WHERE id = ?
-            |]
-    params = PGS.Only cId
-
-updateCorpusPubmedAPIKey :: NodeId -> PUBMED.APIKey -> Cmd err Int64
-updateCorpusPubmedAPIKey cId apiKey =
-  execPGSQuery query params
-  where
-    query :: PGS.Query
-    query = [sql|
-                UPDATE nodes
-                SET hyperdata = hyperdata || ?
-                WHERE id = ?
-            |]
-    params = (encode $ object [ "pubmed_api_key" .= apiKey ], cId)
 ------------------------------------------------------------------------
 -- TODO
 -- currently this function removes the child relation

src/Gargantext/Database/Query/Table/Node/Select.hs

@@ -27,7 +27,7 @@ import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.User
 import Gargantext.Database.Query.Table.User
 
-selectNodesWithUsername :: NodeType -> Username -> Cmd err [NodeId]
+selectNodesWithUsername :: (HasDBid NodeType) => NodeType -> Username -> Cmd err [NodeId]
 selectNodesWithUsername nt u = runOpaQuery $ proc () -> do
   n <- queryNodeTable -< ()
   usrs <- optionalRestrict queryUserTable -<

src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs

@@ -39,10 +39,10 @@ updateHyperdataQuery i h = seq h' $ trace "updateHyperdataQuery: encoded JSON" $
                                 -> Node { _node_hyperdata = h', .. }
                                -- -> trace "updating mate" $ Node _ni _nh _nt _nu _np _nn _nd h'
                               )
-   , uWhere      = (\row -> {-trace "uWhere" $-} _node_id row .== pgNodeId i )
+   , uWhere      = \row -> {-trace "uWhere" $-} _node_id row .== pgNodeId i
    , uReturning  = rCount
    }
-    where h' =  (sqlJSONB $ cs $ encode $ h)
+    where h' =  sqlJSONB $ cs $ encode h
 
 ----------------------------------------------------------------------------------
 updateNodesWithType :: ( HasNodeError err
@@ -54,6 +54,19 @@ updateNodesWithType nt p f = do
   ns <- getNodesWithType nt p
   mapM (\n -> updateHyperdata (_node_id n) (f $ _node_hyperdata n)) ns
 
+updateNodeWithType :: ( HasNodeError err
+                      , JSONB a
+                      , ToJSON a
+                      , HasDBid NodeType
+                      ) => NodeId
+                        -> NodeType
+                        -> proxy a
+                        -> (a -> a)
+                        -> Cmd err [Int64]
+updateNodeWithType nId nt p f = do
+  ns <- getNodeWithType nId nt p
+  mapM (\n -> updateHyperdata (_node_id n) (f $ _node_hyperdata n)) ns
+
 
 -- | In case the Hyperdata Types are not compatible
 updateNodesWithType_ :: ( HasNodeError err

src/Gargantext/Database/Query/Table/User.hs

@@ -13,9 +13,10 @@ Functions to deal with users, database side.
 
 {-# OPTIONS_GHC -fno-warn-orphans        #-}
 
-{-# LANGUAGE TemplateHaskell             #-}
-{-# LANGUAGE FunctionalDependencies      #-}
 {-# LANGUAGE Arrows                      #-}
+{-# LANGUAGE FunctionalDependencies      #-}
+{-# LANGUAGE QuasiQuotes            #-}
+{-# LANGUAGE TemplateHaskell             #-}
 
 module Gargantext.Database.Query.Table.User
   ( insertUsers
@@ -29,6 +30,8 @@ module Gargantext.Database.Query.Table.User
   , updateUserEmail
   , updateUserPassword
   , updateUserForgotPasswordUUID
+  , getUserPubmedAPIKey
+  , updateUserPubmedAPIKey
   , getUser
   , insertNewUsers
   , selectUsersLightWith
@@ -44,22 +47,27 @@ module Gargantext.Database.Query.Table.User
   where
 
 import Control.Arrow (returnA)
-import Control.Lens ((^.))
-import Data.Maybe (fromMaybe)
+import Control.Lens ((^.), (?~))
 import Data.List (find)
+import Data.Maybe (fromMaybe)
+import Data.Proxy
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import qualified Data.UUID as UUID
 import Gargantext.Core.Types.Individu
 import qualified Gargantext.Prelude.Crypto.Auth as Auth
-import Gargantext.Database.Admin.Config (nodeTypeId)
-import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
-import Gargantext.Database.Admin.Types.Node (NodeType(NodeUser), Node)
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..), hu_pubmed_api_key)
+import Gargantext.Database.Admin.Types.Node (NodeType(NodeUser), Node, NodeId(..), pgNodeId)
 import Gargantext.Database.Prelude
-import Gargantext.Database.Schema.Node (NodeRead, node_hyperdata, queryNodeTable, node_user_id, node_typename)
+import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateNodeWithType)
+import Gargantext.Database.Schema.Node (NodeRead, node_hyperdata, queryNodeTable, node_id, node_user_id, node_typename)
 import Gargantext.Database.Schema.User
 import Gargantext.Prelude
 import Opaleye
+import qualified PUBMED.Types as PUBMED
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Core (HasDBid)
+import Gargantext.Database.Admin.Config (nodeTypeId)
 
 ------------------------------------------------------------------------
 -- TODO: on conflict, nice message
@@ -86,7 +94,7 @@ updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us)
                                             , user_email = em'
                                             , .. }
                                  )
-      , uWhere      = (\row -> user_username row .== un')
+      , uWhere      = \row -> user_username row .== un'
       , uReturning  = rCount
       }
         where
@@ -139,52 +147,82 @@ selectUsersLightWithForgotPasswordUUID uuid = proc () -> do
       returnA  -< row
 
 ----------------------------------------------------------
-getUsersWithId :: Int -> Cmd err [UserLight]
-getUsersWithId i = map toUserLight <$> runOpaQuery (selectUsersLightWithId i)
+getUsersWithId :: User -> Cmd err [UserLight]
+getUsersWithId (UserDBId i) = map toUserLight <$> runOpaQuery (selectUsersLightWithId i)
   where
     selectUsersLightWithId :: Int -> Select UserRead
     selectUsersLightWithId i' = proc () -> do
-          row      <- queryUserTable -< ()
-          restrict -< user_id row .== sqlInt4 i'
-          returnA  -< row
+      row      <- queryUserTable -< ()
+      restrict -< user_id row .== sqlInt4 i'
+      returnA  -< row
+getUsersWithId (RootId i) = map toUserLight <$> runOpaQuery (selectUsersLightWithId i)
+  where
+    selectUsersLightWithId :: NodeId -> Select UserRead
+    selectUsersLightWithId i' = proc () -> do
+      n <- queryNodeTable -< ()
+      restrict -< n^.node_id .== pgNodeId i'
+      restrict -< n^.node_typename .== sqlInt4 (nodeTypeId NodeUser)
+      row      <- queryUserTable -< ()
+      restrict -< user_id row .== n^.node_user_id
+      returnA  -< row
+getUsersWithId _ = undefined
 
 
 queryUserTable :: Select UserRead
 queryUserTable = selectTable userTable
 
 ----------------------------------------------------------------------
-getUserHyperdata :: Int -> Cmd err [HyperdataUser]
-getUserHyperdata i = do
-  runOpaQuery (selectUserHyperdataWithId i)
+-- | Get hyperdata associated with user node.
+getUserHyperdata :: User -> Cmd err [HyperdataUser]
+getUserHyperdata (RootId uId) = do
+  runOpaQuery (selectUserHyperdataWithId uId)
   where
-    selectUserHyperdataWithId :: Int -> Select (Column SqlJsonb)
+    selectUserHyperdataWithId :: NodeId -> Select (Field SqlJsonb)
     selectUserHyperdataWithId i' = proc () -> do
       row      <- queryNodeTable -< ()
-      restrict -< row^.node_user_id .== (sqlInt4 i')
-      restrict -< row^.node_typename .== (sqlInt4 $ nodeTypeId NodeUser)
+      restrict -< row^.node_id .== pgNodeId i'
       returnA  -< row^.node_hyperdata
+getUserHyperdata (UserDBId uId) = do
+  runOpaQuery (selectUserHyperdataWithId uId)
+  where
+    selectUserHyperdataWithId :: Int -> Select (Field SqlJsonb)
+    selectUserHyperdataWithId i' = proc () -> do
+      row      <- queryNodeTable -< ()
+      restrict -< row^.node_user_id .== sqlInt4 i'
+      restrict -< row^.node_typename .== sqlInt4 (nodeTypeId NodeUser)
+      returnA  -< row^.node_hyperdata
+getUserHyperdata _ = undefined
 
-getUserNodeHyperdata :: Int -> Cmd err [Node HyperdataUser]
-getUserNodeHyperdata i = do
-  runOpaQuery (selectUserHyperdataWithId i)
+
+-- | Same as `getUserHyperdata` but returns a `Node` type.
+getUserNodeHyperdata :: User -> Cmd err [Node HyperdataUser]
+getUserNodeHyperdata (RootId uId) = do
+  runOpaQuery (selectUserHyperdataWithId uId)
+  where
+    selectUserHyperdataWithId :: NodeId -> Select NodeRead
+    selectUserHyperdataWithId i' = proc () -> do
+      row      <- queryNodeTable -< ()
+      restrict -< row^.node_id .== pgNodeId i'
+      returnA  -< row
+getUserNodeHyperdata (UserDBId uId) = do
+  runOpaQuery (selectUserHyperdataWithId uId)
   where
     selectUserHyperdataWithId :: Int -> Select NodeRead
     selectUserHyperdataWithId i' = proc () -> do
       row      <- queryNodeTable -< ()
-      restrict -< row^.node_user_id .== (sqlInt4 i')
-      restrict -< row^.node_typename .== (sqlInt4 $ nodeTypeId NodeUser)
+      restrict -< row^.node_user_id .== sqlInt4 i'
+      restrict -< row^.node_typename .== sqlInt4 (nodeTypeId NodeUser)
       returnA  -< row
+getUserNodeHyperdata _ = undefined
 
-
-
-getUsersWithHyperdata :: Int -> Cmd err [(UserLight, HyperdataUser)]
+getUsersWithHyperdata :: User -> Cmd err [(UserLight, HyperdataUser)]
 getUsersWithHyperdata i = do
   u <- getUsersWithId i
   h <- getUserHyperdata i
   -- printDebug "[getUsersWithHyperdata]" (u,h)
   pure $ zip u h
 
-getUsersWithNodeHyperdata :: Int -> Cmd err [(UserLight, Node HyperdataUser)]
+getUsersWithNodeHyperdata :: User -> Cmd err [(UserLight, Node HyperdataUser)]
 getUsersWithNodeHyperdata i = do
   u <- getUsersWithId i
   h <- getUserNodeHyperdata i
@@ -208,8 +246,8 @@ updateUserPassword (UserLight { userLight_password = GargPassword password, .. }
     updateUserQuery :: Update Int64
     updateUserQuery = Update
       { uTable      = userTable
-      , uUpdateWith = updateEasy (\ (UserDB { .. }) -> UserDB { user_password = sqlStrictText password, .. } )
-      , uWhere      = (\row -> user_id row .== (sqlInt4 userLight_id))
+      , uUpdateWith = updateEasy (\(UserDB { .. }) -> UserDB { user_password = sqlStrictText password, .. } )
+      , uWhere      = \row -> user_id row .== sqlInt4 userLight_id
       , uReturning  = rCount }
 
 updateUserForgotPasswordUUID :: UserLight -> Cmd err Int64
@@ -219,9 +257,23 @@ updateUserForgotPasswordUUID (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c upd
     updateUserQuery :: Update Int64
     updateUserQuery = Update
       { uTable      = userTable
-      , uUpdateWith = updateEasy (\ (UserDB { .. }) -> UserDB { user_forgot_password_uuid = pass, .. })
-      , uWhere      = (\row -> user_id row .== (sqlInt4 userLight_id))
+      , uUpdateWith = updateEasy (\(UserDB { .. }) -> UserDB { user_forgot_password_uuid = pass, .. })
+      , uWhere      = \row -> user_id row .== sqlInt4 userLight_id
       , uReturning  = rCount }
+
+getUserPubmedAPIKey :: User -> Cmd err (Maybe PUBMED.APIKey)
+getUserPubmedAPIKey user = do
+  hs <- getUserHyperdata user
+  case hs of
+    [] -> pure Nothing
+    (x:_) -> pure $ _hu_pubmed_api_key x
+
+updateUserPubmedAPIKey :: (HasDBid NodeType, HasNodeError err)
+                        => User -> PUBMED.APIKey -> Cmd err Int64
+updateUserPubmedAPIKey (RootId uId) apiKey = do
+  _ <- updateNodeWithType uId NodeUser (Proxy :: Proxy HyperdataUser) (\h -> h & hu_pubmed_api_key ?~ apiKey)
+  pure 1
+updateUserPubmedAPIKey _ _ = undefined
 ------------------------------------------------------------------
 -- | Select User with some parameters
 -- Not optimized version

src/Gargantext/Database/Schema/Node.hs

@@ -72,23 +72,27 @@ nodeTable = Table "nodes" (pNode Node { _node_id         = optionalTableField "i
 queryNodeTable :: Query NodeRead
 queryNodeTable = selectTable nodeTable
 ------------------------------------------------------------------------
-type NodeWrite = NodePoly (Maybe (Field SqlInt4)      )
-                          (Maybe (Field SqlText)      )
-                                 (Field SqlInt4)
-                                 (Field SqlInt4)
-                          (Maybe (Field SqlInt4)      )
-                                 (Field SqlText)
-                          (Maybe (Field SqlTimestamptz))
-                                 (Field SqlJsonb)
-
-type NodeRead = NodePoly (Field SqlInt4        )
-                         (Field SqlText        )
-                         (Field SqlInt4        )
-                         (Field SqlInt4        )
-                         (Field SqlInt4        )
-                         (Field SqlText        )
-                         (Field SqlTimestamptz )
-                         (Field SqlJsonb       )
+type NodeHWrite a = NodePoly (Maybe (Field SqlInt4)      )
+                             (Maybe (Field SqlText)      )
+                             (Field SqlInt4)
+                             (Field SqlInt4)
+                             (Maybe (Field SqlInt4)      )
+                             (Field SqlText)
+                             (Maybe (Field SqlTimestamptz))
+                             (Field a)
+
+type NodeHRead a = NodePoly (Field SqlInt4        )
+                            (Field SqlText        )
+                            (Field SqlInt4        )
+                            (Field SqlInt4        )
+                            (Field SqlInt4        )
+                            (Field SqlText        )
+                            (Field SqlTimestamptz )
+                            (Field a       )
+------------------------------------------------------------------------
+type NodeWrite = NodeHWrite SqlJsonb
+
+type NodeRead = NodeHRead SqlJsonb
 ------------------------------------------------------------------------
 -- | Node(Read|Write)Search is slower than Node(Write|Read) use it
 -- for full text search only