[FEAT] NodeUser type.

src/Gargantext/API.hs

@@ -103,7 +103,6 @@ import Gargantext.Viz.Graph.API
 import Gargantext.API.Orchestrator.Types
 
 ---------------------------------------------------------------------
-
 import GHC.Base (Applicative)
 -- import Control.Lens
 

src/Gargantext/API/Node.hs

@@ -59,7 +59,7 @@ import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Flow.Pairing (pairing)
 import Gargantext.Database.Facet (FacetDoc, OrderBy(..))
 import Gargantext.Database.Node.Children (getChildren)
-import Gargantext.Database.Schema.Node ( getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..))
+import Gargantext.Database.Schema.Node (getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..), getNodeUser)
 import Gargantext.Database.Schema.NodeNode -- (nodeNodesCategory, insertNodeNode, NodeNode(..))
 import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Tree (treeDB)
@@ -360,7 +360,7 @@ postNode :: HasNodeError err
          -> PostNode
          -> Cmd err [NodeId]
 postNode uId pId (PostNode nodeName nt) = do
-  nodeUser <- getNodeWith (NodeId uId) HyperdataUser
+  nodeUser <- getNodeUser (NodeId uId)
   let uId' = nodeUser ^. node_userId
   mkNodeWithParent nt (Just pId) uId' nodeName
 

src/Gargantext/Database/Node/Contact.hs

@@ -28,9 +28,7 @@ import Data.Time (UTCTime)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import GHC.Generics (Generic)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Core.Types (Name)
-import Gargantext.Database.Schema.Node (NodeWrite, node)
-import Gargantext.Database.Types.Node (Node,Hyperdata,NodeType(..), UserId, AnnuaireId)
+import Gargantext.Database.Types.Node (Node,Hyperdata)
 import Gargantext.Database.Utils (fromField')
 import Gargantext.Prelude
 import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
@@ -96,14 +94,6 @@ data ContactTouch =
   } deriving (Eq, Show, Generic)
 
 
-nodeContactW :: Maybe Name -> Maybe HyperdataContact
-             -> AnnuaireId -> UserId -> NodeWrite
-nodeContactW maybeName maybeContact aId = 
-  node NodeContact name contact (Just aId)
-    where
-      name    = maybe "Contact" identity maybeName
-      contact = maybe arbitraryHyperdataContact identity maybeContact
-
 
 -- | ToSchema instances
 instance ToSchema HyperdataContact where

src/Gargantext/Database/Node/User.hs

+{-|
+Module      : Gargantext.Database.Node.User
+Description : User Node in Gargantext
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric          #-}
+{-# LANGUAGE NoImplicitPrelude      #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE OverloadedStrings      #-}
+{-# LANGUAGE FlexibleInstances      #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE TemplateHaskell        #-}
+
+module Gargantext.Database.Node.User
+  where
+
+import Control.Lens (makeLenses)
+import Data.Aeson.TH (deriveJSON)
+import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
+import Data.Text (Text)
+import Database.PostgreSQL.Simple.FromField (FromField, fromField)
+import GHC.Generics (Generic)
+import Gargantext.Core (Lang(..))
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Database.Node.Contact (HyperdataContact)
+import Gargantext.Database.Types.Node (Node,Hyperdata, DocumentId, NodeId(..))
+import Gargantext.Database.Utils (fromField')
+import Gargantext.Prelude
+import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+
+------------------------------------------------------------------------
+
+type NodeUser  = Node HyperdataUser
+
+data HyperdataUser =
+     HyperdataUser { _hu_private   :: !(Maybe HyperdataPrivate)
+                   , _hu_shared    :: !(Maybe HyperdataContact)
+                   , _hu_public    :: !(Maybe HyperdataPublic)
+                   } deriving (Eq, Show, Generic)
+
+data HyperdataPrivate =
+     HyperdataPrivate { _hpr_password :: !Text
+                      , _hpr_lang     :: !Lang
+                      }
+     deriving (Eq, Show, Generic)
+
+data HyperdataPublic =
+     HyperdataPublic { _hpu_pseudo :: !Text
+                     , _hpu_publications :: ![DocumentId]
+                     }
+     deriving (Eq, Show, Generic)
+
+-- | ToSchema instances
+instance ToSchema HyperdataUser where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hu_")
+
+instance ToSchema HyperdataPrivate where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hpr_")
+
+instance ToSchema HyperdataPublic where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hpu_")
+
+
+-- | Arbitrary instances
+instance Arbitrary HyperdataUser where
+  arbitrary = HyperdataUser <$> arbitrary <*> arbitrary <*> arbitrary
+
+instance Arbitrary HyperdataPrivate where
+  arbitrary = elements [HyperdataPrivate "" EN]
+
+instance Arbitrary HyperdataPublic where
+  arbitrary = elements [HyperdataPublic "pseudo" [NodeId 2]]
+
+
+-- | Specific Gargantext instance
+instance Hyperdata HyperdataUser
+instance Hyperdata HyperdataPrivate
+instance Hyperdata HyperdataPublic
+
+-- | Database (Posgresql-simple instance)
+instance FromField HyperdataUser where
+  fromField = fromField'
+instance FromField HyperdataPrivate where
+  fromField = fromField'
+instance FromField HyperdataPublic where
+  fromField = fromField'
+
+-- | Database (Opaleye instance)
+instance QueryRunnerColumnDefault PGJsonb HyperdataUser   where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataPrivate   where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataPublic   where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+-- | All lenses
+makeLenses ''HyperdataUser
+makeLenses ''HyperdataPrivate
+makeLenses ''HyperdataPublic
+
+-- | All Json instances
+$(deriveJSON (unPrefix "_hu_") ''HyperdataUser)
+$(deriveJSON (unPrefix "_hpr_") ''HyperdataPrivate)
+$(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic)

src/Gargantext/Database/Root.hs

@@ -30,7 +30,8 @@ import Opaleye (restrict, (.==), Query)
 import Opaleye.PGTypes (pgStrictText, pgInt4)
 import Control.Arrow (returnA)
 import Gargantext.Prelude
-import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser), HyperdataUser)
+import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser))
+import Gargantext.Database.Node.User (HyperdataUser)
 import Gargantext.Database.Schema.Node (NodeRead)
 import Gargantext.Database.Schema.Node (queryNodeTable)
 import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..))

src/Gargantext/Database/Schema/Node.hs

@@ -33,15 +33,16 @@ import Control.Monad.Error.Class (MonadError(..))
 import Data.Aeson
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
-import Data.Text (Text, pack)
+import Data.Text (Text)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import GHC.Int (Int64)
-import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu (Username)
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Queries.Filter (limit', offset')
 import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..))
+import Gargantext.Database.Node.User (HyperdataUser(..))
+import Gargantext.Database.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact)
 import Gargantext.Database.Utils
 import Gargantext.Prelude hiding (sum, head)
 import Gargantext.Viz.Graph (HyperdataGraph(..))
@@ -90,10 +91,6 @@ instance FromField HyperdataDocumentV3
   where
     fromField = fromField'
 
-instance FromField HyperdataUser
-  where
-    fromField = fromField'
-
 instance FromField HyperData
   where
     fromField = fromField'
@@ -147,10 +144,6 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataUser
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
 instance QueryRunnerColumnDefault PGJsonb HyperdataListModel
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
@@ -382,6 +375,12 @@ getNodeWith nId _ = do
     fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
              <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
 
+getNodeUser :: NodeId -> Cmd err (Node HyperdataUser)
+getNodeUser nId = do
+    fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
+             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
+
+
 getNodePhylo :: NodeId -> Cmd err (Node HyperdataPhylo)
 getNodePhylo nId = do
     fromMaybe (error $ "Node Phylo does not exist: " <> show nId) . headMay
@@ -393,13 +392,22 @@ getNodesWithType = runOpaQuery . selectNodesWithType
 
 ------------------------------------------------------------------------
 defaultUser :: HyperdataUser
-defaultUser = HyperdataUser (Just $ (pack . show) EN)
+defaultUser = HyperdataUser Nothing Nothing Nothing
 
 nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite
 nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing
   where
     name = maybe "User" identity maybeName
     user = maybe defaultUser identity maybeHyperdata
+
+nodeContactW :: Maybe Name -> Maybe HyperdataContact
+             -> AnnuaireId -> UserId -> NodeWrite
+nodeContactW maybeName maybeContact aId = 
+  node NodeContact name contact (Just aId)
+    where
+      name    = maybe "Contact" identity maybeName
+      contact = maybe arbitraryHyperdataContact identity maybeContact
+
 ------------------------------------------------------------------------
 defaultFolder :: HyperdataCorpus
 defaultFolder = defaultCorpus
@@ -633,9 +641,8 @@ mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
 
 ------------------------------------------------------------------------
 mkNodeWithParent NodeUser Nothing  uId name =
-  insertNodesWithParentR Nothing [node NodeUser name hd Nothing uId]
-    where
-      hd = HyperdataUser . Just . pack $ show EN
+  insertNodesWithParentR Nothing [node NodeUser name defaultUser Nothing uId]
+
 mkNodeWithParent _ Nothing _ _ = nodeError HasParent
 ------------------------------------------------------------------------
 mkNodeWithParent NodeFolder (Just i) uId name = 

src/Gargantext/Database/Types/Node.hs

@@ -291,17 +291,8 @@ instance Arbitrary Resource where
 instance ToSchema Resource where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "resource_")
 
-------------------------------------------------------------------------
-data HyperdataUser = HyperdataUser { hyperdataUser_language       :: !(Maybe Text)
-                                       } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
-
-instance Hyperdata HyperdataUser
-------------------------------------------------------------------------
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
-------------------------------------------------------------------------
-
 data Chart =
     CDocsHistogram
   | CAuthorsPie

src/Gargantext/Viz/Graph/API.hs

@@ -36,7 +36,7 @@ import Gargantext.Database.Config
 import Gargantext.Database.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Node.Select
-import Gargantext.Database.Schema.Node (getNodeWith, defaultList, insertGraph, HasNodeError)
+import Gargantext.Database.Schema.Node (getNodeWith, getNodeUser, defaultList, insertGraph, HasNodeError)
 import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId)
 import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Utils (Cmd)
@@ -74,7 +74,7 @@ getGraph uId nId = do
 
   repo <- getRepo
   let v = repo ^. r_version
-  nodeUser <- getNodeWith (NodeId uId) HyperdataUser
+  nodeUser <- getNodeUser (NodeId uId)
 
   let uId' = nodeUser ^. node_userId