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