[FIX] typo
[gargantext.git] / src / Gargantext / API / Node.hs
index 8f93f812947e3b233e2684d916933aaf51e365d2..374e368688285734ad227541447b919ee7e0339f 100644 (file)
@@ -7,110 +7,329 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
+-- TODO-SECURITY: Critical
+
+-- TODO-ACCESS: CanGetNode
+-- TODO-EVENTS: No events as this is a read only query.
 Node API
+-------------------------------------------------------------------
+-- TODO-ACCESS: access by admin only.
+--              At first let's just have an isAdmin check.
+--              Later: check userId CanDeleteNodes Nothing
+-- TODO-EVENTS: DeletedNodes [NodeId]
+--              {"tag": "DeletedNodes", "nodes": [Int*]}
+
 -}
 
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# LANGUAGE DataKinds       #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeOperators   #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TypeOperators        #-}
 
 module Gargantext.API.Node
-      where
+  where
 
-import Control.Monad
-import Control.Monad.IO.Class (liftIO)
-import Data.Aeson (Value())
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson.TH (deriveJSON)
+import Data.Maybe
+import Data.Swagger
+import Data.Text (Text())
+import GHC.Generics (Generic)
 import Servant
-import Servant.Multipart
-import System.IO (putStrLn, readFile)
-import Data.Text (Text(), pack)
-import Database.PostgreSQL.Simple (Connection)
-import Gargantext.Prelude
-import Gargantext.Types.Main (Node, NodeId, NodeType)
-import Gargantext.Database.Node (getNodesWithParentId
-                                , getNode, getNodesWith
-                                , deleteNode, deleteNodes)
-import Gargantext.Database.Facet (FacetDoc, getDocFacet)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
+import Gargantext.API.Admin.Auth.Types (PathId(..))
+import Gargantext.API.Admin.Auth (withAccess)
+import Gargantext.API.Metrics
+import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
+import Gargantext.API.Ngrams.Types (TabType(..))
+import Gargantext.API.Node.File
+import Gargantext.API.Node.New
+import Gargantext.API.Prelude
+import Gargantext.API.Table
+import Gargantext.Core.Types (NodeTableResult)
+import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Core.Types.Main (Tree, NodeTree)
+import Gargantext.Core.Utils.Prefix (unPrefix)
+import Gargantext.Database.Action.Flow.Pairing (pairing)
+import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude -- (Cmd, CmdM)
+import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
+import Gargantext.Database.Query.Table.Node
+import Gargantext.Database.Query.Table.Node.Children (getChildren)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
+import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
+import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
+import Gargantext.Database.Query.Table.NodeNode
+import Gargantext.Database.Query.Tree (tree, TreeMode(..))
+import Gargantext.Prelude
+import Gargantext.Core.Viz.Phylo.API (PhyloAPI, phyloAPI)
+import qualified Gargantext.API.Node.Share  as Share
+import qualified Gargantext.API.Node.Update as Update
+import qualified Gargantext.API.Search as Search
+import qualified Gargantext.Database.Action.Delete as Action (deleteNode)
+import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
 
--- | Node API Types management
-type Roots = Get '[JSON] [Node Value]
+{-
+import qualified Gargantext.Core.Text.List.Learn as Learn
+import qualified Data.Vector as Vec
+--}
 
+-- | Admin NodesAPI
+-- TODO
 type NodesAPI  = Delete '[JSON] Int
 
-type NodeAPI   = Get '[JSON] (Node Value)
+-- | Delete Nodes
+-- Be careful: really delete nodes
+-- Access by admin only
+nodesAPI :: [NodeId] -> GargServer NodesAPI
+nodesAPI = deleteNodes
+
+------------------------------------------------------------------------
+-- | TODO-ACCESS: access by admin only.
+-- At first let's just have an isAdmin check.
+-- Later: CanAccessAnyNode or (CanGetAnyNode, CanPutAnyNode)
+-- To manage the Users roots
+-- TODO-EVENTS:
+--   PutNode ?
+-- TODO needs design discussion.
+type Roots =  Get    '[JSON] [Node HyperdataUser]
+         :<|> Put    '[JSON] Int -- TODO
+
+-- | TODO: access by admin only
+roots :: GargServer Roots
+roots = getNodesWithParentId Nothing
+    :<|> pure (panic "not implemented yet") -- TODO use patch map to update what we need
+
+-------------------------------------------------------------------
+-- | Node API Types management
+-- TODO-ACCESS : access by users
+-- No ownership check is needed if we strictly follow the capability model.
+--
+-- CanGetNode (Node, Children, TableApi, TableNgramsApiGet, PairingApi, ChartApi,
+--             SearchAPI)
+-- CanRenameNode (or part of CanEditNode?)
+-- CanCreateChildren (PostNodeApi)
+-- CanEditNode / CanPutNode TODO not implemented yet
+-- CanDeleteNode
+-- CanPatch (TableNgramsApi)
+-- CanFavorite
+-- CanMoveToTrash
+
+type NodeAPI a = Get '[JSON] (Node a)
+             :<|> "rename" :> RenameApi
+             :<|> PostNodeApi -- TODO move to children POST
+             :<|> PostNodeAsync
+             :<|> ReqBody '[JSON] a :> Put    '[JSON] Int
+             :<|> "update"     :> Update.API
              :<|> Delete '[JSON] Int
+             :<|> "children"  :> ChildrenApi a
+
+             -- TODO gather it
+             :<|> "table"      :> TableApi
+             :<|> "ngrams"     :> TableNgramsApi
+
+             :<|> "category"   :> CatApi
+             :<|> "search"     :> (Search.API Search.SearchResult)
+             :<|> "share"      :> Share.API
+
+             -- Pairing utilities
+             :<|> "pairwith"   :> PairWith
+             :<|> "pairs"      :> Pairs
+             :<|> "pairing"    :> PairingApi
+
+             -- VIZ
+             :<|> "metrics"   :> ScatterAPI
+             :<|> "chart"     :> ChartApi
+             :<|> "pie"       :> PieApi
+             :<|> "tree"      :> TreeApi
+             :<|> "phylo"     :> PhyloAPI
+             -- :<|> "add"       :> NodeAddAPI
+             :<|> "move"      :> MoveAPI
+             :<|> "unpublish" :> Share.Unpublish
+
+             :<|> "file"      :> FileApi
+             :<|> "async"     :> FileAsyncApi
+
+-- TODO-ACCESS: check userId CanRenameNode nodeId
+-- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
+type RenameApi = Summary " Rename Node"
+               :> ReqBody '[JSON] RenameNode
+               :> Put     '[JSON] [Int]
+
+type PostNodeApi = Summary " PostNode Node with ParentId as {id}"
+                 :> ReqBody '[JSON] PostNode
+                 :> Post    '[JSON] [NodeId]
+
+type ChildrenApi a = Summary " Summary children"
+                 :> QueryParam "type"   NodeType
+                 :> QueryParam "offset" Int
+                 :> QueryParam "limit"  Int
+                 -- :> Get '[JSON] [Node a]
+                 :> Get '[JSON] (NodeTableResult a)
+
+------------------------------------------------------------------------
+type NodeNodeAPI a = Get '[JSON] (Node a)
+
+nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a)
+            => proxy a
+            -> UserId
+            -> CorpusId
+            -> NodeId
+            -> GargServer (NodeNodeAPI a)
+nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uId (PathNodeNode cId nId) nodeNodeAPI'
+  where
+    nodeNodeAPI' :: GargServer (NodeNodeAPI a)
+    nodeNodeAPI' = getNodeWith nId p
+
+------------------------------------------------------------------------
+-- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
+nodeAPI :: forall proxy a.
+       ( JSONB a
+       , FromJSON a
+       , ToJSON a
+       ) => proxy a
+         -> UserId
+         -> NodeId
+         -> GargServer (NodeAPI a)
+nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI'
+  where
+    nodeAPI' :: GargServer (NodeAPI a)
+    nodeAPI' =  getNodeWith   id' p
+           :<|> rename        id'
+           :<|> postNode  uId id'
+           :<|> postNodeAsyncAPI  uId id'
+           :<|> putNode       id'
+           :<|> Update.api  uId id'
+           :<|> Action.deleteNode (RootId $ NodeId uId) id'
+           :<|> getChildren   id' p
+
+           -- TODO gather it
+           :<|> tableApi             id'
+           :<|> apiNgramsTableCorpus id'
+
+           :<|> catApi      id'
+           :<|> Search.api  id'
+           :<|> Share.api   (RootId $ NodeId uId) id'
+           -- Pairing Tools
+           :<|> pairWith    id'
+           :<|> pairs       id'
+           :<|> getPair     id'
+
+           -- VIZ
+           :<|> scatterApi id'
+           :<|> chartApi   id'
+           :<|> pieApi     id'
+           :<|> treeApi    id'
+           :<|> phyloAPI   id' uId
+           :<|> moveNode   (RootId $ NodeId uId) id'
+           -- :<|> nodeAddAPI id'
+           -- :<|> postUpload id'
+           :<|> Share.unPublish id'
+
+           :<|> fileApi uId id'
+           :<|> fileAsyncApi uId id'
+
+
+------------------------------------------------------------------------
+data RenameNode = RenameNode { r_name :: Text }
+  deriving (Generic)
 
-             :<|> "children" :> QueryParam "type"   NodeType
-                             :> QueryParam "offset" Int
-                             :> QueryParam "limit"  Int
-                             :> Get '[JSON] [Node Value]
+------------------------------------------------------------------------
+------------------------------------------------------------------------
+type CatApi =  Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral, 2 favorite"
+            :> ReqBody '[JSON] NodesToCategory
+            :> Put     '[JSON] [Int]
 
+data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
+                                       , ntc_category :: Int
+                                       }
+  deriving (Generic)
 
-             :<|> "facet" :> QueryParam "type"   NodeType
-                          :> QueryParam "offset" Int
-                          :> QueryParam "limit"  Int
-                          :> Get '[JSON] [FacetDoc]
+-- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
+instance FromJSON  NodesToCategory
+instance ToJSON    NodesToCategory
+instance ToSchema  NodesToCategory
 
+catApi :: CorpusId -> GargServer CatApi
+catApi = putCat
+  where
+    putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
+    putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
 
-                -- Depending on the Type of the Node, we could post
-                -- New documents for a corpus
-                -- New map list terms
-             :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
-                
-                -- To launch a query and update the corpus
-             :<|> "query"    :> Capture "string" Text       :> Get  '[JSON] Text
+------------------------------------------------------------------------
+-- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
+-- Pairing utilities to move elsewhere
+type PairingApi = Summary " Pairing API"
+                :> QueryParam "view"   TabType
+                -- TODO change TabType -> DocType (CorpusId for pairing)
+                :> QueryParam "offset" Int
+                :> QueryParam "limit"  Int
+                :> QueryParam "order"  OrderBy
+                :> Get '[JSON] [FacetDoc]
 
+----------
+type Pairs    = Summary "List of Pairs"
+              :> Get '[JSON] [AnnuaireId]
+pairs :: CorpusId -> GargServer Pairs
+pairs cId = do
+  ns <- getNodeNode cId
+  pure $ map _nn_node2_id ns
 
+type PairWith = Summary "Pair a Corpus with an Annuaire"
+              :> "annuaire" :> Capture "annuaire_id" AnnuaireId
+              :> QueryParam "list_id"     ListId
+              :> Post '[JSON] Int
 
--- | Node API functions
-roots :: Connection -> Server Roots
-roots conn = liftIO (getNodesWithParentId conn 0 Nothing)
+pairWith :: CorpusId -> GargServer PairWith
+pairWith cId aId lId = do
+  r <- pairing cId aId lId
+  _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
+  pure r
 
-nodeAPI :: Connection -> NodeId -> Server NodeAPI
-nodeAPI conn id =  liftIO (getNode              conn id)
-              :<|> deleteNode'   conn id
-              :<|> getNodesWith' conn id
-              :<|> getDocFacet'  conn id
-              :<|> upload
-              :<|> query
 
-nodesAPI :: Connection -> [NodeId] -> Server NodesAPI
-nodesAPI conn ids = deleteNodes' conn ids
+------------------------------------------------------------------------
+type TreeAPI   = QueryParams "type" NodeType
+                  :> Get '[JSON] (Tree NodeTree)
+                  :<|> "first-level"
+                      :> QueryParams "type" NodeType
+                      :> Get '[JSON] (Tree NodeTree)
 
-deleteNodes' :: Connection -> [NodeId] -> Handler Int
-deleteNodes' conn ids = liftIO (deleteNodes conn ids)
+treeAPI :: NodeId -> GargServer TreeAPI
+treeAPI id = tree TreeAdvanced id
+        :<|> tree TreeFirstLevel id
 
-deleteNode' :: Connection -> NodeId -> Handler Int
-deleteNode' conn id = liftIO (deleteNode conn id)
+------------------------------------------------------------------------
+-- | TODO Check if the name is less than 255 char
+rename :: NodeId -> RenameNode -> Cmd err [Int]
+rename nId (RenameNode name') = U.update (U.Rename nId name')
 
-getNodesWith' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int 
-                        -> Handler [Node Value]
-getNodesWith' conn id nodeType offset limit  = liftIO (getNodesWith conn id nodeType offset limit)
+putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
+        => NodeId
+        -> a
+        -> Cmd err Int
+putNode n h = fromIntegral <$> updateHyperdata n h
 
-getDocFacet' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int
-                        -> Handler [FacetDoc]
-getDocFacet' conn id nodeType offset limit = liftIO (getDocFacet conn id nodeType offset limit)
+-------------------------------------------------------------
+type MoveAPI  = Summary "Move Node endpoint"
+              :> Capture "parent_id" ParentId
+              :> Put '[JSON] [Int]
 
-query :: Text -> Handler Text
-query s = pure s
+moveNode :: User
+         -> NodeId
+         -> ParentId
+         -> Cmd err [Int]
+moveNode _u n p = update (Move n p)
+-------------------------------------------------------------
 
 
--- | Upload files
--- TODO Is it possible to adapt the function according to iValue input ?
-upload :: MultipartData -> Handler Text
-upload multipartData = do
-  liftIO $ do
-    putStrLn "Inputs:"
-    forM_ (inputs multipartData) $ \input ->
-      putStrLn $ "  " <> show (iName input)
-            <> " -> " <> show (iValue input)
+$(deriveJSON (unPrefix "r_"       ) ''RenameNode )
+instance ToSchema  RenameNode
+instance Arbitrary RenameNode where
+  arbitrary = elements [RenameNode "test"]
 
-    forM_ (files multipartData) $ \file -> do
-      content <- readFile (fdFilePath file)
-      putStrLn $ "Content of " <> show (fdFileName file)
-              <> " at " <> fdFilePath file
-      putStrLn content
-  pure (pack "Data loaded")
 
+-------------------------------------------------------------