src/Gargantext/API/Node.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 -- TODO-SECURITY: Critical
  11
  12 -- TODO-ACCESS: CanGetNode
  13 -- TODO-EVENTS: No events as this is a read only query.
  14 Node API
  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 {-# OPTIONS_GHC -fno-warn-orphans #-}
  25
  26 {-# LANGUAGE DataKinds            #-}
  27 {-# LANGUAGE DeriveGeneric        #-}
  28 {-# LANGUAGE FlexibleContexts     #-}
  29 {-# LANGUAGE FlexibleInstances    #-}
  30 {-# LANGUAGE NoImplicitPrelude    #-}
  31 {-# LANGUAGE OverloadedStrings    #-}
  32 {-# LANGUAGE RankNTypes           #-}
  33 {-# LANGUAGE ScopedTypeVariables  #-}
  34 {-# LANGUAGE TemplateHaskell      #-}
  35 {-# LANGUAGE TypeOperators        #-}
  36
  37 module Gargantext.API.Node
  38   where
  39
  40 import Data.Aeson (FromJSON, ToJSON)
  41 import Data.Maybe
  42 import Data.Swagger
  43 import Data.Text (Text())
  44 import Data.Time (UTCTime)
  45 import GHC.Generics (Generic)
  46 import Servant
  47 import Test.QuickCheck (elements)
  48 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  49
  50 import Gargantext.API.Admin.Auth (withAccess, PathId(..))
  51 import Gargantext.API.Prelude
  52 import Gargantext.API.Metrics
  53 import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR)
  54 import Gargantext.API.Ngrams.NTree (MyTree)
  55 import Gargantext.API.Node.New
  56 import Gargantext.API.Search (SearchDocsAPI, searchDocs, SearchPairsAPI, searchPairs)
  57 import Gargantext.API.Table
  58 import Gargantext.Core.Types (NodeTableResult)
  59 import Gargantext.Core.Types.Main (Tree, NodeTree, ListType)
  60 import Gargantext.Database.Action.Flow.Pairing (pairing)
  61 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics)
  62 import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
  63 import Gargantext.Database.Query.Table.Node
  64 import Gargantext.Database.Query.Table.Node.Children (getChildren)
  65 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  66 import Gargantext.Database.Query.Table.Node.User
  67 import Gargantext.Database.Query.Tree (treeDB)
  68 import Gargantext.Database.Admin.Config (nodeTypeId)
  69 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
  70 import Gargantext.Database.Admin.Types.Node
  71 import Gargantext.Database.Prelude -- (Cmd, CmdM)
  72 import Gargantext.Database.Schema.Node (_node_typename)
  73 import Gargantext.Database.Query.Table.NodeNode
  74 import Gargantext.Prelude
  75 import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI)
  76 import Gargantext.Viz.Types
  77 import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
  78
  79 {-
  80 import qualified Gargantext.Text.List.Learn as Learn
  81 import qualified Data.Vector as Vec
  82 --}
  83
  84 type NodesAPI  = Delete '[JSON] Int
  85
  86 -- | Delete Nodes
  87 -- Be careful: really delete nodes
  88 -- Access by admin only
  89 nodesAPI :: [NodeId] -> GargServer NodesAPI
  90 nodesAPI ids = deleteNodes ids
  91
  92 ------------------------------------------------------------------------
  93 -- | TODO-ACCESS: access by admin only.
  94 -- At first let's just have an isAdmin check.
  95 -- Later: CanAccessAnyNode or (CanGetAnyNode, CanPutAnyNode)
  96 -- To manage the Users roots
  97 -- TODO-EVENTS:
  98 --   PutNode ?
  99 -- TODO needs design discussion.
 100 type Roots =  Get    '[JSON] [Node HyperdataUser]
 101          :<|> Put    '[JSON] Int -- TODO
 102
 103 -- | TODO: access by admin only
 104 roots :: GargServer Roots
 105 roots = getNodesWithParentId Nothing
 106     :<|> pure (panic "not implemented yet") -- TODO use patch map to update what we need
 107
 108 -------------------------------------------------------------------
 109 -- | Node API Types management
 110 -- TODO-ACCESS : access by users
 111 -- No ownership check is needed if we strictly follow the capability model.
 112 --
 113 -- CanGetNode (Node, Children, TableApi, TableNgramsApiGet, PairingApi, ChartApi,
 114 --             SearchAPI)
 115 -- CanRenameNode (or part of CanEditNode?)
 116 -- CanCreateChildren (PostNodeApi)
 117 -- CanEditNode / CanPutNode TODO not implemented yet
 118 -- CanDeleteNode
 119 -- CanPatch (TableNgramsApi)
 120 -- CanFavorite
 121 -- CanMoveToTrash
 122
 123 type NodeAPI a = Get '[JSON] (Node a)
 124              :<|> "rename" :> RenameApi
 125              :<|> PostNodeApi -- TODO move to children POST
 126              :<|> PostNodeAsync
 127              :<|> ReqBody '[JSON] a :> Put    '[JSON] Int
 128              :<|> Delete '[JSON] Int
 129              :<|> "children"  :> ChildrenApi a
 130
 131              -- TODO gather it
 132              :<|> "table"     :> TableApi
 133              :<|> "ngrams"    :> TableNgramsApi
 134
 135              :<|> "category"  :> CatApi
 136              :<|> "search"     :> SearchDocsAPI
 137
 138              -- Pairing utilities
 139              :<|> "pairwith"   :> PairWith
 140              :<|> "pairs"      :> Pairs
 141              :<|> "pairing"    :> PairingApi
 142              :<|> "searchPair" :> SearchPairsAPI
 143
 144              -- VIZ
 145              :<|> "metrics"   :> ScatterAPI
 146              :<|> "chart"     :> ChartApi
 147              :<|> "pie"       :> PieApi
 148              :<|> "tree"      :> TreeApi
 149              :<|> "phylo"     :> PhyloAPI
 150              -- :<|> "add"       :> NodeAddAPI
 151
 152 -- TODO-ACCESS: check userId CanRenameNode nodeId
 153 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
 154 type RenameApi = Summary " Rename Node"
 155                :> ReqBody '[JSON] RenameNode
 156                :> Put     '[JSON] [Int]
 157
 158 type PostNodeApi = Summary " PostNode Node with ParentId as {id}"
 159                  :> ReqBody '[JSON] PostNode
 160                  :> Post    '[JSON] [NodeId]
 161
 162 type ChildrenApi a = Summary " Summary children"
 163                  :> QueryParam "type"   NodeType
 164                  :> QueryParam "offset" Int
 165                  :> QueryParam "limit"  Int
 166                  -- :> Get '[JSON] [Node a]
 167                  :> Get '[JSON] (NodeTableResult a)
 168
 169 ------------------------------------------------------------------------
 170 type NodeNodeAPI a = Get '[JSON] (Node a)
 171
 172 nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a)
 173             => proxy a
 174             -> UserId
 175             -> CorpusId
 176             -> NodeId
 177             -> GargServer (NodeNodeAPI a)
 178 nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uId (PathNodeNode cId nId) nodeNodeAPI'
 179   where
 180     nodeNodeAPI' :: GargServer (NodeNodeAPI a)
 181     nodeNodeAPI' = getNodeWith nId p
 182
 183 ------------------------------------------------------------------------
 184 -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
 185 nodeAPI :: forall proxy a.
 186        ( JSONB a
 187        , FromJSON a
 188        , ToJSON a
 189        ) => proxy a
 190          -> UserId
 191          -> NodeId
 192          -> GargServer (NodeAPI a)
 193 nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI'
 194   where
 195     nodeAPI' :: GargServer (NodeAPI a)
 196     nodeAPI' =  getNodeWith   id' p
 197            :<|> rename        id'
 198            :<|> postNode  uId id'
 199            :<|> postNodeAsyncAPI  uId id'
 200            :<|> putNode       id'
 201            :<|> deleteNodeApi id'
 202            :<|> getChildren   id' p
 203
 204            -- TODO gather it
 205            :<|> tableApi             id'
 206            :<|> apiNgramsTableCorpus id'
 207
 208            :<|> catApi      id'
 209
 210            :<|> searchDocs  id'
 211            -- Pairing Tools
 212            :<|> pairWith    id'
 213            :<|> pairs       id'
 214            :<|> getPair     id'
 215            :<|> searchPairs id'
 216
 217            :<|> scatterApi id'
 218            :<|> getChart   id'
 219            :<|> getPie     id'
 220            :<|> getTree    id'
 221            :<|> phyloAPI   id' uId
 222            -- :<|> nodeAddAPI id'
 223            -- :<|> postUpload id'
 224
 225     deleteNodeApi id'' = do
 226       node' <- getNode id''
 227       if _node_typename node' == nodeTypeId NodeUser
 228          then panic "not allowed"  -- TODO add proper Right Management Type
 229          else deleteNode id''
 230
 231 scatterApi :: NodeId -> GargServer ScatterAPI
 232 scatterApi id' =  getScatter id'
 233              :<|> updateScatter id'
 234
 235
 236 ------------------------------------------------------------------------
 237 data RenameNode = RenameNode { r_name :: Text }
 238   deriving (Generic)
 239
 240 -- TODO unPrefix "r_" FromJSON, ToJSON, ToSchema, adapt frontend.
 241 instance FromJSON  RenameNode
 242 instance ToJSON    RenameNode
 243 instance ToSchema  RenameNode
 244 instance Arbitrary RenameNode where
 245   arbitrary = elements [RenameNode "test"]
 246 ------------------------------------------------------------------------
 247 ------------------------------------------------------------------------
 248 type CatApi =  Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral, 2 favorite"
 249             :> ReqBody '[JSON] NodesToCategory
 250             :> Put     '[JSON] [Int]
 251
 252 data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
 253                                        , ntc_category :: Int
 254                                        }
 255   deriving (Generic)
 256
 257 -- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
 258 instance FromJSON  NodesToCategory
 259 instance ToJSON    NodesToCategory
 260 instance ToSchema  NodesToCategory
 261
 262 catApi :: CorpusId -> GargServer CatApi
 263 catApi = putCat
 264   where
 265     putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
 266     putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
 267
 268 ------------------------------------------------------------------------
 269 -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
 270 -- Pairing utilities to move elsewhere
 271 type PairingApi = Summary " Pairing API"
 272               :> QueryParam "view"   TabType
 273               -- TODO change TabType -> DocType (CorpusId for pairing)
 274               :> QueryParam "offset" Int
 275               :> QueryParam "limit"  Int
 276               :> QueryParam "order"  OrderBy
 277               :> Get '[JSON] [FacetDoc]
 278
 279 ----------
 280 type Pairs    = Summary "List of Pairs"
 281               :> Get '[JSON] [AnnuaireId]
 282 pairs :: CorpusId -> GargServer Pairs
 283 pairs cId = do
 284   ns <- getNodeNode cId
 285   pure $ map _nn_node2_id ns
 286
 287 type PairWith = Summary "Pair a Corpus with an Annuaire"
 288               :> "annuaire" :> Capture "annuaire_id" AnnuaireId
 289               :> "list"     :> Capture "list_id"     ListId
 290               :> Post '[JSON] Int
 291
 292 pairWith :: CorpusId -> GargServer PairWith
 293 pairWith cId aId lId = do
 294   r <- pairing cId aId lId
 295   _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
 296   pure r
 297
 298 ------------------------------------------------------------------------
 299 type ChartApi = Summary " Chart API"
 300               :> QueryParam "from" UTCTime
 301               :> QueryParam "to"   UTCTime
 302               :> Get '[JSON] (ChartMetrics Histo)
 303
 304 type PieApi = Summary " Chart API"
 305            :> QueryParam "from" UTCTime
 306            :> QueryParam "to"   UTCTime
 307            :> QueryParamR "ngramsType" TabType
 308            :> Get '[JSON] (ChartMetrics Histo)
 309
 310 type TreeApi = Summary " Tree API"
 311            :> QueryParam "from" UTCTime
 312            :> QueryParam "to"   UTCTime
 313            :> QueryParamR "ngramsType" TabType
 314            :> QueryParamR "listType"   ListType
 315            :> Get '[JSON] (ChartMetrics [MyTree])
 316
 317                 -- Depending on the Type of the Node, we could post
 318                 -- New documents for a corpus
 319                 -- New map list terms
 320              -- :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
 321
 322 ------------------------------------------------------------------------
 323
 324 type TreeAPI   = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)
 325
 326 treeAPI :: NodeId -> GargServer TreeAPI
 327 treeAPI = treeDB
 328
 329 ------------------------------------------------------------------------
 330 -- | Check if the name is less than 255 char
 331 rename :: NodeId -> RenameNode -> Cmd err [Int]
 332 rename nId (RenameNode name') = U.update (U.Rename nId name')
 333
 334 putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
 335         => NodeId
 336         -> a
 337         -> Cmd err Int
 338 putNode n h = fromIntegral <$> updateHyperdata n h
 339 -------------------------------------------------------------
 340
 341