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