Merge branch 'dev' into dev-doc-annotation-issue

devops/postgres/schema.sql

@@ -92,10 +92,11 @@ CREATE TABLE public.nodes_nodes (
     node2_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
     score REAL,
     category INTEGER,
-    PRIMARY KEY (node1_id,node2_id)
+    PRIMARY KEY (node1_id, node2_id)
 );
 ALTER TABLE public.nodes_nodes OWNER TO gargantua;
 
+
 ---------------------------------------------------------------
 CREATE TABLE public.node_node_ngrams (
 node1_id   INTEGER NOT NULL REFERENCES public.nodes  (id) ON DELETE CASCADE,
@@ -107,7 +108,6 @@ PRIMARY KEY (node1_id, node2_id, ngrams_id, ngrams_type)
 );
 ALTER TABLE public.node_node_ngrams OWNER TO gargantua;
 
-
 CREATE TABLE public.node_node_ngrams2 (
 node_id         INTEGER NOT NULL REFERENCES public.nodes  (id) ON DELETE CASCADE,
 nodengrams_id   INTEGER NOT NULL REFERENCES public.node_ngrams  (id) ON DELETE CASCADE,

gargantext.ini_toModify

@@ -4,9 +4,18 @@ MASTER_USER = gargantua
 # SECURITY WARNING: keep the secret key used in production secret!
 SECRET_KEY      = PASSWORD_TO_CHANGE
 
+# Frames
 FRAME_WRITE_URL = URL_TO_CHANGE
 FRAME_CALC_URL  = URL_TO_CHANGE
 
+[network]
+# Emails From address (sent by smtp)
+MAIL = username@gargantext.org
+HOST = localhost
+# if remote smtp host
+# HOST_USER     = user
+# HOST_password = password
+
 [database]
 # PostgreSQL access
 DB_HOST = 127.0.0.1
@@ -14,7 +23,8 @@ DB_PORT = 5432
 DB_NAME = gargandbV5
 DB_USER = gargantua
 DB_PASS = PASSWORD_TO_CHANGE
-# Logs
+
+[logs]
 LOG_FILE = /var/log/gargantext/backend.log
 LOG_LEVEL = DEBUG
 LOG_FORMATTER = verbose

package.yaml

@@ -208,6 +208,16 @@ library:
   - servant-xml
   - simple-reflect
   - singletons # (IGraph)
+
+    # for mail
+  - smtp-mail
+  - mime-mail
+
+    # for password generation
+  - cprng-aes
+  - binary
+  - crypto-random
+
   - split
   - stemmer
   - string-conversions

src/Gargantext/API/HashedResponse.hs

@@ -5,7 +5,7 @@ import Data.Swagger
 import Data.Text (Text)
 
 import Gargantext.Prelude
-import qualified Gargantext.Prelude.Utils as Crypto (hash)
+import qualified Gargantext.Core.Crypto.Hash as Crypto (hash)
 import GHC.Generics (Generic)
 
 data HashedResponse a = HashedResponse { hash :: Text, value :: a }

src/Gargantext/API/Ngrams/List.hs

@@ -55,7 +55,6 @@ instance ToJSON a => MimeRender HTML a where
   mimeRender _ = encode
 
 ------------------------------------------------------------------------
-
 get :: RepoCmdM env err m =>
        ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsList)
 get lId = do
@@ -74,7 +73,6 @@ get' lId = fromList
        <$> mapM (getNgramsTableMap lId) ngramsTypes
 
 ------------------------------------------------------------------------
-
 -- TODO : purge list
 post :: FlowCmdM env err m
     => ListId
@@ -88,7 +86,6 @@ post l m  = do
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
-
 type PostAPI = Summary "Update List"
         :> "add"
         :> "form"

src/Gargantext/API/Ngrams/Tools.hs

@@ -67,16 +67,19 @@ getTermsWith f ls ngt lt = Map.fromListWith (<>)
       Nothing -> (f'' t, [])
       Just  r -> (f'' r, map f'' [t])
 
-mapTermListRoot :: [ListId] -> NgramsType
-                -> NgramsRepo -> Map Text (ListType, (Maybe Text))
+mapTermListRoot :: [ListId]
+                -> NgramsType
+                -> NgramsRepo
+                -> Map Text (ListType, (Maybe Text))
 mapTermListRoot nodeIds ngramsType repo =
   Map.fromList [ (t, (_nre_list nre, _nre_root nre))
                | (t, nre) <- Map.toList ngrams
                ]
   where ngrams = listNgramsFromRepo nodeIds ngramsType repo
 
-filterListWithRoot :: ListType -> Map Text (ListType, Maybe Text)
-                      -> Map Text (Maybe RootTerm)
+filterListWithRoot :: ListType
+                   -> Map Text (ListType, Maybe Text)
+                   -> Map Text (Maybe RootTerm)
 filterListWithRoot lt m = Map.fromList
                     $ map (\(t,(_,r)) -> (t,r))
                     $ filter isMapTerm (Map.toList m)

src/Gargantext/API/Node/Contact.hs

+{-|
+Module      : Gargantext.API.Node.Contact
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE ConstraintKinds      #-}
+{-# LANGUAGE KindSignatures       #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+
+module Gargantext.API.Node.Contact
+      where
+
+import Data.Aeson
+import Data.Either (Either(Right))
+import Data.Maybe (Maybe(..))
+import Data.Swagger
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
+import Gargantext.API.Admin.Settings (HasSettings)
+import Gargantext.API.Node
+import Gargantext.API.Node.Corpus.New (AsyncJobs)
+import Gargantext.API.Prelude (GargServer, simuLogs)
+import Gargantext.Core (Lang(..))
+import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Database.Action.Flow (flow)
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAnnuaire(..), HyperdataContact)
+import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Prelude (($), liftBase, (.), printDebug, pure)
+import Gargantext.Text.Terms (TermType(..))
+import Servant
+import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+
+------------------------------------------------------------------------
+type API = "contact" :> Summary "Contact endpoint"
+            :> API_Async
+          :<|> Capture "contact_id" NodeId
+            :> NodeNodeAPI HyperdataContact
+
+
+api :: UserId -> CorpusId -> GargServer API
+api uid cid =  (api_async   (RootId (NodeId uid)) cid)
+          :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid cid)
+
+type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
+------------------------------------------------------------------------
+data AddContactParams = AddContactParams         { firstname :: !Text, lastname :: !Text }
+                      | AddContactParamsAdvanced { firstname :: !Text
+                                                 , lastname  :: !Text
+                                                 -- TODO add others fields
+                                                 }
+    deriving (Generic)
+
+----------------------------------------------------------------------
+api_async :: User -> NodeId -> GargServer API_Async
+api_async u nId =
+  serveJobsAPI $
+    JobFunction (\p log ->
+      let
+        log' x = do
+          printDebug "addContact" x
+          liftBase $ log x
+      in addContact u nId p (liftBase . log')
+      )
+
+addContact :: (HasSettings env, FlowCmdM env err m)
+    => User
+    -> NodeId
+    -> AddContactParams
+    -> (JobLog -> m ())
+    -> m JobLog
+addContact u nId (AddContactParams fn ln) logStatus = do
+
+  logStatus JobLog { _scst_succeeded = Just 1
+                   , _scst_failed    = Just 0
+                   , _scst_remaining = Just 1
+                   , _scst_events    = Just []
+                   }
+  _ <- flow (Nothing :: Maybe HyperdataAnnuaire) u (Right [nId]) (Multi EN) [[hyperdataContact fn ln]]
+
+  pure  JobLog { _scst_succeeded = Just 2
+               , _scst_failed    = Just 0
+               , _scst_remaining = Just 0
+               , _scst_events    = Just []
+               }
+
+
+addContact _uId _nId _p logStatus = do
+  simuLogs logStatus 10
+
+------------------------------------------------------------------------
+-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
+instance FromJSON  AddContactParams where
+  parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+
+instance ToJSON    AddContactParams where
+  toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
+  
+instance ToSchema  AddContactParams
+instance Arbitrary AddContactParams where
+  arbitrary = elements [AddContactParams "Pierre" "Dupont"]
+
+------------------------------------------------------------------------

src/Gargantext/API/Node/Corpus/Annuaire.hs

@@ -74,30 +74,11 @@ addToAnnuaireWithForm _cid (AnnuaireWithForm ft _d _l) logStatus = do
 
   printDebug "ft" ft
 
-  -- let
-    -- parse = case ft of
-    --   CSV_HAL   -> Parser.parseFormat Parser.CsvHal
-    --   CSV       -> Parser.parseFormat Parser.CsvGargV3
-    --   WOS       -> Parser.parseFormat Parser.WOS
-    --   PresseRIS -> Parser.parseFormat Parser.RisPresse
-
-  -- docs <- liftBase
-  --       $ splitEvery 500
-  --      <$> take 1000000
-  --      <$> parse (cs d)
-
   logStatus JobLog { _scst_succeeded = Just 1
                           , _scst_failed    = Just 0
                           , _scst_remaining = Just 1
                           , _scst_events    = Just []
                           }
-  -- cid' <- flowCorpus "user1"
-  --                    (Right [cid])
-  --                    (Multi $ fromMaybe EN l)
-  --                    (map (map toHyperdataDocument) docs)
-
-  -- printDebug "cid'" cid'
-
   pure      JobLog { _scst_succeeded = Just 2
                           , _scst_failed    = Just 0
                           , _scst_remaining = Just 0

src/Gargantext/API/Node/Corpus/Export.hs

@@ -19,22 +19,19 @@ Main exports of Gargantext:
 module Gargantext.API.Node.Corpus.Export
   where
 
+
 import Data.Aeson.TH (deriveJSON)
-import qualified Data.List as List
-import qualified Data.Map as Map
 import Data.Map (Map)
 import Data.Maybe (fromMaybe)
 import Data.Set (Set)
-import qualified Data.Set as Set
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Servant
-
 import Gargantext.API.Ngrams
 import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo)
 import Gargantext.API.Prelude (GargNoServer)
-import Gargantext.Core.Types --
+import Gargantext.Core.Crypto.Hash (hash)
+import Gargantext.Core.Types
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Metrics.NgramsByNode (getNgramsByNodeOnlyUser)
 import Gargantext.Database.Admin.Config (userMaster)
@@ -42,13 +39,16 @@ import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
 import Gargantext.Database.Admin.Types.Node (Node, NodeId, ListId, CorpusId)
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
 import Gargantext.Database.Query.Table.NodeNode (selectDocNodes)
-import Gargantext.Database.Schema.Node (_node_id, _node_hyperdata)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
+import Gargantext.Database.Schema.Node (_node_id, _node_hyperdata)
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils (hash)
+import Servant
+import qualified Data.List as List
+import qualified Data.Map as Map
+import qualified Data.Set as Set
 
 
 -- Corpus Export

src/Gargantext/API/Node/Corpus/New.hs

@@ -213,12 +213,12 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
                           , _scst_remaining = Just 5
                           , _scst_events    = Just []
                           }
-  printDebug "addToCorpusWithQuery" cid
+  printDebug "addToCorpusWithQuery" (cid, dbs)
   -- TODO add cid
   -- TODO if cid is folder -> create Corpus
   --      if cid is corpus -> add to corpus
   --      if cid is root   -> create corpus in Private
-  txts <- mapM (\db  -> getDataText db     (Multi l) q (Just 10000)) [database2origin dbs]
+  txts <- mapM (\db  -> getDataText db     (Multi l) q Nothing) [database2origin dbs]
 
   logStatus JobLog { _scst_succeeded = Just 2
                           , _scst_failed    = Just 0

src/Gargantext/API/Node/Corpus/New/File.hs

@@ -30,7 +30,7 @@ import Gargantext.API.Ngrams (TODO)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude -- (Cmd, CmdM)
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils (hash)
+import Gargantext.Core.Crypto.Hash (hash)
 import Servant
 import Servant.Multipart
 import Servant.Swagger (HasSwagger(toSwagger))

src/Gargantext/API/Node/Update.hs

@@ -41,10 +41,10 @@ type API = Summary " Update node according to NodeType params"
          :> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
 
 ------------------------------------------------------------------------
-data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: Method      }
-                      | UpdateNodeParamsGraph { methodGraph :: GraphMetric }
-                      | UpdateNodeParamsTexts { methodTexts :: Granularity }
-                      | UpdateNodeParamsBoard { methodBoard :: Charts      }
+data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: !Method      }
+                      | UpdateNodeParamsGraph { methodGraph :: !GraphMetric }
+                      | UpdateNodeParamsTexts { methodTexts :: !Granularity }
+                      | UpdateNodeParamsBoard { methodBoard :: !Charts      }
     deriving (Generic)
 
 ----------------------------------------------------------------------

src/Gargantext/API/Routes.hs

@@ -7,7 +7,6 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-
 -}
 
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
@@ -51,7 +50,7 @@ import qualified Gargantext.API.Node.Corpus.Annuaire  as Annuaire
 import qualified Gargantext.API.Node.Corpus.Export    as Export
 import qualified Gargantext.API.Node.Corpus.New       as New
 import qualified Gargantext.API.Public                as Public
-
+import qualified Gargantext.API.Node.Contact          as Contact
 
 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
 -- | TODO          :<|> Summary "Latest API" :> GargAPI'
@@ -116,9 +115,7 @@ type GargPrivateAPI' =
 
            :<|> "annuaire" :> Summary "Contact endpoint"
                            :> Capture "annuaire_id" NodeId
-                           :> "contact"
-                           :> Capture "contact_id" NodeId
-                           :> NodeNodeAPI HyperdataContact
+                           :> Contact.API
 
            -- Document endpoint
            :<|> "document" :> Summary "Document endpoint"
@@ -208,7 +205,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
      :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny)      uid
      :<|> Export.getCorpus   -- uid
      :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) uid
-     :<|> nodeNodeAPI (Proxy :: Proxy HyperdataContact)  uid
+     :<|> Contact.api uid
 
      :<|> withAccess  (Proxy :: Proxy TableNgramsApi) Proxy uid
           <$> PathNode <*> apiNgramsTableDoc
@@ -246,7 +243,6 @@ waitAPI n = do
   pure $ "Waited: " <> (cs $ show n)
 ----------------------------------------
 
-
 addCorpusWithQuery :: User -> GargServer New.AddWithQuery
 addCorpusWithQuery user cid =
   serveJobsAPI $

src/Gargantext/API/Search.hs

@@ -28,7 +28,7 @@ import Gargantext.API.Prelude (GargServer)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Query.Facet
 import Gargantext.Database.Action.Search
-import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument)
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude
 import Servant
@@ -60,7 +60,7 @@ instance ToSchema SearchDocResults where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sdr_")
 
 data SearchPairedResults =
-     SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]] }
+     SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataContact Int] }
   deriving (Generic)
 $(deriveJSON (unPrefix "spr_") ''SearchPairedResults)
 
@@ -89,12 +89,12 @@ searchDocs nId (SearchQuery q) o l order =
 -----------------------------------------------------------------------
 type SearchPairsAPI = Summary ""
                     :> "list"
-                    :> Capture "list" ListId
+                    :> Capture "annuaire" AnnuaireId
                     :> SearchAPI SearchPairedResults
 searchPairs :: NodeId -> GargServer SearchPairsAPI
 
-searchPairs pId lId (SearchQuery q) o l order =
-  SearchPairedResults <$> searchInCorpusWithContacts pId lId q o l order
+searchPairs pId aId (SearchQuery q) o l order =
+  SearchPairedResults <$> searchInCorpusWithContacts pId aId q o l order
 
 -----------------------------------------------------------------------
 

src/Gargantext/Core/Crypto/Hash.hs

+{-|
+Module      : Gargantext.Core.Crypto.Hash
+Description : Useful Tools near Prelude of the project
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# OPTIONS_GHC -fno-warn-orphans   #-}
+
+module Gargantext.Core.Crypto.Hash
+  where
+
+import Prelude (String)
+import Data.Set (Set)
+import Data.List (foldl)
+import Data.Text (Text)
+import Gargantext.Prelude
+import qualified Data.ByteString.Lazy.Char8  as Char
+import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
+import qualified Data.Set                    as Set
+import qualified Data.Text                   as Text
+
+--------------------------------------------------------------------------
+-- | Use this datatype to keep traceability of hashes
+-- TODO use newtype
+type Hash = Text
+
+-- | Class to make hashes
+class IsHashable a where
+  hash :: a -> Hash
+
+-- | Main API to hash text
+-- using sha256 for now
+instance IsHashable Char.ByteString where
+  hash = Text.pack
+        . SHA.showDigest
+        . SHA.sha256
+
+instance {-# OVERLAPPING #-} IsHashable String where
+  hash = hash . Char.pack
+
+instance IsHashable Text where
+  hash = hash . Text.unpack
+
+instance IsHashable (Set Hash) where
+  hash = hash . foldl (<>) "" . Set.toList
+
+instance {-# OVERLAPPABLE #-} IsHashable a => IsHashable [a] where
+  hash = hash . Set.fromList . map hash
+

src/Gargantext/Core/Crypto/Pass.hs

+{-|
+Module      : Gargantext.Core.Crypto.Pass
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : Public Domain
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+To avoid weak password, just offer an easy way to make "good" one and
+let user add his own entropy.
+
+Thanks to 
+https://zuttobenkyou.wordpress.com/2011/12/23/simple-password-generation-with-haskell/
+
+-}
+
+
+module Gargantext.Core.Crypto.Pass
+      where
+
+-- import Data.List (nub)
+-- import System.Environment (getArgs)
+-- import System.IO (hSetEcho)
+import Control.Monad.State
+import Crypto.Random (cprgGenerate)
+import Crypto.Random.AESCtr
+import Data.Binary (decode)
+import Prelude
+import qualified Data.ByteString.Lazy as B
+
+
+keysChar, keysNum, keysPunc, keysCharNum, keysAll, keysHex :: String
+keysChar = ['a'..'z'] ++ ['A'..'Z']
+keysHex = ['a'..'f']
+keysNum = ['0'..'9']
+keysPunc = "`~!@#$%^&*()-_=+[{]}\\|;:'\",<.>/? "
+keysCharNum = keysChar ++ keysNum
+keysAll = keysChar ++ keysNum ++ keysPunc
+ 
+giveKey ::  String -> Char -> Int -> Char
+giveKey keysCustom c n = extractChar $ case c of
+    'i'  -> (keysNum ++ keysHex)
+    'j'  -> keysNum
+    'k'  -> keysChar
+    'l'  -> keysCharNum
+    ';'  -> keysPunc
+    'h'  -> (keysCharNum ++ keysCustom)
+    '\n' -> ['\n']
+    _    -> keysAll
+    where
+    extractChar xs = xs!!mod n (length xs)
+ 
+showRandomKey :: Int -> String -> StateT AESRNG IO ()
+showRandomKey len keysCustom = handleKey =<< liftIO getChar
+    where
+    handleKey key = case key of
+        '\n' -> liftIO (putChar '\n') >> showRandomKey len keysCustom
+        'q' -> (liftIO $ putStrLn "\nBye!") >> return ()
+        _ -> mapM_ f [0..len] >> (liftIO $ putStrLn []) >> showRandomKey len keysCustom
+        where
+        f _ = liftIO
+            . putChar
+            . giveKey keysCustom key
+            . (\n -> mod n (length (keysAll ++ keysCustom) - 1))
+            =<< aesRandomInt
+ 
+aesRandomInt :: StateT AESRNG IO Int
+aesRandomInt = do
+    aesState <- get
+    -- aesState <- liftIO makeSystem
+    -- let aesState = 128
+    let (bs, aesState') = cprgGenerate 64 aesState
+    put aesState'
+    return (decode $ B.fromChunks [bs])
+
+gargPass :: IO (Int, AESRNG)
+gargPass = do
+  -- let as = ["alphanumeric","punctuation"]
+  -- let as' = filter (\c -> elem c keysAll) . nub $ unwords as
+  aesState <- makeSystem -- gather entropy from the system to use as the initial seed
+  --_ <- runStateT (showRandomKey len as') aesState -- enter loop
+  -- return ()
+  pass <- runStateT aesRandomInt aesState -- enter loop
+  pure pass
+
+{- 
+main :: IO ()
+main = do
+    hSetBuffering stdin NoBuffering  -- disable buffering from STDIN
+    hSetBuffering stdout NoBuffering -- disable buffering from STDOUT
+    hSetEcho stdin False             -- disable terminal echo
+    as <- getArgs
+    let as' = filter (\c -> elem c keysAll) . nub $ unwords as
+    mapM_ putStrLn
+        [ []
+        , "poke: 'q'     quit"
+        , "      'j'     number"
+        , "      'k'     letter"
+        , "      'l'     alphanumeric"
+        , "      ';'     punctuation"
+        , "      'h'     alphanumeric" ++ (if null as' then [] else " + " ++ as')
+        , "      'i'     hexadecimal"
+        , "      'ENTER' newline"
+        , "      else    any"
+        , []
+        ]
+    aesState <- makeSystem -- gather entropy from the system to use as the initial seed
+    _ <- runStateT (showRandomKey as') aesState -- enter loop
+    return ()
+-}

src/Gargantext/Core/Mail.hs

+{-|
+Module      : Gargantext.Core.Mail
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Gargantext.Core.Mail
+  (gargMail)
+  where
+
+import Data.Maybe
+import Network.Mail.SMTP hiding (htmlPart)
+import Gargantext.Prelude
+import Network.Mail.Mime (plainPart)
+
+
+-- | TODO add parameters
+gargMail :: IO ()
+gargMail = sendMail "localhost" mail
+  where
+    mail = simpleMail from to cc bcc subject [body]
+
+    from       = Address (Just "François Rabelais") "francois.rabelais@gargantext.org"
+    to         = [Address (Just "Anoe") "alexandre@localhost"]
+    cc         = []
+    bcc        = []
+    subject    = "email subject"
+    body       = plainPart "email body"
+
+

src/Gargantext/Database.hs

@@ -16,12 +16,40 @@ Gargantext's database.
 
 
 module Gargantext.Database ( module Gargantext.Database.Prelude
+                           , module Gargantext.Database.Schema.NodeNode
+                           , insertDB
                         -- , module Gargantext.Database.Bashql
                            )
     where
 
-import Gargantext.Database.Prelude (connectGargandb)
--- import Gargantext.Database.Bashql
+import Gargantext.Prelude
+import Gargantext.Database.Prelude -- (connectGargandb)
 
+-- import Gargantext.Database.Schema.Node
+-- import Gargantext.Database.Query.Table.Node
 
+import Gargantext.Database.Schema.NodeNode -- (NodeNode(..))
+import Gargantext.Database.Query.Table.NodeNode
 
+
+class InsertDB a where
+  insertDB :: a -> Cmd err Int
+
+{-
+class DeleteDB a where
+  deleteDB :: a -> Cmd err Int
+-}
+
+instance InsertDB [NodeNode] where
+  insertDB = insertNodeNode
+
+
+{-
+instance InsertDB [Node a] where
+  insertDB = insertNodes'
+
+instance InsertDB [NodeNodeNgram] where
+  insertDB = ...
+
+
+-}

src/Gargantext/Database/Action/Flow.hs

@@ -27,6 +27,7 @@ module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
   ( FlowCmdM
   , getDataText
   , flowDataText
+  , flow
 
   , flowCorpusFile
   , flowCorpus
@@ -68,7 +69,7 @@ import Gargantext.Database.Action.Flow.Utils (insertDocNgrams)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
 import Gargantext.Database.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
-import Gargantext.Database.Action.Search (searchInDatabase)
+import Gargantext.Database.Action.Search (searchDocInDatabase)
 import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Admin.Types.Hyperdata
@@ -106,11 +107,9 @@ allDataOrigins = map InternalOrigin API.externalAPIs
               <> map ExternalOrigin API.externalAPIs
 
 ---------------
-
 data DataText = DataOld ![NodeId]
               | DataNew ![[HyperdataDocument]]
 
-
 -- TODO use the split parameter in config file
 getDataText :: FlowCmdM env err m
             => DataOrigin
@@ -126,7 +125,7 @@ getDataText (InternalOrigin _) _la q _li = do
                                            (UserName userMaster)
                                            (Left "")
                                            (Nothing :: Maybe HyperdataCorpus)
-  ids <-  map fst <$> searchInDatabase cId (stemIt q)
+  ids <-  map fst <$> searchDocInDatabase cId (stemIt q)
   pure $ DataOld ids
 
 -------------------------------------------------------------------------------

src/Gargantext/Database/Action/Flow/Pairing.hs

@@ -9,130 +9,177 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE QuasiQuotes       #-}
--- {-# LANGUAGE Arrows #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE Arrows      #-}
 
 module Gargantext.Database.Action.Flow.Pairing
-  (pairing)
+  -- (pairing)
     where
 
 import Control.Lens (_Just, (^.))
-import Data.Map (Map, fromList)
-import Data.Maybe (catMaybes)
-import Data.Text (Text, toLower)
-import Database.PostgreSQL.Simple.SqlQQ (sql)
-import Gargantext.Core.Types (TableResult(..))
-import Gargantext.Database.Action.Flow.Utils
-import Gargantext.Database.Admin.Types.Node (AnnuaireId, CorpusId, ListId{-, DocId, ContactId-})
-import Gargantext.Database.Prelude (Cmd, runPGSQuery)
-import Gargantext.Database.Query.Table.Node.Children (getAllContacts)
+import Data.Map (Map, fromList, fromListWith)
+import Data.Maybe (catMaybes, fromMaybe)
+import Data.Set (Set)
+import Data.Text (Text)
+import Gargantext.API.Ngrams.Tools
+import Gargantext.API.Prelude (GargNoServer)
+import Gargantext.Core.Types (TableResult(..), Term)
+import Gargantext.Core.Types.Main
+import Gargantext.Database
+import Gargantext.Database.Action.Metrics.NgramsByNode (getNodesByNgramsOnlyUser)
+import Gargantext.Database.Admin.Config
+import Gargantext.Database.Admin.Config (nodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata -- (HyperdataContact(..))
+import Gargantext.Database.Admin.Types.Node -- (AnnuaireId, CorpusId, ListId, DocId, ContactId, NodeId)
+import Gargantext.Database.Prelude (Cmd, runOpaQuery)
+import Gargantext.Database.Query.Prelude (leftJoin2, returnA, queryNodeNodeTable)
+import Gargantext.Database.Query.Table.Node.Children (getAllContacts)
+import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
 import Gargantext.Database.Schema.Ngrams -- (NgramsType(..))
+import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (sum)
+import Opaleye
 import Safe (lastMay)
-import qualified Data.Map  as DM
+import qualified Data.List as List
+import qualified Data.Map  as Map
+import qualified Data.Set  as Set
 import qualified Data.Text as DT
 
--- TODO mv this type in Types Main
-type Terms = Text
 
-{-
-pairing'' :: (CorpusId, CorpusId) -> (DocId -> DocId)
-pairing'' = undefined
-
-pairing' :: (CorpusId, AnnuaireId) -> (DocId -> ContactId)
-pairing' = undefined
--}
-
--- | TODO : add paring policy as parameter
-pairing :: CorpusId   -- (CorpusId,   ListId) -- Pair (Either CorpusId AnnuaireId) ListId
-        -> AnnuaireId -- (AnnuaireId, ListId) -- Pair (Either CorpusId AnnuaireId) ListId
-        -> ListId
-        -> Cmd err Int
-pairing cId aId lId = do
-  contacts' <- getAllContacts aId
-  let contactsMap = pairingPolicyToMap toLower
-                  $ toMaps extractNgramsT (tr_docs contacts')
+-- | isPairedWith
+-- All NodeAnnuaire paired with a Corpus of NodeId nId:
+-- isPairedWith NodeAnnuaire corpusId
+isPairedWith :: NodeType -> NodeId -> Cmd err [NodeId]
+isPairedWith nt nId = runOpaQuery (selectQuery nt nId)
+  where
+    selectQuery :: NodeType -> NodeId -> Query (Column PGInt4)
+    selectQuery nt' nId' = proc () -> do
+      (node, node_node) <- queryJoin -< ()
+      restrict -< (node^.node_typename)    .== (pgInt4 $ nodeTypeId nt')
+      restrict -< (node_node^.nn_node1_id) .== (toNullable $ pgNodeId nId')
+      returnA  -<  node^.node_id
+
+    queryJoin :: Query (NodeRead, NodeNodeReadNull)
+    queryJoin = leftJoin2 queryNodeTable queryNodeNodeTable cond
+      where
+        cond (node, node_node) = node^.node_id .== node_node^. nn_node2_id
 
-  ngramsMap' <- getNgramsTindexed cId Authors
-  let ngramsMap = pairingPolicyToMap lastName ngramsMap'
 
-  let indexedNgrams = pairMaps contactsMap ngramsMap
 
-  insertDocNgrams lId indexedNgrams
 
-lastName :: Terms -> Terms
-lastName texte = DT.toLower
-               $ maybe texte (\x -> if DT.length x > 3 then x else texte) (lastName' texte)
+-----------------------------------------------------------------------
+pairing :: AnnuaireId -> CorpusId -> ListId -> GargNoServer Int
+pairing a c l = do
+  dataPaired <- dataPairing a (c,l,Authors) takeName takeName
+  insertDB $ prepareInsert dataPaired
+
+
+dataPairing :: AnnuaireId
+             -> (CorpusId, ListId, NgramsType)
+             -> (ContactName -> Projected)
+             -> (DocAuthor   -> Projected)
+             -> GargNoServer (Map ContactId (Set DocId))
+dataPairing aId (cId, lId, ngt) fc fa = do
+  mc <- getNgramsContactId aId
+  md <- getNgramsDocId cId lId ngt
+
+  printDebug "ngramsContactId" mc
+  printDebug "ngramsDocId"     md
+  let
+    from = projectionFrom (Set.fromList $ Map.keys mc) fc
+    to   = projectionTo   (Set.fromList $ Map.keys md) fa
+
+  pure $ fusion mc $ align from to md
+
+
+
+prepareInsert :: Map ContactId (Set DocId) -> [NodeNode]
+prepareInsert m =  map (\(n1,n2) -> NodeNode n1 n2 Nothing Nothing)
+                $ List.concat
+                $ map (\(contactId, setDocIds)
+                        -> map (\setDocId
+                                 -> (contactId, setDocId)
+                               ) $ Set.toList setDocIds
+                       )
+                $ Map.toList m
+
+------------------------------------------------------------------------
+type ContactName = Text
+type DocAuthor   = Text
+type Projected   = Text
+
+projectionFrom :: Set ContactName -> (ContactName -> Projected) -> Map ContactName Projected
+projectionFrom ss f = fromList $ map (\s -> (s, f s)) (Set.toList ss)
+
+projectionTo :: Set DocAuthor -> (DocAuthor -> Projected) -> Map Projected (Set DocAuthor)
+projectionTo ss f = fromListWith (<>) $ map (\s -> (f s, Set.singleton s)) (Set.toList ss)
+------------------------------------------------------------------------
+takeName :: Term -> Term
+takeName texte = DT.toLower texte'
   where
+    texte' = maybe texte (\x -> if DT.length x > 3 then x else texte)
+                           (lastName' texte)
     lastName' = lastMay . DT.splitOn " "
 
--- TODO: this method is dangerous (maybe equalities of the result are
--- not taken into account emergency demo plan...)
-pairingPolicyToMap :: (Terms -> Terms)
-                   -> Map (NgramsT Ngrams) a
-                   -> Map (NgramsT Ngrams) a
-pairingPolicyToMap f = DM.mapKeys (pairingPolicy f)
-
-pairingPolicy :: (Terms -> Terms)
-              -> NgramsT Ngrams
-              -> NgramsT Ngrams
-pairingPolicy f (NgramsT nt (Ngrams ng _)) = (NgramsT nt (Ngrams (f ng) 1))
-
--- | TODO : use Occurrences in place of Int
-extractNgramsT :: HyperdataContact
-               -> Map (NgramsT Ngrams) Int
-extractNgramsT contact = fromList [(NgramsT Authors    a' , 1)| a' <- authors    ]
-  where
-    authors    = map text2ngrams
-               $ catMaybes [ contact^.(hc_who . _Just . cw_lastName) ]
-
 
-pairMaps :: Map (NgramsT Ngrams) a
-         -> Map (NgramsT Ngrams) NgramsId
-         -> Map NgramsIndexed (Map NgramsType a)
-pairMaps m1 m2 =
-  DM.fromList
-    [ (NgramsIndexed ng nId, DM.singleton nt n2i)
-    | (k@(NgramsT nt ng),n2i) <- DM.toList m1
-    , Just nId <- [DM.lookup k m2]
-    ]
-
------------------------------------------------------------------------
-getNgramsTindexed :: CorpusId
-                  -> NgramsType
-                  -> Cmd err (Map (NgramsT Ngrams) NgramsId)
-getNgramsTindexed corpusId ngramsType' = fromList
-    <$> map (\(ngramsId',t,n) -> (NgramsT ngramsType' (Ngrams t n),ngramsId'))
-    <$> selectNgramsTindexed corpusId ngramsType'
+------------------------------------------------------------------------
+align :: Map ContactName Projected
+      -> Map Projected (Set DocAuthor)
+      -> Map DocAuthor (Set DocId)
+      -> Map ContactName (Set DocId)
+align mc ma md = fromListWith (<>)
+               $ map (\c -> (c, getProjection md $ testProjection c mc ma))
+               $ Map.keys mc
   where
-    selectNgramsTindexed :: CorpusId
-                         -> NgramsType
-                         -> Cmd err [(NgramsId, Terms, Int)]
-    selectNgramsTindexed corpusId' ngramsType'' = runPGSQuery selectQuery (corpusId', ngramsTypeId ngramsType'')
-      where
-        selectQuery = [sql| SELECT n.id,n.terms,n.n from ngrams n
-                      JOIN node_node_ngrams occ ON occ.ngrams_id = n.id
-                      -- JOIN node_node_ngrams2 occ ON occ.ngrams_id = n.id
-                      JOIN nodes_nodes      nn  ON nn.node2_id   = occ.node2_id
-
-                      WHERE nn.node1_id     = ?
-                        AND occ.ngrams_type = ?
-                        AND occ.node2_id = nn.node2_id
-                      GROUP BY n.id;
-                     |]
-
-{- | TODO more typed SQL queries
-selectNgramsTindexed :: CorpusId -> NgramsType -> Query NgramsRead
-selectNgramsTindexed corpusId ngramsType = proc () -> do
-    nodeNode   <- queryNodeNodeTable     -< ()
-    nodeNgrams <- queryNodesNgramsTable  -< ()
-    ngrams     <- queryNgramsTable       -< ()
-
-    restrict -< node1_id nodeNode .== pgInt4 corpusId
-    restrict -< node2_id nodeNode .== node_id nodeNgrams
-    restrict -< ngrams_id ngrams  .== node_ngrams nodeNgrams
-
-    result <- aggregate groupBy (ngrams_id ngrams)
-    returnA -< result
---}
+    getProjection :: Map DocAuthor (Set DocId) -> Set DocAuthor -> Set DocId
+    getProjection ma' sa' =
+      if Set.null sa'
+         then Set.empty
+         else Set.unions $ sets ma' sa'
+           where
+             sets ma'' sa'' = Set.map (\s -> lookup s ma'') sa''
+             lookup s' ma''= fromMaybe Set.empty (Map.lookup s' ma'')
+
+    testProjection :: ContactName
+                   -> Map ContactName Projected
+                   -> Map Projected (Set DocAuthor)
+                   -> Set DocAuthor
+    testProjection cn' mc' ma' = case Map.lookup cn' mc' of
+      Nothing -> Set.empty
+      Just  c -> case Map.lookup c ma' of
+        Nothing -> Set.empty
+        Just  a -> a
+
+fusion :: Map ContactName (Set ContactId)
+       -> Map ContactName (Set DocId)
+       -> Map ContactId   (Set DocId)
+fusion mc md = Map.fromListWith (<>)
+             $ catMaybes
+             $ [ (,) <$> Just cId <*> Map.lookup cn md
+                      | (cn, setContactId) <- Map.toList mc
+                      , cId <- Set.toList setContactId
+               ]
+------------------------------------------------------------------------
+
+getNgramsContactId :: AnnuaireId
+                   -> Cmd err (Map ContactName (Set NodeId))
+getNgramsContactId aId = do
+  contacts <- getAllContacts aId
+  pure $ fromListWith (<>)
+       $ catMaybes
+       $ map (\contact -> (,) <$> contact^.(node_hyperdata . hc_who . _Just . cw_lastName)
+                              <*> Just ( Set.singleton (contact^.node_id))
+              ) (tr_docs contacts)
+
+
+getNgramsDocId :: CorpusId
+                -> ListId
+                -> NgramsType
+                -> GargNoServer (Map DocAuthor (Set NodeId))
+getNgramsDocId cId lId nt = do
+  repo <- getRepo
+  lIds <- selectNodesWithUsername NodeList userMaster
+  let ngs = filterListWithRoot MapTerm $ mapTermListRoot [lId] nt repo
+
+  groupNodesByNgrams ngs
+    <$> getNodesByNgramsOnlyUser cId (lIds <> [lId]) nt (Map.keys ngs)

src/Gargantext/Database/Action/Learn.hs

@@ -34,9 +34,9 @@ data FavOrTrash = IsFav | IsTrash
 
 moreLike :: CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
          -> FavOrTrash -> Cmd err [FacetDoc]
-moreLike cId o l order ft = do
+moreLike cId o _l order ft = do
   priors <- getPriors ft cId
-  moreLikeWith cId o l order ft priors
+  moreLikeWith cId o (Just 3) order ft priors
 
 ---------------------------------------------------------------------------
 getPriors :: FavOrTrash -> CorpusId -> Cmd err (Events Bool)

src/Gargantext/Database/Action/Node.hs

@@ -28,7 +28,7 @@ import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils (hash)
+import Gargantext.Core.Crypto.Hash (hash)
 import Gargantext.Database.Prelude
 import Control.Lens (view)
 import Gargantext.Config (GargConfig(..))

src/Gargantext/Database/Action/Search.hs

@@ -15,41 +15,39 @@ module Gargantext.Database.Action.Search where
 import Control.Arrow (returnA)
 import Control.Lens ((^.))
 import Data.Aeson
-import Data.List (intersperse, take, drop)
-import Data.Map.Strict hiding (map, drop, take)
+import Data.List (intersperse)
 import Data.Maybe
 import Data.String (IsString(..))
 import Data.Text (Text, words, unpack, intercalate)
 import Data.Time (UTCTime)
 import Database.PostgreSQL.Simple (Query)
 import Database.PostgreSQL.Simple.ToField
-import Opaleye hiding (Query, Order)
-import qualified Opaleye as O hiding (Order)
-
 import Gargantext.Core.Types
 import Gargantext.Database.Admin.Config (nodeTypeId)
-import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..), HyperdataContact(..))
 import Gargantext.Database.Admin.Types.Node (NodeType(..))
+import Gargantext.Database.Prelude (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery)
 import Gargantext.Database.Query.Facet
-import Gargantext.Database.Query.Join (leftJoin6)
+import Gargantext.Database.Query.Filter
+import Gargantext.Database.Query.Join (leftJoin5)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.NodeNode
-import Gargantext.Database.Query.Table.NodeNodeNgrams
-import Gargantext.Database.Query.Table.Ngrams
-import Gargantext.Database.Prelude (Cmd, runPGSQuery, runOpaQuery, runCountOpaQuery)
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
 import Gargantext.Text.Terms.Mono.Stem.En (stemIt)
+import Opaleye hiding (Query, Order)
+import Data.Profunctor.Product (p4)
+import qualified Opaleye as O hiding (Order)
 
 ------------------------------------------------------------------------
-searchInDatabase :: ParentId
+searchDocInDatabase :: ParentId
                  -> Text
                  -> Cmd err [(NodeId, HyperdataDocument)]
-searchInDatabase p t = runOpaQuery (queryInDatabase p t)
+searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
   where
     -- | Global search query where ParentId is Master Node Corpus Id 
-    queryInDatabase :: ParentId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
-    queryInDatabase _ q = proc () -> do
+    queryDocInDatabase :: ParentId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
+    queryDocInDatabase _ q = proc () -> do
         row <- queryNodeSearchTable -< ()
         restrict -< (_ns_search row)    @@ (pgTSQuery (unpack q))
         restrict -< (_ns_typename row) .== (pgInt4 $ nodeTypeId NodeDocument)
@@ -105,131 +103,134 @@ joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
     cond (n, nn) = nn^.nn_node2_id .== _ns_id n
 
 ------------------------------------------------------------------------
-type AuthorName = Text
-
--- | TODO Optim: Offset and Limit in the Query
--- TODO-SECURITY check
 searchInCorpusWithContacts
   :: CorpusId
-  -> ListId
+  -> AnnuaireId
   -> [Text]
   -> Maybe Offset
   -> Maybe Limit
   -> Maybe OrderBy
-  -> Cmd err [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]]
-searchInCorpusWithContacts cId lId q o l order =
-      take (maybe 10 identity l)
-  <$> drop (maybe 0 identity o)
-  <$> map (\((i,u,h,s), ps) -> FacetPaired i u h s ps)
-  <$> toList <$> fromListWith (<>)
-  <$> map (\(FacetPaired i u h s (p1,p2)) -> ( (i,u,h,s)
-                                             , catMaybes [Pair <$> p1 <*> p2]
-                                             )
-          )
-  <$> searchInCorpusWithContacts' cId lId q o l order
-
--- TODO-SECURITY check
-searchInCorpusWithContacts'
-  :: CorpusId
-  -> ListId
-  -> [Text]
-  -> Maybe Offset
-  -> Maybe Limit
-  -> Maybe OrderBy
-  -> Cmd err [(FacetPaired Int UTCTime HyperdataDocument Int (Maybe Int, Maybe Text))]
-searchInCorpusWithContacts' cId lId q o l order =
-  runOpaQuery $ queryInCorpusWithContacts cId lId o l order
+  -> Cmd err [FacetPaired Int UTCTime HyperdataContact Int]
+searchInCorpusWithContacts cId aId q o l _order =
+  runOpaQuery $ limit'   l
+              $ offset'  o
+              $ orderBy ( desc _fp_score)
+              $ group cId aId
               $ intercalate " | "
               $ map stemIt q
 
+-- TODO group by
+selectContactViaDoc
+  :: CorpusId
+  -> AnnuaireId
+  -> Text
+  -> Select FacetPairedReadNull
+selectContactViaDoc cId aId q = proc () -> do
+  (doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
+  restrict -< (doc^.ns_search)           @@ (pgTSQuery  $ unpack q  )
+  restrict -< (doc^.ns_typename)        .== (pgInt4 $ nodeTypeId NodeDocument)
+  restrict -< (corpus_doc^.nn_node1_id)  .== (toNullable $ pgNodeId cId)
+  restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId)
+  restrict -< (contact^.node_typename)        .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
+  returnA  -< FacetPaired (contact^.node_id)
+                          (contact^.node_date)
+                          (contact^.node_hyperdata)
+                          (toNullable $ pgInt4 1)
+
 
-queryInCorpusWithContacts
+selectContactViaDoc'
   :: CorpusId
-  -> ListId
-  -> Maybe Offset
-  -> Maybe Limit
-  -> Maybe OrderBy
+  -> AnnuaireId
   -> Text
-  -> O.Query FacetPairedRead
-queryInCorpusWithContacts cId _lId _ _ _ q = proc () -> do
-  (n, (nn, (_nng, (ngrams', (_, contacts))))) <- joinInCorpusWithContacts -< ()
-  restrict -< (n^.ns_search)        @@ (pgTSQuery  $ unpack q  )
-  restrict -< (n^.ns_typename)     .== (pgInt4 $ nodeTypeId NodeDocument)
---  restrict -< (nng^.nnng_node1_id) .== (toNullable $ pgNodeId lId)
-  restrict -< (nn^.nn_node1_id)    .== (toNullable $ pgNodeId cId)
---   -- restrict -< (nng_listType nng)      .== (toNullable $ pgNgramsType Authors)
---  restrict -< (contacts^.node_typename) .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
---   -- let contact_id    = ifThenElse (isNull $ _node_id contacts) (toNullable $ pgInt4 0) (_node_id contacts)
-  returnA  -< FacetPaired (n^.ns_id)
-                          (n^.ns_date)
-                          (n^.ns_hyperdata)
-                          (pgInt4 0)
-                          (contacts^.node_id, ngrams'^.ngrams_terms)
-
-joinInCorpusWithContacts :: O.Query ( NodeSearchRead
-                                    , ( NodeNodeReadNull
-                                      , ( NodeNodeNgramsReadNull
-                                        , ( NgramsReadNull
-                                          , ( NodeNodeNgramsReadNull
-                                            , NodeReadNull
-                                            )
-                                          )
-                                        )
-                                      )
+  -> QueryArr ()
+              ( Column (Nullable PGInt4)
+              , Column (Nullable PGTimestamptz)
+              , Column (Nullable PGJsonb)
+              , Column (Nullable PGInt4)
+              )
+selectContactViaDoc' cId aId q = proc () -> do
+  (doc, (corpus_doc, (_contact_doc, (annuaire_contact, contact)))) <- queryContactViaDoc -< ()
+  restrict -< (doc^.ns_search)           @@ (pgTSQuery  $ unpack q  )
+  restrict -< (doc^.ns_typename)        .== (pgInt4 $ nodeTypeId NodeDocument)
+  restrict -< (corpus_doc^.nn_node1_id)  .== (toNullable $ pgNodeId cId)
+  restrict -< (annuaire_contact^.nn_node1_id) .== (toNullable $ pgNodeId aId)
+  restrict -< (contact^.node_typename)        .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
+  returnA  -< ( contact^.node_id
+              , contact^.node_date
+              , contact^.node_hyperdata
+              , toNullable $ pgInt4 1
+              )
+
+group :: NodeId
+      -> NodeId
+      -> Text
+     -> Select FacetPairedReadNull
+group cId aId q = proc () -> do
+  (a, b, c, d) <- aggregate (p4 (groupBy, groupBy, groupBy, O.sum))
+                            (selectContactViaDoc' cId aId q) -< ()
+  returnA -< FacetPaired a b c d
+
+
+
+
+
+
+
+
+queryContactViaDoc :: O.Query ( NodeSearchRead
+                              , ( NodeNodeReadNull
+                                , ( NodeNodeReadNull
+                                  , ( NodeNodeReadNull
+                                    , NodeReadNull
                                     )
-joinInCorpusWithContacts =
-  leftJoin6
+                                  )
+                                )
+                              )
+queryContactViaDoc =
+  leftJoin5
   queryNodeTable
-  queryNodeNodeNgramsTable
-  queryNgramsTable
-  queryNodeNodeNgramsTable
+  queryNodeNodeTable
+  queryNodeNodeTable
   queryNodeNodeTable
   queryNodeSearchTable
   cond12
   cond23
   cond34
   cond45
-  cond56
     where
-      cond12 :: (NodeNodeNgramsRead, NodeRead) -> Column PGBool
-      cond12 (nnng, n2) = n2^.node_id .== nnng^.nnng_node1_id
-
-      cond23 :: (NgramsRead, (NodeNodeNgramsRead, NodeReadNull)) -> Column PGBool
-      cond23 (ng2, (nnng2, _)) = nnng2^.nnng_ngrams_id .== ng2^.ngrams_id
+      cond12 :: (NodeNodeRead, NodeRead) -> Column PGBool
+      cond12 (annuaire_contact, contact) = contact^.node_id .== annuaire_contact^.nn_node2_id
 
-      cond34 :: ( NodeNodeNgramsRead
-                , ( NgramsRead
-                  , ( NodeNodeNgramsReadNull
-                    , NodeReadNull
-                    )
+      cond23 :: ( NodeNodeRead
+                , ( NodeNodeRead
+                  , NodeReadNull
                   )
                 ) -> Column PGBool
-      cond34 (nng, (ng, (_,_))) = ng^.ngrams_id .== nng^.nnng_ngrams_id
- 
-      cond45 :: ( NodeNodeRead
-                , ( NodeNodeNgramsRead
-                  , ( NgramsReadNull
-                    , ( NodeNodeNgramsReadNull
-                      , NodeReadNull
-                      )
+      cond23 (contact_doc, (annuaire_contact, _)) = contact_doc^.nn_node1_id .== annuaire_contact^.nn_node2_id
+
+      cond34 :: ( NodeNodeRead
+                , ( NodeNodeRead
+                  , ( NodeNodeReadNull
+                    , NodeReadNull
                     )
                   )
                 ) -> Column PGBool
-      cond45 (nn, (nng, (_,(_,_)))) = nng^.nnng_node1_id .== nn^.nn_node2_id
- 
-      cond56 :: ( NodeSearchRead
+      cond34 (corpus_doc, (contact_doc, (_,_))) =  corpus_doc^.nn_node2_id .== contact_doc^.nn_node2_id
+
+
+      cond45 :: ( NodeSearchRead
                 , ( NodeNodeRead
-                  , ( NodeNodeNgramsReadNull
-                    , ( NgramsReadNull
-                      , ( NodeNodeNgramsReadNull
-                        , NodeReadNull
-                        )
+                  , ( NodeNodeReadNull
+                    , ( NodeNodeReadNull
+                      , NodeReadNull
                       )
                     )
                   )
                 ) -> Column PGBool
-      cond56 (n, (nn, (_,(_,(_,_))))) = _ns_id n .== nn^.nn_node2_id
- 
+      cond45 (doc, (corpus_doc, (_,(_,_)))) = doc^.ns_id .== corpus_doc^.nn_node2_id
+
+
+------------------------------------------------------------------------
 
 newtype TSQuery = UnsafeTSQuery [Text]
 

src/Gargantext/Database/Action/Share.hs

@@ -14,6 +14,7 @@ module Gargantext.Database.Action.Share
   where
 
 import Control.Lens (view)
+import Gargantext.Database
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Flow.Utils (getUserId)
 import Gargantext.Database.Admin.Config (hasNodeType, isInNodeTypes)
@@ -23,7 +24,7 @@ import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Node (getNode, getNodesWith)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError, errorWith)
-import Gargantext.Database.Query.Table.NodeNode (insertNodeNode, deleteNodeNode)
+import Gargantext.Database.Query.Table.NodeNode (deleteNodeNode)
 import Gargantext.Database.Query.Tree.Root (getRootId)
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.NodeNode (NodeNodePoly(..))
@@ -45,7 +46,7 @@ data ShareNodeWith = ShareNodeWith_User { snwu_nodetype :: NodeType
 shareNodeWith :: HasNodeError err
               => ShareNodeWith
               -> NodeId
-              -> Cmd err Int64
+              -> Cmd err Int
 shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
   nodeToCheck <- getNode   n
   userIdCheck <- getUserId u
@@ -56,7 +57,7 @@ shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
         then errorWith "[G.D.A.S.shareNodeWith] Can share to others only"
         else do
           folderSharedId  <- getFolderId u NodeFolderShared
-          insertNodeNode [NodeNode folderSharedId n Nothing Nothing]
+          insertDB ([NodeNode folderSharedId n Nothing Nothing]:: [NodeNode])
 
 shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
   nodeToCheck <- getNode n
@@ -66,7 +67,7 @@ shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
     else do
       folderToCheck <- getNode nId
       if hasNodeType folderToCheck NodeFolderPublic
-         then insertNodeNode [NodeNode nId n Nothing Nothing]
+         then insertDB ([NodeNode nId n Nothing Nothing] :: [NodeNode])
          else errorWith "[G.D.A.S.shareNodeWith] Can share NodeWith NodeFolderPublic only"
 
 shareNodeWith _ _ = errorWith "[G.D.A.S.shareNodeWith] Not implemented for this NodeType"

src/Gargantext/Database/Admin/Config.hs

@@ -39,18 +39,18 @@ userArbitrary = "user1"
 nodeTypeId :: NodeType -> NodeTypeId
 nodeTypeId n =
   case n of
-    NodeUser      -> 1
-    NodeFolder    -> 2
+    NodeUser          -> 1
+    NodeFolder        -> 2
     NodeFolderPrivate -> 20
     NodeFolderShared  -> 21
     NodeTeam          -> 210
     NodeFolderPublic  -> 22
-    NodeCorpusV3  -> 3
-    NodeCorpus    -> 30
-    NodeAnnuaire  -> 31
-    NodeTexts     -> 40
-    NodeDocument  -> 4
-    NodeContact   -> 41
+    NodeCorpusV3      -> 3
+    NodeCorpus        -> 30
+    NodeAnnuaire      -> 31
+    NodeTexts         -> 40
+    NodeDocument      -> 4
+    NodeContact       -> 41
   --NodeSwap   -> 19
 
 ----  Lists

src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs

@@ -54,6 +54,15 @@ defaultHyperdataContact = HyperdataContact (Just "bdd")
                                          (Just "DO NOT expose this")
                                          (Just "DO NOT expose this")
 
+hyperdataContact :: FirstName -> LastName -> HyperdataContact
+hyperdataContact fn ln = HyperdataContact Nothing
+                                          (Just (contactWho fn ln))
+                                          []
+                                          Nothing
+                                          Nothing
+                                          Nothing
+                                          Nothing
+                                          Nothing
 
 -- TOD0 contact metadata (Type is too flat)
 data ContactMetaData =
@@ -78,12 +87,20 @@ data ContactWho =
                 , _cw_freetags :: [Text]
   } deriving (Eq, Show, Generic)
 
+type FirstName = Text
+type LastName  = Text
+
 defaultContactWho :: ContactWho
-defaultContactWho = ContactWho (Just "123123")
-                             (Just "First Name")
-                             (Just "Last Name")
-                             ["keyword A"]
-                             ["freetag A"]
+defaultContactWho = contactWho "Pierre" "Dupont"
+
+contactWho :: FirstName -> LastName -> ContactWho
+contactWho fn ln = ContactWho Nothing
+                             (Just fn)
+                             (Just ln)
+                             []
+                             []
+
+
 
 data ContactWhere =
      ContactWhere { _cw_organization :: [Text]
@@ -150,6 +167,12 @@ instance FromField HyperdataContact where
 instance QueryRunnerColumnDefault PGJsonb HyperdataContact   where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
+
+instance QueryRunnerColumnDefault (Nullable PGJsonb) HyperdataContact where
+  queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+
+
 -- | All lenses
 makeLenses ''ContactWho
 makeLenses ''ContactWhere

src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs

@@ -48,7 +48,7 @@ import GHC.Generics (Generic)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Prelude (fromField')
 import Gargantext.Prelude
-import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
+import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn, Nullable)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 

src/Gargantext/Database/Admin/Types/Node.hs

@@ -156,7 +156,8 @@ instance Arbitrary NodeId where
   arbitrary = NodeId <$> arbitrary
 
 type ParentId = NodeId
-type CorpusId = NodeId
+type CorpusId    = NodeId
+type CommunityId = NodeId
 type ListId   = NodeId
 type DocumentId = NodeId
 type DocId      = NodeId
@@ -241,6 +242,8 @@ data NodeType = NodeUser
               | NodeFolderPublic
               | NodeFolder
 
+              -- | NodeAnalysis | NodeCommunity
+
               | NodeCorpus     | NodeCorpusV3 | NodeTexts | NodeDocument
               | NodeAnnuaire   | NodeContact
               | NodeGraph      | NodePhylo
@@ -336,4 +339,7 @@ instance QueryRunnerColumnDefault (Nullable PGInt4) NodeId
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
+instance (QueryRunnerColumnDefault (Nullable O.PGTimestamptz) UTCTime)
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
 

src/Gargantext/Database/Prelude.hs

@@ -45,7 +45,6 @@ import qualified Data.List as DL
 import qualified Database.PostgreSQL.Simple as PGS
 
 -------------------------------------------------------
-
 class HasConnectionPool env where
   connPool :: Getter env (Pool Connection)
 

src/Gargantext/Database/Query/Facet.hs

@@ -29,6 +29,8 @@ module Gargantext.Database.Query.Facet
   , FacetDocRead
   , FacetPaired(..)
   , FacetPairedRead
+  , FacetPairedReadNull
+  , FacetPairedReadNullAgg
   , OrderBy(..)
   )
   where
@@ -111,44 +113,61 @@ instance (Typeable i, Typeable l, ToSchema i, ToSchema l) => ToSchema (Pair i l)
 instance (Arbitrary i, Arbitrary l) => Arbitrary (Pair i l) where
   arbitrary = Pair <$> arbitrary <*> arbitrary
 
-data FacetPaired id date hyperdata score pair =
+data FacetPaired id date hyperdata score =
   FacetPaired {_fp_id        :: id
               ,_fp_date      :: date
               ,_fp_hyperdata :: hyperdata
               ,_fp_score     :: score
-              ,_fp_pair      :: pair
   } deriving (Show, Generic)
 $(deriveJSON (unPrefix "_fp_") ''FacetPaired)
 $(makeAdaptorAndInstance "pFacetPaired" ''FacetPaired)
 
+
+
 instance ( ToSchema id
          , ToSchema date
          , ToSchema hyperdata
          , ToSchema score
-         , ToSchema pair
          , Typeable id
          , Typeable date
          , Typeable hyperdata
          , Typeable score
-         , Typeable pair
-         ) => ToSchema (FacetPaired id date hyperdata score pair) where
+         ) => ToSchema (FacetPaired id date hyperdata score) where
   declareNamedSchema = wellNamedSchema "_fp_"
 
 instance ( Arbitrary id
          , Arbitrary date
          , Arbitrary hyperdata
          , Arbitrary score
-         , Arbitrary pair
-         ) => Arbitrary (FacetPaired id date hyperdata score pair) where
-  arbitrary = FacetPaired <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+         ) => Arbitrary (FacetPaired id date hyperdata score) where
+  arbitrary = FacetPaired <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 
 type FacetPairedRead = FacetPaired (Column PGInt4       )
                                    (Column PGTimestamptz)
                                    (Column PGJsonb      )
                                    (Column PGInt4       )
-                                   ( Column (Nullable PGInt4)
-                                   , Column (Nullable PGText)
-                                   )
+
+type FacetPairedReadNull = FacetPaired (Column (Nullable PGInt4)       )
+                                       (Column (Nullable PGTimestamptz))
+                                       (Column (Nullable PGJsonb)      )
+                                       (Column (Nullable PGInt4)       )
+
+type FacetPairedReadNullAgg = FacetPaired (Aggregator (Column (Nullable PGInt4)       )
+                                                      (Column (Nullable PGInt4)       ) 
+                                          )
+                                          (Aggregator (Column (Nullable PGTimestamptz))
+                                                      (Column (Nullable PGTimestamptz))
+
+                                          )
+                                          (Aggregator (Column (Nullable PGJsonb)      )
+                                                      (Column (Nullable PGJsonb)      )
+                                          )
+                                          (Aggregator (Column (Nullable PGInt4)       )
+                                                      (Column (Nullable PGInt4)       )
+                                          )
+
+
+
 
 -- | JSON instance
 $(deriveJSON (unPrefix "facetDoc_") ''Facet)

src/Gargantext/Database/Query/Join.hs

@@ -22,7 +22,15 @@ Multiple Join functions with Opaleye.
 
 ------------------------------------------------------------------------
 
-module Gargantext.Database.Query.Join
+module Gargantext.Database.Query.Join ( leftJoin2
+                                      , leftJoin3
+                                      , leftJoin4
+                                      , leftJoin5
+                                      , leftJoin6
+                                      , leftJoin7
+                                      , leftJoin8
+                                      , leftJoin9
+                                      )
   where
 
 import Control.Applicative ((<*>))
@@ -33,17 +41,24 @@ import Opaleye
 import Opaleye.Internal.Join (NullMaker(..))
 import qualified Opaleye.Internal.Unpackspec()
 
---leftJoin3 :: Query columnsL1 -> Query columnsR -> Query columnsL
---     -> ((columnsL1, columnsR) -> Column PGBool)
---     -> ((columnsL, (columnsL1, nullableColumnsR1)) -> Column PGBool)
---     -> Query (columnsL, nullableColumnsR)
---leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
-join3 :: Query columnsA -> Query columnsB -> Query columnsC 
+------------------------------------------------------------------------
+leftJoin2 :: (Default Unpackspec fieldsL fieldsL,
+              Default Unpackspec fieldsR fieldsR,
+              Default NullMaker fieldsR nullableFieldsR) =>
+             Select fieldsL
+             -> Select fieldsR
+             -> ((fieldsL, fieldsR) -> Column PGBool)
+             -> Select (fieldsL, nullableFieldsR)
+leftJoin2 = leftJoin
+
+------------------------------------------------------------------------
+-- | LeftJoin3 in two ways to write it
+_leftJoin3 :: Query columnsA -> Query columnsB -> Query columnsC
       -> ((columnsA, columnsB, columnsC) -> Column PGBool) 
       -> Query (columnsA, columnsB, columnsC)
-join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
+_leftJoin3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
+
 
-------------------------------------------------------------------------
 leftJoin3
   :: (Default Unpackspec fieldsL1 fieldsL1,
       Default Unpackspec fieldsL2 fieldsL2,

src/Gargantext/Database/Query/Prelude.hs

+{-|
+Module      : Gargantext.Database.Query.Prelude
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+
+-}
+
+------------------------------------------------------------------------
+module Gargantext.Database.Query.Prelude
+ ( module Gargantext.Database.Query.Join
+ , module Gargantext.Database.Query.Table.Node
+ , module Gargantext.Database.Query.Table.NodeNode
+ , module Control.Arrow
+ )
+  where
+
+import Control.Arrow (returnA)
+import Gargantext.Database.Query.Join
+import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Query.Table.NodeNode

src/Gargantext/Database/Query/Table/Ngrams.hs

@@ -59,7 +59,7 @@ selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
 _postNgrams :: CorpusId -> DocId -> [Text] -> Cmd err Int
 _postNgrams = undefined
 
-_dbGetNgramsDb :: Cmd err [NgramsDb]
+_dbGetNgramsDb :: Cmd err [NgramsDB]
 _dbGetNgramsDb = runOpaQuery queryNgramsTable
 
 

src/Gargantext/Database/Query/Table/Node.hs

@@ -190,6 +190,23 @@ node nodeType name hyperData parentId userId =
 insertNodes :: [NodeWrite] -> Cmd err Int64
 insertNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing
 
+{-
+insertNodes' :: [Node a] -> Cmd err Int64
+insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
+                        $ Insert nodeTable ns' rCount Nothing
+  where
+    ns' :: [NodeWrite]
+    ns' = map (\(Node i t u p n d h)
+                -> Node (pgNodeId          <$> i)
+                        (pgInt4 $ nodeTypeId   t)
+                        (pgInt4                u)
+                        (pgNodeId          <$> p)
+                        (pgStrictText          n)
+                        (pgUTCTime         <$> d)
+                        (pgJSONB $ cs $ encode h)
+              ) ns
+-}
+
 insertNodesR :: [NodeWrite] -> Cmd err [NodeId]
 insertNodesR ns = mkCmd $ \conn ->
   runInsert_ conn (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ _) -> i)) Nothing)

src/Gargantext/Database/Query/Table/Node/Children.hs

@@ -30,10 +30,13 @@ import Gargantext.Database.Schema.Node
 import Opaleye
 import Protolude
 
+
+-- TODO getAllTableDocuments
 getAllDocuments :: ParentId -> Cmd err (TableResult (Node HyperdataDocument))
 getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)
                                          (Just NodeDocument)
 
+-- TODO getAllTableContacts
 getAllContacts :: ParentId -> Cmd err (TableResult (Node HyperdataContact))
 getAllContacts pId = getAllChildren pId (Proxy :: Proxy HyperdataContact)
                                         (Just NodeContact)

src/Gargantext/Database/Query/Table/Node/Document/Insert.hs

@@ -72,7 +72,7 @@ import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
 import Gargantext.Prelude
-import Gargantext.Prelude.Utils (hash)
+import Gargantext.Core.Crypto.Hash (hash)
 import qualified Data.Text                   as DT (pack, concat, take)
 
 -- TODO : the import of Document constructor below does not work

src/Gargantext/Database/Query/Table/NodeNode.hs

@@ -71,9 +71,33 @@ getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
       returnA -< ns
 
 ------------------------------------------------------------------------
-insertNodeNode :: [NodeNode] -> Cmd err Int64
-insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn
-                          $ Insert nodeNodeTable ns' rCount Nothing
+-- TODO (refactor with Children)
+{-
+getNodeNodeWith :: NodeId -> proxy a -> Maybe NodeType -> Cmd err [a]
+getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
+  where
+    query = selectChildren pId maybeNodeType
+
+    selectChildren :: ParentId
+                   -> Maybe NodeType
+                   -> Query NodeRead
+    selectChildren parentId maybeNodeType = proc () -> do
+        row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
+        (NodeNode _ n1id n2id _ _) <- queryNodeNodeTable -< ()
+
+        let nodeType = maybe 0 nodeTypeId maybeNodeType
+        restrict -< typeName  .== pgInt4 nodeType
+
+        restrict -< (.||) (parent_id .== (pgNodeId parentId))
+                          ( (.&&) (n1id .== pgNodeId parentId)
+                                  (n2id .== nId))
+        returnA -< row
+-}
+
+------------------------------------------------------------------------
+insertNodeNode :: [NodeNode] -> Cmd err Int
+insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
+                          $ Insert nodeNodeTable ns' rCount (Just DoNothing))
   where
     ns' :: [NodeNodeWrite]
     ns' = map (\(NodeNode n1 n2 x y)
@@ -83,6 +107,8 @@ insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn
                             (pgInt4   <$> y)
               ) ns
 
+
+
 ------------------------------------------------------------------------
 type Node1_Id = NodeId
 type Node2_Id = NodeId

src/Gargantext/Database/Schema/Ngrams.hs

@@ -42,7 +42,7 @@ type NgramsId    = Int
 type NgramsTerms = Text
 type Size        = Int
 
-data NgramsPoly id terms n = NgramsDb { _ngrams_id    :: !id
+data NgramsPoly id terms n = NgramsDB { _ngrams_id    :: !id
                                       , _ngrams_terms :: !terms
                                       , _ngrams_n     :: !n
                                       } deriving (Show)
@@ -59,14 +59,14 @@ type NgramsReadNull = NgramsPoly (Column (Nullable PGInt4))
                                  (Column (Nullable PGText))
                                  (Column (Nullable PGInt4))
 
-type NgramsDb = NgramsPoly Int Text Int
+type NgramsDB = NgramsPoly Int Text Int
 
 $(makeAdaptorAndInstance "pNgramsDb"    ''NgramsPoly)
 makeLenses ''NgramsPoly
 
 
 ngramsTable :: Table NgramsWrite NgramsRead
-ngramsTable = Table "ngrams" (pNgramsDb NgramsDb { _ngrams_id    = optional "id"
+ngramsTable = Table "ngrams" (pNgramsDb NgramsDB { _ngrams_id    = optional "id"
                                                  , _ngrams_terms = required "terms"
                                                  , _ngrams_n     = required "n"
                                                  }

src/Gargantext/Database/Schema/Node.hs

@@ -25,7 +25,6 @@ import Prelude hiding (null, id, map, sum)
 
 ------------------------------------------------------------------------
 -- Main polymorphic Node definition
-
 data NodePoly id
               typename
               userId
@@ -53,7 +52,6 @@ $(makeLenses ''NodePoly)
 $(makeAdaptorAndInstance "pNode"   ''NodePoly)
 $(makeLensesWith abbreviatedFields ''NodePoly)
 
-------------------------------------------------------------------------
 nodeTable :: Table NodeWrite NodeRead
 nodeTable = Table "nodes" (pNode Node { _node_id         = optional "id"
                                       , _node_typename   = required "typename"

src/Gargantext/Database/Schema/NodeNode.hs

@@ -54,15 +54,15 @@ $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
 makeLenses ''NodeNodePoly
 
 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
-nodeNodeTable  = Table "nodes_nodes" (pNodeNode
-                                NodeNode { _nn_node1_id = required "node1_id"
-                                         , _nn_node2_id = required "node2_id"
-                                         , _nn_score    = optional "score"
-                                         , _nn_category = optional "category"
-                                     }
-                                     )
-
-
+nodeNodeTable  =
+  Table "nodes_nodes"
+         ( pNodeNode
+           NodeNode { _nn_node1_id = required "node1_id"
+                    , _nn_node2_id = required "node2_id"
+                    , _nn_score    = optional "score"
+                    , _nn_category = optional "category"
+                    }
+                )
 
 instance QueryRunnerColumnDefault (Nullable PGInt4)   Int            where
     queryRunnerColumnDefault = fieldQueryRunnerColumn

src/Gargantext/Database/Schema/Prelude.hs

@@ -37,7 +37,7 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
 import Data.Swagger hiding (required, in_)
 import GHC.Generics (Generic)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Opaleye hiding (FromField)
+import Opaleye hiding (FromField, readOnly)
 import Opaleye.Internal.QueryArr (Query)
 import Test.QuickCheck.Arbitrary
 

src/Gargantext/Prelude.hs

@@ -292,9 +292,6 @@ deviation = sqrt . variance
 movingAverage :: (Eq b, Fractional b) => Int -> [b] -> [b]
 movingAverage steps xs = map mean $ chunkAlong steps 1 xs
 
-ma :: [Double] -> [Double]
-ma = movingAverage 3
-
 -----------------------------------------------------------------------
 -----------------------------------------------------------------------
 --- Map in Map = Map2

src/Gargantext/Prelude/Utils.hs

@@ -14,9 +14,6 @@ Portability : POSIX
 module Gargantext.Prelude.Utils
   where
 
-import Prelude (String)
-import Data.Set (Set)
-import Data.List (foldl)
 import Control.Lens (view)
 import Control.Monad.Random.Class (MonadRandom)
 import Control.Monad.Reader (MonadReader)
@@ -26,46 +23,16 @@ import GHC.IO (FilePath)
 import Gargantext.API.Admin.Settings
 import Gargantext.Database.Admin.Types.Node (NodeId, NodeType)
 import Gargantext.Prelude
+import Gargantext.Core.Crypto.Hash
 import System.Directory (createDirectoryIfMissing)
 import System.Random (newStdGen)
-import qualified Data.ByteString.Lazy.Char8  as Char
-import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
-import qualified Data.Set                    as Set
-import qualified Data.Text                   as Text
+import qualified Data.Text             as Text
 import qualified System.Random.Shuffle as SRS
 
 --------------------------------------------------------------------------
 shuffle :: MonadRandom m => [a] -> m [a]
 shuffle ns = SRS.shuffleM ns 
 
---------------------------------------------------------------------------
--- | Use this datatype to keep traceability of hashes
--- TODO use newtype
-type Hash = Text
-
--- | Class to make hashes
-class IsHashable a where
-  hash :: a -> Hash
-
--- | Main API to hash text
--- using sha256 for now
-instance IsHashable Char.ByteString where
-  hash = Text.pack
-        . SHA.showDigest
-        . SHA.sha256
-
-instance {-# OVERLAPPING #-} IsHashable String where
-  hash = hash . Char.pack
-
-instance IsHashable Text where
-  hash = hash . Text.unpack
-
-instance IsHashable (Set Hash) where
-  hash = hash . foldl (<>) "" . Set.toList
-
-instance {-# OVERLAPPABLE #-} IsHashable a => IsHashable [a] where
-  hash = hash . Set.fromList . map hash
-
 --------------------------------------------------------------------------
 data NodeToHash = NodeToHash { nodeType :: NodeType
                              , nodeId   :: NodeId

stack.yaml

@@ -53,7 +53,7 @@ extra-deps:
 - git: https://github.com/np/patches-map
   commit: 8c6f38c4844ead53e664cf9c82ba461715dbe445
 - git: https://github.com/delanoe/haskell-opaleye.git  #- opaleye-0.6.7002.0
-  commit: 53385de076be09f728a1b58c035a18e9ff9bcfd6
+  commit: 63ee65d974e9d20eaaf17a2e83652175988cbb79
 - git: https://github.com/delanoe/hsparql.git
   commit: 308c74b71a1abb0a91546fa57d353131248e3a7f
 - Unique-0.4.7.6@sha256:a1ff411f4d68c756e01e8d532fbe8e57f1ac77f2cc0ee8a999770be2bca185c5,2723
@@ -85,5 +85,5 @@ extra-deps:
 - ghc-byteorder-4.11.0.0.10@sha256:5ee4a907279bfec27b0f9de7b8fba4cecfd34395a0235a7784494de70ad4e98f,1535
   # Matrix Computation
 - accelerate-1.2.0.1
-
+- smtp-mail-0.2.0.0@sha256:b91c81f6dbb41a9ceee8c443385118684ecec55006b77f7d3c0e49cffd2468cf,1211