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
69f8b4f0
Commit
69f8b4f0
authored
Jul 09, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FEAT PUBLIC] API ok, needs updateTreePublic fix (WIP)
parent
c38cd6a5
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
73 additions
and
46 deletions
+73
-46
Share.hs
src/Gargantext/API/Node/Share.hs
+15
-15
Share.hs
src/Gargantext/Database/Action/Share.hs
+36
-22
Config.hs
src/Gargantext/Database/Admin/Config.hs
+2
-0
Tree.hs
src/Gargantext/Database/Query/Tree.hs
+20
-9
No files found.
src/Gargantext/API/Node/Share.hs
View file @
69f8b4f0
...
...
@@ -21,7 +21,7 @@ import Data.Swagger
import
Data.Text
(
Text
)
import
GHC.Generics
(
Generic
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Database.Action.Share
(
shareNodeWith
)
import
Gargantext.Database.Action.Share
(
shareNodeWith
,
ShareNodeWith
(
..
)
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
...
...
@@ -31,34 +31,34 @@ import Test.QuickCheck (elements)
import
Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
data
ShareNode
=
ShareTeam
{
username
::
Text
}
|
SharePublic
{
rights
::
Text
}
data
ShareNode
Params
=
ShareTeamParams
{
username
::
Text
}
|
SharePublicParams
{
node_id
::
NodeId
}
deriving
(
Generic
)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance
FromJSON
ShareNode
where
instance
FromJSON
ShareNode
Params
where
parseJSON
=
genericParseJSON
(
defaultOptions
{
sumEncoding
=
ObjectWithSingleField
})
instance
ToJSON
ShareNode
where
instance
ToJSON
ShareNode
Params
where
toJSON
=
genericToJSON
(
defaultOptions
{
sumEncoding
=
ObjectWithSingleField
})
instance
ToSchema
ShareNode
instance
Arbitrary
ShareNode
where
arbitrary
=
elements
[
ShareTeam
"user1"
,
SharePublic
"public"
instance
ToSchema
ShareNode
Params
instance
Arbitrary
ShareNode
Params
where
arbitrary
=
elements
[
ShareTeam
Params
"user1"
,
SharePublic
Params
(
NodeId
1
)
]
------------------------------------------------------------------------
-- TODO permission
api
::
HasNodeError
err
=>
NodeId
->
ShareNode
->
ShareNode
Params
->
Cmd
err
Int
api
nId
(
ShareTeam
user
)
=
fromIntegral
<$>
shareNodeWith
nId
NodeFolderShared
(
UserName
user
)
api
nId
(
SharePublic
_rights
)
=
fromIntegral
<$>
shareNodeWith
nId
NodeFolderPublic
UserPublic
api
nId
(
ShareTeam
Params
user
)
=
fromIntegral
<$>
shareNodeWith
(
ShareNodeWith_User
NodeFolderShared
(
UserName
user
))
nId
api
nId
2
(
SharePublicParams
nId1
)
=
fromIntegral
<$>
shareNodeWith
(
ShareNodeWith_Node
NodeFolderPublic
nId1
)
nId2
------------------------------------------------------------------------
type
API
=
Summary
" Share Node with username"
:>
ReqBody
'[
J
SON
]
ShareNode
:>
ReqBody
'[
J
SON
]
ShareNode
Params
:>
Post
'[
J
SON
]
Int
...
...
src/Gargantext/Database/Action/Share.hs
View file @
69f8b4f0
...
...
@@ -9,13 +9,14 @@ Portability : POSIX
-}
module
Gargantext.Database.Action.Share
where
import
Control.Lens
(
view
)
import
Gargantext.Core.Types.Individu
(
User
(
..
))
import
Gargantext.Database.Action.Flow.Utils
(
getUserId
)
import
Gargantext.Database.Admin.Config
(
hasNodeType
)
import
Gargantext.Database.Admin.Config
(
hasNodeType
,
isInNodeTypes
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataAny
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Admin.Types.Node
-- (NodeType(..))
...
...
@@ -28,33 +29,46 @@ import Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.NodeNode
(
NodeNodePoly
(
..
))
import
Gargantext.Prelude
-- | TODO move in Config of Gargantext
publicNodeTypes
::
[
NodeType
]
publicNodeTypes
=
[
NodeDashboard
,
NodeGraph
,
NodePhylo
]
------------------------------------------------------------------------
data
ShareNodeWith
=
ShareNodeWith_User
{
snwu_nodetype
::
NodeType
,
snwu_user
::
User
}
|
ShareNodeWith_Node
{
snwn_nodetype
::
NodeType
,
snwn_node_id
::
NodeId
}
------------------------------------------------------------------------
shareNodeWith
::
HasNodeError
err
=>
NodeId
->
NodeType
->
User
=>
ShareNodeWith
->
NodeId
->
Cmd
err
Int64
shareNodeWith
n
nt
u
=
do
shareNodeWith
(
ShareNodeWith_User
NodeFolderShared
u
)
n
=
do
nodeToCheck
<-
getNode
n
case
nt
of
NodeFolderShared
->
do
userIdCheck
<-
getUserId
u
if
not
(
hasNodeType
nodeToCheck
NodeTeam
)
then
msg
"Can share node Team only"
else
if
(
view
node_userId
nodeToCheck
==
userIdCheck
)
then
msg
"Can share to others only"
else
do
folderSharedId
<-
getFolderId
u
NodeFolderShared
insertNodeNode
[
NodeNode
folderSharedId
n
Nothing
Nothing
]
userIdCheck
<-
getUserId
u
if
not
(
hasNodeType
nodeToCheck
NodeTeam
)
then
msg
"Can share node Team only"
else
if
(
view
node_userId
nodeToCheck
==
userIdCheck
)
then
msg
"Can share to others only"
else
do
folderSharedId
<-
getFolderId
u
NodeFolderShared
insertNodeNode
[
NodeNode
folderSharedId
n
Nothing
Nothing
]
NodeFolderPublic
->
if
not
(
hasNodeType
nodeToCheck
NodeGraph
)
then
msg
"Can share node graph only"
else
do
folderId
<-
getFolderId
(
UserDBId
$
view
node_userId
nodeToCheck
)
NodeFolderPublic
insertNodeNode
[
NodeNode
folderId
n
Nothing
Nothing
]
shareNodeWith
(
ShareNodeWith_Node
NodeFolderPublic
nId
)
n
=
do
nodeToCheck
<-
getNode
n
if
not
(
isInNodeTypes
nodeToCheck
publicNodeTypes
)
then
msg
$
"Can share this nodesTypes only: "
<>
(
cs
$
show
publicNodeTypes
)
else
do
folderToCheck
<-
getNode
nId
if
hasNodeType
folderToCheck
NodeFolderPublic
then
insertNodeNode
[
NodeNode
nId
n
Nothing
Nothing
]
else
msg
"Can share NodeWith NodeFolderPublic only"
_
->
msg
"shareNodeWith not implemented with
this NodeType"
shareNodeWith
_
_
=
msg
"shareNodeWith not implemented for
this NodeType"
------------------------------------------------------------------------
getFolderId
::
HasNodeError
err
=>
User
->
NodeType
->
Cmd
err
NodeId
...
...
src/Gargantext/Database/Admin/Config.hs
View file @
69f8b4f0
...
...
@@ -87,6 +87,8 @@ nodeTypeId n =
hasNodeType
::
forall
a
.
Node
a
->
NodeType
->
Bool
hasNodeType
n
nt
=
(
view
node_typename
n
)
==
(
nodeTypeId
nt
)
isInNodeTypes
::
forall
a
.
Node
a
->
[
NodeType
]
->
Bool
isInNodeTypes
n
ts
=
elem
(
view
node_typename
n
)
(
map
nodeTypeId
ts
)
-- | Nodes are typed in the database according to a specific ID
--
...
...
src/Gargantext/Database/Query/Tree.hs
View file @
69f8b4f0
...
...
@@ -40,7 +40,7 @@ import Data.Text (Text)
import
Database.PostgreSQL.Simple
import
Database.PostgreSQL.Simple.SqlQQ
import
Gargantext.Core.Types.Main
(
NodeTree
(
..
),
Tree
(
..
))
import
Gargantext.Database.Admin.Config
(
fromNodeTypeId
,
nodeTypeId
)
import
Gargantext.Database.Admin.Config
(
fromNodeTypeId
,
nodeTypeId
,
fromNodeTypeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
,
NodeType
,
DocId
,
allNodeTypes
)
import
Gargantext.Database.Admin.Types.Node
-- (pgNodeId, NodeType(..))
import
Gargantext.Database.Prelude
(
Cmd
,
runPGSQuery
)
...
...
@@ -89,28 +89,39 @@ tree_advanced :: HasTreeError err
->
Cmd
err
(
Tree
NodeTree
)
tree_advanced
r
nodeTypes
=
do
mainRoot
<-
dbTree
r
nodeTypes
sharedRoots
<-
findShared
r
NodeFolderShared
nodeTypes
publicRoots
<-
findShared
r
NodeFolderPublic
nodeTypes
sharedRoots
<-
findShared
r
NodeFolderShared
nodeTypes
sharedTreeUpdate
publicRoots
<-
findShared
r
NodeFolderPublic
nodeTypes
publicTreeUpdate
toTree
$
toTreeParent
(
mainRoot
<>
sharedRoots
<>
publicRoots
)
------------------------------------------------------------------------
-- | Collaborative Nodes in the Tree
findShared
::
RootId
->
NodeType
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
findShared
r
nt
nts
=
do
findShared
::
RootId
->
NodeType
->
[
NodeType
]
->
UpdateTree
err
->
Cmd
err
[
DbTreeNode
]
findShared
r
nt
nts
fun
=
do
folderSharedId
<-
maybe
(
panic
"no folder found"
)
identity
<$>
head
<$>
findNodesId
r
[
nt
]
folders
<-
getNodeNode
folderSharedId
nodesSharedId
<-
mapM
(
\
child
->
sharedTree
folderSharedId
child
nts
)
nodesSharedId
<-
mapM
(
\
child
->
fun
folderSharedId
child
nts
)
$
map
_nn_node2_id
folders
pure
$
concat
nodesSharedId
sharedTree
::
ParentId
->
NodeId
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
sharedTree
p
n
nt
=
dbTree
n
nt
<&>
map
(
\
n'
->
if
_dt_nodeId
n'
==
n
type
UpdateTree
err
=
ParentId
->
NodeId
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
sharedTreeUpdate
::
ParentId
->
NodeId
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
sharedTreeUpdate
p
n
nt
=
dbTree
n
nt
<&>
map
(
\
n'
->
if
_dt_nodeId
n'
==
n
then
set
dt_parentId
(
Just
p
)
n'
else
n'
)
publicTreeUpdate
::
ParentId
->
NodeId
->
[
NodeType
]
->
Cmd
err
[
DbTreeNode
]
publicTreeUpdate
p
n
nt
=
dbTree
n
nt
<&>
map
(
\
n'
->
if
_dt_nodeId
n'
==
n
-- && (fromNodeTypeId $ _dt_typeId n') /= NodeFolderPublic
then
set
dt_parentId
(
Just
p
)
n'
else
n'
)
-- | findNodesId returns all nodes matching nodeType but the root (Nodeuser)
findNodesId
::
RootId
->
[
NodeType
]
->
Cmd
err
[
NodeId
]
findNodesId
r
nt
=
tail
...
...
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