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.Action.Learn (FavOrTrash(..), moreLike)
  49 import Gargantext.Database.Action.Search
  50 import Gargantext.Database.Admin.Types.Node
  51 import Gargantext.Database.Prelude -- (Cmd, CmdM)
  52 import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
  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 { tq_offset = 0
  90                                    , tq_limit = 10
  91                                    , tq_orderBy = DateAsc
  92                                    , tq_view = Docs
  93                                    , tq_query = "electrodes" }]
  94
  95
  96 tableApi :: NodeId -> GargServer TableApi
  97 tableApi id' = getTableApi id'
  98           :<|> postTableApi id'
  99           :<|> getTableHashApi id'
 100
 101
 102 getTableApi :: NodeId
 103             -> Maybe TabType
 104             -> Maybe ListId
 105             -> Maybe Int
 106             -> Maybe Int
 107             -> Maybe OrderBy
 108             -> Maybe Text
 109             -> Cmd err (HashedResponse FacetTableResult)
 110 getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery = do
 111   printDebug "[getTableApi] mQuery" mQuery
 112   t <- getTable cId tabType mOffset mLimit mOrderBy mQuery
 113   pure $ constructHashedResponse t
 114
 115 postTableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
 116 postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing
 117 postTableApi cId (TableQuery o l order ft q) = case ft of
 118       Docs  -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
 119       Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
 120       x     -> panic $ "not implemented in tableApi " <> (cs $ show x)
 121
 122 getTableHashApi :: NodeId -> Maybe TabType -> Cmd err Text
 123 getTableHashApi cId tabType = do
 124   HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing
 125   pure h
 126
 127 searchInCorpus' :: CorpusId
 128                 -> Bool
 129                 -> [Text]
 130                 -> Maybe Offset
 131                 -> Maybe Limit
 132                 -> Maybe OrderBy
 133                 -> Cmd err FacetTableResult
 134 searchInCorpus' cId t q o l order = do
 135   docs          <- searchInCorpus cId t q o l order
 136   countAllDocs  <- searchCountInCorpus cId t q
 137   pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
 138
 139
 140 getTable :: NodeId
 141          -> Maybe TabType
 142          -> Maybe Offset
 143          -> Maybe Limit
 144          -> Maybe OrderBy
 145          -> Maybe Text
 146          -> Cmd err FacetTableResult
 147 getTable cId ft o l order query = do
 148   docs      <- getTable' cId ft o l order query
 149   docsCount <- runCountDocuments cId (ft == Just Trash) query
 150   pure $ TableResult { tr_docs = docs, tr_count = docsCount }
 151
 152 getTable' :: NodeId
 153           -> Maybe TabType
 154           -> Maybe Offset
 155           -> Maybe Limit
 156           -> Maybe OrderBy
 157           -> Maybe Text
 158           -> Cmd err [FacetDoc]
 159 getTable' cId ft o l order query =
 160   case ft of
 161     (Just Docs)      -> runViewDocuments cId False o l order query
 162     (Just Trash)     -> runViewDocuments cId True  o l order query
 163     (Just MoreFav)   -> moreLike cId o l order IsFav
 164     (Just MoreTrash) -> moreLike cId o l order IsTrash
 165     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 166
 167
 168 getPair :: ContactId -> Maybe TabType
 169          -> Maybe Offset  -> Maybe Limit
 170          -> Maybe OrderBy -> Cmd err [FacetDoc]
 171 getPair cId ft o l order =
 172   case ft of
 173     (Just Docs)  -> runViewAuthorsDoc cId False o l order
 174     (Just Trash) -> runViewAuthorsDoc cId True  o l order
 175     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
 176