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
dc484896
Commit
dc484896
authored
Nov 25, 2019
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Annuanire][Contact] Route + script.
parent
229f0d44
Changes
5
Show whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
46 additions
and
32 deletions
+46
-32
Main.hs
bin/gargantext-import/Main.hs
+18
-7
API.hs
src/Gargantext/API.hs
+12
-6
Auth.hs
src/Gargantext/API/Auth.hs
+7
-15
Node.hs
src/Gargantext/API/Node.hs
+6
-2
Flow.hs
src/Gargantext/Database/Flow.hs
+3
-2
No files found.
bin/gargantext-import/Main.hs
View file @
dc484896
...
@@ -23,7 +23,7 @@ import Data.Either
...
@@ -23,7 +23,7 @@ import Data.Either
import
Prelude
(
read
)
import
Prelude
(
read
)
import
Control.Exception
(
finally
)
import
Control.Exception
(
finally
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Database.Flow
(
FlowCmdM
,
flowCorpusFile
)
import
Gargantext.Database.Flow
(
FlowCmdM
,
flowCorpusFile
,
flowAnnuaire
)
import
Gargantext.Text.Corpus.Parsers
(
FileFormat
(
..
))
import
Gargantext.Text.Corpus.Parsers
(
FileFormat
(
..
))
import
Gargantext.Database.Utils
(
Cmd
,
)
import
Gargantext.Database.Utils
(
Cmd
,
)
import
Gargantext.Database.Types.Node
(
CorpusId
,
toHyperdataDocument
)
import
Gargantext.Database.Types.Node
(
CorpusId
,
toHyperdataDocument
)
...
@@ -41,9 +41,10 @@ import Control.Monad.IO.Class (liftIO)
...
@@ -41,9 +41,10 @@ import Control.Monad.IO.Class (liftIO)
main
::
IO
()
main
::
IO
()
main
=
do
main
=
do
[
userCreate
,
user
,
name
,
iniPath
,
limit
,
corpusPath
]
<-
getArgs
[
fun
,
user
,
name
,
iniPath
,
limit
,
corpusPath
]
<-
getArgs
--{-
--{-
let
createUsers
::
Cmd
GargError
Int64
let
createUsers
::
Cmd
GargError
Int64
createUsers
=
insertUsersDemo
createUsers
=
insertUsersDemo
...
@@ -51,8 +52,13 @@ main = do
...
@@ -51,8 +52,13 @@ main = do
--tt = (Unsupervised EN 6 0 Nothing)
--tt = (Unsupervised EN 6 0 Nothing)
tt
=
(
Multi
EN
)
tt
=
(
Multi
EN
)
format
=
CsvGargV3
-- CsvHalFormat --WOS
format
=
CsvGargV3
-- CsvHalFormat --WOS
cmd
::
forall
m
.
FlowCmdM
DevEnv
GargError
m
=>
m
CorpusId
corpus
::
forall
m
.
FlowCmdM
DevEnv
GargError
m
=>
m
CorpusId
cmd
=
flowCorpusFile
(
cs
user
)
(
Left
(
cs
name
::
Text
))
(
read
limit
::
Int
)
tt
format
corpusPath
corpus
=
flowCorpusFile
(
cs
user
)
(
Left
(
cs
name
::
Text
))
(
read
limit
::
Int
)
tt
format
corpusPath
annuaire
::
forall
m
.
FlowCmdM
DevEnv
GargError
m
=>
m
CorpusId
annuaire
=
flowAnnuaire
(
cs
user
)
(
Left
"Annuaire"
)
(
Multi
EN
)
corpusPath
{-
{-
let debatCorpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
let debatCorpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
debatCorpus = do
debatCorpus = do
...
@@ -64,13 +70,18 @@ main = do
...
@@ -64,13 +70,18 @@ main = do
flowCorpus (Text.pack user) (Text.pack name) (Multi FR) (map (map toHyperdataDocument) docs)
flowCorpus (Text.pack user) (Text.pack name) (Multi FR) (map (map toHyperdataDocument) docs)
--}
--}
withDevEnv
iniPath
$
\
env
->
do
withDevEnv
iniPath
$
\
env
->
do
_
<-
if
userCreate
==
"true
"
_
<-
if
fun
==
"users
"
then
runCmdDev
env
createUsers
then
runCmdDev
env
createUsers
else
pure
0
--(cs "false")
else
pure
0
--(cs "false")
_
<-
runCmdDev
env
cmd
_
<-
if
fun
==
"corpus"
then
runCmdDev
env
corpus
else
pure
0
--(cs "false")
_
<-
if
fun
==
"annuaire"
then
runCmdDev
env
annuaire
else
pure
0
{-
{-
_ <- if corpusType == "csv"
_ <- if corpusType == "csv"
then runCmdDev env csvCorpus
then runCmdDev env csvCorpus
...
...
src/Gargantext/API.hs
View file @
dc484896
...
@@ -70,7 +70,7 @@ import Text.Blaze.Html (Html)
...
@@ -70,7 +70,7 @@ import Text.Blaze.Html (Html)
--import Gargantext.API.Swagger
--import Gargantext.API.Swagger
--
import Gargantext.Database.Node.Contact (HyperdataContact)
import
Gargantext.Database.Node.Contact
(
HyperdataContact
)
import
Gargantext.API.Auth
(
AuthRequest
,
AuthResponse
,
AuthenticatedUser
(
..
),
AuthContext
,
auth
,
withAccess
,
PathId
(
..
))
import
Gargantext.API.Auth
(
AuthRequest
,
AuthResponse
,
AuthenticatedUser
(
..
),
AuthContext
,
auth
,
withAccess
,
PathId
(
..
))
import
Gargantext.API.Count
(
CountAPI
,
count
,
Query
)
import
Gargantext.API.Count
(
CountAPI
,
count
,
Query
)
import
Gargantext.API.FrontEnd
(
FrontEndAPI
,
frontEndServer
)
import
Gargantext.API.FrontEnd
(
FrontEndAPI
,
frontEndServer
)
...
@@ -249,6 +249,11 @@ type GargPrivateAPI' =
...
@@ -249,6 +249,11 @@ type GargPrivateAPI' =
:<|>
"annuaire"
:>
Summary
"Annuaire endpoint"
:<|>
"annuaire"
:>
Summary
"Annuaire endpoint"
:>
Capture
"id"
AnnuaireId
:>
NodeAPI
HyperdataAnnuaire
:>
Capture
"id"
AnnuaireId
:>
NodeAPI
HyperdataAnnuaire
:<|>
"annuaire"
:>
Summary
"Contact endpoint"
:>
Capture
"annuaire_id"
NodeId
:>
"contact"
:>
Capture
"contact_id"
NodeId
:>
NodeNodeAPI
HyperdataContact
-- Document endpoint
-- Document endpoint
:<|>
"document"
:>
Summary
"Document endpoint"
:<|>
"document"
:>
Summary
"Document endpoint"
:>
Capture
"id"
DocId
:>
"ngrams"
:>
TableNgramsApi
:>
Capture
"id"
DocId
:>
"ngrams"
:>
TableNgramsApi
...
@@ -329,6 +334,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
...
@@ -329,6 +334,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataCorpus
)
uid
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataCorpus
)
uid
:<|>
nodeNodeAPI
(
Proxy
::
Proxy
HyperdataAny
)
uid
:<|>
nodeNodeAPI
(
Proxy
::
Proxy
HyperdataAny
)
uid
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataAnnuaire
)
uid
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataAnnuaire
)
uid
:<|>
nodeNodeAPI
(
Proxy
::
Proxy
HyperdataContact
)
uid
:<|>
withAccess
(
Proxy
::
Proxy
TableNgramsApi
)
Proxy
uid
<$>
PathNode
<*>
apiNgramsTableDoc
:<|>
withAccess
(
Proxy
::
Proxy
TableNgramsApi
)
Proxy
uid
<$>
PathNode
<*>
apiNgramsTableDoc
:<|>
count
-- TODO: undefined
:<|>
count
-- TODO: undefined
:<|>
withAccess
(
Proxy
::
Proxy
SearchPairsAPI
)
Proxy
uid
<$>
PathNode
<*>
searchPairs
-- TODO: move elsewhere
:<|>
withAccess
(
Proxy
::
Proxy
SearchPairsAPI
)
Proxy
uid
<$>
PathNode
<*>
searchPairs
-- TODO: move elsewhere
...
...
src/Gargantext/API/Auth.hs
View file @
dc484896
...
@@ -102,7 +102,7 @@ checkAuthRequest u p
...
@@ -102,7 +102,7 @@ checkAuthRequest u p
|
not
(
u
`
elem
`
arbitraryUsername
)
=
pure
InvalidUser
|
not
(
u
`
elem
`
arbitraryUsername
)
=
pure
InvalidUser
|
u
/=
reverse
p
=
pure
InvalidPassword
|
u
/=
reverse
p
=
pure
InvalidPassword
|
otherwise
=
do
|
otherwise
=
do
muId
<-
head
<$>
getRoot
"user1"
-- TODO user1 hard-coded
muId
<-
head
<$>
getRoot
u
case
_node_id
<$>
muId
of
case
_node_id
<$>
muId
of
Nothing
->
pure
InvalidUser
Nothing
->
pure
InvalidUser
Just
uid
->
do
Just
uid
->
do
...
@@ -179,7 +179,7 @@ instance Arbitrary AuthValid where
...
@@ -179,7 +179,7 @@ instance Arbitrary AuthValid where
,
tr
<-
[
1
..
3
]
,
tr
<-
[
1
..
3
]
]
]
data
PathId
=
PathNode
NodeId
|
Path
Doc
ListId
DocId
data
PathId
=
PathNode
NodeId
|
Path
NodeNode
ListId
DocId
withAccessM
::
(
CmdM
env
err
m
,
HasServerError
err
)
withAccessM
::
(
CmdM
env
err
m
,
HasServerError
err
)
=>
UserId
=>
UserId
...
@@ -190,13 +190,12 @@ withAccessM uId (PathNode id) m = do
...
@@ -190,13 +190,12 @@ withAccessM uId (PathNode id) m = do
d
<-
id
`
isDescendantOf
`
NodeId
uId
d
<-
id
`
isDescendantOf
`
NodeId
uId
if
d
then
m
else
m
-- serverError err401
if
d
then
m
else
m
-- serverError err401
withAccessM
uId
(
Path
Doc
cId
docId
)
m
=
do
withAccessM
uId
(
Path
NodeNode
cId
docId
)
m
=
do
a
<-
isIn
cId
docId
-- TODO use one query for all ?
_
a
<-
isIn
cId
docId
-- TODO use one query for all ?
d
<-
cId
`
isDescendantOf
`
NodeId
uId
_
d
<-
cId
`
isDescendantOf
`
NodeId
uId
if
a
&&
d
if
True
--
a && d
then
m
then
m
else
m
-- serverError err401
else
m
withAccess
::
forall
env
err
m
api
.
withAccess
::
forall
env
err
m
api
.
(
GargServerC
env
err
m
,
HasServer
api
'[
]
)
=>
(
GargServerC
env
err
m
,
HasServer
api
'[
]
)
=>
...
@@ -208,16 +207,9 @@ withAccess p _ uId id = hoistServer p f
...
@@ -208,16 +207,9 @@ withAccess p _ uId id = hoistServer p f
f
::
forall
a
.
m
a
->
m
a
f
::
forall
a
.
m
a
->
m
a
f
=
withAccessM
uId
id
f
=
withAccessM
uId
id
{- | Collaborative Schema
{- | Collaborative Schema
User at his root can create Teams Folder
User at his root can create Teams Folder
User can create Team in Teams Folder.
User can create Team in Teams Folder.
User can invite User in Team as NodeNode only if Team in his parents.
User can invite User in Team as NodeNode only if Team in his parents.
All users can access to the Team folder as if they were owner.
All users can access to the Team folder as if they were owner.
-}
-}
src/Gargantext/API/Node.hs
View file @
dc484896
...
@@ -164,11 +164,13 @@ type ChildrenApi a = Summary " Summary children"
...
@@ -164,11 +164,13 @@ type ChildrenApi a = Summary " Summary children"
type
NodeNodeAPI
a
=
Get
'[
J
SON
]
(
Node
a
)
type
NodeNodeAPI
a
=
Get
'[
J
SON
]
(
Node
a
)
nodeNodeAPI
::
forall
proxy
a
.
(
JSONB
a
,
ToJSON
a
)
=>
proxy
a
->
UserId
->
CorpusId
->
NodeId
->
GargServer
(
NodeNodeAPI
a
)
nodeNodeAPI
::
forall
proxy
a
.
(
JSONB
a
,
ToJSON
a
)
=>
proxy
a
->
UserId
->
CorpusId
->
NodeId
->
GargServer
(
NodeNodeAPI
a
)
nodeNodeAPI
p
uId
cId
nId
=
withAccess
(
Proxy
::
Proxy
(
NodeNodeAPI
a
))
Proxy
uId
(
Path
Doc
cId
nId
)
nodeNodeAPI'
nodeNodeAPI
p
uId
cId
nId
=
withAccess
(
Proxy
::
Proxy
(
NodeNodeAPI
a
))
Proxy
uId
(
Path
NodeNode
cId
nId
)
nodeNodeAPI'
where
where
nodeNodeAPI'
::
GargServer
(
NodeNodeAPI
a
)
nodeNodeAPI'
::
GargServer
(
NodeNodeAPI
a
)
nodeNodeAPI'
=
getNode
nId
p
nodeNodeAPI'
=
getNode
nId
p
------------------------------------------------------------------------
------------------------------------------------------------------------
-- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
-- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
nodeAPI
::
forall
proxy
a
.
(
JSONB
a
,
ToJSON
a
)
=>
proxy
a
->
UserId
->
NodeId
->
GargServer
(
NodeAPI
a
)
nodeAPI
::
forall
proxy
a
.
(
JSONB
a
,
ToJSON
a
)
=>
proxy
a
->
UserId
->
NodeId
->
GargServer
(
NodeAPI
a
)
...
@@ -207,6 +209,8 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i
...
@@ -207,6 +209,8 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i
-- Annuaire
-- Annuaire
-- :<|> query
-- :<|> query
------------------------------------------------------------------------
------------------------------------------------------------------------
data
RenameNode
=
RenameNode
{
r_name
::
Text
}
data
RenameNode
=
RenameNode
{
r_name
::
Text
}
deriving
(
Generic
)
deriving
(
Generic
)
...
...
src/Gargantext/Database/Flow.hs
View file @
dc484896
...
@@ -37,6 +37,7 @@ module Gargantext.Database.Flow -- (flowDatabase, ngrams2list)
...
@@ -37,6 +37,7 @@ module Gargantext.Database.Flow -- (flowDatabase, ngrams2list)
,
flowCorpusSearchInDatabase
,
flowCorpusSearchInDatabase
,
getOrMkRoot
,
getOrMkRoot
,
getOrMkRootWithCorpus
,
getOrMkRootWithCorpus
,
flowAnnuaire
)
)
where
where
import
Prelude
(
String
)
import
Prelude
(
String
)
...
@@ -120,9 +121,9 @@ _flowCorpusApi u n tt l q = do
...
@@ -120,9 +121,9 @@ _flowCorpusApi u n tt l q = do
------------------------------------------------------------------------
------------------------------------------------------------------------
-- UNUSED
-- UNUSED
_
flowAnnuaire
::
FlowCmdM
env
err
m
flowAnnuaire
::
FlowCmdM
env
err
m
=>
Username
->
Either
CorpusName
[
CorpusId
]
->
(
TermType
Lang
)
->
FilePath
->
m
AnnuaireId
=>
Username
->
Either
CorpusName
[
CorpusId
]
->
(
TermType
Lang
)
->
FilePath
->
m
AnnuaireId
_
flowAnnuaire
u
n
l
filePath
=
do
flowAnnuaire
u
n
l
filePath
=
do
docs
<-
liftIO
$
((
splitEvery
500
<$>
deserialiseImtUsersFromFile
filePath
)
::
IO
[[
HyperdataContact
]])
docs
<-
liftIO
$
((
splitEvery
500
<$>
deserialiseImtUsersFromFile
filePath
)
::
IO
[[
HyperdataContact
]])
flow
(
Nothing
::
Maybe
HyperdataAnnuaire
)
u
n
l
docs
flow
(
Nothing
::
Maybe
HyperdataAnnuaire
)
u
n
l
docs
...
...
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