Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
141
Issues
141
List
Board
Labels
Milestones
Merge Requests
5
Merge Requests
5
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
f58dad0d
Commit
f58dad0d
authored
Jul 07, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FEAT] public node sharing/unpublish implemented (need api and web rights)
parent
55b37efd
Pipeline
#934
failed with stage
Changes
10
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
10 changed files
with
61 additions
and
42 deletions
+61
-42
psql
bin/psql
+0
-4
Share.hs
src/Gargantext/API/Node/Share.hs
+8
-5
Routes.hs
src/Gargantext/API/Routes.hs
+4
-4
Individu.hs
src/Gargantext/Core/Types/Individu.hs
+1
-1
Delete.hs
src/Gargantext/Database/Action/Delete.hs
+3
-1
Utils.hs
src/Gargantext/Database/Action/Flow/Utils.hs
+2
-1
Share.hs
src/Gargantext/Database/Action/Share.hs
+31
-14
Config.hs
src/Gargantext/Database/Admin/Config.hs
+1
-2
Tree.hs
src/Gargantext/Database/Query/Tree.hs
+10
-9
Root.hs
src/Gargantext/Database/Query/Tree/Root.hs
+1
-1
No files found.
bin/psql
deleted
100755 → 0
View file @
55b37efd
#!/bin/bash
psql postgresql://gargantua:C8kdcUrAQy66U@localhost/gargandbV5
src/Gargantext/API/Node/Share.hs
View file @
f58dad0d
...
...
@@ -31,7 +31,8 @@ import Test.QuickCheck (elements)
import
Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
data
ShareNode
=
ShareNode
{
username
::
Text
}
data
ShareNode
=
ShareTeam
{
username
::
Text
}
|
SharePublic
{
rights
::
Text
}
deriving
(
Generic
)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
...
...
@@ -39,8 +40,8 @@ instance FromJSON ShareNode
instance
ToJSON
ShareNode
instance
ToSchema
ShareNode
instance
Arbitrary
ShareNode
where
arbitrary
=
elements
[
Share
Node
"user1"
,
Share
Node
"user2
"
arbitrary
=
elements
[
Share
Team
"user1"
,
Share
Public
"public
"
]
------------------------------------------------------------------------
-- TODO permission
...
...
@@ -48,8 +49,10 @@ api :: HasNodeError err
=>
NodeId
->
ShareNode
->
Cmd
err
Int
api
nId
(
ShareNode
user
)
=
fromIntegral
<$>
shareNodeWith
nId
(
UserName
user
)
api
nId
(
ShareTeam
user
)
=
fromIntegral
<$>
shareNodeWith
nId
NodeFolderShared
(
UserName
user
)
api
nId
(
SharePublic
_rights
)
=
fromIntegral
<$>
shareNodeWith
nId
NodeFolderPublic
UserPublic
------------------------------------------------------------------------
type
API
=
Summary
" Share Node with username"
...
...
src/Gargantext/API/Routes.hs
View file @
f58dad0d
...
...
@@ -50,7 +50,7 @@ import Gargantext.Viz.Graph.API
import
qualified
Gargantext.API.Node.Corpus.Annuaire
as
Annuaire
import
qualified
Gargantext.API.Node.Corpus.Export
as
Export
import
qualified
Gargantext.API.Node.Corpus.New
as
New
import
qualified
Gargantext.API.Ngrams.List
as
List
import
qualified
Gargantext.API.Ngrams.List
as
List
...
...
@@ -147,7 +147,7 @@ type GargPrivateAPI' =
:>
TreeAPI
-- :<|> New.Upload
:<|>
New
.
AddWithForm
:<|>
New
.
AddWithForm
:<|>
New
.
AddWithQuery
-- :<|> "annuaire" :> Annuaire.AddWithForm
...
...
@@ -224,8 +224,8 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
:<|>
withAccess
(
Proxy
::
Proxy
TreeAPI
)
Proxy
uid
<$>
PathNode
<*>
treeAPI
-- TODO access
:<|>
addCorpusWithForm
(
UserDBId
uid
)
:<|>
addCorpusWithQuery
(
RootId
(
NodeId
uid
))
:<|>
addCorpusWithForm
(
RootId
(
NodeId
uid
)
)
:<|>
addCorpusWithQuery
(
RootId
(
NodeId
uid
))
-- :<|> addAnnuaireWithForm
-- :<|> New.api uid -- TODO-SECURITY
...
...
src/Gargantext/Core/Types/Individu.hs
View file @
f58dad0d
...
...
@@ -25,7 +25,7 @@ import Gargantext.Prelude hiding (reverse)
import
qualified
Gargantext.Core.Auth
as
Auth
-- FIXME UserName used twice
data
User
=
UserDBId
UserId
|
UserName
Text
|
RootId
NodeId
data
User
=
UserDBId
UserId
|
UserName
Text
|
RootId
NodeId
|
UserPublic
deriving
(
Eq
)
type
Username
=
Text
...
...
src/Gargantext/Database/Action/Delete.hs
View file @
f58dad0d
...
...
@@ -29,7 +29,8 @@ import Gargantext.Prelude
import
qualified
Gargantext.Database.Query.Table.Node
as
N
(
getNode
,
deleteNode
)
import
Gargantext.Database.Action.Share
(
delFolderTeam
)
deleteNode
::
HasNodeError
err
------------------------------------------------------------------------
deleteNode
::
HasNodeError
err
=>
User
->
NodeId
->
Cmd
err
Int
...
...
@@ -46,3 +47,4 @@ deleteNode u nodeId = do
else
N
.
deleteNode
nodeId
src/Gargantext/Database/Action/Flow/Utils.hs
View file @
f58dad0d
...
...
@@ -40,7 +40,8 @@ getUserId (UserName u ) = do
case
muser
of
Just
user
->
pure
$
userLight_id
user
Nothing
->
nodeError
NoUserFound
getUserId
UserPublic
=
nodeError
NoUserFound
toMaps
::
Hyperdata
a
=>
(
a
->
Map
(
NgramsT
Ngrams
)
Int
)
...
...
src/Gargantext/Database/Action/Share.hs
View file @
f58dad0d
...
...
@@ -31,24 +31,36 @@ import Gargantext.Prelude
------------------------------------------------------------------------
shareNodeWith
::
HasNodeError
err
=>
NodeId
->
NodeType
->
User
->
Cmd
err
Int64
shareNodeWith
n
u
=
do
shareNodeWith
n
nt
u
=
do
nodeToCheck
<-
getNode
n
userIdCheck
<-
getUserId
u
if
not
(
hasNodeType
nodeToCheck
NodeTeam
)
then
panic
"Can share node Team only"
else
if
(
view
node_userId
nodeToCheck
==
userIdCheck
)
then
panic
"Can share to others only"
else
do
folderSharedId
<-
getFolderSharedId
u
insertNodeNode
[
NodeNode
folderSharedId
n
Nothing
Nothing
]
------------------------------------------------------------------------
case
nt
of
NodeFolderShared
->
do
userIdCheck
<-
getUserId
u
if
not
(
hasNodeType
nodeToCheck
NodeTeam
)
then
panic
"Can share node Team only"
else
if
(
view
node_userId
nodeToCheck
==
userIdCheck
)
then
panic
"Can share to others only"
else
do
folderSharedId
<-
getFolderId
u
NodeFolderShared
insertNodeNode
[
NodeNode
folderSharedId
n
Nothing
Nothing
]
NodeFolderPublic
->
if
not
(
hasNodeType
nodeToCheck
NodeGraph
)
then
panic
"Can share node graph only"
else
do
folderId
<-
getFolderId
(
UserDBId
$
view
node_userId
nodeToCheck
)
NodeFolderPublic
insertNodeNode
[
NodeNode
folderId
n
Nothing
Nothing
]
_
->
panic
"shareNodeWith not implemented with this NodeType"
getFolderSharedId
::
User
->
Cmd
err
NodeId
getFolderSharedId
u
=
do
------------------------------------------------------------------------
getFolderId
::
User
->
NodeType
->
Cmd
err
NodeId
getFolderId
u
nt
=
do
rootId
<-
getRootId
u
s
<-
getNodesWith
rootId
HyperdataAny
(
Just
NodeFolderShared
)
Nothing
Nothing
s
<-
getNodesWith
rootId
HyperdataAny
(
Just
nt
)
Nothing
Nothing
case
head
s
of
Nothing
->
panic
"No folder shared found"
Just
f
->
pure
(
_node_id
f
)
...
...
@@ -57,7 +69,12 @@ type TeamId = NodeId
delFolderTeam
::
User
->
TeamId
->
Cmd
err
Int
delFolderTeam
u
nId
=
do
folderSharedId
<-
getFolder
SharedId
u
folderSharedId
<-
getFolder
Id
u
NodeFolderShared
deleteNodeNode
folderSharedId
nId
unPublish
::
User
->
NodeId
->
Cmd
err
Int
unPublish
u
nId
=
do
folderId
<-
getFolderId
u
NodeFolderPublic
deleteNodeNode
folderId
nId
src/Gargantext/Database/Admin/Config.hs
View file @
f58dad0d
...
...
@@ -84,11 +84,10 @@ nodeTypeId n =
-- Node management
-- NodeFavorites -> 15
hasNodeType
::
forall
a
.
Node
a
->
NodeType
->
Bool
hasNodeType
n
nt
=
(
view
node_typename
n
)
==
(
nodeTypeId
nt
)
--
-- | Nodes are typed in the database according to a specific ID
--
nodeTypeInv
::
[(
NodeTypeId
,
NodeType
)]
...
...
src/Gargantext/Database/Query/Tree.hs
View file @
f58dad0d
...
...
@@ -88,20 +88,21 @@ tree_advanced :: HasTreeError err
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
tree_advanced
r
nodeTypes
=
do
mainRoot
<-
dbTree
r
nodeTypes
sharedRoots
<-
findShared
r
nodeTypes
toTree
$
toTreeParent
(
mainRoot
<>
sharedRoots
)
mainRoot
<-
dbTree
r
nodeTypes
sharedRoots
<-
findShared
r
NodeFolderShared
nodeTypes
publicRoots
<-
findShared
r
NodeFolderPublic
nodeTypes
toTree
$
toTreeParent
(
mainRoot
<>
sharedRoots
<>
publicRoots
)
------------------------------------------------------------------------
-- | Collaborative Nodes in the Tree
findShared
::
RootId
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
findShared
r
nt
=
do
findShared
::
RootId
->
NodeType
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
findShared
r
nt
nts
=
do
folderSharedId
<-
maybe
(
panic
"no folder found"
)
identity
<$>
head
<$>
findNodesId
r
[
NodeFolderShared
]
folders
<-
getNodeNode
folderSharedId
nodesSharedId
<-
mapM
(
\
child
->
sharedTree
folderSharedId
child
nt
)
$
map
_nn_node2_id
folders
<$>
findNodesId
r
[
nt
]
folders
<-
getNodeNode
folderSharedId
nodesSharedId
<-
mapM
(
\
child
->
sharedTree
folderSharedId
child
nt
s
)
$
map
_nn_node2_id
folders
pure
$
concat
nodesSharedId
sharedTree
::
ParentId
->
NodeId
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
...
...
src/Gargantext/Database/Query/Tree/Root.hs
View file @
f58dad0d
...
...
@@ -147,4 +147,4 @@ selectRoot (RootId nid) =
restrict
-<
_node_typename
row
.==
(
pgInt4
$
nodeTypeId
NodeUser
)
restrict
-<
_node_id
row
.==
(
pgNodeId
nid
)
returnA
-<
row
selectRoot
UserPublic
=
panic
"No root for Public"
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment