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            :<|> chartApi   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
 234 chartApi :: NodeId -> GargServer ChartApi
 235 chartApi id' =  getChart id'
 236            :<|> updateChart id'
 237
 238
 239 ------------------------------------------------------------------------
 240 data RenameNode = RenameNode { r_name :: Text }
 241   deriving (Generic)
 242
 243 -- TODO unPrefix "r_" FromJSON, ToJSON, ToSchema, adapt frontend.
 244 instance FromJSON  RenameNode
 245 instance ToJSON    RenameNode
 246 instance ToSchema  RenameNode
 247 instance Arbitrary RenameNode where
 248   arbitrary = elements [RenameNode "test"]
 249 ------------------------------------------------------------------------
 250 ------------------------------------------------------------------------
 251 type CatApi =  Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral, 2 favorite"
 252             :> ReqBody '[JSON] NodesToCategory
 253             :> Put     '[JSON] [Int]
 254
 255 data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
 256                                        , ntc_category :: Int
 257                                        }
 258   deriving (Generic)
 259
 260 -- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
 261 instance FromJSON  NodesToCategory
 262 instance ToJSON    NodesToCategory
 263 instance ToSchema  NodesToCategory
 264
 265 catApi :: CorpusId -> GargServer CatApi
 266 catApi = putCat
 267   where
 268     putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
 269     putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
 270
 271 ------------------------------------------------------------------------
 272 -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
 273 -- Pairing utilities to move elsewhere
 274 type PairingApi = Summary " Pairing API"
 275               :> QueryParam "view"   TabType
 276               -- TODO change TabType -> DocType (CorpusId for pairing)
 277               :> QueryParam "offset" Int
 278               :> QueryParam "limit"  Int
 279               :> QueryParam "order"  OrderBy
 280               :> Get '[JSON] [FacetDoc]
 281
 282 ----------
 283 type Pairs    = Summary "List of Pairs"
 284               :> Get '[JSON] [AnnuaireId]
 285 pairs :: CorpusId -> GargServer Pairs
 286 pairs cId = do
 287   ns <- getNodeNode cId
 288   pure $ map _nn_node2_id ns
 289
 290 type PairWith = Summary "Pair a Corpus with an Annuaire"
 291               :> "annuaire" :> Capture "annuaire_id" AnnuaireId
 292               :> "list"     :> Capture "list_id"     ListId
 293               :> Post '[JSON] Int
 294
 295 pairWith :: CorpusId -> GargServer PairWith
 296 pairWith cId aId lId = do
 297   r <- pairing cId aId lId
 298   _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
 299   pure r
 300
 301 ------------------------------------------------------------------------
 302 type ChartApi = Summary " Chart API"
 303               :> QueryParam "from" UTCTime
 304               :> QueryParam "to"   UTCTime
 305               :> Get '[JSON] (ChartMetrics Histo)
 306         :<|> Summary "SepGen IncExc chart update"
 307                 :> QueryParam  "list"       ListId
 308                 :> QueryParamR "ngramsType" TabType
 309                 :> QueryParam  "limit"      Int
 310                 :> Post '[JSON] ()
 311
 312 type PieApi = Summary " Chart API"
 313            :> QueryParam "from" UTCTime
 314            :> QueryParam "to"   UTCTime
 315            :> QueryParamR "ngramsType" TabType
 316            :> Get '[JSON] (ChartMetrics Histo)
 317
 318 type TreeApi = Summary " Tree API"
 319            :> QueryParam "from" UTCTime
 320            :> QueryParam "to"   UTCTime
 321            :> QueryParamR "ngramsType" TabType
 322            :> QueryParamR "listType"   ListType
 323            :> Get '[JSON] (ChartMetrics [MyTree])
 324
 325                 -- Depending on the Type of the Node, we could post
 326                 -- New documents for a corpus
 327                 -- New map list terms
 328              -- :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
 329
 330 ------------------------------------------------------------------------
 331
 332 type TreeAPI   = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)
 333
 334 treeAPI :: NodeId -> GargServer TreeAPI
 335 treeAPI = treeDB
 336
 337 ------------------------------------------------------------------------
 338 -- | Check if the name is less than 255 char
 339 rename :: NodeId -> RenameNode -> Cmd err [Int]
 340 rename nId (RenameNode name') = U.update (U.Rename nId name')
 341
 342 putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
 343         => NodeId
 344         -> a
 345         -> Cmd err Int
 346 putNode n h = fromIntegral <$> updateHyperdata n h
 347 -------------------------------------------------------------
 348
 349