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