Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Przemyslaw Kaminski
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
Changes
10
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)
...
@@ -31,7 +31,8 @@ import Test.QuickCheck (elements)
import
Test.QuickCheck.Arbitrary
import
Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
------------------------------------------------------------------------
data
ShareNode
=
ShareNode
{
username
::
Text
}
data
ShareNode
=
ShareTeam
{
username
::
Text
}
|
SharePublic
{
rights
::
Text
}
deriving
(
Generic
)
deriving
(
Generic
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
...
@@ -39,8 +40,8 @@ instance FromJSON ShareNode
...
@@ -39,8 +40,8 @@ instance FromJSON ShareNode
instance
ToJSON
ShareNode
instance
ToJSON
ShareNode
instance
ToSchema
ShareNode
instance
ToSchema
ShareNode
instance
Arbitrary
ShareNode
where
instance
Arbitrary
ShareNode
where
arbitrary
=
elements
[
Share
Node
"user1"
arbitrary
=
elements
[
Share
Team
"user1"
,
Share
Node
"user2
"
,
Share
Public
"public
"
]
]
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO permission
-- TODO permission
...
@@ -48,8 +49,10 @@ api :: HasNodeError err
...
@@ -48,8 +49,10 @@ api :: HasNodeError err
=>
NodeId
=>
NodeId
->
ShareNode
->
ShareNode
->
Cmd
err
Int
->
Cmd
err
Int
api
nId
(
ShareNode
user
)
=
api
nId
(
ShareTeam
user
)
=
fromIntegral
<$>
shareNodeWith
nId
(
UserName
user
)
fromIntegral
<$>
shareNodeWith
nId
NodeFolderShared
(
UserName
user
)
api
nId
(
SharePublic
_rights
)
=
fromIntegral
<$>
shareNodeWith
nId
NodeFolderPublic
UserPublic
------------------------------------------------------------------------
------------------------------------------------------------------------
type
API
=
Summary
" Share Node with username"
type
API
=
Summary
" Share Node with username"
...
...
src/Gargantext/API/Routes.hs
View file @
f58dad0d
...
@@ -50,7 +50,7 @@ import Gargantext.Viz.Graph.API
...
@@ -50,7 +50,7 @@ import Gargantext.Viz.Graph.API
import
qualified
Gargantext.API.Node.Corpus.Annuaire
as
Annuaire
import
qualified
Gargantext.API.Node.Corpus.Annuaire
as
Annuaire
import
qualified
Gargantext.API.Node.Corpus.Export
as
Export
import
qualified
Gargantext.API.Node.Corpus.Export
as
Export
import
qualified
Gargantext.API.Node.Corpus.New
as
New
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' =
...
@@ -147,7 +147,7 @@ type GargPrivateAPI' =
:>
TreeAPI
:>
TreeAPI
-- :<|> New.Upload
-- :<|> New.Upload
:<|>
New
.
AddWithForm
:<|>
New
.
AddWithForm
:<|>
New
.
AddWithQuery
:<|>
New
.
AddWithQuery
-- :<|> "annuaire" :> Annuaire.AddWithForm
-- :<|> "annuaire" :> Annuaire.AddWithForm
...
@@ -224,8 +224,8 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
...
@@ -224,8 +224,8 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
:<|>
withAccess
(
Proxy
::
Proxy
TreeAPI
)
Proxy
uid
:<|>
withAccess
(
Proxy
::
Proxy
TreeAPI
)
Proxy
uid
<$>
PathNode
<*>
treeAPI
<$>
PathNode
<*>
treeAPI
-- TODO access
-- TODO access
:<|>
addCorpusWithForm
(
UserDBId
uid
)
:<|>
addCorpusWithForm
(
RootId
(
NodeId
uid
)
)
:<|>
addCorpusWithQuery
(
RootId
(
NodeId
uid
))
:<|>
addCorpusWithQuery
(
RootId
(
NodeId
uid
))
-- :<|> addAnnuaireWithForm
-- :<|> addAnnuaireWithForm
-- :<|> New.api uid -- TODO-SECURITY
-- :<|> New.api uid -- TODO-SECURITY
...
...
src/Gargantext/Core/Types/Individu.hs
View file @
f58dad0d
...
@@ -25,7 +25,7 @@ import Gargantext.Prelude hiding (reverse)
...
@@ -25,7 +25,7 @@ import Gargantext.Prelude hiding (reverse)
import
qualified
Gargantext.Core.Auth
as
Auth
import
qualified
Gargantext.Core.Auth
as
Auth
-- FIXME UserName used twice
-- FIXME UserName used twice
data
User
=
UserDBId
UserId
|
UserName
Text
|
RootId
NodeId
data
User
=
UserDBId
UserId
|
UserName
Text
|
RootId
NodeId
|
UserPublic
deriving
(
Eq
)
deriving
(
Eq
)
type
Username
=
Text
type
Username
=
Text
...
...
src/Gargantext/Database/Action/Delete.hs
View file @
f58dad0d
...
@@ -29,7 +29,8 @@ import Gargantext.Prelude
...
@@ -29,7 +29,8 @@ import Gargantext.Prelude
import
qualified
Gargantext.Database.Query.Table.Node
as
N
(
getNode
,
deleteNode
)
import
qualified
Gargantext.Database.Query.Table.Node
as
N
(
getNode
,
deleteNode
)
import
Gargantext.Database.Action.Share
(
delFolderTeam
)
import
Gargantext.Database.Action.Share
(
delFolderTeam
)
deleteNode
::
HasNodeError
err
------------------------------------------------------------------------
deleteNode
::
HasNodeError
err
=>
User
=>
User
->
NodeId
->
NodeId
->
Cmd
err
Int
->
Cmd
err
Int
...
@@ -46,3 +47,4 @@ deleteNode u nodeId = do
...
@@ -46,3 +47,4 @@ deleteNode u nodeId = do
else
N
.
deleteNode
nodeId
else
N
.
deleteNode
nodeId
src/Gargantext/Database/Action/Flow/Utils.hs
View file @
f58dad0d
...
@@ -40,7 +40,8 @@ getUserId (UserName u ) = do
...
@@ -40,7 +40,8 @@ getUserId (UserName u ) = do
case
muser
of
case
muser
of
Just
user
->
pure
$
userLight_id
user
Just
user
->
pure
$
userLight_id
user
Nothing
->
nodeError
NoUserFound
Nothing
->
nodeError
NoUserFound
getUserId
UserPublic
=
nodeError
NoUserFound
toMaps
::
Hyperdata
a
toMaps
::
Hyperdata
a
=>
(
a
->
Map
(
NgramsT
Ngrams
)
Int
)
=>
(
a
->
Map
(
NgramsT
Ngrams
)
Int
)
...
...
src/Gargantext/Database/Action/Share.hs
View file @
f58dad0d
...
@@ -31,24 +31,36 @@ import Gargantext.Prelude
...
@@ -31,24 +31,36 @@ import Gargantext.Prelude
------------------------------------------------------------------------
------------------------------------------------------------------------
shareNodeWith
::
HasNodeError
err
shareNodeWith
::
HasNodeError
err
=>
NodeId
=>
NodeId
->
NodeType
->
User
->
User
->
Cmd
err
Int64
->
Cmd
err
Int64
shareNodeWith
n
u
=
do
shareNodeWith
n
nt
u
=
do
nodeToCheck
<-
getNode
n
nodeToCheck
<-
getNode
n
userIdCheck
<-
getUserId
u
case
nt
of
if
not
(
hasNodeType
nodeToCheck
NodeTeam
)
NodeFolderShared
->
do
then
panic
"Can share node Team only"
userIdCheck
<-
getUserId
u
else
if
(
view
node_userId
nodeToCheck
==
userIdCheck
)
if
not
(
hasNodeType
nodeToCheck
NodeTeam
)
then
panic
"Can share to others only"
then
panic
"Can share node Team only"
else
do
else
folderSharedId
<-
getFolderSharedId
u
if
(
view
node_userId
nodeToCheck
==
userIdCheck
)
insertNodeNode
[
NodeNode
folderSharedId
n
Nothing
Nothing
]
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
rootId
<-
getRootId
u
s
<-
getNodesWith
rootId
HyperdataAny
(
Just
NodeFolderShared
)
Nothing
Nothing
s
<-
getNodesWith
rootId
HyperdataAny
(
Just
nt
)
Nothing
Nothing
case
head
s
of
case
head
s
of
Nothing
->
panic
"No folder shared found"
Nothing
->
panic
"No folder shared found"
Just
f
->
pure
(
_node_id
f
)
Just
f
->
pure
(
_node_id
f
)
...
@@ -57,7 +69,12 @@ type TeamId = NodeId
...
@@ -57,7 +69,12 @@ type TeamId = NodeId
delFolderTeam
::
User
->
TeamId
->
Cmd
err
Int
delFolderTeam
::
User
->
TeamId
->
Cmd
err
Int
delFolderTeam
u
nId
=
do
delFolderTeam
u
nId
=
do
folderSharedId
<-
getFolder
SharedId
u
folderSharedId
<-
getFolder
Id
u
NodeFolderShared
deleteNodeNode
folderSharedId
nId
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 =
...
@@ -84,11 +84,10 @@ nodeTypeId n =
-- Node management
-- Node management
-- NodeFavorites -> 15
-- NodeFavorites -> 15
hasNodeType
::
forall
a
.
Node
a
->
NodeType
->
Bool
hasNodeType
::
forall
a
.
Node
a
->
NodeType
->
Bool
hasNodeType
n
nt
=
(
view
node_typename
n
)
==
(
nodeTypeId
nt
)
hasNodeType
n
nt
=
(
view
node_typename
n
)
==
(
nodeTypeId
nt
)
--
-- | Nodes are typed in the database according to a specific ID
-- | Nodes are typed in the database according to a specific ID
--
--
nodeTypeInv
::
[(
NodeTypeId
,
NodeType
)]
nodeTypeInv
::
[(
NodeTypeId
,
NodeType
)]
...
...
src/Gargantext/Database/Query/Tree.hs
View file @
f58dad0d
...
@@ -88,20 +88,21 @@ tree_advanced :: HasTreeError err
...
@@ -88,20 +88,21 @@ tree_advanced :: HasTreeError err
->
[
NodeType
]
->
[
NodeType
]
->
Cmd
err
(
Tree
NodeTree
)
->
Cmd
err
(
Tree
NodeTree
)
tree_advanced
r
nodeTypes
=
do
tree_advanced
r
nodeTypes
=
do
mainRoot
<-
dbTree
r
nodeTypes
mainRoot
<-
dbTree
r
nodeTypes
sharedRoots
<-
findShared
r
nodeTypes
sharedRoots
<-
findShared
r
NodeFolderShared
nodeTypes
toTree
$
toTreeParent
(
mainRoot
<>
sharedRoots
)
publicRoots
<-
findShared
r
NodeFolderPublic
nodeTypes
toTree
$
toTreeParent
(
mainRoot
<>
sharedRoots
<>
publicRoots
)
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Collaborative Nodes in the Tree
-- | Collaborative Nodes in the Tree
findShared
::
RootId
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
findShared
::
RootId
->
NodeType
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
findShared
r
nt
=
do
findShared
r
nt
nts
=
do
folderSharedId
<-
maybe
(
panic
"no folder found"
)
identity
folderSharedId
<-
maybe
(
panic
"no folder found"
)
identity
<$>
head
<$>
head
<$>
findNodesId
r
[
NodeFolderShared
]
<$>
findNodesId
r
[
nt
]
folders
<-
getNodeNode
folderSharedId
folders
<-
getNodeNode
folderSharedId
nodesSharedId
<-
mapM
(
\
child
->
sharedTree
folderSharedId
child
nt
)
nodesSharedId
<-
mapM
(
\
child
->
sharedTree
folderSharedId
child
nt
s
)
$
map
_nn_node2_id
folders
$
map
_nn_node2_id
folders
pure
$
concat
nodesSharedId
pure
$
concat
nodesSharedId
sharedTree
::
ParentId
->
NodeId
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
sharedTree
::
ParentId
->
NodeId
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
...
...
src/Gargantext/Database/Query/Tree/Root.hs
View file @
f58dad0d
...
@@ -147,4 +147,4 @@ selectRoot (RootId nid) =
...
@@ -147,4 +147,4 @@ selectRoot (RootId nid) =
restrict
-<
_node_typename
row
.==
(
pgInt4
$
nodeTypeId
NodeUser
)
restrict
-<
_node_typename
row
.==
(
pgInt4
$
nodeTypeId
NodeUser
)
restrict
-<
_node_id
row
.==
(
pgNodeId
nid
)
restrict
-<
_node_id
row
.==
(
pgNodeId
nid
)
returnA
-<
row
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