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 Node API
  11 -}
  12
  13 {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}
  14
  15 {-# LANGUAGE DataKinds          #-}
  16 {-# LANGUAGE DeriveGeneric      #-}
  17 {-# LANGUAGE FlexibleContexts   #-}
  18 {-# LANGUAGE NoImplicitPrelude  #-}
  19 {-# LANGUAGE OverloadedStrings  #-}
  20 {-# LANGUAGE TemplateHaskell    #-}
  21 {-# LANGUAGE TypeOperators      #-}
  22
  23 -------------------------------------------------------------------
  24 module Gargantext.API.Node
  25   ( module Gargantext.API.Node
  26   , HyperdataCorpus(..)
  27   , HyperdataResource(..)
  28   , HyperdataUser(..)
  29   , HyperdataDocument(..)
  30   , HyperdataDocumentV3(..)
  31   ) where
  32 -------------------------------------------------------------------
  33 import Prelude (Enum, Bounded, minBound, maxBound)
  34 import Control.Lens (prism')
  35 import Control.Monad.IO.Class (liftIO)
  36 import Control.Monad ((>>))
  37 --import System.IO (putStrLn, readFile)
  38
  39 import Data.Either(Either(Left))
  40 import Data.Aeson (FromJSON, ToJSON, Value())
  41 --import Data.Text (Text(), pack)
  42 import Data.Text (Text())
  43 import Data.Swagger
  44 import Data.Time (UTCTime)
  45
  46 import Database.PostgreSQL.Simple (Connection)
  47
  48 import GHC.Generics (Generic)
  49 import Servant
  50
  51 import Gargantext.Prelude
  52 import Gargantext.Database.Types.Node
  53 import Gargantext.Database.Node ( runCmd
  54                                 , getNodesWithParentId
  55                                 , getNode, getNodesWith
  56                                 , deleteNode, deleteNodes, mk, JSONB)
  57 import qualified Gargantext.Database.Node.Update as U (update, Update(..))
  58 import Gargantext.Database.Facet (FacetDoc , runViewDocuments', OrderBy(..)
  59                                  ,FacetChart)
  60 import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
  61
  62 -- Graph
  63 import Gargantext.TextFlow
  64 import Gargantext.Viz.Graph (Graph)
  65 import Gargantext.Core (Lang(..))
  66 import Gargantext.Core.Types (Offset, Limit)
  67 import Gargantext.Core.Types.Main (Tree, NodeTree)
  68 import Gargantext.Text.Terms (TermType(..))
  69
  70 import Test.QuickCheck (elements)
  71 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  72 -------------------------------------------------------------------
  73 -- | Node API Types management
  74 type Roots =  Get    '[JSON] [Node Value]
  75          :<|> Post   '[JSON] Int -- TODO
  76          :<|> Put    '[JSON] Int -- TODO
  77          :<|> Delete '[JSON] Int -- TODO
  78
  79 type NodesAPI  = Delete '[JSON] Int
  80
  81
  82 ------------------------------------------------------------------------
  83 ------------------------------------------------------------------------
  84 data RenameNode = RenameNode { r_name :: Text }
  85   deriving (Generic)
  86
  87 instance FromJSON  RenameNode
  88 instance ToJSON    RenameNode
  89 instance ToSchema  RenameNode
  90 instance Arbitrary RenameNode where
  91   arbitrary = elements [RenameNode "test"]
  92
  93 ------------------------------------------------------------------------
  94
  95 data PostNode = PostNode { pn_name :: Text
  96                          , pn_typename :: NodeType}
  97   deriving (Generic)
  98
  99 instance FromJSON  PostNode
 100 instance ToJSON    PostNode
 101 instance ToSchema  PostNode
 102 instance Arbitrary PostNode where
 103   arbitrary = elements [PostNode "Node test" NodeCorpus]
 104
 105 ------------------------------------------------------------------------
 106 ------------------------------------------------------------------------
 107 type NodeAPI a = Get '[JSON] (Node a)
 108              :<|> "rename" :> Summary " RenameNode Node"
 109                            :> ReqBody '[JSON] RenameNode
 110                            :> Put     '[JSON] [Int]
 111              :<|> Summary " PostNode Node with ParentId as {id}"
 112                            :> ReqBody '[JSON] PostNode
 113                            :> Post    '[JSON] [Int]
 114              :<|> Put    '[JSON] Int
 115              :<|> Delete '[JSON] Int
 116              :<|> "children" :> Summary " Summary children"
 117                              :> QueryParam "type"   NodeType
 118                              :> QueryParam "offset" Int
 119                              :> QueryParam "limit"  Int
 120                              :> Get '[JSON] [Node a]
 121              :<|> Summary " Tabs" :> FacetDocAPI
 122
 123 --data FacetFormat = Table | Chart
 124 data FacetType   = Docs   | Terms  | Sources | Authors | Trash
 125   deriving (Generic, Enum, Bounded)
 126
 127 instance FromHttpApiData FacetType
 128   where
 129     parseUrlPiece "Docs" = pure Docs
 130     parseUrlPiece "Terms" = pure Terms
 131     parseUrlPiece "Sources" = pure Sources
 132     parseUrlPiece "Authors" = pure Authors
 133     parseUrlPiece "Trash"   = pure Trash
 134     parseUrlPiece _         = Left "Unexpected value of FacetType"
 135
 136 instance ToParamSchema   FacetType
 137 instance ToJSON    FacetType
 138 instance FromJSON  FacetType
 139 instance ToSchema  FacetType
 140 instance Arbitrary FacetType
 141   where
 142     arbitrary = elements [minBound .. maxBound]
 143
 144 type FacetDocAPI = "table"
 145                    :> Summary " Table data"
 146                    :> QueryParam "view"   FacetType
 147                    :> QueryParam "offset" Int
 148                    :> QueryParam "limit"  Int
 149                    :> QueryParam "order"  OrderBy
 150                    :> Get '[JSON] [FacetDoc]
 151
 152                 :<|> "chart"
 153                    :> Summary " Chart data"
 154                    :> QueryParam "from" UTCTime
 155                    :> QueryParam "to"   UTCTime
 156                    :> Get '[JSON] [FacetChart]
 157
 158                 -- Depending on the Type of the Node, we could post
 159                 -- New documents for a corpus
 160                 -- New map list terms
 161              -- :<|> "process"  :> MultipartForm MultipartData :> Post '[JSON] Text
 162
 163                 -- To launch a query and update the corpus
 164              -- :<|> "query"    :> Capture "string" Text       :> Get  '[JSON] Text
 165
 166
 167 -- | Node API functions
 168 roots :: Connection -> Server Roots
 169 roots conn = liftIO (putStrLn ( "/user" :: Text) >> getNodesWithParentId 0 Nothing conn)
 170           :<|> pure (panic "not implemented yet") -- TODO
 171           :<|> pure (panic "not implemented yet") -- TODO
 172           :<|> pure (panic "not implemented yet") -- TODO
 173
 174
 175 type GraphAPI   = Get '[JSON] Graph
 176 graphAPI :: Connection -> NodeId -> Server GraphAPI
 177 graphAPI _ _ = liftIO $ textFlow (Mono EN) (Contexts contextText)
 178   -- TODO what do we get about the node? to replace contextText
 179
 180 -- TODO(orphan): There should be a proper APIError data type with a case TreeError.
 181 instance HasTreeError ServantErr where
 182   _TreeError = prism' mk (const Nothing) -- Note a prism
 183     where
 184       mk NoRoot       = err404 { errBody = "Root node not found"           }
 185       mk EmptyRoot    = err500 { errBody = "Root node should not be empty" }
 186       mk TooManyRoots = err500 { errBody = "Too many root nodes"           }
 187
 188 type TreeAPI   = Get '[JSON] (Tree NodeTree)
 189 treeAPI :: Connection -> NodeId -> Server TreeAPI
 190 treeAPI = treeDB
 191
 192 -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
 193 nodeAPI :: JSONB a => Connection -> proxy a -> NodeId -> Server (NodeAPI a)
 194 nodeAPI conn p id
 195                 =  liftIO (getNode conn id p)
 196               :<|> rename        conn id
 197               :<|> postNode      conn id
 198               :<|> putNode       conn id
 199               :<|> deleteNode'   conn id
 200               :<|> getNodesWith' conn id p
 201               :<|> getTable      conn id
 202               :<|> getChart      conn id
 203               -- :<|> upload
 204               -- :<|> query
 205 -- | Check if the name is less than 255 char
 206 --rename :: Connection -> NodeId -> Rename -> Server NodeAPI
 207 rename :: Connection -> NodeId -> RenameNode -> Handler [Int]
 208 rename c nId (RenameNode name) = liftIO $ U.update (U.Rename nId name) c
 209
 210 nodesAPI :: Connection -> [NodeId] -> Server NodesAPI
 211 nodesAPI conn ids = deleteNodes' conn ids
 212
 213 getTable :: Connection -> NodeId -> Maybe FacetType -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Handler [FacetDoc]
 214 getTable c cId ft o l order = liftIO $ case ft of
 215                                 (Just Docs)  -> runViewDocuments' c cId False o l order
 216                                 (Just Trash) -> runViewDocuments' c cId True  o l order
 217                                 _     -> panic "not implemented"
 218
 219
 220
 221
 222 postNode :: Connection -> NodeId -> PostNode -> Handler [Int]
 223 postNode c pId (PostNode name nt) = liftIO $ mk c nt (Just pId) name
 224
 225 putNode :: Connection -> NodeId -> Handler Int
 226 putNode = undefined -- TODO
 227
 228 deleteNodes' :: Connection -> [NodeId] -> Handler Int
 229 deleteNodes' conn ids = liftIO (runCmd conn $ deleteNodes ids)
 230
 231 deleteNode' :: Connection -> NodeId -> Handler Int
 232 deleteNode' conn id = liftIO (runCmd conn $ deleteNode id)
 233
 234 getNodesWith' :: JSONB a => Connection -> NodeId -> proxy a -> Maybe NodeType
 235               -> Maybe Int -> Maybe Int -> Handler [Node a]
 236 getNodesWith' conn id p nodeType offset limit  = liftIO (getNodesWith conn id p nodeType offset limit)
 237
 238
 239 getChart :: Connection -> NodeId -> Maybe UTCTime -> Maybe UTCTime
 240                         -> Handler [FacetChart]
 241 getChart _ _ _ _ = undefined -- TODO
 242
 243
 244 query :: Text -> Handler Text
 245 query s = pure s
 246
 247
 248 -- | Upload files
 249 -- TODO Is it possible to adapt the function according to iValue input ?
 250 --upload :: MultipartData -> Handler Text
 251 --upload multipartData = do
 252 --  liftIO $ do
 253 --    putStrLn "Inputs:"
 254 --    forM_ (inputs multipartData) $ \input ->
 255 --      putStrLn $ "  " <> show (iName input)
 256 --            <> " -> " <> show (iValue input)
 257 --
 258 --    forM_ (files multipartData) $ \file -> do
 259 --      content <- readFile (fdFilePath file)
 260 --      putStrLn $ "Content of " <> show (fdFileName file)
 261 --              <> " at " <> fdFilePath file
 262 --      putStrLn content
 263 --  pure (pack "Data loaded")
 264