[Community] Query search contact with text query on documents

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/Database.hs

@@ -33,11 +33,17 @@ import Gargantext.Database.Query.Table.NodeNode
 
 
 class InsertDB a where
-  insertDB :: a -> Cmd err Int64
+  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'

src/Gargantext/Database/Action/Flow.hs

@@ -68,7 +68,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
@@ -126,7 +126,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

@@ -67,8 +67,7 @@ pairMaps m1 m2 =
 pairing :: AnnuaireId -> CorpusId -> ListId -> Cmd err Int
 pairing a c l = do
   dataPaired <- dataPairing a (c,l,Authors) lastName toLower
-  r <- insertDB $ prepareInsert dataPaired
-  pure (fromIntegral r)
+  insertDB $ prepareInsert dataPaired
 
 
 dataPairing :: AnnuaireId

src/Gargantext/Database/Action/Search.hs

@@ -27,11 +27,12 @@ import Opaleye hiding (Query, Order)
 import qualified Opaleye as O hiding (Order)
 
 import Gargantext.Core.Types
+import Gargantext.Database.Query.Filter
 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.Query.Facet
-import Gargantext.Database.Query.Join (leftJoin6)
+import Gargantext.Database.Query.Join (leftJoin6, leftJoin5)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.NodeNode
 import Gargantext.Database.Query.Table.NodeNodeNgrams
@@ -42,14 +43,14 @@ import Gargantext.Prelude
 import Gargantext.Text.Terms.Mono.Stem.En (stemIt)
 
 ------------------------------------------------------------------------
-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 +106,96 @@ 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
-  -> [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
+  -> AnnuaireId
   -> [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 ( o l order
+              $ selectContactViaDoc cId aId
               $ intercalate " | "
               $ map stemIt q
 
 
-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
-                                            )
-                                          )
-                                        )
-                                      )
+  -> O.Query 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 0)
+
+
+
+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)
@@ -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/Types/Hyperdata/Contact.hs

@@ -150,6 +150,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

@@ -337,4 +337,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,7 @@ module Gargantext.Database.Query.Facet
   , FacetDocRead
   , FacetPaired(..)
   , FacetPairedRead
+  , FacetPairedReadNull
   , OrderBy(..)
   )
   where
@@ -111,12 +112,11 @@ 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)
@@ -125,30 +125,31 @@ 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)       )
+
+
 
 -- | JSON instance
 $(deriveJSON (unPrefix "facetDoc_") ''Facet)

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

@@ -95,9 +95,9 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
 -}
 
 ------------------------------------------------------------------------
-insertNodeNode :: [NodeNode] -> Cmd err Int64
-insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn
-                          $ Insert nodeNodeTable ns' rCount Nothing
+insertNodeNode :: [NodeNode] -> Cmd err Int
+insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
+                          $ Insert nodeNodeTable ns' rCount Nothing)
   where
     ns' :: [NodeNodeWrite]
     ns' = map (\(NodeNode n1 n2 x y)
@@ -107,6 +107,8 @@ insertNodeNode ns = mkCmd $ \conn -> runInsert_ conn
                             (pgInt4   <$> y)
               ) ns
 
+
+
 ------------------------------------------------------------------------
 type Node1_Id = NodeId
 type Node2_Id = NodeId