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.Legacy.LegacyAPI (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              :<|> "score"      :> ScoreApi
 137              :<|> "search"     :> (Search.API Search.SearchResult)
 138              :<|> "share"      :> Share.API
 139
 140              -- Pairing utilities
 141              :<|> "pairwith"   :> PairWith
 142              :<|> "pairs"      :> Pairs
 143              :<|> "pairing"    :> PairingApi
 144
 145              -- VIZ
 146              :<|> "metrics"   :> ScatterAPI
 147              :<|> "chart"     :> ChartApi
 148              :<|> "pie"       :> PieApi
 149              :<|> "tree"      :> TreeApi
 150              :<|> "phylo"     :> PhyloAPI
 151              -- :<|> "add"       :> NodeAddAPI
 152              :<|> "move"      :> MoveAPI
 153              :<|> "unpublish" :> Share.Unpublish
 154
 155              :<|> "file"      :> FileApi
 156              :<|> "async"     :> FileAsyncApi
 157
 158 -- TODO-ACCESS: check userId CanRenameNode nodeId
 159 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
 160 type RenameApi = Summary " Rename Node"
 161                :> ReqBody '[JSON] RenameNode
 162                :> Put     '[JSON] [Int]
 163
 164 type PostNodeApi = Summary " PostNode Node with ParentId as {id}"
 165                  :> ReqBody '[JSON] PostNode
 166                  :> Post    '[JSON] [NodeId]
 167
 168 type ChildrenApi a = Summary " Summary children"
 169                  :> QueryParam "type"   NodeType
 170                  :> QueryParam "offset" Int
 171                  :> QueryParam "limit"  Int
 172                  -- :> Get '[JSON] [Node a]
 173                  :> Get '[JSON] (NodeTableResult a)
 174
 175 ------------------------------------------------------------------------
 176 type NodeNodeAPI a = Get '[JSON] (Node a)
 177
 178 nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a)
 179             => proxy a
 180             -> UserId
 181             -> CorpusId
 182             -> NodeId
 183             -> GargServer (NodeNodeAPI a)
 184 nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uId (PathNodeNode cId nId) nodeNodeAPI'
 185   where
 186     nodeNodeAPI' :: GargServer (NodeNodeAPI a)
 187     nodeNodeAPI' = getNodeWith nId p
 188
 189 ------------------------------------------------------------------------
 190 -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
 191 nodeAPI :: forall proxy a.
 192        ( JSONB a
 193        , FromJSON a
 194        , ToJSON a
 195        , MimeRender JSON a
 196        , MimeUnrender JSON a
 197        ) => proxy a
 198          -> UserId
 199          -> NodeId
 200          -> GargServer (NodeAPI a)
 201 nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI'
 202   where
 203     nodeAPI' :: GargServer (NodeAPI a)
 204     nodeAPI' =  getNodeWith   id' p
 205            :<|> rename        id'
 206            :<|> postNode  uId id'
 207            :<|> postNodeAsyncAPI  uId id'
 208            :<|> putNode       id'
 209            :<|> Update.api  uId id'
 210            :<|> Action.deleteNode (RootId $ NodeId uId) id'
 211            :<|> getChildren   id' p
 212
 213            -- TODO gather it
 214            :<|> tableApi             id'
 215            :<|> apiNgramsTableCorpus id'
 216
 217            :<|> catApi      id'
 218            :<|> scoreApi    id'
 219            :<|> Search.api  id'
 220            :<|> Share.api   (RootId $ NodeId uId) id'
 221            -- Pairing Tools
 222            :<|> pairWith    id'
 223            :<|> pairs       id'
 224            :<|> getPair     id'
 225
 226            -- VIZ
 227            :<|> scatterApi id'
 228            :<|> chartApi   id'
 229            :<|> pieApi     id'
 230            :<|> treeApi    id'
 231            :<|> phyloAPI   id' uId
 232            :<|> moveNode   (RootId $ NodeId uId) id'
 233            -- :<|> nodeAddAPI id'
 234            -- :<|> postUpload id'
 235            :<|> Share.unPublish id'
 236
 237            :<|> fileApi uId id'
 238            :<|> fileAsyncApi uId id'
 239
 240
 241 ------------------------------------------------------------------------
 242 data RenameNode = RenameNode { r_name :: Text }
 243   deriving (Generic)
 244
 245 ------------------------------------------------------------------------
 246 ------------------------------------------------------------------------
 247 type CatApi =  Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral, 2 favorite"
 248             :> ReqBody '[JSON] NodesToCategory
 249             :> Put     '[JSON] [Int]
 250
 251 data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
 252                                        , ntc_category :: Int
 253                                        }
 254   deriving (Generic)
 255
 256 -- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
 257 instance FromJSON  NodesToCategory
 258 instance ToJSON    NodesToCategory
 259 instance ToSchema  NodesToCategory
 260
 261 catApi :: CorpusId -> GargServer CatApi
 262 catApi = putCat
 263   where
 264     putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
 265     putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
 266
 267 ------------------------------------------------------------------------
 268 type ScoreApi =  Summary " To Score NodeNodes"
 269             :> ReqBody '[JSON] NodesToScore
 270             :> Put     '[JSON] [Int]
 271
 272 data NodesToScore = NodesToScore { nts_nodesId :: [NodeId]
 273                                  , nts_score :: Int
 274                                  }
 275   deriving (Generic)
 276
 277 -- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
 278 instance FromJSON  NodesToScore
 279 instance ToJSON    NodesToScore
 280 instance ToSchema  NodesToScore
 281
 282 scoreApi :: CorpusId -> GargServer ScoreApi
 283 scoreApi = putScore
 284   where
 285     putScore :: CorpusId -> NodesToScore -> Cmd err [Int]
 286     putScore cId cs' = nodeNodesScore $ map (\n -> (cId, n, nts_score cs')) (nts_nodesId cs')
 287
 288 ------------------------------------------------------------------------
 289 -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
 290 -- Pairing utilities to move elsewhere
 291 type PairingApi = Summary " Pairing API"
 292                 :> QueryParam "view"   TabType
 293                 -- TODO change TabType -> DocType (CorpusId for pairing)
 294                 :> QueryParam "offset" Int
 295                 :> QueryParam "limit"  Int
 296                 :> QueryParam "order"  OrderBy
 297                 :> Get '[JSON] [FacetDoc]
 298
 299 ----------
 300 type Pairs    = Summary "List of Pairs"
 301               :> Get '[JSON] [AnnuaireId]
 302 pairs :: CorpusId -> GargServer Pairs
 303 pairs cId = do
 304   ns <- getNodeNode cId
 305   pure $ map _nn_node2_id ns
 306
 307 type PairWith = Summary "Pair a Corpus with an Annuaire"
 308               :> "annuaire" :> Capture "annuaire_id" AnnuaireId
 309               :> QueryParam "list_id"     ListId
 310               :> Post '[JSON] Int
 311
 312 pairWith :: CorpusId -> GargServer PairWith
 313 pairWith cId aId lId = do
 314   r <- pairing cId aId lId
 315   _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
 316   pure r
 317
 318
 319 ------------------------------------------------------------------------
 320 type TreeAPI   = QueryParams "type" NodeType
 321                   :> Get '[JSON] (Tree NodeTree)
 322                   :<|> "first-level"
 323                       :> QueryParams "type" NodeType
 324                       :> Get '[JSON] (Tree NodeTree)
 325
 326 treeAPI :: NodeId -> GargServer TreeAPI
 327 treeAPI id = tree TreeAdvanced id
 328         :<|> tree TreeFirstLevel id
 329
 330 ------------------------------------------------------------------------
 331 -- | TODO Check if the name is less than 255 char
 332 rename :: NodeId -> RenameNode -> Cmd err [Int]
 333 rename nId (RenameNode name') = U.update (U.Rename nId name')
 334
 335 putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
 336         => NodeId
 337         -> a
 338         -> Cmd err Int
 339 putNode n h = fromIntegral <$> updateHyperdata n h
 340
 341 -------------------------------------------------------------
 342 type MoveAPI  = Summary "Move Node endpoint"
 343               :> Capture "parent_id" ParentId
 344               :> Put '[JSON] [Int]
 345
 346 moveNode :: User
 347          -> NodeId
 348          -> ParentId
 349          -> Cmd err [Int]
 350 moveNode _u n p = update (Move n p)
 351 -------------------------------------------------------------
 352
 353
 354 $(deriveJSON (unPrefix "r_"       ) ''RenameNode )
 355 instance ToSchema  RenameNode
 356 instance Arbitrary RenameNode where
 357   arbitrary = elements [RenameNode "test"]
 358
 359
 360 -------------------------------------------------------------