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 Data.Time (UTCTime)
  38 import GHC.Generics (Generic)
  39 import Gargantext.API.Admin.Auth (withAccess, PathId(..))
  40 import Gargantext.API.Prelude
  41 import Gargantext.API.Metrics
  42 import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus, QueryParamR)
  43 import Gargantext.API.Ngrams.NTree (MyTree)
  44 import Gargantext.API.Node.New
  45 import qualified Gargantext.API.Node.Share  as Share
  46 import qualified Gargantext.API.Node.Update as Update
  47
  48 import Gargantext.API.Search (SearchDocsAPI, searchDocs, SearchPairsAPI, searchPairs)
  49 import Gargantext.API.Table
  50 import Gargantext.Core.Types (NodeTableResult)
  51 import Gargantext.Core.Types.Main (Tree, NodeTree, ListType)
  52 import Gargantext.Database.Action.Flow.Pairing (pairing)
  53 import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
  54 import Gargantext.Core.Types.Individu (User(..))
  55 import Gargantext.Database.Query.Table.Node
  56 import Gargantext.Database.Query.Table.Node.Children (getChildren)
  57 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  58 import Gargantext.Database.Query.Table.Node.User
  59 import Gargantext.Database.Query.Tree (tree, TreeMode(..))
  60 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
  61 import Gargantext.Database.Admin.Types.Node
  62 import Gargantext.Database.Prelude -- (Cmd, CmdM)
  63 import Gargantext.Database.Query.Table.NodeNode
  64 import Gargantext.Prelude
  65 import Gargantext.Viz.Chart
  66 import Gargantext.Viz.Phylo.API (PhyloAPI, phyloAPI)
  67 import Servant
  68 import Test.QuickCheck (elements)
  69 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  70 import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
  71 import qualified Gargantext.Database.Action.Delete as Action (deleteNode)
  72
  73 {-
  74 import qualified Gargantext.Text.List.Learn as Learn
  75 import qualified Data.Vector as Vec
  76 --}
  77
  78 -- | Admin NodesAPI
  79 -- TODO
  80 type NodesAPI  = Delete '[JSON] Int
  81
  82 -- | Delete Nodes
  83 -- Be careful: really delete nodes
  84 -- Access by admin only
  85 nodesAPI :: [NodeId] -> GargServer NodesAPI
  86 nodesAPI ids = deleteNodes ids
  87
  88 ------------------------------------------------------------------------
  89 -- | TODO-ACCESS: access by admin only.
  90 -- At first let's just have an isAdmin check.
  91 -- Later: CanAccessAnyNode or (CanGetAnyNode, CanPutAnyNode)
  92 -- To manage the Users roots
  93 -- TODO-EVENTS:
  94 --   PutNode ?
  95 -- TODO needs design discussion.
  96 type Roots =  Get    '[JSON] [Node HyperdataUser]
  97          :<|> Put    '[JSON] Int -- TODO
  98
  99 -- | TODO: access by admin only
 100 roots :: GargServer Roots
 101 roots = getNodesWithParentId Nothing
 102     :<|> pure (panic "not implemented yet") -- TODO use patch map to update what we need
 103
 104 -------------------------------------------------------------------
 105 -- | Node API Types management
 106 -- TODO-ACCESS : access by users
 107 -- No ownership check is needed if we strictly follow the capability model.
 108 --
 109 -- CanGetNode (Node, Children, TableApi, TableNgramsApiGet, PairingApi, ChartApi,
 110 --             SearchAPI)
 111 -- CanRenameNode (or part of CanEditNode?)
 112 -- CanCreateChildren (PostNodeApi)
 113 -- CanEditNode / CanPutNode TODO not implemented yet
 114 -- CanDeleteNode
 115 -- CanPatch (TableNgramsApi)
 116 -- CanFavorite
 117 -- CanMoveToTrash
 118
 119 type NodeAPI a = Get '[JSON] (Node a)
 120              :<|> "rename" :> RenameApi
 121              :<|> PostNodeApi -- TODO move to children POST
 122              :<|> PostNodeAsync
 123              :<|> ReqBody '[JSON] a :> Put    '[JSON] Int
 124              :<|> Delete '[JSON] Int
 125              :<|> "children"  :> ChildrenApi a
 126
 127              -- TODO gather it
 128              :<|> "table"      :> TableApi
 129              :<|> "ngrams"     :> TableNgramsApi
 130
 131              :<|> "update"     :> Update.API
 132              :<|> "category"   :> CatApi
 133              :<|> "search"     :> SearchDocsAPI
 134              :<|> "share"      :> Share.API
 135
 136              -- Pairing utilities
 137              :<|> "pairwith"   :> PairWith
 138              :<|> "pairs"      :> Pairs
 139              :<|> "pairing"    :> PairingApi
 140              :<|> "searchPair" :> SearchPairsAPI
 141
 142              -- VIZ
 143              :<|> "metrics"    :> ScatterAPI
 144              :<|> "chart"      :> ChartApi
 145              :<|> "pie"        :> PieApi
 146              :<|> "tree"       :> TreeApi
 147              :<|> "phylo"      :> PhyloAPI
 148              -- :<|> "add"       :> NodeAddAPI
 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            :<|> Action.deleteNode (RootId $ NodeId uId) id'
 200            :<|> getChildren   id' p
 201
 202            -- TODO gather it
 203            :<|> tableApi             id'
 204            :<|> apiNgramsTableCorpus id'
 205
 206            :<|> Update.api  id'
 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            :<|> getScatter id'
 217            :<|> getChart   id'
 218            :<|> getPie     id'
 219            :<|> getTree    id'
 220            :<|> phyloAPI   id' uId
 221            -- :<|> nodeAddAPI id'
 222            -- :<|> postUpload id'
 223
 224 ------------------------------------------------------------------------
 225 data RenameNode = RenameNode { r_name :: Text }
 226   deriving (Generic)
 227
 228 -- TODO unPrefix "r_" FromJSON, ToJSON, ToSchema, adapt frontend.
 229 instance FromJSON  RenameNode
 230 instance ToJSON    RenameNode
 231 instance ToSchema  RenameNode
 232 instance Arbitrary RenameNode where
 233   arbitrary = elements [RenameNode "test"]
 234 ------------------------------------------------------------------------
 235 ------------------------------------------------------------------------
 236 type CatApi =  Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral, 2 favorite"
 237             :> ReqBody '[JSON] NodesToCategory
 238             :> Put     '[JSON] [Int]
 239
 240 data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
 241                                        , ntc_category :: Int
 242                                        }
 243   deriving (Generic)
 244
 245 -- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
 246 instance FromJSON  NodesToCategory
 247 instance ToJSON    NodesToCategory
 248 instance ToSchema  NodesToCategory
 249
 250 catApi :: CorpusId -> GargServer CatApi
 251 catApi = putCat
 252   where
 253     putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
 254     putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
 255
 256 ------------------------------------------------------------------------
 257 -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
 258 -- Pairing utilities to move elsewhere
 259 type PairingApi = Summary " Pairing API"
 260               :> QueryParam "view"   TabType
 261               -- TODO change TabType -> DocType (CorpusId for pairing)
 262               :> QueryParam "offset" Int
 263               :> QueryParam "limit"  Int
 264               :> QueryParam "order"  OrderBy
 265               :> Get '[JSON] [FacetDoc]
 266
 267 ----------
 268 type Pairs    = Summary "List of Pairs"
 269               :> Get '[JSON] [AnnuaireId]
 270 pairs :: CorpusId -> GargServer Pairs
 271 pairs cId = do
 272   ns <- getNodeNode cId
 273   pure $ map _nn_node2_id ns
 274
 275 type PairWith = Summary "Pair a Corpus with an Annuaire"
 276               :> "annuaire" :> Capture "annuaire_id" AnnuaireId
 277               :> "list"     :> Capture "list_id"     ListId
 278               :> Post '[JSON] Int
 279
 280 pairWith :: CorpusId -> GargServer PairWith
 281 pairWith cId aId lId = do
 282   r <- pairing cId aId lId
 283   _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
 284   pure r
 285
 286 ------------------------------------------------------------------------
 287 type ChartApi = Summary " Chart API"
 288               :> QueryParam "from" UTCTime
 289               :> QueryParam "to"   UTCTime
 290               :> Get '[JSON] (ChartMetrics Histo)
 291
 292 type PieApi = Summary " Chart API"
 293            :> QueryParam "from" UTCTime
 294            :> QueryParam "to"   UTCTime
 295            :> QueryParamR "ngramsType" TabType
 296            :> Get '[JSON] (ChartMetrics Histo)
 297
 298 type TreeApi = Summary " Tree API"
 299            :> QueryParam "from" UTCTime
 300            :> QueryParam "to"   UTCTime
 301            :> QueryParamR "ngramsType" TabType
 302            :> QueryParamR "listType"   ListType
 303            :> Get '[JSON] (ChartMetrics [MyTree])
 304
 305                 -- Depending on the Type of the Node, we could post
 306                 -- New documents for a corpus
 307                 -- New map list terms
 308              -- :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
 309
 310 ------------------------------------------------------------------------
 311 type TreeAPI   = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)
 312
 313 treeAPI :: NodeId -> GargServer TreeAPI
 314 treeAPI = tree Advanced
 315
 316 ------------------------------------------------------------------------
 317 -- | Check if the name is less than 255 char
 318 rename :: NodeId -> RenameNode -> Cmd err [Int]
 319 rename nId (RenameNode name') = U.update (U.Rename nId name')
 320
 321 putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
 322         => NodeId
 323         -> a
 324         -> Cmd err Int
 325 putNode n h = fromIntegral <$> updateHyperdata n h
 326 -------------------------------------------------------------
 327
 328