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