src/Gargantext/API/Table.hs

   1 {-|
   2 Module      : Gargantext.API.Node
   3 Description : Server API
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10
  11 -- TODO-ACCESS: CanGetNode
  12 -- TODO-EVENTS: No events as this is a read only query.
  13 Node API
  14
  15 -------------------------------------------------------------------
  16 -- TODO-ACCESS: access by admin only.
  17 --              At first let's just have an isAdmin check.
  18 --              Later: check userId CanDeleteNodes Nothing
  19 -- TODO-EVENTS: DeletedNodes [NodeId]
  20 --              {"tag": "DeletedNodes", "nodes": [Int*]}
  21
  22
  23 -}
  24
  25 {-# OPTIONS_GHC -fno-warn-orphans #-}
  26
  27 {-# LANGUAGE ScopedTypeVariables  #-}
  28 {-# LANGUAGE TemplateHaskell      #-}
  29 {-# LANGUAGE TypeOperators        #-}
  30
  31 module Gargantext.API.Table
  32   where
  33
  34 import Data.Aeson.TH (deriveJSON)
  35 import Data.Maybe
  36 import Data.Swagger
  37 import Data.Text (Text())
  38 import GHC.Generics (Generic)
  39 import Servant
  40 import Test.QuickCheck (elements)
  41 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  42
  43 import Gargantext.API.HashedResponse
  44 import Gargantext.API.Ngrams.Types (TabType(..))
  45 import Gargantext.API.Prelude (GargServer)
  46 import Gargantext.Core.Types (Offset, Limit, TableResult(..))
  47 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
  48 import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
  49 import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
  50 import Gargantext.Database.Action.Search
  51 import Gargantext.Database.Admin.Types.Node
  52 import Gargantext.Database.Prelude -- (Cmd, CmdM)
  53 import Gargantext.Prelude
  54
  55 ------------------------------------------------------------------------
  56
  57 type TableApi = Summary "Table API"
  58               :> QueryParam "tabType" TabType
  59               :> QueryParam "list" ListId
  60               :> QueryParam "limit" Int
  61               :> QueryParam "offset" Int
  62               :> QueryParam "orderBy" OrderBy
  63               :> QueryParam "query" Text
  64               :> Get    '[JSON] (HashedResponse FacetTableResult)
  65             :<|> Summary "Table API (POST)"
  66               :> ReqBody '[JSON] TableQuery
  67               :> Post    '[JSON] FacetTableResult
  68             :<|> "hash" :>
  69                    Summary "Hash Table"
  70                 :> QueryParam "tabType" TabType
  71                 :> Get '[JSON] Text
  72
  73 data TableQuery = TableQuery
  74   { tq_offset  :: Int
  75   , tq_limit   :: Int
  76   , tq_orderBy :: OrderBy
  77   , tq_view    :: TabType
  78   , tq_query  :: Text
  79   } deriving (Generic)
  80
  81 type FacetTableResult = TableResult FacetDoc
  82
  83 $(deriveJSON (unPrefix "tq_") ''TableQuery)
  84
  85 instance ToSchema TableQuery where
  86   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
  87
  88 instance Arbitrary TableQuery where
  89   arbitrary = elements [TableQuery 0 10 DateAsc Docs "electrodes"]
  90
  91
  92 tableApi :: NodeId -> GargServer TableApi
  93 tableApi id' = getTableApi id'
  94           :<|> postTableApi id'
  95           :<|> getTableHashApi id'
  96
  97
  98 getTableApi :: NodeId
  99             -> Maybe TabType
 100             -> Maybe ListId
 101             -> Maybe Int
 102             -> Maybe Int
 103             -> Maybe OrderBy
 104             -> Maybe Text
 105             -> Cmd err (HashedResponse FacetTableResult)
 106 getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery = do
 107   printDebug "[getTableApi] mQuery" mQuery
 108   t <- getTable cId tabType mOffset mLimit mOrderBy mQuery
 109   pure $ constructHashedResponse t
 110
 111 postTableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
 112 postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing
 113 postTableApi cId (TableQuery o l order ft q) = case ft of
 114       Docs  -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
 115       Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
 116       x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
 117
 118 getTableHashApi :: NodeId -> Maybe TabType -> Cmd err Text
 119 getTableHashApi cId tabType = do
 120   HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing
 121   pure h
 122
 123 searchInCorpus' :: CorpusId
 124                 -> Bool
 125                 -> [Text]
 126                 -> Maybe Offset
 127                 -> Maybe Limit
 128                 -> Maybe OrderBy
 129                 -> Cmd err FacetTableResult
 130 searchInCorpus' cId t q o l order = do
 131   docs          <- searchInCorpus cId t q o l order
 132   countAllDocs  <- searchCountInCorpus cId t q
 133   pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
 134
 135
 136 getTable :: NodeId
 137          -> Maybe TabType
 138          -> Maybe Offset
 139          -> Maybe Limit
 140          -> Maybe OrderBy
 141          -> Maybe Text
 142          -> Cmd err FacetTableResult
 143 getTable cId ft o l order query = do
 144   docs      <- getTable' cId ft o l order query
 145   docsCount <- runCountDocuments cId (ft == Just Trash) query
 146   pure $ TableResult { tr_docs = docs, tr_count = docsCount }
 147
 148 getTable' :: NodeId
 149           -> Maybe TabType
 150           -> Maybe Offset
 151           -> Maybe Limit
 152           -> Maybe OrderBy
 153           -> Maybe Text
 154           -> Cmd err [FacetDoc]
 155 getTable' cId ft o l order query =
 156   case ft of
 157     (Just Docs)      -> runViewDocuments cId False o l order query
 158     (Just Trash)     -> runViewDocuments cId True  o l order query
 159     (Just MoreFav)   -> moreLike cId o l order IsFav
 160     (Just MoreTrash) -> moreLike cId o l order IsTrash
 161     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 162
 163
 164 getPair :: ContactId -> Maybe TabType
 165          -> Maybe Offset  -> Maybe Limit
 166          -> Maybe OrderBy -> Cmd err [FacetDoc]
 167 getPair cId ft o l order =
 168   case ft of
 169     (Just Docs)  -> runViewAuthorsDoc cId False o l order
 170     (Just Trash) -> runViewAuthorsDoc cId True  o l order
 171     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
 172