2 Module : Gargantext.Database.Root
3 Description : Main requests to get root of users
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
11 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
12 {-# OPTIONS_GHC -fno-warn-orphans #-}
14 {-# LANGUAGE Arrows #-}
15 {-# LANGUAGE ConstraintKinds #-}
16 {-# LANGUAGE FunctionalDependencies #-}
17 {-# LANGUAGE TemplateHaskell #-}
19 module Gargantext.Database.Query.Tree.Root
22 import Data.Either (Either, fromLeft, fromRight)
23 import Control.Arrow (returnA)
24 import Gargantext.Core.Types.Main (CorpusName)
25 import Gargantext.Core.Types.Individu (User(..))
26 import Gargantext.Database.Admin.Config (nodeTypeId, userMaster)
27 import Gargantext.Database.Query.Table.Node.Error
28 import Gargantext.Database.Admin.Types.Node
29 import Gargantext.Database.Query.Table.Node
30 import Gargantext.Database.Query.Table.Node.User (HyperdataUser)
31 import Gargantext.Database.Action.Flow.Utils (getUserId)
32 import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead)
33 import Gargantext.Database.Schema.Node (queryNodeTable)
34 import Gargantext.Database.Action.Node
35 import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..))
36 import Gargantext.Database.Admin.Types.Node (Node, NodeType(NodeUser), pgNodeId)
37 import Gargantext.Database.Prelude (Cmd, runOpaQuery)
38 import Gargantext.Prelude
39 import Opaleye (restrict, (.==), Query)
40 import Opaleye.PGTypes (pgStrictText, pgInt4)
44 getOrMkRoot :: (HasNodeError err)
46 -> Cmd err (UserId, RootId)
48 userId <- getUserId user
50 rootId' <- map _node_id <$> getRoot user
52 rootId'' <- case rootId' of
54 n -> case length n >= 2 of
55 True -> nodeError ManyNodeUsers
58 rootId <- maybe (nodeError NoRootFound) pure (head rootId'')
62 getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a)
64 -> Either CorpusName [CorpusId]
66 -> Cmd err (UserId, RootId, CorpusId)
67 getOrMk_RootWithCorpus user cName c = do
68 (userId, rootId) <- getOrMkRoot user
69 corpusId'' <- if user == UserName userMaster
71 ns <- getCorporaWithParentId rootId
72 pure $ map _node_id ns
74 pure $ fromRight [] cName
76 corpusId' <- if corpusId'' /= []
79 c' <- mk (Just $ fromLeft "Default" cName) c rootId userId
80 _tId <- case head c' of
82 Just c'' -> mkNode NodeTexts c'' userId
85 corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId')
86 pure (userId, rootId, corpusId)
93 mkRoot :: HasNodeError err
99 -- udb <- getUserDb user
100 -- let uid = user_id udb
101 uid <- getUserId user
103 -- TODO ? Which name for user Node ?
107 False -> nodeError NegativeId
109 rs <- mkNodeWithParent NodeUser Nothing uid una
112 _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una
113 _ <- mkNodeWithParent NodeFolderShared (Just r) uid una
114 _ <- mkNodeWithParent NodeFolderPublic (Just r) uid una
119 getRoot :: User -> Cmd err [Node HyperdataUser]
120 getRoot = runOpaQuery . selectRoot
122 selectRoot :: User -> Query NodeRead
123 selectRoot (UserName username) = proc () -> do
124 row <- queryNodeTable -< ()
125 users <- queryUserTable -< ()
126 restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
127 restrict -< user_username users .== (pgStrictText username)
128 restrict -< _node_userId row .== (user_id users)
131 selectRoot (UserDBId uid) = proc () -> do
132 row <- queryNodeTable -< ()
133 restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
134 restrict -< _node_userId row .== (pgInt4 uid)
137 selectRoot (RootId nid) =
139 row <- queryNodeTable -< ()
140 restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
141 restrict -< _node_id row .== (pgNodeId nid)