Skip to content

haskell-gargantext
haskell-gargantext
Commit 8a83ba4e authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[HASH] adding argon2

parent c45dba95
Show whitespace changes
Inline Side-by-side
Showing with 37 additions and 182 deletions
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
......
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
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
------------------------------------------------------------------------
......
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 @hashParameters@.
the concatenation of the parameters defined by @shaParameters@.
> -- * 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(..)
......
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" ''NodeNgramPoly)
makeLenses ''NodeNgramPoly
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
;
|]
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 :: 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)
......
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment