]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Node/Document/Insert.hs
Merge branch 'ngrams-order' into dev
[gargantext.git] / src / Gargantext / Database / Node / Document / Insert.hs
1 {-|
2 Module : Gargantext.Database.Node.Document.Insert
3 Description : Importing context of texts (documents)
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 * Purpose of this module
11
12 Enabling "common goods" of text data and respecting privacy.
13
14 Gargantext shares as "common good" the links between context of texts
15 and terms / words / ngrams.
16
17 Basically a context of text can be defined as a document (see 'Gargantext.Text').
18
19 Issue to tackle in that module: each global document of Gargantext has
20 to be unique, then shared, but how to respect privacy if needed ?
21
22
23 * Methodology to get uniqueness and privacy by design
24
25 As a consequence, when importing/inserting a new document in Gargantext,
26 a policy for the uniqueness of the inserted docuemnts has to be defined.
27
28 That is the purpose of this module which defines its main concepts.
29
30 Unique identifier in database is of a 3-tuple of 3 policies that
31 together define uniqueness:
32
33 - Design policy: type of node is needed as TypenameId, that is a
34 Document or Individual or something else;
35
36 - Privacy policy: with ParentId, parent becomes unique, then it enables
37 users to get their own copy without sharing it with all the users of the
38 database (in others words parent_id is necessary to preserve privacy for
39 instance).
40
41 - Hash policy: this UniqId is a sha256 uniq id which is the result of
42 the concatenation of the parameters defined by @hashParameters@.
43
44 > -- * Example
45 > insertTest :: FromRow r => CorpusId -> [Node HyperdataDocument] -> IO [r]
46 > insertTest :: IO [ReturnId]
47 > insertTest = runCmdDev $ insertDocuments 1 452162 hyperdataDocuments
48
49 -}
50 ------------------------------------------------------------------------
51 {-# LANGUAGE DeriveGeneric #-}
52 {-# LANGUAGE FlexibleInstances #-}
53 {-# LANGUAGE NoImplicitPrelude #-}
54 {-# LANGUAGE OverloadedStrings #-}
55 {-# LANGUAGE QuasiQuotes #-}
56 {-# LANGUAGE RankNTypes #-}
57 {-# LANGUAGE TypeSynonymInstances #-}
58 ------------------------------------------------------------------------
59 module Gargantext.Database.Node.Document.Insert where
60
61 import Control.Lens (set, view)
62 import Control.Lens.Prism
63 import Control.Lens.Cons
64 import Data.Aeson (toJSON)
65 import Data.Maybe (maybe)
66 import Data.Time.Segment (jour)
67 import Data.Text (Text)
68 import Database.PostgreSQL.Simple (FromRow, Query, Only(..))
69 import Database.PostgreSQL.Simple.FromRow (fromRow, field)
70 import Database.PostgreSQL.Simple.SqlQQ
71 import Database.PostgreSQL.Simple.ToField (toField, Action)
72 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
73 import GHC.Generics (Generic)
74 import Gargantext.Database.Config (nodeTypeId)
75 import Gargantext.Database.Utils (Cmd, runPGSQuery)
76 import Gargantext.Database.Node.Contact -- (HyperdataContact(..), ContactWho(..))
77 import Gargantext.Database.Types.Node
78 import Gargantext.Prelude
79 import qualified Data.ByteString.Lazy.Char8 as DC (pack)
80 import qualified Data.Digest.Pure.SHA as SHA (sha256, showDigest)
81 import qualified Data.Text as DT (pack, unpack, concat, take)
82 import Gargantext.Prelude.Utils (hash)
83 -- TODO : the import of Document constructor below does not work
84 -- import Gargantext.Database.Types.Node (Document)
85 --import Gargantext.Database.Types.Node (docExample, hyperdataDocument, HyperdataDocument(..)
86 -- , hyperdataDocument_uniqId
87 -- , hyperdataDocument_title
88 -- , hyperdataDocument_abstract
89 -- , hyperdataDocument_source
90 -- , Node(..), node_typename
91 -- , node_userId
92 -- , node_parentId, node_name, node_hyperdata, hyperdataDocuments
93 -- , NodeTypeId
94 -- )
95 {-| To Print result query
96 import Data.ByteString.Internal (ByteString)
97 import Database.PostgreSQL.Simple (formatQuery)
98 -}
99
100 ---------------------------------------------------------------------------
101 -- * Main Insert functions
102
103 -- | Insert Document main function
104 -- UserId : user who is inserting the documents
105 -- ParentId : folder ID which is parent of the inserted documents
106 -- Administrator of the database has to create a uniq index as following SQL command:
107 -- `create unique index on nodes (typename, parent_id, (hyperdata ->> 'uniqId'));`
108 insertDb :: InsertDb a => UserId -> ParentId -> [a] -> Cmd err [ReturnId]
109 insertDb u p = runPGSQuery queryInsert . Only . Values fields . map (insertDb' u p)
110 where
111 fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
112
113 class InsertDb a
114 where
115 insertDb' :: UserId -> ParentId -> a -> [Action]
116
117
118 instance InsertDb HyperdataDocument
119 where
120 insertDb' u p h = [ toField $ nodeTypeId NodeDocument
121 , toField u
122 , toField p
123 , toField $ maybe "No Title" (DT.take 255) (_hyperdataDocument_title h)
124 , toField $ _hyperdataDocument_publication_date h -- TODO USE UTCTime
125 , (toField . toJSON) h
126 ]
127
128 instance InsertDb HyperdataContact
129 where
130 insertDb' u p h = [ toField $ nodeTypeId NodeContact
131 , toField u
132 , toField p
133 , toField $ maybe "Contact" (DT.take 255) (Just "Name") -- (_hc_name h)
134 , toField $ jour 2010 1 1 -- TODO put default date
135 , (toField . toJSON) h
136 ]
137
138
139 -- | Debug SQL function
140 --
141 -- to print rendered query (Debug purpose) use @formatQuery@ function.
142 {-
143 insertDocuments_Debug :: (Hyperdata a, ToJSON a, ToRow a) => UserId -> ParentId -> [a] -> Cmd ByteString
144 insertDocuments_Debug uId pId hs = formatPGSQuery queryInsert (Only $ Values fields inputData)
145 where
146 fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
147 inputData = prepare uId pId hs
148 -}
149
150
151 -- | Input Tables: types of the tables
152 inputSqlTypes :: [Text]
153 inputSqlTypes = map DT.pack ["int4","int4","int4","text","date","jsonb"]
154
155 -- | SQL query to insert documents inside the database
156 queryInsert :: Query
157 queryInsert = [sql|
158 WITH input_rows(typename,user_id,parent_id,name,date,hyperdata) AS (?)
159 , ins AS (
160 INSERT INTO nodes (typename,user_id,parent_id,name,date,hyperdata)
161 SELECT * FROM input_rows
162 ON CONFLICT ((hyperdata ->> 'uniqIdBdd')) DO NOTHING -- on unique index
163 -- ON CONFLICT (typename, parent_id, (hyperdata ->> 'uniqId')) DO NOTHING -- on unique index
164 RETURNING id,hyperdata
165 )
166
167 SELECT true AS source -- true for 'newly inserted'
168 , id
169 , hyperdata ->> 'uniqId' as doi
170 FROM ins
171 UNION ALL
172 SELECT false AS source -- false for 'not inserted'
173 , c.id
174 , hyperdata ->> 'uniqId' as doi
175 FROM input_rows
176 JOIN nodes c USING (hyperdata); -- columns of unique index
177 |]
178
179 ------------------------------------------------------------------------
180 -- * Main Types used
181
182 -- ** Return Types
183
184 -- | When documents are inserted
185 -- ReturnType after insertion
186 data ReturnId = ReturnId { reInserted :: Bool -- if the document is inserted (True: is new, False: is not new)
187 , reId :: NodeId -- always return the id of the document (even new or not new)
188 -- this is the uniq id in the database
189 , reUniqId :: Text -- Hash Id with concatenation of hash parameters
190 } deriving (Show, Generic)
191
192 instance FromRow ReturnId where
193 fromRow = ReturnId <$> field <*> field <*> field
194
195 ---------------------------------------------------------------------------
196 -- * Uniqueness of document definition
197
198 class AddUniqId a
199 where
200 addUniqId :: a -> a
201
202 instance AddUniqId HyperdataDocument
203 where
204 addUniqId = addUniqIdsDoc
205 where
206 addUniqIdsDoc :: HyperdataDocument -> HyperdataDocument
207 addUniqIdsDoc doc = set hyperdataDocument_uniqIdBdd (Just hashBdd)
208 $ set hyperdataDocument_uniqId (Just hashUni) doc
209 where
210 hashUni = hash $ DT.concat $ map ($ doc) hashParametersDoc
211 hashBdd = hash $ DT.concat $ map ($ doc) ([(\d -> maybeText (_hyperdataDocument_bdd d))] <> hashParametersDoc)
212
213 hashParametersDoc :: [(HyperdataDocument -> Text)]
214 hashParametersDoc = [ \d -> maybeText (_hyperdataDocument_title d)
215 , \d -> maybeText (_hyperdataDocument_abstract d)
216 , \d -> maybeText (_hyperdataDocument_source d)
217 , \d -> maybeText (_hyperdataDocument_publication_date d)
218 ]
219
220 ---------------------------------------------------------------------------
221 -- * Uniqueness of document definition
222 -- TODO factorize with above (use the function below for tests)
223
224 instance AddUniqId HyperdataContact
225 where
226 addUniqId = addUniqIdsContact
227
228 addUniqIdsContact :: HyperdataContact -> HyperdataContact
229 addUniqIdsContact hc = set (hc_uniqIdBdd) (Just hashBdd)
230 $ set (hc_uniqId ) (Just hashUni) hc
231 where
232 hashUni = uniqId $ DT.concat $ map ($ hc) hashParametersContact
233 hashBdd = uniqId $ DT.concat $ map ($ hc) ([\d -> maybeText (view hc_bdd d)] <> hashParametersContact)
234
235 uniqId :: Text -> Text
236 uniqId = DT.pack . SHA.showDigest . SHA.sha256 . DC.pack . DT.unpack
237
238 -- | TODO add more hashparameters
239 hashParametersContact :: [(HyperdataContact -> Text)]
240 hashParametersContact = [ \d -> maybeText $ view (hc_who . _Just . cw_firstName) d
241 , \d -> maybeText $ view (hc_who . _Just . cw_lastName ) d
242 , \d -> maybeText $ view (hc_where . _head . cw_touch . _Just . ct_mail) d
243 ]
244
245
246
247 maybeText :: Maybe Text -> Text
248 maybeText = maybe (DT.pack "") identity
249
250 ---------------------------------------------------------------------------