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