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
147
Issues
147
List
Board
Labels
Milestones
Merge Requests
6
Merge Requests
6
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
8a83ba4e
Commit
8a83ba4e
authored
5 years ago
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[HASH] adding argon2
parent
c45dba95
Changes
7
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
37 additions
and
182 deletions
+37
-182
package.yaml
package.yaml
+2
-0
Node.hs
src/Gargantext/API/Node.hs
+2
-2
Flow.hs
src/Gargantext/Database/Flow.hs
+3
-3
Insert.hs
src/Gargantext/Database/Node/Document/Insert.hs
+2
-2
NodeNgram.hs
src/Gargantext/Database/Schema/NodeNgram.hs
+0
-168
Utils.hs
src/Gargantext/Prelude/Utils.hs
+27
-7
stack.yaml
stack.yaml
+1
-0
No files found.
package.yaml
View file @
8a83ba4e
...
...
@@ -86,11 +86,13 @@ library:
-
aeson
-
aeson-lens
-
aeson-pretty
-
argon2
-
async
-
attoparsec
-
auto-update
-
base >=4.7 && <5
-
base16-bytestring
-
base64-bytestring
-
blaze-html
-
blaze-markup
-
blaze-svg
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/API/Node.hs
View file @
8a83ba4e
...
...
@@ -65,7 +65,7 @@ import Gargantext.Database.Tree (treeDB)
import
Gargantext.Database.Types.Node
import
Gargantext.Database.Utils
-- (Cmd, CmdM)
import
Gargantext.Prelude
import
Gargantext.Prelude.Utils
(
hash
)
import
Gargantext.Prelude.Utils
(
sha
)
import
Gargantext.Viz.Chart
import
Gargantext.Viz.Phylo.API
(
PhyloAPI
,
phyloAPI
)
import
Servant
...
...
@@ -400,4 +400,4 @@ postUpload _ multipartData (Just fileType) = do
--pure $ cs content
-- is <- inputs multipartData
pure
$
map
(
hash
.
cs
)
is
pure
$
map
(
sha
.
cs
)
is
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Flow.hs
View file @
8a83ba4e
...
...
@@ -79,7 +79,7 @@ import Gargantext.Text.Corpus.Parsers (parseFile, FileFormat)
import
qualified
Gargantext.Text.Corpus.API.Isidore
as
Isidore
import
Gargantext.Text.Terms
(
TermType
(
..
),
tt_lang
,
extractTerms
,
uniText
)
import
Gargantext.Text.Terms.Mono.Stem.En
(
stemIt
)
import
Gargantext.Prelude.Utils
hiding
(
hash
)
import
Gargantext.Prelude.Utils
hiding
(
sha
)
import
System.FilePath
(
FilePath
)
import
qualified
Data.List
as
List
import
qualified
Data.Map
as
Map
...
...
@@ -325,8 +325,8 @@ mergeData :: Map HashId ReturnId
->
[
DocumentWithId
a
]
mergeData
rs
=
catMaybes
.
map
toDocumentWithId
.
Map
.
toList
where
toDocumentWithId
(
hash
,
hpd
)
=
DocumentWithId
<$>
fmap
reId
(
lookup
hash
rs
)
toDocumentWithId
(
sha
,
hpd
)
=
DocumentWithId
<$>
fmap
reId
(
lookup
sha
rs
)
<*>
Just
hpd
------------------------------------------------------------------------
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Node/Document/Insert.hs
View file @
8a83ba4e
...
...
@@ -39,7 +39,7 @@ database (in others words parent_id is necessary to preserve privacy for
instance).
- Hash policy: this UniqId is a sha256 uniq id which is the result of
the concatenation of the parameters defined by @
hash
Parameters@.
the concatenation of the parameters defined by @
sha
Parameters@.
> -- * Example
> insertTest :: FromRow r => CorpusId -> [Node HyperdataDocument] -> IO [r]
...
...
@@ -79,7 +79,7 @@ import Gargantext.Prelude
import
qualified
Data.ByteString.Lazy.Char8
as
DC
(
pack
)
import
qualified
Data.Digest.Pure.SHA
as
SHA
(
sha256
,
showDigest
)
import
qualified
Data.Text
as
DT
(
pack
,
unpack
,
concat
,
take
)
import
Gargantext.Prelude.Utils
(
hash
)
import
Gargantext.Prelude.Utils
(
sha
)
-- TODO : the import of Document constructor below does not work
-- import Gargantext.Database.Types.Node (Document)
--import Gargantext.Database.Types.Node (docExample, hyperdataDocument, HyperdataDocument(..)
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Schema/NodeNgram.hs
deleted
100644 → 0
View file @
c45dba95
{-|
Module : Gargantext.Database.Schema.NodeNgrams
Description : NodeNgram for Ngram indexation or Lists
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
NodeNgram: relation between a Node and a Ngrams
if Node is a Document then it is indexing
if Node is a List then it is listing (either Stop, Candidate or Map)
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
-- TODO NodeNgrams
module
Gargantext.Database.Schema.NodeNgram
where
import
Data.ByteString
(
ByteString
)
import
Data.Text
(
Text
)
import
Control.Lens.TH
(
makeLenses
)
import
Control.Monad
(
void
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Gargantext.Database.Utils
(
mkCmd
,
Cmd
,
execPGSQuery
)
import
Gargantext.Core.Types.Main
(
ListTypeId
)
import
Gargantext.Database.Types.Node
(
NodeId
,
ListId
)
import
Gargantext.Database.Schema.Node
(
pgNodeId
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsTypeId
,
pgNgramsTypeId
)
import
Gargantext.Prelude
import
Gargantext.Database.Utils
(
formatPGSQuery
)
import
Opaleye
import
qualified
Database.PostgreSQL.Simple
as
DPS
-- | TODO : remove id
data
NodeNgramPoly
node_id
ngrams_id
parent_id
ngrams_type
list_type
weight
=
NodeNgram
{
nng_node_id
::
node_id
,
nng_ngrams_id
::
ngrams_id
,
nng_parent_id
::
parent_id
,
nng_ngramsType
::
ngrams_type
,
nng_listType
::
list_type
,
nng_weight
::
weight
}
deriving
(
Show
)
type
NodeNgramWrite
=
NodeNgramPoly
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Maybe
(
Column
PGInt4
))
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGFloat8
)
type
NodeNgramRead
=
NodeNgramPoly
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGFloat8
)
type
NodeNgramReadNull
=
NodeNgramPoly
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGInt4
))
(
Column
(
Nullable
PGFloat8
))
type
NodeNgram
=
NodeNgramPoly
NodeId
Int
(
Maybe
NgramsParentId
)
NgramsTypeId
Int
Double
newtype
NgramsParentId
=
NgramsParentId
Int
deriving
(
Show
,
Eq
,
Num
)
pgNgramsParentId
::
NgramsParentId
->
Column
PGInt4
pgNgramsParentId
(
NgramsParentId
n
)
=
pgInt4
n
$
(
makeAdaptorAndInstance
"pNodeNgram"
''
N
odeNgramPoly
)
makeLenses
''
N
odeNgramPoly
nodeNgramTable
::
Table
NodeNgramWrite
NodeNgramRead
nodeNgramTable
=
Table
"nodes_ngrams"
(
pNodeNgram
NodeNgram
{
nng_node_id
=
required
"node_id"
,
nng_ngrams_id
=
required
"ngrams_id"
,
nng_parent_id
=
optional
"parent_id"
,
nng_ngramsType
=
required
"ngrams_type"
,
nng_listType
=
required
"list_type"
,
nng_weight
=
required
"weight"
}
)
queryNodeNgramTable
::
Query
NodeNgramRead
queryNodeNgramTable
=
queryTable
nodeNgramTable
--{-
insertNodeNgrams
::
[
NodeNgram
]
->
Cmd
err
Int
insertNodeNgrams
=
insertNodeNgramW
.
map
(
\
(
NodeNgram
n
g
p
ngt
lt
w
)
->
NodeNgram
(
pgNodeId
n
)
(
pgInt4
g
)
(
pgNgramsParentId
<$>
p
)
(
pgNgramsTypeId
ngt
)
(
pgInt4
lt
)
(
pgDouble
w
)
)
insertNodeNgramW
::
[
NodeNgramWrite
]
->
Cmd
err
Int
insertNodeNgramW
nns
=
mkCmd
$
\
c
->
fromIntegral
<$>
runInsert_
c
insertNothing
where
insertNothing
=
(
Insert
{
iTable
=
nodeNgramTable
,
iRows
=
nns
,
iReturning
=
rCount
,
iOnConflict
=
(
Just
DoNothing
)
})
--}
type
NgramsText
=
Text
updateNodeNgrams'
::
ListId
->
[(
NgramsTypeId
,
NgramsText
,
ListTypeId
)]
->
Cmd
err
()
updateNodeNgrams'
_
[]
=
pure
()
updateNodeNgrams'
listId
input
=
void
$
execPGSQuery
updateQuery
(
DPS
.
Only
$
Values
fields
input'
)
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"int4"
,
"int4"
,
"text"
,
"int4"
]
input'
=
map
(
\
(
nt
,
t
,
lt
)
->
(
listId
,
nt
,
t
,
lt
))
input
updateNodeNgrams'_debug
::
ListId
->
[(
NgramsTypeId
,
NgramsText
,
ListTypeId
)]
->
Cmd
err
ByteString
updateNodeNgrams'_debug
listId
input
=
formatPGSQuery
updateQuery
(
DPS
.
Only
$
Values
fields
input'
)
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"int4"
,
"int4"
,
"text"
,
"int4"
]
input'
=
map
(
\
(
nt
,
t
,
lt
)
->
(
listId
,
nt
,
t
,
lt
))
input
updateQuery
::
DPS
.
Query
updateQuery
=
[
sql
|
WITH new(node_id,ngrams_type,terms,typeList) as (?)
INSERT into nodes_ngrams (node_id,ngrams_id,ngrams_type,list_type,weight)
SELECT node_id,ngrams.id,ngrams_type,typeList,1 FROM new
JOIN ngrams ON ngrams.terms = new.terms
ON CONFLICT (node_id, ngrams_id, ngrams_type) DO
-- DO NOTHING
UPDATE SET list_type = excluded.list_type
;
|]
This diff is collapsed.
Click to expand it.
src/Gargantext/Prelude/Utils.hs
View file @
8a83ba4e
...
...
@@ -30,23 +30,43 @@ import System.Directory (createDirectoryIfMissing)
import
qualified
Data.ByteString.Lazy.Char8
as
Char
import
qualified
Data.Digest.Pure.SHA
as
SHA
(
sha256
,
showDigest
)
import
qualified
Data.Text
as
Text
import
Gargantext.Database.Types.Node
(
NodeId
,
NodeType
)
import
Data.ByteString
(
ByteString
)
import
Crypto.Argon2
as
Crypto
import
Data.Either
import
Data.ByteString.Base64.URL
as
URL
shuffle
::
MonadRandom
m
=>
[
a
]
->
m
[
a
]
shuffle
ns
=
SRS
.
shuffleM
ns
type
FolderPath
=
FilePath
type
FileName
=
FilePath
hash
::
Text
->
Text
hash
=
Text
.
pack
.
SHA
.
showDigest
.
SHA
.
sha256
sha
::
Text
->
Text
sha
=
Text
.
pack
.
SHA
.
showDigest
.
SHA
.
sha256
.
Char
.
pack
.
Text
.
unpack
data
NodeToHash
=
NodeToHash
{
nodeType
::
NodeType
,
nodeId
::
NodeId
}
secret_key
::
ByteString
secret_key
=
"WRV5ymit8s~ge6%08dLR7Q!gBcpb1MY%7e67db2206"
type
SecretKey
=
ByteString
hashNode
::
SecretKey
->
NodeToHash
->
ByteString
hashNode
sk
(
NodeToHash
nt
ni
)
=
case
hashResult
of
Left
e
->
panic
(
cs
$
show
e
)
Right
h
->
URL
.
encode
h
where
hashResult
=
Crypto
.
hash
Crypto
.
defaultHashOptions
sk
(
cs
$
show
nt
<>
show
ni
)
toPath
::
Int
->
Text
->
(
FolderPath
,
FileName
)
toPath
n
x
=
(
Text
.
unpack
$
Text
.
intercalate
"/"
[
x1
,
x2
],
Text
.
unpack
xs
)
...
...
This diff is collapsed.
Click to expand it.
stack.yaml
View file @
8a83ba4e
...
...
@@ -68,3 +68,4 @@ extra-deps:
-
validity-0.9.0.0
# patches-{map,class}
-
directory-1.3.1.5
-
process-1.6.5.1@sha256:77a9afeb676357f67fe5cf1ad79aca0745fb6f7fb96b786d510af08f622643f6,2468
-
argon2-1.3.0.1@sha256:e7771caf255929453c7cebfed0809617c51428d1c1b22f207c80b8711b792d78,4592
This diff is collapsed.
Click to expand it.
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