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