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