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