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