-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-
----------------------------------------------------------------------
+{-# LANGUAGE TypeOperators #-}
module Gargantext.API
where
----------------------------------------------------------------------
+
import Control.Exception (finally)
import Control.Lens
-import Control.Monad.Except (withExceptT)
import Control.Monad.Reader (runReaderT)
-import Data.Aeson.Encode.Pretty (encodePretty)
import Data.List (lookup)
-import Data.Swagger
-import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
+import Data.Text.IO (putStrLn)
import Data.Validity
-import Data.Version (showVersion)
import GHC.Base (Applicative)
-import GHC.Generics (D1, Meta (..), Rep, Generic)
-import GHC.TypeLits (AppendSymbol, Symbol)
-import Gargantext.API.Admin.Auth (AuthContext, auth)
-import Gargantext.API.Admin.FrontEnd (frontEndServer)
-import Gargantext.API.Admin.Settings
-import Gargantext.API.Ngrams (HasRepoSaver(..), saveRepo)
+import GHC.Generics (Generic)
+import Gargantext.API.Admin.Auth.Types (AuthContext)
+import Gargantext.API.Admin.Settings (newEnv)
+import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings)
+import Gargantext.API.EKG
+import Gargantext.API.Ngrams (saveNodeStory)
import Gargantext.API.Prelude
import Gargantext.API.Routes
-import Gargantext.Prelude
+import Gargantext.API.Server (server)
+import Gargantext.Core.NodeStory
+import Gargantext.Prelude hiding (putStrLn)
import Network.HTTP.Types hiding (Query)
import Network.Wai
-import Network.Wai (Request, requestHeaders)
import Network.Wai.Handler.Warp hiding (defaultSettings)
import Network.Wai.Middleware.Cors
import Network.Wai.Middleware.RequestLogger
+import Paths_gargantext (getDataDir)
import Servant
-import Servant.Auth.Server (AuthResult(..))
-import Servant.Auth.Swagger ()
-import Servant.Swagger
-import Servant.Swagger.UI
-import System.IO (FilePath)
-import qualified Data.ByteString.Lazy.Char8 as BL8
-import qualified Data.Text.IO as T
-import qualified Paths_gargantext as PG -- cabal magic build module
-import qualified Gargantext.API.Public as Public
-
+import System.FilePath
-data Mode = Dev | Mock | Prod
- deriving (Show, Read, Generic)
+data Mode = Dev | Mock | Prod
+ deriving (Show, Read, Generic)
-- | startGargantext takes as parameters port number and Ini file.
startGargantext :: Mode -> PortNumber -> FilePath -> IO ()
portRouteInfo :: PortNumber -> IO ()
portRouteInfo port = do
- T.putStrLn " ----Main Routes----- "
- T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
- T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
+ putStrLn " ----Main Routes----- "
+ putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
+ putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
-- TODO clean this Monad condition (more generic) ?
-stopGargantext :: HasRepoSaver env => env -> IO ()
+stopGargantext :: HasNodeStorySaver env => env -> IO ()
stopGargantext env = do
- T.putStrLn "----- Stopping gargantext -----"
- runReaderT saveRepo env
-
--- | Output generated @swagger.json@ file for the @'TodoAPI'@.
-swaggerWriteJSON :: IO ()
-swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
-
--- | Swagger Specifications
-swaggerDoc :: Swagger
-swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
- & info.title .~ "Gargantext"
- & info.version .~ (cs $ showVersion PG.version)
- -- & 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))
- ["Gargantext" & 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"
+ putStrLn "----- Stopping gargantext -----"
+ runReaderT saveNodeStory env
{-
startGargantextMock :: PortNumber -> IO ()
blocking <- fireWall req (env ^. menv_firewall)
case blocking of
True -> app req resp
- False -> resp ( responseLBS status401 []
+ False -> resp ( responseLBS status401 []
"Invalid Origin or Host header")
-
+
let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
-- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
{ corsOrigins = Nothing -- == /*
--let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
-- $ Warp.defaultSettings
-
+
--pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
-}
-- blocking <- fireWall req (env ^. menv_firewall)
-- case blocking of
-- True -> app req resp
--- False -> resp ( responseLBS status401 []
+-- False -> resp ( responseLBS status401 []
-- "Invalid Origin or Host header")
--
let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
---------------------------------------------------------------------
-- | API Global
---------------------------------------------------------------------
--- | Server declarations
-server :: forall env. EnvC env => env -> IO (Server API)
-server env = do
- -- orchestrator <- scrapyOrchestrator env
- pure $ schemaUiServer swaggerDoc
- :<|> hoistServerWithContext
- (Proxy :: Proxy GargAPI)
- (Proxy :: Proxy AuthContext)
- transform
- serverGargAPI
- :<|> frontEndServer
- where
- transform :: forall a. GargServerM env GargError a -> Handler a
- transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
-
-showAsServantErr :: GargError -> ServerError
-showAsServantErr (GargServerError err) = err
-showAsServantErr a = err500 { errBody = BL8.pack $ show a }
---------------------------
-serverGargAPI :: GargServerT env err (GargServerM env err) GargAPI
-serverGargAPI -- orchestrator
- = auth
- :<|> gargVersion
- :<|> serverPrivateGargAPI
- :<|> Public.api
-
- -- :<|> orchestrator
- where
-
- gargVersion :: GargServer GargVersion
- gargVersion = pure (cs $ showVersion PG.version)
-
- serverPrivateGargAPI :: GargServerT env err (GargServerM env err) GargPrivateAPI
- serverPrivateGargAPI (Authenticated auser) = serverPrivateGargAPI' auser
- serverPrivateGargAPI _ = throwAll' (_ServerError # err401)
--- Here throwAll' requires a concrete type for the monad.
-
-- TODO-SECURITY admin only: withAdmin
-- Question: How do we mark admins?
--gargMock :: Server GargAPI
--gargMock = mock apiGarg Proxy
---------------------------------------------------------------------
-makeApp :: EnvC env => env -> IO Application
-makeApp env = serveWithContext api cfg <$> server env
+
+makeApp :: (Typeable env, EnvC env) => env -> IO Application
+makeApp env = do
+ serv <- server env
+ (ekgStore, ekgMid) <- newEkgStore api
+ ekgDir <- (</> "ekg-assets") <$> getDataDir
+ return $ ekgMid $ serveWithContext apiWithEkg cfg
+ (ekgServer ekgDir ekgStore :<|> serv)
where
cfg :: Servant.Context AuthContext
cfg = env ^. settings . jwtSettings
api :: Proxy API
api = Proxy
+apiWithEkg :: Proxy (EkgAPI :<|> API)
+apiWithEkg = Proxy
+
apiGarg :: Proxy GargAPI
apiGarg = Proxy
---------------------------------------------------------------------
-schemaUiServer :: (Server api ~ Handler Swagger)
- => Swagger -> Server (SwaggerSchemaUI' dir api)
-schemaUiServer = swaggerSchemaUIServer
+{- UNUSED
+--import GHC.Generics (D1, Meta (..), Rep, Generic)
+--import GHC.TypeLits (AppendSymbol, Symbol)
---------------------------------------------------------------------
-- Type Family for the Documentation
type family TypeName (x :: *) :: Symbol where
GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
-
-
+-}