{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
---------------------------------------------------------------------
module Gargantext.API
---------------------------------------------------------------------
import Gargantext.Prelude
-import System.IO (FilePath, print)
+import System.IO (FilePath)
import GHC.Generics (D1, Meta (..), Rep)
import GHC.TypeLits (AppendSymbol, Symbol)
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Swagger
-import Data.Text (Text, pack)
+import Data.Text (Text)
+import qualified Data.Text.IO as T
--import qualified Data.Set as Set
-import Database.PostgreSQL.Simple (Connection, connect)
-
import Network.Wai
-import Network.Wai.Handler.Warp
+import Network.Wai.Handler.Warp hiding (defaultSettings)
import Servant
import Servant.Mock (mock)
+import Servant.Job.Server (WithCallbacks)
import Servant.Swagger
import Servant.Swagger.UI
-- import Servant.API.Stream
, NodesAPI , nodesAPI
)
import Gargantext.API.Count ( CountAPI, count, Query)
-import Gargantext.Database.Utils (databaseParameters)
+import Gargantext.API.Orchestrator
+import Gargantext.API.Orchestrator.Types
---------------------------------------------------------------------
-
import GHC.Base (Applicative)
-- import Control.Lens
--import qualified Network.Wai.Handler.Warp as Warp
import Network.Wai.Middleware.Cors
--- import Network.Wai.Middleware.RequestLogger
+import Network.Wai.Middleware.RequestLogger
-- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
import Network.HTTP.Types hiding (Query)
--- import Gargantext.API.Settings
-
-data FireWall = FireWall { unFireWall :: Bool }
+import Gargantext.API.Settings
fireWall :: Applicative f => Request -> FireWall -> f Bool
fireWall req fw = do
let hostOk = Just (encodeUtf8 "localhost:3000")
let originOk = Just (encodeUtf8 "http://localhost:8008")
- if origin == originOk && host == hostOk || unFireWall fw
+ if origin == originOk
+ && host == hostOk
+ || (not $ unFireWall fw)
+
then pure True
else pure False
--- makeApp :: Env -> IO (Warp.Settings, Application)
-makeApp :: FireWall -> IO Application
-makeApp fw = do
+-- makeMockApp :: Env -> IO (Warp.Settings, Application)
+makeMockApp :: MockEnv -> IO Application
+makeMockApp env = do
let serverApp = appMock
-- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
-
+ --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
let checkOriginAndHost app req resp = do
- blocking <- fireWall req fw
+ blocking <- fireWall req (env ^. menv_firewall)
case blocking of
True -> app req resp
- False -> resp ( responseLBS status401 [] "Invalid Origin or Host header" )
+ False -> resp ( responseLBS status401 []
+ "Invalid Origin or Host header")
let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
--- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
- { corsOrigins = Just (["http://localhost:8008"], False)
- , corsMethods = [methodGet, methodPost, methodPut, methodDelete]
+-- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
+ { corsOrigins = Nothing -- == /*
+ , corsMethods = [ methodGet , methodPost , methodPut
+ , methodDelete, methodOptions, methodHead]
, corsRequestHeaders = ["authorization", "content-type"]
, corsExposedHeaders = Nothing
, corsMaxAge = Just ( 60*60*24 ) -- one day
, corsVaryOrigin = False
- , corsRequireOrigin = True
+ , corsRequireOrigin = False
, corsIgnoreFailures = False
}
-- $ Warp.defaultSettings
--pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
- pure $ checkOriginAndHost $ corsMiddleware $ serverApp
+ pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
+--
+makeDevApp :: Env -> IO Application
+makeDevApp env = do
+ serverApp <- makeApp env
+
+ -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
+ --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
+-- let checkOriginAndHost app req resp = do
+-- blocking <- fireWall req (env ^. menv_firewall)
+-- case blocking of
+-- True -> app req resp
+-- False -> resp ( responseLBS status401 []
+-- "Invalid Origin or Host header")
+--
+ let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
+-- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
+ { corsOrigins = Nothing -- == /*
+ , corsMethods = [ methodGet , methodPost , methodPut
+ , methodDelete, methodOptions, methodHead]
+ , corsRequestHeaders = ["authorization", "content-type"]
+ , corsExposedHeaders = Nothing
+ , corsMaxAge = Just ( 60*60*24 ) -- one day
+ , corsVaryOrigin = False
+ , corsRequireOrigin = False
+ , corsIgnoreFailures = False
+ }
+
+ --let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
+ -- $ Warp.defaultSettings
+
+ --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
+ pure $ logStdoutDev $ corsMiddleware $ serverApp
+
+--
----------------------------------------------------------------------
-type PortNumber = Int
---------------------------------------------------------------------
-- | API Global
:<|> "count" :> Summary "Count endpoint"
:> ReqBody '[JSON] Query :> CountAPI
+ -- :<|> "scraper" :> WithCallbacks ScraperAPI
+
-- /mv/<id>/<id>
-- /merge/<id>/<id>
-- /rename/<id>
---------------------------------------------------------------------
-- | Server declaration
-server :: Connection -> Server API
-server conn = swaggerFront
- :<|> roots conn
- :<|> nodeAPI conn
- :<|> nodeAPI conn
- :<|> nodesAPI conn
- :<|> count
+server :: Env -> IO (Server API)
+server env = do
+ -- orchestrator <- scrapyOrchestrator env
+ pure $ swaggerFront
+ :<|> roots conn
+ :<|> nodeAPI conn
+ :<|> nodeAPI conn
+ :<|> nodesAPI conn
+ :<|> count
+ -- :<|> orchestrator
+ where
+ conn = env ^. env_conn
---------------------------------------------------------------------
swaggerFront :: Server SwaggerFrontAPI
gargMock = mock apiGarg Proxy
---------------------------------------------------------------------
-app :: Connection -> Application
-app = serve api . server
+makeApp :: Env -> IO Application
+makeApp = fmap (serve api) . server
appMock :: Application
appMock = serve api (swaggerFront :<|> gargMock)
schemaUiServer = swaggerSchemaUIServer
--- Type Familiy for the Documentation
+-- Type Family for the Documentation
type family TypeName (x :: *) :: Symbol where
TypeName Int = "Int"
TypeName Text = "Text"
portRouteInfo :: PortNumber -> IO ()
portRouteInfo port = do
- print (pack " ----Main Routes----- ")
- print ("http://localhost:" <> show port <> "/index.html")
- print ("http://localhost:" <> show port <> "/swagger-ui")
+ T.putStrLn " ----Main Routes----- "
+ T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
+ T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
-- | startGargantext takes as parameters port number and Ini file.
startGargantext :: PortNumber -> FilePath -> IO ()
startGargantext port file = do
-
- param <- databaseParameters file
- conn <- connect param
-
+ env <- newEnv port file
portRouteInfo port
- run port (app conn)
+ app <- makeDevApp env
+ run port app
startGargantextMock :: PortNumber -> IO ()
startGargantextMock port = do
portRouteInfo port
-
- application <- makeApp (FireWall False)
-
+ application <- makeMockApp . MockEnv $ FireWall False
run port application
-
-
-
-
-