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        , MimeRender JSON a
 203        , MimeUnrender JSON a
 204        ) => proxy a
 205          -> UserId
 206          -> NodeId
 207          -> GargServer (NodeAPI a)
 208 nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI'
 209   where
 210     nodeAPI' :: GargServer (NodeAPI a)
 211     nodeAPI' =  getNodeWith   id' p
 212            :<|> rename        id'
 213            :<|> postNode  uId id'
 214            :<|> postNodeAsyncAPI  uId id'
 215            :<|> FrameCalcUpload.api uId id'
 216            :<|> putNode       id'
 217            :<|> Update.api  uId id'
 218            :<|> Action.deleteNode (RootId $ NodeId uId) id'
 219            :<|> getChildren   id' p
 220
 221            -- TODO gather it
 222            :<|> tableApi             id'
 223            :<|> apiNgramsTableCorpus id'
 224
 225            :<|> catApi      id'
 226            :<|> scoreApi    id'
 227            :<|> Search.api  id'
 228            :<|> Share.api   (RootId $ NodeId uId) id'
 229            -- Pairing Tools
 230            :<|> pairWith    id'
 231            :<|> pairs       id'
 232            :<|> getPair     id'
 233
 234            -- VIZ
 235            :<|> scatterApi id'
 236            :<|> chartApi   id'
 237            :<|> pieApi     id'
 238            :<|> treeApi    id'
 239            :<|> phyloAPI   id' uId
 240            :<|> moveNode   (RootId $ NodeId uId) id'
 241            -- :<|> nodeAddAPI id'
 242            -- :<|> postUpload id'
 243            :<|> Share.unPublish id'
 244
 245            :<|> fileApi uId id'
 246            :<|> fileAsyncApi uId id'
 247
 248            :<|> DocumentsFromWriteNodes.api uId id'
 249            :<|> DocumentUpload.api uId id'
 250
 251
 252 ------------------------------------------------------------------------
 253 data RenameNode = RenameNode { r_name :: Text }
 254   deriving (Generic)
 255
 256 ------------------------------------------------------------------------
 257 ------------------------------------------------------------------------
 258 type CatApi =  Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral, 2 favorite"
 259             :> ReqBody '[JSON] NodesToCategory
 260             :> Put     '[JSON] [Int]
 261
 262 data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
 263                                        , ntc_category :: Int
 264                                        }
 265   deriving (Generic)
 266
 267 -- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
 268 instance FromJSON  NodesToCategory
 269 instance ToJSON    NodesToCategory
 270 instance ToSchema  NodesToCategory
 271
 272 catApi :: CorpusId -> GargServer CatApi
 273 catApi = putCat
 274   where
 275     putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
 276     putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
 277
 278 ------------------------------------------------------------------------
 279 type ScoreApi =  Summary " To Score NodeNodes"
 280             :> ReqBody '[JSON] NodesToScore
 281             :> Put     '[JSON] [Int]
 282
 283 data NodesToScore = NodesToScore { nts_nodesId :: [NodeId]
 284                                  , nts_score :: Int
 285                                  }
 286   deriving (Generic)
 287
 288 -- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
 289 instance FromJSON  NodesToScore
 290 instance ToJSON    NodesToScore
 291 instance ToSchema  NodesToScore
 292
 293 scoreApi :: CorpusId -> GargServer ScoreApi
 294 scoreApi = putScore
 295   where
 296     putScore :: CorpusId -> NodesToScore -> Cmd err [Int]
 297     putScore cId cs' = nodeNodesScore $ map (\n -> (cId, n, nts_score cs')) (nts_nodesId cs')
 298
 299 ------------------------------------------------------------------------
 300 -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
 301 -- Pairing utilities to move elsewhere
 302 type PairingApi = Summary " Pairing API"
 303                 :> QueryParam "view"   TabType
 304                 -- TODO change TabType -> DocType (CorpusId for pairing)
 305                 :> QueryParam "offset" Int
 306                 :> QueryParam "limit"  Int
 307                 :> QueryParam "order"  OrderBy
 308                 :> Get '[JSON] [FacetDoc]
 309
 310 ----------
 311 type Pairs    = Summary "List of Pairs"
 312               :> Get '[JSON] [AnnuaireId]
 313 pairs :: CorpusId -> GargServer Pairs
 314 pairs cId = do
 315   ns <- getNodeNode cId
 316   pure $ map _nn_node2_id ns
 317
 318 type PairWith = Summary "Pair a Corpus with an Annuaire"
 319               :> "annuaire" :> Capture "annuaire_id" AnnuaireId
 320               :> QueryParam "list_id"     ListId
 321               :> Post '[JSON] Int
 322
 323 pairWith :: CorpusId -> GargServer PairWith
 324 pairWith cId aId lId = do
 325   r <- pairing cId aId lId
 326   _ <- insertNodeNode [ NodeNode { _nn_node1_id = cId
 327                                  , _nn_node2_id = aId
 328                                  , _nn_score = Nothing
 329                                  , _nn_category = Nothing }]
 330   pure r
 331
 332
 333 ------------------------------------------------------------------------
 334 type TreeAPI   = QueryParams "type" NodeType
 335                   :> Get '[JSON] (Tree NodeTree)
 336                   :<|> "first-level"
 337                       :> QueryParams "type" NodeType
 338                       :> Get '[JSON] (Tree NodeTree)
 339
 340 treeAPI :: NodeId -> GargServer TreeAPI
 341 treeAPI id = tree TreeAdvanced id
 342         :<|> tree TreeFirstLevel id
 343
 344 ------------------------------------------------------------------------
 345 -- | TODO Check if the name is less than 255 char
 346 rename :: NodeId -> RenameNode -> Cmd err [Int]
 347 rename nId (RenameNode name') = U.update (U.Rename nId name')
 348
 349 putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
 350         => NodeId
 351         -> a
 352         -> Cmd err Int
 353 putNode n h = fromIntegral <$> updateHyperdata n h
 354
 355 -------------------------------------------------------------
 356 type MoveAPI  = Summary "Move Node endpoint"
 357               :> Capture "parent_id" ParentId
 358               :> Put '[JSON] [Int]
 359
 360 moveNode :: User
 361          -> NodeId
 362          -> ParentId
 363          -> Cmd err [Int]
 364 moveNode _u n p = update (Move n p)
 365 -------------------------------------------------------------
 366
 367
 368 $(deriveJSON (unPrefix "r_"       ) ''RenameNode )
 369 instance ToSchema  RenameNode
 370 instance Arbitrary RenameNode where
 371   arbitrary = elements [RenameNode "test"]
 372
 373
 374 -------------------------------------------------------------