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