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