Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
153
Issues
153
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
ee53ce3c
Commit
ee53ce3c
authored
Feb 09, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[API] improving the node route of the API and adding Auth file.
parent
1622dcfa
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
195 additions
and
6 deletions
+195
-6
Main.hs
app/Main.hs
+1
-1
gargantext.cabal
gargantext.cabal
+5
-2
package.yaml
package.yaml
+3
-1
API.hs
src/Gargantext/API.hs
+71
-0
Auth.hs
src/Gargantext/API/Auth.hs
+33
-0
Node.hs
src/Gargantext/API/Node.hs
+79
-0
Node.hs
src/Gargantext/Database/Node.hs
+2
-2
stack.yaml
stack.yaml
+1
-0
No files found.
app/Main.hs
View file @
ee53ce3c
...
...
@@ -3,7 +3,7 @@
module
Main
where
import
Gargantext.Prelude
import
Gargantext.
Server
(
startGargantext
)
import
Gargantext.
API
(
startGargantext
)
import
Text.Read
(
read
)
import
System.Environment
(
getArgs
)
...
...
gargantext.cabal
View file @
ee53ce3c
...
...
@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash:
1afbb68941e4a0da5a3c812595ca12ed611c36aa9ab55736742c3f093dbf7f06
-- hash:
a2fe1d6feb24181e934eedb42289d2b31ac73c4c6cd4e0e0f7904dc32e65bbfc
name: gargantext
version: 0.1.0.0
...
...
@@ -58,6 +58,7 @@ library
, safe
, semigroups
, servant
, servant-auth
, servant-client
, servant-multipart
, servant-server
...
...
@@ -105,13 +106,15 @@ library
Gargantext.Parsers.Date
Gargantext.Prelude
Gargantext.RCT
Gargantext.Server
Gargantext.API
Gargantext.API.Auth
Gargantext.Types
Gargantext.Types.Main
Gargantext.Types.Node
Gargantext.Utils.DateUtils
Gargantext.Utils.Prefix
other-modules:
Gargantext.API.Node
Gargantext.Utils
Paths_gargantext
default-language: Haskell2010
...
...
package.yaml
View file @
ee53ce3c
...
...
@@ -50,7 +50,8 @@ library:
-
Gargantext.Parsers.Date
-
Gargantext.Prelude
-
Gargantext.RCT
-
Gargantext.Server
-
Gargantext.API
-
Gargantext.API.Auth
-
Gargantext.Types
-
Gargantext.Types.Main
-
Gargantext.Types.Node
...
...
@@ -92,6 +93,7 @@ library:
-
servant-client
-
servant-multipart
-
servant-server
-
servant-auth
-
split
-
tagsoup
-
text-metrics
...
...
src/Gargantext/
Server
.hs
→
src/Gargantext/
API
.hs
View file @
ee53ce3c
{-|
Module : Gargantext.Server
Description : Server API
...
...
@@ -10,64 +9,52 @@ Portability : POSIX
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 #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module
Gargantext.Server
-- ( startApp
-- , app
-- )
module
Gargantext.API
where
import
Gargantext.Prelude
import
Control.Monad
import
Control.Monad.IO.Class
import
Data.Aeson
import
Network.Wai
import
Network.Wai.Handler.Warp
import
Servant
import
Servant.Multipart
import
Database.PostgreSQL.Simple
(
Connection
,
connect
)
import
Opaleye
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
)
import
System.IO
(
FilePath
,
print
)
-- | TODO, use MOCK feature of Servant to generate fake data (for tests)
type
NodeAPI
=
Get
'[
J
SON
]
(
Node
Value
)
:<|>
"children"
:>
Get
'[
J
SON
]
[
Node
Value
]
-- import Gargantext.API.Auth
import
Gargantext.API.Node
(
Roots
,
roots
,
NodeAPI
,
nodeAPI
)
type
API
=
"roots"
:>
Get
'[
J
SON
]
[
Node
Value
]
:<|>
"node"
:>
Capture
"id"
Int
:>
NodeAPI
:<|>
"echo"
:>
Capture
"string"
Text
:>
Get
'[
J
SON
]
Text
:<|>
"upload"
:>
MultipartForm
MultipartData
:>
Post
'[
J
SON
]
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
import
Gargantext.Database.Private
(
databaseParameters
)
-- | startGargantext takes as parameters port number and Ini file.
startGargantext
::
Int
->
FilePath
->
IO
()
startGargantext
port
file
=
do
print
(
"Starting server on port "
<>
show
port
)
param
<-
databaseParameters
file
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.
-- Provide config, state, logs and IO
...
...
@@ -82,26 +69,3 @@ app = serve api . server
api
::
Proxy
API
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"
)
src/Gargantext/API/Auth.hs
0 → 100644
View file @
ee53ce3c
{-|
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)
src/Gargantext/API/Node.hs
0 → 100644
View file @
ee53ce3c
{-|
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
'[
J
SON
]
[
Node
Value
]
type
NodeAPI
=
Get
'[
J
SON
]
(
Node
Value
)
:<|>
"children"
:>
Get
'[
J
SON
]
[
Node
Value
]
:<|>
"process"
:>
MultipartForm
MultipartData
:>
Post
'[
J
SON
]
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
'[
J
SON
]
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"
)
src/Gargantext/Database/Node.hs
View file @
ee53ce3c
...
...
@@ -144,9 +144,9 @@ selectNodesWithType type_id = proc () -> do
restrict
-<
tn
.==
type_id
returnA
-<
row
getNode
::
Connection
->
Column
PGInt4
->
IO
(
Node
Value
)
getNode
::
Connection
->
Int
->
IO
(
Node
Value
)
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
conn
type_id
=
do
...
...
stack.yaml
View file @
ee53ce3c
...
...
@@ -9,4 +9,5 @@ extra-deps:
-
duckling-0.1.3.0
-
protolude-0.2
-
servant-multipart-0.10.0.1
-
servant-auth-0.3.0.1
resolver
:
lts-9.2
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment