[Flow] using user id. TODO : tests.

src/Gargantext/API.hs

@@ -53,26 +53,15 @@ import Control.Lens
 import Control.Monad.Except (withExceptT, ExceptT)
 import Control.Monad.Reader (ReaderT, runReaderT)
 import Data.Aeson.Encode.Pretty (encodePretty)
+import Data.List (lookup)
 import Data.Swagger
 import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
 import Data.Validity
 import Data.Version (showVersion)
+import GHC.Base (Applicative)
 import GHC.Generics (D1, Meta (..), Rep)
 import GHC.TypeLits (AppendSymbol, Symbol)
-import Network.Wai
-import Network.Wai.Handler.Warp hiding (defaultSettings)
-import qualified Paths_gargantext as PG -- cabal magic build module
-import Servant
-import Servant.Auth as SA
-import Servant.Auth.Server (AuthResult(..))
-import Servant.Auth.Swagger ()
-import Servant.Job.Async
-import Servant.Swagger
-import Servant.Swagger.UI
-import System.IO (FilePath)
-import Data.List (lookup)
-import Data.Text.Encoding (encodeUtf8)
-import GHC.Base (Applicative)
 import Gargantext.API.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), AuthContext, auth, withAccess, PathId(..))
 import Gargantext.API.Count  ( CountAPI, count, Query)
 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
@@ -82,6 +71,7 @@ import Gargantext.API.Orchestrator.Types
 import Gargantext.API.Search (SearchPairsAPI, searchPairs)
 import Gargantext.API.Settings
 import Gargantext.API.Types
+import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Node.Contact (HyperdataContact)
 import Gargantext.Database.Types.Node
 import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
@@ -89,9 +79,20 @@ import Gargantext.Database.Utils (HasConnectionPool)
 import Gargantext.Prelude
 import Gargantext.Viz.Graph.API
 import Network.HTTP.Types hiding (Query)
+import Network.Wai
 import Network.Wai (Request, requestHeaders)
+import Network.Wai.Handler.Warp hiding (defaultSettings)
 import Network.Wai.Middleware.Cors
 import Network.Wai.Middleware.RequestLogger
+import Servant
+import Servant.Auth as SA
+import Servant.Auth.Server (AuthResult(..))
+import Servant.Auth.Swagger ()
+import Servant.Job.Async
+import Servant.Swagger
+import Servant.Swagger.UI
+import System.IO (FilePath)
+import qualified Paths_gargantext as PG -- cabal magic build module
 import qualified Data.ByteString.Lazy.Char8 as BL8
 import qualified Data.Text.IO               as T
 import qualified Gargantext.API.Annuaire    as Annuaire
@@ -405,7 +406,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      -- TODO access
      -- :<|> addUpload
      -- :<|> (\corpus -> addWithQuery corpus :<|> addWithFile corpus)
-     :<|> addCorpusWithForm "user1"
+     :<|> addCorpusWithForm (UserDBId uid) -- "user1"
      :<|> addCorpusWithQuery
 
      :<|> addAnnuaireWithForm
@@ -431,15 +432,15 @@ addWithFile cid i f =
   serveJobsAPI $
     JobFunction (\_i log -> New.addToCorpusWithFile cid i f (liftBase . log))
 
-addCorpusWithForm :: Text -> GargServer New.AddWithForm
-addCorpusWithForm username cid =
+addCorpusWithForm :: User -> GargServer New.AddWithForm
+addCorpusWithForm user cid =
   serveJobsAPI $
     JobFunction (\i log ->
       let
         log' x = do
           printDebug "addCorpusWithForm" x
           liftBase $ log x
-      in New.addToCorpusWithForm username cid i log')
+      in New.addToCorpusWithForm user cid i log')
 
 addAnnuaireWithForm :: GargServer Annuaire.AddWithForm
 addAnnuaireWithForm cid =

src/Gargantext/API/Auth.hs

@@ -53,7 +53,7 @@ import Gargantext.Database.Utils (Cmd', CmdM, HasConnectionPool)
 import Gargantext.Prelude hiding (reverse)
 import Test.QuickCheck (elements, oneof)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-import Gargantext.Core.Types.Individu (Username, Password, arbitraryUsername, arbitraryPassword)
+import Gargantext.Core.Types.Individu (User(..), Username, Password, arbitraryUsername, arbitraryPassword)
 
 ---------------------------------------------------
 
@@ -101,7 +101,7 @@ checkAuthRequest u p
   | not (u `elem` arbitraryUsername) = pure InvalidUser
   | u /= reverse p = pure InvalidPassword
   | otherwise = do
-      muId <- head <$> getRoot u
+      muId <- head <$> getRoot (UserName u)
       case _node_id <$> muId of
         Nothing  -> pure InvalidUser
         Just uid -> do

src/Gargantext/API/Corpus/New.hs

@@ -42,7 +42,7 @@ import Gargantext.Database.Flow (FlowCmdM, flowCorpus)
 import Gargantext.Database.Flow (flowCorpusSearchInDatabase)
 import Gargantext.Database.Types.Node (CorpusId)
 import Gargantext.Database.Types.Node (ToHyperdataDocument(..))
-import Gargantext.Database.Types.Node (UserId)
+import Gargantext.Core.Types.Individu (UserId, User(..))
 import Gargantext.Prelude
 import qualified Gargantext.Text.Corpus.Parsers as Parser (FileFormat(..), parseFormat)
 import Gargantext.Text.Terms (TermType(..))
@@ -89,13 +89,13 @@ type GetApi = Get '[JSON] ApiInfo
 -- TODO-ACCESS
 -- TODO this is only the POST
 api :: (FlowCmdM env err m) => UserId -> Query -> m CorpusId
-api _uId (Query q _ as) = do
+api uid (Query q _ as) = do
   cId <- case head as of
-    Nothing      -> flowCorpusSearchInDatabase "user1" EN q
-    Just API.All -> flowCorpusSearchInDatabase "user1" EN q
+    Nothing      -> flowCorpusSearchInDatabase (UserDBId uid) EN q
+    Just API.All -> flowCorpusSearchInDatabase (UserDBId uid) EN q
     Just a   -> do
       docs <- liftBase $ API.get a q (Just 1000)
-      cId' <- flowCorpus "user1" (Left q) (Multi EN) [docs]
+      cId' <- flowCorpus (UserDBId uid) (Left q) (Multi EN) [docs]
       pure cId'
 
   pure cId
@@ -240,12 +240,12 @@ addToCorpusWithForm' cid (WithForm ft d l) logStatus = do
   pure s'
 -}
 addToCorpusWithForm :: FlowCmdM env err m
-                    => Text
+                    => User
                     -> CorpusId
                     -> WithForm
                     -> (ScraperStatus -> m ())
                     -> m ScraperStatus
-addToCorpusWithForm username cid (WithForm ft d l _n) logStatus = do
+addToCorpusWithForm user cid (WithForm ft d l _n) logStatus = do
 
   let
     parse = case ft of
@@ -271,7 +271,7 @@ addToCorpusWithForm username cid (WithForm ft d l _n) logStatus = do
   printDebug "Starting extraction     : " cid
 
   -- TODO granularity of the logStatus
-  _cid' <- flowCorpus username
+  _cid' <- flowCorpus user
                      (Right [cid])
                      (Multi $ fromMaybe EN l)
                      (map (map toHyperdataDocument) docs)

src/Gargantext/API/Export.hs

@@ -41,7 +41,8 @@ import Gargantext.Database.Config (userMaster)
 import Gargantext.Database.Metrics.NgramsByNode (getNgramsByNodeOnlyUser)
 import Gargantext.Database.Node.Select (selectNodesWithUsername)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
-import Gargantext.Database.Schema.Node (defaultList, HasNodeError)
+import Gargantext.Database.Schema.Node (defaultList)
+import Gargantext.Database.Types.Errors (HasNodeError)
 import Gargantext.Database.Schema.NodeNode (selectDocNodes)
 import Gargantext.Database.Types.Node (Node, HyperdataDocument(..), NodeId, ListId, CorpusId)
 import Gargantext.Database.Utils (Cmd)

src/Gargantext/API/Ngrams.hs

@@ -146,7 +146,7 @@ import Gargantext.Database.Utils (fromField', HasConnectionPool)
 import Gargantext.Database.Node.Select
 import Gargantext.Database.Ngrams
 --import Gargantext.Database.Lists (listsWith)
-import Gargantext.Database.Schema.Node (HasNodeError)
+import Gargantext.Database.Types.Errors (HasNodeError)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import qualified Gargantext.Database.Schema.Ngrams as Ngrams
 -- import Gargantext.Database.Schema.NodeNgram hiding (Action)

src/Gargantext/API/Node.hs

@@ -58,10 +58,11 @@ import Gargantext.Database.Flow.Pairing (pairing)
 import Gargantext.Database.Facet (FacetDoc, OrderBy(..))
 import Gargantext.Database.Node.Children (getChildren)
 import Gargantext.Database.Node.User (NodeUser)
-import Gargantext.Database.Schema.Node (getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, HasNodeError(..), getNodeUser)
+import Gargantext.Database.Schema.Node (getNodesWithParentId, getNodeWith, getNode, deleteNode, deleteNodes, mkNodeWithParent, JSONB, getNodeUser)
 import Gargantext.Database.Schema.NodeNode -- (nodeNodesCategory, insertNodeNode, NodeNode(..))
 import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Tree (treeDB)
+import Gargantext.Database.Types.Errors (HasNodeError(..))
 import Gargantext.Database.Types.Node
 import Gargantext.Database.Utils -- (Cmd, CmdM)
 import Gargantext.Prelude

src/Gargantext/API/Types.hs

@@ -45,6 +45,7 @@ import Gargantext.API.Settings
 import Gargantext.API.Orchestrator.Types
 import Gargantext.API.Ngrams
 import Gargantext.Core.Types
+import Gargantext.Database.Types.Errors (NodeError(..), HasNodeError(..))
 import Gargantext.Database.Tree
 import Gargantext.Database.Utils
 import Gargantext.Database.Schema.Node

src/Gargantext/Core/Types.hs

@@ -164,5 +164,7 @@ data TODO = TODO
 instance ToSchema TODO where
 instance ToParamSchema TODO where
 
+----------------------------------------------------------------------------
+
 
 

src/Gargantext/Core/Types/Individu.hs

@@ -20,6 +20,12 @@ module Gargantext.Core.Types.Individu
 
 import Gargantext.Prelude hiding (reverse)
 import Data.Text (Text, pack, reverse)
+import Gargantext.Database.Types.Node (NodeId)
+
+type UserId = Int
+
+data User = UserDBId UserId | UserName Text
+  deriving (Eq)
 
 type Username = Text
 type Password = Text
@@ -38,4 +44,3 @@ arbitraryPassword :: [Password]
 arbitraryPassword = map reverse arbitraryUsername
 
 
-

src/Gargantext/Database/Flow.hs

@@ -38,53 +38,53 @@ module Gargantext.Database.Flow -- (flowDatabase, ngrams2list)
   )
     where
 
-import Prelude (String)
-import Data.Either
-import Data.Tuple.Extra (first, second)
-import Data.Traversable (traverse)
-import Debug.Trace (trace)
 import Control.Lens ((^.), view, _Just)
+import Data.Either
 import Data.List (concat)
 import Data.Map (Map, lookup)
 import Data.Maybe (Maybe(..), catMaybes)
 import Data.Monoid
 import Data.Text (Text, splitOn, intercalate)
+import Data.Traversable (traverse)
+import Data.Tuple.Extra (first, second)
+import Debug.Trace (trace)
 import Gargantext.Core (Lang(..))
-import Gargantext.Core.Types (NodePoly(..), Terms(..))
-import Gargantext.Core.Types.Individu (Username)
 import Gargantext.Core.Flow.Types
+import Gargantext.Core.Types (NodePoly(..), Terms(..))
+import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Config (userMaster, corpusMasterName)
-import Gargantext.Database.Flow.Utils (insertDocNgrams)
 import Gargantext.Database.Flow.List
 import Gargantext.Database.Flow.Types
+import Gargantext.Database.Flow.Utils (insertDocNgrams)
 import Gargantext.Database.Node.Contact -- (HyperdataContact(..), ContactWho(..))
 import Gargantext.Database.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
 import Gargantext.Database.Root (getRoot)
-
 import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams,  NgramsType(..), text2ngrams, ngramsTypeId)
 import Gargantext.Database.Schema.Node -- (mkRoot, mkCorpus, getOrMkList, mkGraph, {-mkPhylo,-} mkDashboard, mkAnnuaire, getCorporaWithParentId, HasNodeError, NodeError(..), nodeError)
 import Gargantext.Database.Schema.NodeNgrams (listInsertDb , getCgramsId)
 import Gargantext.Database.Schema.NodeNodeNgrams2 -- (NodeNodeNgrams2, insertNodeNodeNgrams2)
-import Gargantext.Database.Schema.User (getUser, UserLight(..))
+import Gargantext.Database.Schema.User (getUserId)
 import Gargantext.Database.TextSearch (searchInDatabase)
+import Gargantext.Database.Types.Errors (HasNodeError(..), NodeError(..), nodeError)
 import Gargantext.Database.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
 import Gargantext.Database.Utils (Cmd)
 import Gargantext.Ext.IMT (toSchoolName)
 import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
 import Gargantext.Prelude
-import Gargantext.Text.Terms.Eleve (buildTries, toToken)
-import Gargantext.Text.List (buildNgramsLists,StopSize(..))
+import Gargantext.Prelude.Utils hiding (sha)
 import Gargantext.Text.Corpus.Parsers (parseFile, FileFormat)
-import qualified Gargantext.Text.Corpus.API.Isidore as Isidore
+import Gargantext.Text.List (buildNgramsLists,StopSize(..))
 import Gargantext.Text.Terms (TermType(..), tt_lang, extractTerms, uniText)
+import Gargantext.Text.Terms.Eleve (buildTries, toToken)
 import Gargantext.Text.Terms.Mono.Stem.En (stemIt)
-import Gargantext.Prelude.Utils hiding (sha)
+import Prelude (String)
 import System.FilePath (FilePath)
 import qualified Data.List as List
 import qualified Data.Map  as Map
 import qualified Data.Text as Text
 import qualified Gargantext.Database.Node.Document.Add  as Doc  (add)
+import qualified Gargantext.Text.Corpus.API.Isidore as Isidore
 import qualified Gargantext.Text.Corpus.Parsers.GrandDebat as GD
 
 ------------------------------------------------------------------------
@@ -102,7 +102,7 @@ getDataApi lang limit (ApiIsidoreAuth  q) = Isidore.get lang limit Nothing  (Jus
 
 -- UNUSED
 _flowCorpusApi :: ( FlowCmdM env err m)
-               => Username -> Either CorpusName [CorpusId]
+               => User -> Either CorpusName [CorpusId]
                -> TermType Lang
                -> Maybe Limit
                -> ApiQuery
@@ -114,7 +114,7 @@ _flowCorpusApi u n tt l q = do
 ------------------------------------------------------------------------
 
 flowAnnuaire :: FlowCmdM env err m
-             => Username
+             => User
              -> Either CorpusName [CorpusId]
              -> (TermType Lang)
              -> FilePath
@@ -125,7 +125,7 @@ flowAnnuaire u n l filePath = do
 
 -- UNUSED
 _flowCorpusDebat :: FlowCmdM env err m
-                 => Username -> Either CorpusName [CorpusId]
+                 => User -> Either CorpusName [CorpusId]
                  -> Limit -> FilePath
                  -> m CorpusId
 _flowCorpusDebat u n l fp = do
@@ -137,7 +137,7 @@ _flowCorpusDebat u n l fp = do
   flowCorpus u n (Multi FR) (map (map toHyperdataDocument) docs)
 
 flowCorpusFile :: FlowCmdM env err m
-           => Username -> Either CorpusName [CorpusId]
+           => User -> Either CorpusName [CorpusId]
            -> Limit -- Limit the number of docs (for dev purpose)
            -> TermType Lang -> FileFormat -> FilePath
            -> m CorpusId
@@ -150,13 +150,13 @@ flowCorpusFile u n l la ff fp = do
 
 -- TODO query with complex query
 flowCorpusSearchInDatabase :: FlowCmdM env err m
-                           => Username
+                           => User
                            -> Lang
                            -> Text
                            -> m CorpusId
 flowCorpusSearchInDatabase u la q = do
   (_masterUserId, _masterRootId, cId) <- getOrMk_RootWithCorpus
-                                           userMaster
+                                           (UserName userMaster)
                                            (Left "")
                                            (Nothing :: Maybe HyperdataCorpus)
   ids <-  map fst <$> searchInDatabase cId (stemIt q)
@@ -165,13 +165,13 @@ flowCorpusSearchInDatabase u la q = do
 
 -- UNUSED
 _flowCorpusSearchInDatabaseApi :: FlowCmdM env err m
-                               => Username
+                               => User
                                -> Lang
                                -> Text
                                -> m CorpusId
 _flowCorpusSearchInDatabaseApi u la q = do
   (_masterUserId, _masterRootId, cId) <- getOrMk_RootWithCorpus
-                                           userMaster
+                                           (UserName userMaster)
                                            (Left "")
                                            (Nothing :: Maybe HyperdataCorpus)
   ids <-  map fst <$> searchInDatabase cId (stemIt q)
@@ -188,7 +188,7 @@ data CorpusInfo = CorpusName Lang Text
 
 flow :: (FlowCmdM env err m, FlowCorpus a, MkCorpus c)
      => Maybe c
-     -> Username
+     -> User
      -> Either CorpusName [CorpusId]
      -> TermType Lang
      -> [[a]]
@@ -198,7 +198,7 @@ flow c u cn la docs = do
   flowCorpusUser (la ^. tt_lang) u cn c (concat ids)
 
 flowCorpus :: (FlowCmdM env err m, FlowCorpus a)
-           => Username
+           => User
            -> Either CorpusName [CorpusId]
            -> TermType Lang
            -> [[a]]
@@ -208,7 +208,7 @@ flowCorpus = flow (Nothing :: Maybe HyperdataCorpus)
 ------------------------------------------------------------------------
 flowCorpusUser :: (FlowCmdM env err m, MkCorpus c)
                => Lang
-               -> Username
+               -> User
                -> Either CorpusName [CorpusId]
                -> Maybe c
                -> [NodeId]
@@ -225,7 +225,7 @@ flowCorpusUser l userName corpusName ctype ids = do
   -- printDebug "Node Text Id" tId
 
   -- User List Flow
-  (masterUserId, _masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus userMaster (Left "") ctype
+  (masterUserId, _masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left "") ctype
   ngs         <- buildNgramsLists l 2 3 (StopSize 3) userCorpusId masterCorpusId
   _userListId <- flowList_DbRepo listId ngs
   _mastListId <- getOrMkList masterCorpusId masterUserId
@@ -250,7 +250,7 @@ insertMasterDocs :: ( FlowCmdM env err m
                  -> [a]
                  -> m [DocId]
 insertMasterDocs c lang hs  =  do
-  (masterUserId, _, masterCorpusId) <- getOrMk_RootWithCorpus userMaster (Left corpusMasterName) c
+  (masterUserId, _, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left corpusMasterName) c
 
   -- TODO Type NodeDocumentUnicised
   let docs = map addUniqId hs
@@ -314,20 +314,16 @@ withLang l _ = l
 
 type CorpusName = Text
 
-
 getOrMkRoot :: (HasNodeError err)
-            => Username
+            => User
             -> Cmd err (UserId, RootId)
-getOrMkRoot username = do
-  maybeUserId <- getUser username
-  userId <- case maybeUserId of
-        Nothing   -> nodeError NoUserFound
-        Just user -> pure $ userLight_id user
+getOrMkRoot user = do
+  userId <- getUserId user
 
-  rootId' <- map _node_id <$> getRoot username
+  rootId' <- map _node_id <$> getRoot user
 
   rootId'' <- case rootId' of
-        []  -> mkRoot username userId
+        []  -> mkRoot user
         n   -> case length n >= 2 of
             True  -> nodeError ManyNodeUsers
             False -> pure rootId'
@@ -337,13 +333,13 @@ getOrMkRoot username = do
 
 
 getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a)
-                      => Username
+                      => User
                       -> Either CorpusName [CorpusId]
                       -> Maybe a
                       -> Cmd err (UserId, RootId, CorpusId)
 getOrMk_RootWithCorpus username cName c = do
   (userId, rootId) <- getOrMkRoot username
-  corpusId'' <- if username == userMaster
+  corpusId'' <- if username == UserName userMaster
                   then do
                     ns <- getCorporaWithParentId rootId
                     pure $ map _node_id ns

src/Gargantext/Database/Flow/Types.hs

@@ -30,7 +30,7 @@ import Gargantext.Core.Flow.Types
 import Gargantext.API.Ngrams (HasRepoVar, RepoCmdM)
 import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..))
 import Gargantext.Database.Types.Node (NodeId)
-import Gargantext.Database.Schema.Node (HasNodeError)
+import Gargantext.Database.Types.Errors (HasNodeError)
 import Gargantext.Database.Utils (CmdM)
 
 type FlowCmdM env err m =

src/Gargantext/Database/Root.hs

@@ -26,24 +26,25 @@ Portability : POSIX
 
 module Gargantext.Database.Root where
 
-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))
+import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Node.User (HyperdataUser)
 import Gargantext.Database.Schema.Node (NodeRead)
+import Gargantext.Database.Schema.Node (pgNodeId)
 import Gargantext.Database.Schema.Node (queryNodeTable)
 import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..))
-import Gargantext.Database.Config (nodeTypeId)
-import Gargantext.Core.Types.Individu (Username)
+import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser))
 import Gargantext.Database.Utils (Cmd, runOpaQuery)
+import Gargantext.Prelude
+import Opaleye (restrict, (.==), Query)
+import Opaleye.PGTypes (pgStrictText, pgInt4)
 
-getRoot :: Username -> Cmd err [Node HyperdataUser]
+getRoot :: User -> Cmd err [Node HyperdataUser]
 getRoot = runOpaQuery . selectRoot
 
-selectRoot :: Username -> Query NodeRead
-selectRoot username = proc () -> do
+selectRoot :: User -> Query NodeRead
+selectRoot (UserName username) = proc () -> do
     row   <- queryNodeTable -< ()
     users <- queryUserTable -< ()
     restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
@@ -51,4 +52,15 @@ selectRoot username = proc () -> do
     restrict -< _node_userId   row   .== (user_id users)
     returnA  -< row
 
+selectRoot (UserDBId uid) = proc () -> do
+    row   <- queryNodeTable -< ()
+    restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
+    restrict -< _node_userId   row   .== (pgInt4 uid)
+    returnA  -< row
+
+
+
+
+
+
 

src/Gargantext/Database/Schema/Node.hs

@@ -37,12 +37,14 @@ import Data.Text (Text)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import GHC.Int (Int64)
 import Gargantext.Core.Types
-import Gargantext.Core.Types.Individu (Username)
+import Gargantext.Database.Types.Errors
+import Gargantext.Core.Types.Individu (User(..))
 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(..), fake_HyperdataUser)
 import Gargantext.Database.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact)
+import Gargantext.Database.Schema.User (getUserId)
 import Gargantext.Database.Utils
 import Gargantext.Prelude hiding (sum, head)
 import Gargantext.Viz.Graph (HyperdataGraph(..))
@@ -51,30 +53,6 @@ import Opaleye hiding (FromField)
 import Opaleye.Internal.QueryArr (Query)
 import Prelude hiding (null, id, map, sum)
 
-------------------------------------------------------------------------
-
-data NodeError = NoListFound
-               | NoRootFound
-               | NoCorpusFound
-               | NoUserFound
-               | MkNode
-               | UserNoParent
-               | HasParent
-               | ManyParents
-               | NegativeId
-               | NotImplYet
-               | ManyNodeUsers
-  deriving (Show)
-
-class HasNodeError e where
-  _NodeError :: Prism' e NodeError
-
-nodeError :: (MonadError e m, HasNodeError e) => NodeError -> m a
-nodeError ne = throwError $ _NodeError # ne
-
-catchNodeError :: (MonadError e m, HasNodeError e) => m a -> (NodeError -> m a) -> m a
-catchNodeError f g = catchError f (\e -> maybe (throwError e) g (e ^? _NodeError))
-
 ------------------------------------------------------------------------
 instance FromField HyperdataAny where
     fromField = fromField'
@@ -637,36 +615,41 @@ childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a c
 -- =================================================================== --
 ------------------------------------------------------------------------
 -- | TODO mk all others nodes
-mkNodeWithParent :: HasNodeError err => NodeType -> Maybe ParentId -> UserId -> Name -> Cmd err [NodeId]
+mkNodeWithParent :: HasNodeError err
+                 => NodeType
+                 -> Maybe ParentId
+                 -> UserId
+                 -> Name
+                 -> Cmd err [NodeId]
 mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
 
 ------------------------------------------------------------------------
-mkNodeWithParent NodeUser Nothing  uId name =
+mkNodeWithParent NodeUser Nothing uId name =
   insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId]
 
 mkNodeWithParent _ Nothing _ _ = nodeError HasParent
 ------------------------------------------------------------------------
-mkNodeWithParent NodeFolder (Just i) uId name = 
+mkNodeWithParent NodeFolder (Just i) uId name =
    insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId]
     where
       hd = defaultFolder
 
-mkNodeWithParent NodeFolderPrivate (Just i) uId _ = 
+mkNodeWithParent NodeFolderPrivate (Just i) uId _ =
    insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId]
     where
       hd = defaultFolder
 
-mkNodeWithParent NodeFolderShared (Just i) uId _ = 
+mkNodeWithParent NodeFolderShared (Just i) uId _ =
    insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId]
     where
       hd = defaultFolder
 
-mkNodeWithParent NodeFolderPublic (Just i) uId _ = 
+mkNodeWithParent NodeFolderPublic (Just i) uId _ =
    insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId]
     where
       hd = defaultFolder
 
-mkNodeWithParent NodeTeam (Just i) uId _ = 
+mkNodeWithParent NodeTeam (Just i) uId _ =
    insertNodesWithParentR (Just i) [node NodeTeam "Team" hd Nothing uId]
     where
       hd = defaultFolder
@@ -685,21 +668,27 @@ mkNodeWithParent _ _ _ _       = nodeError NotImplYet
 ------------------------------------------------------------------------
 -- =================================================================== --
 
-
-
-mkRoot :: HasNodeError err => Username -> UserId -> Cmd err [RootId]
-mkRoot uname uId = case uId > 0 of
-               False -> nodeError NegativeId
-               True  -> do
-                 rs <- mkNodeWithParent NodeUser Nothing uId uname
-                 _ <- case rs of
-                   [r] -> do
-                     _ <- mkNodeWithParent NodeFolderPrivate (Just r) uId uname
-                     _ <- mkNodeWithParent NodeFolderShared  (Just r) uId uname
-                     _ <- mkNodeWithParent NodeFolderPublic  (Just r) uId uname
-                     pure rs
-                   _   -> pure rs
-                 pure rs
+mkRoot :: HasNodeError err
+       => User
+       -> Cmd err [RootId]
+mkRoot user = do
+
+  uid <- getUserId user
+
+  let una = "username"
+
+  case uid > 0 of
+     False -> nodeError NegativeId
+     True  -> do
+       rs <- mkNodeWithParent NodeUser Nothing uid una
+       _ <- case rs of
+         [r] -> do
+           _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una
+           _ <- mkNodeWithParent NodeFolderShared  (Just r) uid una
+           _ <- mkNodeWithParent NodeFolderPublic  (Just r) uid una
+           pure rs
+         _   -> pure rs
+       pure rs
 
 -- |
 -- CorpusDocument is a corpus made from a set of documents

src/Gargantext/Database/Schema/User.hs

@@ -34,27 +34,26 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Data.Text (Text)
 import Data.Time (UTCTime)
 import GHC.Show(Show(..))
-import Gargantext.Core.Types.Individu (Username, arbitraryUsername)
+import Gargantext.Core.Types.Individu (Username, arbitraryUsername, User(..), UserId)
+import Gargantext.Database.Types.Errors
 import Gargantext.Database.Utils
 import Gargantext.Prelude
 import Opaleye
 
 ------------------------------------------------------------------------
-
 ------------------------------------------------------------------------
-type UserId = Int
 
 data UserLight = UserLight { userLight_id   :: Int
                            , userLight_username :: Text
                            , userLight_email    :: Text
                            } deriving (Show)
 
-toUserLight :: User -> UserLight
-toUserLight (User id _ _ _ u _ _ e _ _ _ ) = UserLight id u e
+toUserLight :: UserDB -> UserLight
+toUserLight (UserDB id _ _ _ u _ _ e _ _ _ ) = UserLight id u e
 
 data UserPoly id pass llogin suser
               uname fname lname
-              mail staff active djoined = User { user_id          :: id
+              mail staff active djoined = UserDB { user_id          :: id
                                                , user_password    :: pass
                                                , user_lastLogin   :: llogin
                                                , user_isSuperUser :: suser
@@ -93,14 +92,14 @@ type UserReadNull = UserPoly     (Column (Nullable PGInt4))         (Column (Nul
 
 
 
-type User = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime
+type UserDB = UserPoly Int Text (Maybe UTCTime) Bool Text Text Text Text Bool Bool UTCTime
 
-$(makeAdaptorAndInstance "pUser"     ''UserPoly)
+$(makeAdaptorAndInstance "pUserDB"   ''UserPoly)
 $(makeLensesWith abbreviatedFields   ''UserPoly)
 
 
 userTable :: Table UserWrite UserRead
-userTable = Table "auth_user" (pUser User { user_id      = optional "id"
+userTable = Table "auth_user" (pUserDB UserDB { user_id      = optional "id"
                                           , user_password    = required "password"
                                           , user_lastLogin   = optional "last_login"
                                           , user_isSuperUser = required "is_superuser"
@@ -122,7 +121,7 @@ insertUsers us = mkCmd $ \c -> runInsert_ c insert
 
 
 gargantextUser :: Username -> UserWrite
-gargantextUser u = User (Nothing) (pgStrictText "password")
+gargantextUser u = UserDB (Nothing) (pgStrictText "password")
                          (Nothing) (pgBool True) (pgStrictText u)
                          (pgStrictText "first_name")
                          (pgStrictText "last_name")
@@ -132,14 +131,13 @@ gargantextUser u = User (Nothing) (pgStrictText "password")
 insertUsersDemo :: Cmd err Int64
 insertUsersDemo = insertUsers $ map (\u -> gargantextUser u) arbitraryUsername
 
-
 ------------------------------------------------------------------
 queryUserTable :: Query UserRead
 queryUserTable = queryTable userTable
 
 selectUsersLight :: Query UserRead
 selectUsersLight = proc () -> do
-      row@(User i _p _ll _is _un _fn _ln _m _iff _ive _dj) <- queryUserTable -< ()
+      row@(UserDB i _p _ll _is _un _fn _ln _m _iff _ive _dj) <- queryUserTable -< ()
       restrict -< i .== 1
       --returnA -< User i p ll is un fn ln m iff ive dj
       returnA -< row
@@ -150,10 +148,10 @@ userWith :: (Eq a1, Foldable t) => (a -> a1) -> a1 -> t a -> Maybe a
 userWith f t xs = find (\x -> f x == t) xs
 
 -- | Select User with Username
-userWithUsername :: Text -> [User] -> Maybe User
+userWithUsername :: Text -> [UserDB] -> Maybe UserDB
 userWithUsername t xs = userWith user_username t xs
 
-userWithId :: Int -> [User] -> Maybe User
+userWithId :: Int -> [UserDB] -> Maybe UserDB
 userWithId t xs = userWith user_id t xs
 
 userLightWithUsername :: Text -> [UserLight] -> Maybe UserLight
@@ -167,7 +165,7 @@ instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
 
-users :: Cmd err [User]
+users :: Cmd err [UserDB]
 users = runOpaQuery queryUserTable
 
 usersLight :: Cmd err [UserLight]
@@ -177,3 +175,14 @@ getUser :: Username -> Cmd err (Maybe UserLight)
 getUser u = userLightWithUsername u <$> usersLight
 
 
+getUserId :: HasNodeError err
+          => User
+          -> Cmd err UserId
+getUserId (UserDBId uid) = pure uid
+getUserId (UserName u  ) = do
+  muser <- getUser u
+  case muser of
+    Just user -> pure $ userLight_id user
+    Nothing   -> nodeError NoUserFound
+
+

src/Gargantext/Viz/Graph/API.hs

@@ -48,7 +48,8 @@ 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, getNodeUser, defaultList, insertGraph, HasNodeError)
+import Gargantext.Database.Schema.Node (getNodeWith, getNodeUser, defaultList, insertGraph)
+import Gargantext.Database.Types.Errors (HasNodeError)
 import Gargantext.Database.Types.Node hiding (node_id) -- (GraphId, ListId, CorpusId, NodeId)
 import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Utils (Cmd)