Skip to content

haskell-gargantext
haskell-gargantext
Commit feff26cf authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[FEAT] serving static files for front-end.

parent 46a03125
Hide whitespace changes
Inline Side-by-side
Showing with 171 additions and 98 deletions
gargantext.cabal
View file @ feff26cf
......@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: 77bf1f45b7b9eececd1b8192dcff6ab64602222d598b7571ccafd4e14c0b6267
-- hash: 40e4da714abaf501251279c2ed061b50ad5e31f7e99e84defabf222a04998a2e
name: gargantext
version: 0.1.0.0
......@@ -108,7 +108,9 @@ library
, servant-mock
, servant-multipart
, servant-server
, servant-static-th
, servant-swagger
, servant-swagger-ui
, split
, swagger2
, tagsoup
......
package.yaml
View file @ feff26cf
......@@ -100,6 +100,8 @@ library:
- servant-multipart
- servant-server
- servant-swagger
- servant-swagger-ui
- servant-static-th
- split
- swagger2
- tagsoup
......
src/Gargantext/API.hs
View file @ feff26cf
......@@ -26,30 +26,38 @@ Thanks @yannEsposito for this.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
---------------------------------------------------------------------
module Gargantext.API
where
---------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Prelude
import System.IO (FilePath, print)
import Control.Lens
import System.IO (FilePath, print)
import GHC.Generics (D1, Meta (..), Rep)
import GHC.TypeLits (AppendSymbol, Symbol)
import Control.Lens
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Swagger
import Data.Text (pack)
import Data.Text (Text)
--import qualified Data.Set as Set
import Database.PostgreSQL.Simple (Connection, connect)
import Database.PostgreSQL.Simple (Connection, connect)
import Network.Wai
import Network.Wai.Handler.Warp
import Network.Wai
import Network.Wai.Handler.Warp
import Servant
import Servant.Mock (mock)
import Servant.Swagger
import Servant
-- import Servant.Mock (mock)
import Servant.Swagger
import Servant.Swagger.UI
import Servant.Static.TH (createApiAndServerDecs)
-- import Servant.API.Stream
......@@ -62,43 +70,40 @@ import Gargantext.API.Count ( CountAPI, count, Query)
import Gargantext.Database.Utils (databaseParameters)
---------------------------------------------------------------------
---------------------------------------------------------------------
type PortNumber = Int
---------------------------------------------------------------------
-- | startGargantext takes as parameters port number and Ini file.
startGargantext :: PortNumber -> FilePath -> IO ()
startGargantext port file = do
print ("Starting Gargantext server" <> show port)
print ("http://localhost:" <> show port)
param <- databaseParameters file
conn <- connect param
run port ( app conn )
startGargantextMock :: PortNumber -> IO ()
startGargantextMock port = do
print (pack "Starting Mock server")
print (pack $ "curl "
<> "-H \"content-type: application/json"
<> "-d \'{\"query_query\":\"query\"}\' "
<> "-v http://localhost:"
<> show port
<>"/count"
)
run port ( serve api $ mock api Proxy )
---------------------------------------------------------------------
-- | API Global
type API = GargAPI
-- | API for serving @swagger.json@
-- TODO Do we need to add this in the API ?
-- type SwaggerAPI = "swagger.json" :> Get '[JSON] Swagger
type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
-- | API for serving main operational routes of @gargantext.org@
type GargAPI = "roots" :> Roots
type GargAPI = "user" :> Summary "First user endpoint"
:> Roots
:<|> "node" :> Capture "id" Int :> NodeAPI
:<|> "nodes" :> ReqBody '[JSON] [Int] :> NodesAPI
:<|> "node" :> Summary "Node endpoint"
:> Capture "id" Int :> NodeAPI
:<|> "corpus":> Summary "Corpus endpoint"
:> Capture "id" Int :> NodeAPI
:<|> "nodes" :> Summary "Nodes endpoint"
:> ReqBody '[JSON] [Int] :> NodesAPI
-- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
:<|> "count" :> ReqBody '[JSON] Query :> CountAPI
:<|> "count" :> Summary "Count endpoint"
:> ReqBody '[JSON] Query :> CountAPI
-- /mv/<id>/<id>
-- /merge/<id>/<id>
......@@ -107,10 +112,20 @@ type GargAPI = "roots" :> Roots
-- :<|> "list" :> Capture "id" Int :> NodeAPI
-- :<|> "ngrams" :> Capture "id" Int :> NodeAPI
-- :<|> "auth" :> Capture "id" Int :> NodeAPI
---------------------------------------------------------------------
-- | Serve front end files
$(createApiAndServerDecs "FrontEndAPI" "frontEndServer" "frontEnd")
type API = SwaggerAPI :<|> FrontEndAPI :<|> GargAPI
---------------------------------------------------------------------
-- | Server declaration
server :: Connection -> Server API
server conn = roots conn
server conn = schemaUiServer swaggerDoc
:<|> frontEndServer
:<|> roots conn
:<|> nodeAPI conn
:<|> nodeAPI conn
:<|> nodesAPI conn
:<|> count
......@@ -123,20 +138,62 @@ api :: Proxy API
api = Proxy
---------------------------------------------------------------------
-- | Swagger Specifications
gargSwagger :: Swagger
gargSwagger = toSwagger api
& info.title .~ "Gargantext API"
& info.version .~ "O.1.0"
& info.description ?~ "This is the main API of Gargantext"
& info.license ?~ ("AGPL and CECILLv3" & url ?~ URL "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE")
schemaUiServer :: (Server api ~ Handler Swagger)
=> Swagger -> Server (SwaggerSchemaUI' dir api)
schemaUiServer = swaggerSchemaUIServer
-- | API for serving @swagger.json@
-- TODO Do we need to add this in the API ?
-- type SwaggerAPI = "swagger.json" :> Get '[JSON] Swagger
-- Type Familiy for the Documentation
type family TypeName (x :: *) :: Symbol where
TypeName Int = "Int"
TypeName Text = "Text"
TypeName x = GenericTypeName x (Rep x ())
type family GenericTypeName t (r :: *) :: Symbol where
GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
-- | Swagger Specifications
swaggerDoc :: Swagger
swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
& info.title .~ "Gargantext"
& info.version .~ "0.1.0"
-- & info.base_url ?~ (URL "http://gargantext.org/")
& info.description ?~ "REST API specifications"
-- & tags .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
& applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
["Garg" & description ?~ "Main operations"]
& info.license ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
where
urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
-- | Output generated @swagger.json@ file for the @'TodoAPI'@.
writeSwaggerJSON :: IO ()
writeSwaggerJSON = BL8.writeFile "swagger.json" (encodePretty gargSwagger)
swaggerWriteJSON :: IO ()
swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
-- | startGargantext takes as parameters port number and Ini file.
startGargantext :: PortNumber -> FilePath -> IO ()
startGargantext port file = do
print ("Starting Gargantext server" <> show port)
print ("http://localhost:" <> show port)
param <- databaseParameters file
conn <- connect param
run port ( app conn )
--
--startGargantextMock :: PortNumber -> IO ()
--startGargantextMock port = do
-- print (pack "Starting Mock server")
-- print (pack $ "curl "
-- <> "-H \"content-type: application/json"
-- <> "-d \'{\"query_query\":\"query\"}\' "
-- <> "-v http://localhost:"
-- <> show port
-- <>"/count"
-- )
-- run port ( serve api $ mock api Proxy )
src/Gargantext/API/Node.hs
View file @ feff26cf
......@@ -21,7 +21,10 @@ module Gargantext.API.Node
where
-------------------------------------------------------------------
import System.IO (putStrLn)
import Control.Monad.IO.Class (liftIO)
import Control.Monad ((>>))
--import System.IO (putStrLn, readFile)
-- import Data.Aeson (Value())
......@@ -43,9 +46,10 @@ import Gargantext.Database.Facet (FacetDoc, getDocFacet)
-------------------------------------------------------------------
-------------------------------------------------------------------
-- | Node API Types management
type Roots = Get '[JSON] [Node HyperdataDocument]
type Roots = Get '[JSON] [Node HyperdataDocument]
:<|> Post '[JSON] Int
:<|> Delete '[JSON] Int
type NodesAPI = Delete '[JSON] Int
......@@ -76,10 +80,12 @@ type NodeAPI = Get '[JSON] (Node HyperdataDocument)
-- | Node API functions
roots :: Connection -> Server Roots
roots conn = liftIO (getNodesWithParentId conn 0 Nothing)
roots conn = liftIO (putStrLn "Log Needed" >> getNodesWithParentId conn 0 Nothing)
:<|> pure (panic "not implemented yet")
:<|> pure (panic "not implemented yet")
nodeAPI :: Connection -> NodeId -> Server NodeAPI
nodeAPI conn id = liftIO (getNode conn id)
nodeAPI conn id = liftIO (putStrLn "getNode" >> getNode conn id )
:<|> deleteNode' conn id
:<|> getNodesWith' conn id
:<|> getDocFacet' conn id
......
src/Gargantext/Prelude.hs
View file @ feff26cf
......@@ -25,6 +25,7 @@ import Protolude ( Bool(True, False), Int, Double, Integer
, takeWhile, sqrt, undefined, identity
, abs, maximum, minimum, return, snd, truncate
, (+), (*), (/), (-), (.), (>=), ($), (**), (^), (<), (>), (==), (<>)
, toS
)
-- TODO import functions optimized in Utils.Count
......
src/Gargantext/Types/Node.hs
View file @ feff26cf
......@@ -19,27 +19,29 @@ module Gargantext.Types.Node where
import GHC.Generics (Generic)
import Data.Aeson
import Data.Aeson (Value(),toJSON)
import Data.Aeson.TH (deriveJSON)
import Data.ByteString.Lazy (ByteString)
import Data.Either
import Data.Eq (Eq)
import Data.Text (Text, unpack)
import Data.Time (UTCTime)
import Data.Time.Segment (jour)
import Data.Swagger
import Text.Read (read)
import Text.Show (Show())
import Servant
import Test.QuickCheck.Arbitrary
import Test.QuickCheck (elements)
import Gargantext.Prelude
import Gargantext.Utils.Prefix (unPrefix)
import Control.Lens hiding (elements)
import qualified Control.Lens as L
import Data.Aeson
import Data.Aeson (Value(),toJSON)
import Data.Aeson.TH (deriveJSON)
import Data.ByteString.Lazy (ByteString)
import Data.Either
import Data.Eq (Eq)
import Data.Text (Text, unpack)
import Data.Time (UTCTime)
import Data.Time.Segment (jour)
import Data.Swagger
import Text.Read (read)
import Text.Show (Show())
import Servant
import Test.QuickCheck.Arbitrary
import Test.QuickCheck (elements)
import Gargantext.Prelude
import Gargantext.Utils.Prefix (unPrefix)
------------------------------------------------------------------------
data Status = Status { status_date :: Maybe UTCTime
......@@ -91,22 +93,22 @@ $(deriveJSON (unPrefix "languageNodes_") ''LanguageNodes)
------------------------------------------------------------------------
data Resource = Resource { resource_Url :: Maybe Text
, resource_Path :: Maybe Text
, resource_Type :: Maybe Int
, resource_Extracted :: Maybe Bool
data Resource = Resource { resource_url :: Maybe Text
, resource_path :: Maybe Text
, resource_type :: Maybe Int
, resource_extracted :: Maybe Bool
} deriving (Show, Generic)
$(deriveJSON (unPrefix "resource_") ''Resource)
instance Arbitrary Resource where
arbitrary = elements [Resource Nothing Nothing Nothing Nothing]
data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_Action :: Maybe Text
, hyperdataCorpus_Statuses :: Maybe [Status]
, hyperdataCorpus_Languages :: Maybe LanguageNodes
, hyperdataCorpus_Resources :: Maybe [Resource]
, hyperdataCorpus_Language_id :: Maybe Text
, hyperdataCorpus_Skipped_docs :: Maybe [Int]
data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_action :: Maybe Text
, hyperdataCorpus_statuses :: Maybe [Status]
, hyperdataCorpus_languages :: Maybe LanguageNodes
, hyperdataCorpus_resources :: Maybe [Resource]
, hyperdataCorpus_language_id :: Maybe Text
, hyperdataCorpus_skipped_docs :: Maybe [Int]
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
......@@ -117,50 +119,50 @@ $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
-- Preferences ?
data HyperdataFolder = HyperdataFolder { hyperdataFolder_Preferences :: Maybe Text
data HyperdataFolder = HyperdataFolder { hyperdataFolder_preferences :: Maybe Text
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
data HyperdataProject = HyperdataProject { hyperdataProject_Preferences :: Maybe Text
data HyperdataProject = HyperdataProject { hyperdataProject_preferences :: Maybe Text
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataProject_") ''HyperdataProject)
data HyperdataList = HyperdataList { hyperdataList_Preferences :: Maybe Text
data HyperdataList = HyperdataList { hyperdataList_preferences :: Maybe Text
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
data HyperdataScore = HyperdataScore { hyperdataScore_Preferences :: Maybe Text
data HyperdataScore = HyperdataScore { hyperdataScore_preferences :: Maybe Text
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
data HyperdataFavorites = HyperdataFavorites { hyperdataFavorites_Preferences :: Maybe Text
data HyperdataFavorites = HyperdataFavorites { hyperdataFavorites_preferences :: Maybe Text
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataFavorites_") ''HyperdataFavorites)
data HyperdataResource = HyperdataResource { hyperdataResource_Preferences :: Maybe Text
data HyperdataResource = HyperdataResource { hyperdataResource_preferences :: Maybe Text
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
-- TODO add the Graph Structure here
data HyperdataGraph = HyperdataGraph { hyperdataGraph_Preferences :: Maybe Text
data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences :: Maybe Text
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
-- TODO add the Graph Structure here
data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_Preferences :: Maybe Text
data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences :: Maybe Text
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
-- | TODO FEATURE: Notebook saved in the node (to work with Python or Haskell)
data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_Preferences :: Maybe Text
data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences :: Maybe Text
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
......@@ -243,10 +245,11 @@ docExample :: ByteString
docExample = "{\"publication_day\":6,\"language_iso2\":\"en\",\"publication_minute\":0,\"publication_month\":7,\"language_iso3\":\"eng\",\"publication_second\":0,\"authors\":\"Nils Hovdenak, Kjell Haram\",\"publication_year\":2012,\"publication_date\":\"2012-07-06 00:00:00+00:00\",\"language_name\":\"English\",\"statuses\":[],\"realdate_full_\":\"2012 01 12\",\"source\":\"European journal of obstetrics, gynecology, and reproductive biology\",\"abstract\":\"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome.\",\"title\":\"Influence of mineral and vitamin supplements on pregnancy outcome.\",\"publication_hour\":0}"
instance ToSchema HyperdataDocument
instance ToSchema HyperdataDocument where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
L.& mapped.schema.description ?~ "a document"
L.& mapped.schema.example ?~ toJSON hyperdataDocument
-- instance ToSchema HyperdataDocument where
-- declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
instance ToSchema (NodePoly NodeId NodeTypeId NodeUserId
(Maybe NodeParentId) NodeName
......
stack.yaml
View file @ feff26cf
......@@ -20,6 +20,7 @@ extra-deps:
- servant-docs-0.11.1
- servant-multipart-0.11.1
- servant-server-0.12
- servant-swagger-ui-0.2.3.2.2.8
- text-1.2.3.0
- text-show-3.6.2
resolver: lts-10.6
swagger.json
View file @ feff26cf
......@@ -7,7 +7,7 @@
"url": "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE",
"name": "AGPL and CECILLv3"
},
"description": "This is the main API of Gargantext"
"description": "Gargantext API specifications"
},
"definitions": {
"Status": {
......@@ -333,6 +333,7 @@
},
"/roots": {
"get": {
"summary": "First cat endpoint",
"responses": {
"200": {
"schema": {
......
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