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