Commit b60923da authored by Alexandre Delanoë's avatar Alexandre Delanoë

[API] improving the node route of the API and adding Auth file.

parent b8f4abba
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
module Main where module Main where
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Server (startGargantext) import Gargantext.API (startGargantext)
import Text.Read (read) import Text.Read (read)
import System.Environment (getArgs) import System.Environment (getArgs)
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- --
-- see: https://github.com/sol/hpack -- see: https://github.com/sol/hpack
-- --
-- hash: 1afbb68941e4a0da5a3c812595ca12ed611c36aa9ab55736742c3f093dbf7f06 -- hash: a2fe1d6feb24181e934eedb42289d2b31ac73c4c6cd4e0e0f7904dc32e65bbfc
name: gargantext name: gargantext
version: 0.1.0.0 version: 0.1.0.0
...@@ -58,6 +58,7 @@ library ...@@ -58,6 +58,7 @@ library
, safe , safe
, semigroups , semigroups
, servant , servant
, servant-auth
, servant-client , servant-client
, servant-multipart , servant-multipart
, servant-server , servant-server
...@@ -105,13 +106,15 @@ library ...@@ -105,13 +106,15 @@ library
Gargantext.Parsers.Date Gargantext.Parsers.Date
Gargantext.Prelude Gargantext.Prelude
Gargantext.RCT Gargantext.RCT
Gargantext.Server Gargantext.API
Gargantext.API.Auth
Gargantext.Types Gargantext.Types
Gargantext.Types.Main Gargantext.Types.Main
Gargantext.Types.Node Gargantext.Types.Node
Gargantext.Utils.DateUtils Gargantext.Utils.DateUtils
Gargantext.Utils.Prefix Gargantext.Utils.Prefix
other-modules: other-modules:
Gargantext.API.Node
Gargantext.Utils Gargantext.Utils
Paths_gargantext Paths_gargantext
default-language: Haskell2010 default-language: Haskell2010
......
...@@ -50,7 +50,8 @@ library: ...@@ -50,7 +50,8 @@ library:
- Gargantext.Parsers.Date - Gargantext.Parsers.Date
- Gargantext.Prelude - Gargantext.Prelude
- Gargantext.RCT - Gargantext.RCT
- Gargantext.Server - Gargantext.API
- Gargantext.API.Auth
- Gargantext.Types - Gargantext.Types
- Gargantext.Types.Main - Gargantext.Types.Main
- Gargantext.Types.Node - Gargantext.Types.Node
...@@ -92,6 +93,7 @@ library: ...@@ -92,6 +93,7 @@ library:
- servant-client - servant-client
- servant-multipart - servant-multipart
- servant-server - servant-server
- servant-auth
- split - split
- tagsoup - tagsoup
- text-metrics - text-metrics
......
{-| {-|
Module : Gargantext.Server Module : Gargantext.Server
Description : Server API Description : Server API
...@@ -10,64 +9,52 @@ Portability : POSIX ...@@ -10,64 +9,52 @@ Portability : POSIX
Main REST API of Gargantext (both Server and Client sides) Main REST API of Gargantext (both Server and Client sides)
TODO/IDEA, use MOCK feature of Servant to generate fake data (for tests)
-} -}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Gargantext.Server
-- ( startApp module Gargantext.API
-- , app
-- )
where where
import Gargantext.Prelude import Gargantext.Prelude
import Control.Monad
import Control.Monad.IO.Class
import Data.Aeson
import Network.Wai import Network.Wai
import Network.Wai.Handler.Warp import Network.Wai.Handler.Warp
import Servant import Servant
import Servant.Multipart
import Database.PostgreSQL.Simple (Connection, connect) import Database.PostgreSQL.Simple (Connection, connect)
import Opaleye import System.IO (FilePath, print)
import System.IO (FilePath, putStrLn, readFile, print)
import Data.Text (Text(), pack)
import Gargantext.Types.Main (Node, NodeId)
import Gargantext.Database.Node (getNodesWithParentId, getNode)
import Gargantext.Database.Private (databaseParameters)
-- | TODO, use MOCK feature of Servant to generate fake data (for tests)
type NodeAPI = Get '[JSON] (Node Value) -- import Gargantext.API.Auth
:<|> "children" :> Get '[JSON] [Node Value] import Gargantext.API.Node (Roots, roots, NodeAPI, nodeAPI)
type API = "roots" :> Get '[JSON] [Node Value] import Gargantext.Database.Private (databaseParameters)
:<|> "node" :> Capture "id" Int :> NodeAPI
:<|> "echo" :> Capture "string" Text :> Get '[JSON] Text
:<|> "upload" :> MultipartForm MultipartData :> Post '[JSON] Text
-- :<|> "node" :> Capture "id" Int :> Get '[JSON] Node
server :: Connection -> Server API
server conn
= liftIO (getNodesWithParentId conn 0)
:<|> nodeAPI conn
:<|> echo
:<|> upload
where
echo s = pure s
-- | startGargantext takes as parameters port number and Ini file.
startGargantext :: Int -> FilePath -> IO () startGargantext :: Int -> FilePath -> IO ()
startGargantext port file = do startGargantext port file = do
print ("Starting server on port " <> show port) print ("Starting server on port " <> show port)
param <- databaseParameters file param <- databaseParameters file
conn <- connect param conn <- connect param
run port ( app conn )
run port $ app conn
-- | Main routes of the API are typed
type API = "roots" :> Roots
:<|> "node" :> Capture "id" Int :> NodeAPI
-- :<|> "list" :> Capture "id" Int :> NodeAPI
-- :<|> "ngrams" :> Capture "id" Int :> NodeAPI
-- :<|> "auth" :> Capture "id" Int :> NodeAPI
-- | Server declaration
server :: Connection -> Server API
server conn = roots conn
:<|> nodeAPI conn
-- | TODO App type, the main monad in which the bot code is written with. -- | TODO App type, the main monad in which the bot code is written with.
-- Provide config, state, logs and IO -- Provide config, state, logs and IO
...@@ -82,26 +69,3 @@ app = serve api . server ...@@ -82,26 +69,3 @@ app = serve api . server
api :: Proxy API api :: Proxy API
api = Proxy api = Proxy
nodeAPI :: Connection -> NodeId -> Server NodeAPI
nodeAPI conn id
= liftIO (getNode conn id')
:<|> liftIO (getNodesWithParentId conn id)
where
id' = pgInt4 id
-- | 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)
forM_ (files multipartData) $ \file -> do
content <- readFile (fdFilePath file)
putStrLn $ "Content of " <> show (fdFileName file)
<> " at " <> fdFilePath file
putStrLn content
pure (pack "Data loaded")
{-|
Module : Gargantext.API.Auth
Description : Server API Auth Module
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Main authorisation of Gargantext are managed in this module
-- 1: Implement the Server / Client JWT authentication
-> Client towards Python Backend
-> Server towards Purescript Front-End
-- 2: Implement the Auth API backend
https://github.com/haskell-servant/servant-auth
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Auth
where
--import Gargantext.Prelude
--data Auth = Auth { username :: Text
-- , password :: Text
-- } deriving (Generics)
{-|
Module : Gargantext.API.Node
Description : Server API
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Node API
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module Gargantext.API.Node
where
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (Value())
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)
import Gargantext.Database.Node (getNodesWithParentId, getNode)
-- | Node API Types management
type Roots = Get '[JSON] [Node Value]
type NodeAPI = Get '[JSON] (Node Value)
:<|> "children" :> Get '[JSON] [Node Value]
:<|> "process" :> MultipartForm MultipartData :> Post '[JSON] Text
-- Depending on the Type of the Node, we could post
-- New documents for a corpus
-- New map list terms
:<|> "query" :> Capture "string" Text :> Get '[JSON] Text
-- :<|> "children" :> QueryParam "type" Text :> Get '[JSON] [Node Value]
-- | Node API functions
roots :: Connection -> Server Roots
roots conn = liftIO (getNodesWithParentId conn 0)
nodeAPI :: Connection -> NodeId -> Server NodeAPI
nodeAPI conn id = liftIO (getNode conn id)
:<|> liftIO (getNodesWithParentId conn id)
:<|> upload
:<|> query
query :: Text -> Handler Text
query s = pure s
-- | 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)
forM_ (files multipartData) $ \file -> do
content <- readFile (fdFilePath file)
putStrLn $ "Content of " <> show (fdFileName file)
<> " at " <> fdFilePath file
putStrLn content
pure (pack "Data loaded")
...@@ -144,9 +144,9 @@ selectNodesWithType type_id = proc () -> do ...@@ -144,9 +144,9 @@ selectNodesWithType type_id = proc () -> do
restrict -< tn .== type_id restrict -< tn .== type_id
returnA -< row returnA -< row
getNode :: Connection -> Column PGInt4 -> IO (Node Value) getNode :: Connection -> Int -> IO (Node Value)
getNode conn id = do getNode conn id = do
fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes id) fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value] getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
getNodesWithType conn type_id = do getNodesWithType conn type_id = do
......
...@@ -9,4 +9,5 @@ extra-deps: ...@@ -9,4 +9,5 @@ extra-deps:
- duckling-0.1.3.0 - duckling-0.1.3.0
- protolude-0.2 - protolude-0.2
- servant-multipart-0.10.0.1 - servant-multipart-0.10.0.1
- servant-auth-0.3.0.1
resolver: lts-9.2 resolver: lts-9.2
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment