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