]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Query/Table/Node/Document/Add.hs
[SECURITY] implemeting password hash
[gargantext.git] / src / Gargantext / Database / Query / Table / Node / Document / Add.hs
1 {-|
2 Module : Gargantext.Database.Node.Document.Add
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 Add Documents/Contact to a Corpus/Annuaire.
11
12 -}
13 ------------------------------------------------------------------------
14 {-# LANGUAGE DeriveDataTypeable #-}
15 {-# LANGUAGE DeriveGeneric #-}
16 {-# LANGUAGE FlexibleContexts #-}
17 {-# LANGUAGE FlexibleInstances #-}
18 {-# LANGUAGE FlexibleInstances #-}
19 {-# LANGUAGE NoImplicitPrelude #-}
20 {-# LANGUAGE OverloadedStrings #-}
21 {-# LANGUAGE QuasiQuotes #-}
22 {-# LANGUAGE RankNTypes #-}
23 {-# LANGUAGE TypeSynonymInstances #-}
24
25 ------------------------------------------------------------------------
26 module Gargantext.Database.Query.Table.Node.Document.Add
27 where
28
29 import Data.ByteString.Internal (ByteString)
30 import Data.Text (Text)
31 import Data.Typeable (Typeable)
32 import Database.PostgreSQL.Simple (Query, Only(..))
33 import Database.PostgreSQL.Simple.SqlQQ
34 import Database.PostgreSQL.Simple.ToField (toField)
35 import Database.PostgreSQL.Simple.ToRow (ToRow(..))
36 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
37 import GHC.Generics (Generic)
38 import Gargantext.Database.Admin.Types.Node
39 import Gargantext.Database.Prelude (Cmd, runPGSQuery, formatPGSQuery)
40 import Gargantext.Prelude
41
42 ---------------------------------------------------------------------------
43
44 add :: ParentId -> [NodeId] -> Cmd err [Only Int]
45 add pId ns = runPGSQuery queryAdd (Only $ Values fields inputData)
46 where
47 fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
48 inputData = prepare pId ns
49
50 add_debug :: ParentId -> [NodeId] -> Cmd err ByteString
51 add_debug pId ns = formatPGSQuery queryAdd (Only $ Values fields inputData)
52 where
53 fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
54 inputData = prepare pId ns
55
56
57 -- | Input Tables: types of the tables
58 inputSqlTypes :: [Text]
59 inputSqlTypes = ["int4","int4","int4"]
60
61 -- | SQL query to add documents
62 -- TODO return id of added documents only
63 queryAdd :: Query
64 queryAdd = [sql|
65 WITH input_rows(node1_id,node2_id,category) AS (?)
66 INSERT INTO nodes_nodes (node1_id, node2_id,category)
67 SELECT * FROM input_rows
68 ON CONFLICT (node1_id, node2_id) DO NOTHING -- on unique index
69 RETURNING 1
70 ;
71 |]
72
73 prepare :: ParentId -> [NodeId] -> [InputData]
74 prepare pId ns = map (\nId -> InputData pId nId) ns
75
76 ------------------------------------------------------------------------
77 -- * Main Types used
78
79 data InputData = InputData { inNode1_id :: NodeId
80 , inNode2_id :: NodeId
81 } deriving (Show, Generic, Typeable)
82
83 instance ToRow InputData where
84 toRow inputData = [ toField (inNode1_id inputData)
85 , toField (inNode2_id inputData)
86 , toField (1 :: Int)
87 ]
88