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