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 (withAccess, PathId(..))
  44 import Gargantext.API.Metrics
  45 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
  46 import Gargantext.API.Ngrams.Types (TabType(..))
  47 import Gargantext.API.Node.File
  48 import Gargantext.API.Node.New
  49 import Gargantext.API.Prelude
  50 import Gargantext.API.Table
  51 import Gargantext.Core.Types (NodeTableResult)
  52 import Gargantext.Core.Types.Individu (User(..))
  53 import Gargantext.Core.Types.Main (Tree, NodeTree)
  54 import Gargantext.Core.Utils.Prefix (unPrefix)
  55 import Gargantext.Database.Action.Flow.Pairing (pairing)
  56 import Gargantext.Database.Admin.Types.Hyperdata
  57 import Gargantext.Database.Admin.Types.Node
  58 import Gargantext.Database.Prelude -- (Cmd, CmdM)
  59 import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
  60 import Gargantext.Database.Query.Table.Node
  61 import Gargantext.Database.Query.Table.Node.Children (getChildren)
  62 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
  63 import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
  64 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  65 import Gargantext.Database.Query.Table.NodeNode
  66 import Gargantext.Database.Query.Tree (tree, TreeMode(..))
  67 import Gargantext.Prelude
  68 import Gargantext.Core.Viz.Phylo.API (PhyloAPI, phyloAPI)
  69 import qualified Gargantext.API.Node.Share  as Share
  70 import qualified Gargantext.API.Node.Update as Update
  71 import qualified Gargantext.API.Search as Search
  72 import qualified Gargantext.Database.Action.Delete as Action (deleteNode)
  73 import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
  74
  75 {-
  76 import qualified Gargantext.Core.Text.List.Learn as Learn
  77 import qualified Data.Vector as Vec
  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              :<|> 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              :<|> "search"     :> (Search.API Search.SearchResult)
 136              :<|> "share"      :> Share.API
 137
 138              -- Pairing utilities
 139              :<|> "pairwith"   :> PairWith
 140              :<|> "pairs"      :> Pairs
 141              :<|> "pairing"    :> PairingApi
 142
 143              -- VIZ
 144              :<|> "metrics"   :> ScatterAPI
 145              :<|> "chart"     :> ChartApi
 146              :<|> "pie"       :> PieApi
 147              :<|> "tree"      :> TreeApi
 148              :<|> "phylo"     :> PhyloAPI
 149              -- :<|> "add"       :> NodeAddAPI
 150              :<|> "move"      :> MoveAPI
 151              :<|> "unpublish" :> Share.Unpublish
 152
 153              :<|> "file"      :> FileApi
 154              :<|> "async"     :> FileAsyncApi
 155
 156 -- TODO-ACCESS: check userId CanRenameNode nodeId
 157 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
 158 type RenameApi = Summary " Rename Node"
 159                :> ReqBody '[JSON] RenameNode
 160                :> Put     '[JSON] [Int]
 161
 162 type PostNodeApi = Summary " PostNode Node with ParentId as {id}"
 163                  :> ReqBody '[JSON] PostNode
 164                  :> Post    '[JSON] [NodeId]
 165
 166 type ChildrenApi a = Summary " Summary children"
 167                  :> QueryParam "type"   NodeType
 168                  :> QueryParam "offset" Int
 169                  :> QueryParam "limit"  Int
 170                  -- :> Get '[JSON] [Node a]
 171                  :> Get '[JSON] (NodeTableResult a)
 172
 173 ------------------------------------------------------------------------
 174 type NodeNodeAPI a = Get '[JSON] (Node a)
 175
 176 nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a)
 177             => proxy a
 178             -> UserId
 179             -> CorpusId
 180             -> NodeId
 181             -> GargServer (NodeNodeAPI a)
 182 nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uId (PathNodeNode cId nId) nodeNodeAPI'
 183   where
 184     nodeNodeAPI' :: GargServer (NodeNodeAPI a)
 185     nodeNodeAPI' = getNodeWith nId p
 186
 187 ------------------------------------------------------------------------
 188 -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
 189 nodeAPI :: forall proxy a.
 190        ( JSONB a
 191        , FromJSON a
 192        , ToJSON a
 193        ) => proxy a
 194          -> UserId
 195          -> NodeId
 196          -> GargServer (NodeAPI a)
 197 nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI'
 198   where
 199     nodeAPI' :: GargServer (NodeAPI a)
 200     nodeAPI' =  getNodeWith   id' p
 201            :<|> rename        id'
 202            :<|> postNode  uId id'
 203            :<|> postNodeAsyncAPI  uId id'
 204            :<|> putNode       id'
 205            :<|> Update.api  uId id'
 206            :<|> Action.deleteNode (RootId $ NodeId uId) id'
 207            :<|> getChildren   id' p
 208
 209            -- TODO gather it
 210            :<|> tableApi             id'
 211            :<|> apiNgramsTableCorpus id'
 212
 213            :<|> catApi      id'
 214            :<|> Search.api  id'
 215            :<|> Share.api   id'
 216            -- Pairing Tools
 217            :<|> pairWith    id'
 218            :<|> pairs       id'
 219            :<|> getPair     id'
 220
 221            -- VIZ
 222            :<|> scatterApi id'
 223            :<|> chartApi   id'
 224            :<|> pieApi     id'
 225            :<|> treeApi    id'
 226            :<|> phyloAPI   id' uId
 227            :<|> moveNode   (RootId $ NodeId uId) id'
 228            -- :<|> nodeAddAPI id'
 229            -- :<|> postUpload id'
 230            :<|> Share.unPublish id'
 231
 232            :<|> fileApi uId id'
 233            :<|> fileAsyncApi uId id'
 234
 235
 236 ------------------------------------------------------------------------
 237 data RenameNode = RenameNode { r_name :: Text }
 238   deriving (Generic)
 239
 240 ------------------------------------------------------------------------
 241 ------------------------------------------------------------------------
 242 type CatApi =  Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral, 2 favorite"
 243             :> ReqBody '[JSON] NodesToCategory
 244             :> Put     '[JSON] [Int]
 245
 246 data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
 247                                        , ntc_category :: Int
 248                                        }
 249   deriving (Generic)
 250
 251 -- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
 252 instance FromJSON  NodesToCategory
 253 instance ToJSON    NodesToCategory
 254 instance ToSchema  NodesToCategory
 255
 256 catApi :: CorpusId -> GargServer CatApi
 257 catApi = putCat
 258   where
 259     putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
 260     putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
 261
 262 ------------------------------------------------------------------------
 263 -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
 264 -- Pairing utilities to move elsewhere
 265 type PairingApi = Summary " Pairing API"
 266                 :> QueryParam "view"   TabType
 267                 -- TODO change TabType -> DocType (CorpusId for pairing)
 268                 :> QueryParam "offset" Int
 269                 :> QueryParam "limit"  Int
 270                 :> QueryParam "order"  OrderBy
 271                 :> Get '[JSON] [FacetDoc]
 272
 273 ----------
 274 type Pairs    = Summary "List of Pairs"
 275               :> Get '[JSON] [AnnuaireId]
 276 pairs :: CorpusId -> GargServer Pairs
 277 pairs cId = do
 278   ns <- getNodeNode cId
 279   pure $ map _nn_node2_id ns
 280
 281 type PairWith = Summary "Pair a Corpus with an Annuaire"
 282               :> "annuaire" :> Capture "annuaire_id" AnnuaireId
 283               :> QueryParam "list_id"     ListId
 284               :> Post '[JSON] Int
 285
 286 pairWith :: CorpusId -> GargServer PairWith
 287 pairWith cId aId lId = do
 288   r <- pairing cId aId lId
 289   _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
 290   pure r
 291
 292
 293 ------------------------------------------------------------------------
 294 type TreeAPI   = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)
 295
 296 treeAPI :: NodeId -> GargServer TreeAPI
 297 treeAPI = tree TreeAdvanced
 298
 299 ------------------------------------------------------------------------
 300 -- | TODO Check if the name is less than 255 char
 301 rename :: NodeId -> RenameNode -> Cmd err [Int]
 302 rename nId (RenameNode name') = U.update (U.Rename nId name')
 303
 304 putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
 305         => NodeId
 306         -> a
 307         -> Cmd err Int
 308 putNode n h = fromIntegral <$> updateHyperdata n h
 309
 310 -------------------------------------------------------------
 311 type MoveAPI  = Summary "Move Node endpoint"
 312               :> Capture "parent_id" ParentId
 313               :> Put '[JSON] [Int]
 314
 315 moveNode :: User
 316          -> NodeId
 317          -> ParentId
 318          -> Cmd err [Int]
 319 moveNode _u n p = update (Move n p)
 320 -------------------------------------------------------------
 321
 322
 323 $(deriveJSON (unPrefix "r_"       ) ''RenameNode )
 324 instance ToSchema  RenameNode
 325 instance Arbitrary RenameNode where
 326   arbitrary = elements [RenameNode "test"]
 327
 328
 329 -------------------------------------------------------------