Commit 61aac410 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch '465-dev-share-url-fixes' into 'dev'

[BREAKING] refactoring of fc_url

Closes #465

See merge request !405
parents b6f257b3 2772e02c
Pipeline #7787 passed with stages
in 89 minutes and 50 seconds
...@@ -11,10 +11,7 @@ Import a corpus binary. ...@@ -11,10 +11,7 @@ Import a corpus binary.
-} -}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Strict #-} {-# LANGUAGE Strict #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
module CLI.Ini where module CLI.Ini where
...@@ -104,12 +101,12 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo = ...@@ -104,12 +101,12 @@ convertConfigs ini@(Ini.GargConfig { .. }) iniMail nlpConfig connInfo =
mkFrontendConfig :: Ini.GargConfig -> CTypes.FrontendConfig mkFrontendConfig :: Ini.GargConfig -> CTypes.FrontendConfig
mkFrontendConfig (Ini.GargConfig { .. }) = mkFrontendConfig (Ini.GargConfig { .. }) =
CTypes.FrontendConfig { _fc_url = _gc_url CTypes.FrontendConfig { _fc_external_url = _fc_url
, _fc_internal_url = _fc_url
, _fc_directory = "./purescript-gargantext/dist"
, _fc_backend_name = _gc_backend_name , _fc_backend_name = _gc_backend_name
, _fc_url_backend_api = _gc_url_backend_api
, _fc_cors , _fc_cors
, _fc_microservices , _fc_microservices
, _fc_appPort = 3000
, _fc_cookie_settings = CTypes.defaultCookieSettings } , _fc_cookie_settings = CTypes.defaultCookieSettings }
where where
_fc_cors = CTypes.CORSSettings { _corsAllowedOrigins = [ _fc_cors = CTypes.CORSSettings { _corsAllowedOrigins = [
...@@ -138,6 +135,10 @@ mkFrontendConfig (Ini.GargConfig { .. }) = ...@@ -138,6 +135,10 @@ mkFrontendConfig (Ini.GargConfig { .. }) =
case parseBaseUrl (T.unpack url) of case parseBaseUrl (T.unpack url) of
Nothing -> panicTrace $ "Cannot parse base url for: " <> url Nothing -> panicTrace $ "Cannot parse base url for: " <> url
Just b -> CTypes.CORSOrigin b Just b -> CTypes.CORSOrigin b
_fc_url =
case parseBaseUrl (T.unpack _gc_url) of
Nothing -> panicTrace $ "Cannot parse base url for: " <> _gc_url
Just b -> b
defaultNotificationsConfig :: CTypes.NotificationsConfig defaultNotificationsConfig :: CTypes.NotificationsConfig
defaultNotificationsConfig = defaultNotificationsConfig =
......
...@@ -77,13 +77,11 @@ serverParser = hsubparser ( ...@@ -77,13 +77,11 @@ serverParser = hsubparser (
start_p :: Parser CLIServer start_p :: Parser CLIServer
start_p = fmap CLIS_start $ ServerArgs start_p = fmap CLIS_start $ ServerArgs
<$> mode_p <$> mode_p
<*> port_p
<*> settings_p <*> settings_p
start_all_p :: Parser CLIServer start_all_p :: Parser CLIServer
start_all_p = fmap CLIS_startAll $ ServerArgs start_all_p = fmap CLIS_startAll $ ServerArgs
<$> mode_p <$> mode_p
<*> port_p
<*> settings_p <*> settings_p
mode_p :: Parser Mode mode_p :: Parser Mode
...@@ -92,21 +90,13 @@ mode_p = option auto ( long "mode" ...@@ -92,21 +90,13 @@ mode_p = option auto ( long "mode"
<> metavar "M" <> metavar "M"
<> help "Possible modes: Dev | Mock | Prod" ) <> help "Possible modes: Dev | Mock | Prod" )
port_p :: Parser Int
port_p = option auto ( long "port"
<> short 'p'
<> metavar "P"
<> showDefault
<> value 8008
<> help "Port" )
version_p :: Parser CLIServer version_p :: Parser CLIServer
version_p = pure CLIS_version version_p = pure CLIS_version
startServerCLI :: Logger IO -> ServerArgs -> IO () startServerCLI :: Logger IO -> ServerArgs -> IO ()
startServerCLI ioLogger (ServerArgs { .. }) = do startServerCLI ioLogger (ServerArgs { .. }) = do
logMsg ioLogger INFO $ "starting server, mode: " <> show server_mode <> ", port: " <> show server_port <> ", config: " <> _SettingsFile server_toml logMsg ioLogger INFO $ "starting server, mode: " <> show server_mode <> ", config: " <> _SettingsFile server_toml
-- Sets the locale to avoid encoding issues like in #284. -- Sets the locale to avoid encoding issues like in #284.
setLocaleEncoding utf8 setLocaleEncoding utf8
...@@ -114,4 +104,4 @@ startServerCLI ioLogger (ServerArgs { .. }) = do ...@@ -114,4 +104,4 @@ startServerCLI ioLogger (ServerArgs { .. }) = do
logMsg ioLogger ERROR "Mock mode not supported!" logMsg ioLogger ERROR "Mock mode not supported!"
exitFailure exitFailure
startGargantext server_mode server_port server_toml startGargantext server_mode server_toml
...@@ -100,7 +100,6 @@ data CLIServer ...@@ -100,7 +100,6 @@ data CLIServer
data ServerArgs = ServerArgs data ServerArgs = ServerArgs
{ server_mode :: !Mode { server_mode :: !Mode
, server_port :: !Int
, server_toml :: !SettingsFile } , server_toml :: !SettingsFile }
deriving (Show, Eq) deriving (Show, Eq)
......
[frontend] [frontend]
# Main url serving the FrontEnd (public URL)
external_url = "http://localhost:8008"
# Main url serving the FrontEnd # host/port where the GarganText server will bind to
url = "http://localhost" internal_url = "http://localhost:8008"
backend_name = "localhost" # Location of the frontend code. This will be served at the root of
# the path (e.g. index.html)
directory = "./purescript-gargantext/dist"
# Main API url serving the BackEnd backend_name = "localhost"
url_backend_api = "http://localhost:8008/api/v1.0"
jwt_settings = "TODO" jwt_settings = "TODO"
......
# https://nix.dev/tutorials/first-steps/towards-reproducibility-pinning-nixpkgs.html
{ pkgs ? import (if builtins.elem builtins.currentSystem ["x86_64-darwin" "aarch64-darwin"] { pkgs ? import (if builtins.elem builtins.currentSystem ["x86_64-darwin" "aarch64-darwin"]
then ./pinned-25.05.darwin.nix then ./pinned-25.05.darwin.nix
else ./pinned-25.05.nix) {} }: else ./pinned-25.05.nix) {} }:
rec { rec {
inherit pkgs; inherit pkgs;
ghc966 = pkgs.haskell.compiler.ghc966; ghcVersion = "ghc966";
cabal_install = pkgs.haskell.lib.compose.justStaticExecutables pkgs.haskell.packages.ghc966.cabal-install; gargGhc = pkgs.haskell.compiler.${ghcVersion};
cabal_install = pkgs.haskell.lib.compose.justStaticExecutables pkgs.haskell.packages.${ghcVersion}.cabal-install;
graphviz = pkgs.callPackage ./graphviz.nix {}; graphviz = pkgs.callPackage ./graphviz.nix {};
igraph_0_10_4 = pkgs.callPackage ./igraph.nix {}; igraph_0_10_4 = pkgs.callPackage ./igraph.nix {};
corenlp = pkgs.callPackage ./corenlp.nix { }; # 4.5.8 corenlp = pkgs.callPackage ./corenlp.nix { }; # 4.5.9
cabal2stack = pkgs.callPackage ./cabal2stack.nix { ghc = ghc966; }; cabal2stack = pkgs.callPackage ./cabal2stack.nix { ghc = gargGhc; };
nng_notls = pkgs.nng.overrideAttrs (old: { nng_notls = pkgs.nng.overrideAttrs (old: {
cmakeFlags = (old.cmakeFlags or []) ++ [ "-DNNG_ENABLE_TLS=OFF" ]; cmakeFlags = (old.cmakeFlags or []) ++ [ "-DNNG_ENABLE_TLS=OFF" ];
}); });
hsBuildInputs = [ hsBuildInputs = [
ghc966 gargGhc
cabal_install cabal_install
pkgs.haskellPackages.alex pkgs.haskellPackages.alex
pkgs.haskellPackages.ghcid pkgs.haskellPackages.ghcid
......
...@@ -49,7 +49,7 @@ import Gargantext.API.Routes.Named (API) ...@@ -49,7 +49,7 @@ import Gargantext.API.Routes.Named (API)
import Gargantext.API.Routes.Named.EKG (EkgAPI) import Gargantext.API.Routes.Named.EKG (EkgAPI)
import Gargantext.API.Server.Named (server) import Gargantext.API.Server.Named (server)
import Gargantext.Core.Config import Gargantext.Core.Config
import Gargantext.Core.Config.Types (CORSOrigin(..), CORSSettings, MicroServicesProxyStatus(..), NotificationsConfig(..), PortNumber, SettingsFile(..), corsAllowedOrigins, fc_appPort, fc_cors, fc_cookie_settings, microServicesProxyStatus) import Gargantext.Core.Config.Types (CORSOrigin(..), CORSSettings, MicroServicesProxyStatus(..), NotificationsConfig(..), PortNumber, SettingsFile(..), corsAllowedOrigins, fc_cors, fc_cookie_settings, fc_internal_url, microServicesProxyStatus)
import Gargantext.Core.Config.Utils (readConfig) import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.Core.Notifications (withNotifications) import Gargantext.Core.Notifications (withNotifications)
import Gargantext.Database.Prelude qualified as DB import Gargantext.Database.Prelude qualified as DB
...@@ -62,21 +62,20 @@ import Network.Wai.Handler.Warp hiding (defaultSettings) ...@@ -62,21 +62,20 @@ import Network.Wai.Handler.Warp hiding (defaultSettings)
import Network.Wai.Middleware.Cors import Network.Wai.Middleware.Cors
import Network.Wai.Middleware.RequestLogger (logStdout) import Network.Wai.Middleware.RequestLogger (logStdout)
import Servant hiding (Header) import Servant hiding (Header)
import Servant.Client.Core.BaseUrl (showBaseUrl) import Servant.Client.Core.BaseUrl (showBaseUrl, baseUrlPort)
import System.Clock qualified as Clock import System.Clock qualified as Clock
import System.Cron.Schedule qualified as Cron import System.Cron.Schedule qualified as Cron
-- | startGargantext takes as parameters port number and Toml file. -- | startGargantext takes as parameters port number and Toml file.
startGargantext :: Mode -> PortNumber -> SettingsFile -> IO () startGargantext :: Mode -> SettingsFile -> IO ()
startGargantext mode port sf@(SettingsFile settingsFile) = do startGargantext mode sf@(SettingsFile settingsFile) = do
config <- readConfig sf <&> (gc_frontend_config . fc_appPort) .~ port config <- readConfig sf
withLoggerIO (config ^. gc_logging) $ \logger -> do withLoggerIO (config ^. gc_logging) $ \logger -> do
when (port /= config ^. gc_frontend_config . fc_appPort) $
panicTrace "TODO: conflicting settings of port"
withNotifications config $ \dispatcher -> do withNotifications config $ \dispatcher -> do
env <- newEnv logger config dispatcher env <- newEnv logger config dispatcher
let fc = env ^. env_config . gc_frontend_config let fc = env ^. env_config . gc_frontend_config
let proxyStatus = microServicesProxyStatus fc let proxyStatus = microServicesProxyStatus fc
let port = baseUrlPort (fc ^. fc_internal_url)
runDbCheck env runDbCheck env
startupInfo config port proxyStatus startupInfo config port proxyStatus
app <- makeApp env app <- makeApp env
......
...@@ -16,9 +16,10 @@ Loads all static file for the front-end. ...@@ -16,9 +16,10 @@ Loads all static file for the front-end.
--------------------------------------------------------------------- ---------------------------------------------------------------------
module Gargantext.API.Admin.FrontEnd where module Gargantext.API.Admin.FrontEnd where
import GHC.IO (FilePath)
import Servant import Servant
type FrontEndAPI = Raw type FrontEndAPI = Raw
frontEndServer :: Server FrontEndAPI frontEndServer :: FilePath -> Server FrontEndAPI
frontEndServer = serveDirectoryFileServer "./purescript-gargantext/dist" frontEndServer path = serveDirectoryFileServer path
...@@ -10,7 +10,7 @@ import Data.Validity qualified as V ...@@ -10,7 +10,7 @@ import Data.Validity qualified as V
import Gargantext.API.Prelude (IsGargServer) import Gargantext.API.Prelude (IsGargServer)
import Gargantext.API.Routes.Named.Share qualified as Named import Gargantext.API.Routes.Named.Share qualified as Named
import Gargantext.Core.Config (GargConfig, gc_frontend_config, HasConfig(hasConfig)) import Gargantext.Core.Config (GargConfig, gc_frontend_config, HasConfig(hasConfig))
import Gargantext.Core.Config.Types (fc_appPort, fc_url) import Gargantext.Core.Config.Types (getPublicUrl)
import Gargantext.Core.Types (NodeType, NodeId, unNodeId, _ValidationError) import Gargantext.Core.Types (NodeType, NodeId, unNodeId, _ValidationError)
import Gargantext.Database.Prelude (IsDBEnvExtra) import Gargantext.Database.Prelude (IsDBEnvExtra)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -37,18 +37,21 @@ get_url :: Maybe NodeType ...@@ -37,18 +37,21 @@ get_url :: Maybe NodeType
-> GargConfig -> GargConfig
-> Either String Named.ShareLink -> Either String Named.ShareLink
get_url nt id gc = do get_url nt id gc = do
let urlHost = T.unpack $ gc ^. gc_frontend_config . fc_url let fc = gc ^. gc_frontend_config
let urlPort = gc ^. gc_frontend_config . fc_appPort -- let urlHost = T.unpack $ gc ^. gc_frontend_config . fc_url
-- let urlPort = gc ^. gc_frontend_config . fc_appPort
t <- maybe (Left "Invalid node Type") Right nt t <- maybe (Left "Invalid node Type") Right nt
i <- maybe (Left "Invalid node ID") Right id i <- maybe (Left "Invalid node ID") Right id
let sharePart = "/#/share/" <> show t <> "/" <> show (unNodeId i)
-- Include the port the server is running on if this is -- Include the port the server is running on if this is
-- localhost, so that share URLs would work out of the box. -- localhost, so that share URLs would work out of the box.
let !rawURL let !rawURL = T.unpack $ (getPublicUrl fc) <> sharePart
| "localhost" `isInfixOf` urlHost -- | "localhost" `isInfixOf` urlHost
= urlHost <> ":" <> show urlPort <> "/#/share/" <> show t <> "/" <> show (unNodeId i) -- = urlHost <> ":" <> show urlPort <> "/#/share/" <> show t <> "/" <> show (unNodeId i)
| otherwise -- | otherwise
= urlHost <> "/#/share/" <> show t <> "/" <> show (unNodeId i) -- = urlHost <> "/#/share/" <> show t <> "/" <> show (unNodeId i)
maybe (Left $ "Couldn't construct a valid share URL from '" <> rawURL <> "'") maybe (Left $ "Couldn't construct a valid share URL from '" <> rawURL <> "'")
(Right . Named.ShareLink) (Right . Named.ShareLink)
(parseURI rawURL) (parseURI rawURL)
...@@ -16,7 +16,7 @@ import Gargantext.API.Admin.EnvTypes (Env) ...@@ -16,7 +16,7 @@ import Gargantext.API.Admin.EnvTypes (Env)
import Gargantext.API.Admin.FrontEnd (frontEndServer) import Gargantext.API.Admin.FrontEnd (frontEndServer)
import Gargantext.API.Auth.PolicyCheck () import Gargantext.API.Auth.PolicyCheck ()
import Gargantext.API.Errors import Gargantext.API.Errors
import Gargantext.API.GraphQL as GraphQL import Gargantext.API.GraphQL as GraphQL ( GraphQLAPI, api )
import Gargantext.API.Prelude (GargM) import Gargantext.API.Prelude (GargM)
import Gargantext.API.Routes.Named import Gargantext.API.Routes.Named
import Gargantext.API.Server.Named.Public (serverPublicGargAPI) import Gargantext.API.Server.Named.Public (serverPublicGargAPI)
...@@ -24,7 +24,7 @@ import Gargantext.API.Swagger (openApiDoc) ...@@ -24,7 +24,7 @@ import Gargantext.API.Swagger (openApiDoc)
import Gargantext.API.ThrowAll (serverPrivateGargAPI) import Gargantext.API.ThrowAll (serverPrivateGargAPI)
import Gargantext.Core.Notifications.Dispatcher.WebSocket qualified as Dispatcher import Gargantext.Core.Notifications.Dispatcher.WebSocket qualified as Dispatcher
import Gargantext.Core.Config (gc_frontend_config, hasConfig) import Gargantext.Core.Config (gc_frontend_config, hasConfig)
import Gargantext.Core.Config.Types (fc_url_backend_api) import Gargantext.Core.Config.Types (fc_directory, fc_external_url)
import Gargantext.Prelude hiding (Handler, catch) import Gargantext.Prelude hiding (Handler, catch)
import Gargantext.System.Logging (logLocM, LogLevel(..)) import Gargantext.System.Logging (logLocM, LogLevel(..))
import Paths_gargantext qualified as PG -- cabal magic build module import Paths_gargantext qualified as PG -- cabal magic build module
...@@ -40,7 +40,7 @@ serverGargAPI env ...@@ -40,7 +40,7 @@ serverGargAPI env
, gargForgotPasswordAsyncAPI = forgotPasswordAsync , gargForgotPasswordAsyncAPI = forgotPasswordAsync
, gargVersionAPI = gargVersion , gargVersionAPI = gargVersion
, gargPrivateAPI = serverPrivateGargAPI , gargPrivateAPI = serverPrivateGargAPI
, gargPublicAPI = serverPublicGargAPI (env ^. hasConfig . gc_frontend_config . fc_url_backend_api) , gargPublicAPI = serverPublicGargAPI (env ^. hasConfig . gc_frontend_config . fc_external_url)
} }
where where
gargVersion :: GargVersion (AsServerT (GargM Env BackendInternalError)) gargVersion :: GargVersion (AsServerT (GargM Env BackendInternalError))
...@@ -66,7 +66,7 @@ server env = ...@@ -66,7 +66,7 @@ server env =
-- (Proxy :: Proxy AuthContext) -- (Proxy :: Proxy AuthContext)
(transformJSON errScheme) (transformJSON errScheme)
Dispatcher.wsServer Dispatcher.wsServer
, frontendAPI = frontEndServer , frontendAPI = frontEndServer (env ^. hasConfig . gc_frontend_config . fc_directory)
} }
where where
transformJSON :: forall a. GargErrorScheme -> GargM Env BackendInternalError a -> Handler a transformJSON :: forall a. GargErrorScheme -> GargM Env BackendInternalError a -> Handler a
......
...@@ -9,7 +9,7 @@ import Gargantext.API.Errors.Types (BackendInternalError) ...@@ -9,7 +9,7 @@ import Gargantext.API.Errors.Types (BackendInternalError)
import Gargantext.API.Members (members) import Gargantext.API.Members (members)
import Gargantext.API.Ngrams.List qualified as List import Gargantext.API.Ngrams.List qualified as List
import Gargantext.API.Node (annuaireNodeAPI, corpusNodeAPI, nodeAPI, nodeNodeAPI, nodesAPI, roots) import Gargantext.API.Node (annuaireNodeAPI, corpusNodeAPI, nodeAPI, nodeNodeAPI, nodesAPI, roots)
import Gargantext.API.Node.Contact as Contact import Gargantext.API.Node.Contact as Contact ( contactAPI )
import Gargantext.API.Node.Corpus.Export qualified as CorpusExport import Gargantext.API.Node.Corpus.Export qualified as CorpusExport
import Gargantext.API.Node.Corpus.Subcorpus qualified as Subcorpus import Gargantext.API.Node.Corpus.Subcorpus qualified as Subcorpus
import Gargantext.API.Node.Document.Export (documentExportAPI) import Gargantext.API.Node.Document.Export (documentExportAPI)
...@@ -19,7 +19,7 @@ import Gargantext.API.Node.ShareURL ( shareURL ) ...@@ -19,7 +19,7 @@ import Gargantext.API.Node.ShareURL ( shareURL )
import Gargantext.API.Prelude (GargM) import Gargantext.API.Prelude (GargM)
import Gargantext.API.Routes (addWithTempFileApi, addCorpusWithQuery) import Gargantext.API.Routes (addWithTempFileApi, addCorpusWithQuery)
import Gargantext.API.Routes.Named.Private qualified as Named import Gargantext.API.Routes.Named.Private qualified as Named
import Gargantext.API.Server.Named.Ngrams import Gargantext.API.Server.Named.Ngrams ( apiNgramsTableDoc )
import Gargantext.API.Server.Named.Viz qualified as Viz import Gargantext.API.Server.Named.Viz qualified as Viz
import Gargantext.Core.Types.Individu (User(..)) import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny) import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny)
......
...@@ -4,9 +4,9 @@ module Gargantext.API.Server.Named.Public ( ...@@ -4,9 +4,9 @@ module Gargantext.API.Server.Named.Public (
) where ) where
import Control.Lens ((^?), _Just) import Control.Lens ((^?), _Just)
import Data.List qualified as List
import Data.Map.Strict qualified as Map import Data.Map.Strict qualified as Map
import Data.Set qualified as Set import Data.Set qualified as Set
import Data.Text qualified as T
import Gargantext.API.Node.File (fileApi) import Gargantext.API.Node.File (fileApi)
import Gargantext.API.Prelude (serverError, IsGargServer) import Gargantext.API.Prelude (serverError, IsGargServer)
import Gargantext.API.Public.Types (PublicData(..)) import Gargantext.API.Public.Types (PublicData(..))
...@@ -22,29 +22,30 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..)) ...@@ -22,29 +22,30 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Table.NodeNode (selectPublicNodes) import Gargantext.Database.Query.Table.NodeNode (selectPublicNodes)
import Gargantext.Database.Schema.Node ( NodePoly(..), node_date, node_hyperdata ) -- (NodePoly(..)) import Gargantext.Database.Schema.Node ( NodePoly(..), node_date, node_hyperdata ) -- (NodePoly(..))
import Gargantext.Prelude import Gargantext.Prelude
import Servant import Servant ( ServerError(errBody), err405 )
import Servant.Client.Core.BaseUrl (BaseUrl(..), showBaseUrl)
import Servant.Server.Generic (AsServerT) import Servant.Server.Generic (AsServerT)
serverPublicGargAPI :: IsGargServer env err m => Text -> Named.GargPublicAPI (AsServerT m) serverPublicGargAPI :: IsGargServer env err m => BaseUrl -> Named.GargPublicAPI (AsServerT m)
serverPublicGargAPI baseUrl = Named.GargPublicAPI $ serverPublicGargAPI baseUrl = Named.GargPublicAPI $
Named.GargPublicAPI' Named.GargPublicAPI'
{ publicHomeAPI = api_home baseUrl { publicHomeAPI = apiHome baseUrl
, publicNodeAPI = Named.NodeAPI api_node , publicNodeAPI = Named.NodeAPI apiNode
} }
api_home :: IsGargServer env err m => Text -> Named.HomeAPI (AsServerT m) apiHome :: IsGargServer env err m => BaseUrl -> Named.HomeAPI (AsServerT m)
api_home baseUrl = Named.HomeAPI $ runDBQuery $ catMaybes apiHome baseUrl = Named.HomeAPI $ runDBQuery $ catMaybes
<$> map (toPublicData baseUrl) <$> map (toPublicData baseUrl)
<$> filterPublicDatas <$> filterPublicDatas
<$> selectPublic <$> selectPublic
api_node :: IsGargServer env err m => NodeId -> Named.FileAPI (AsServerT m) apiNode :: IsGargServer env err m => NodeId -> Named.FileAPI (AsServerT m)
api_node nId = Named.FileAPI $ do apiNode nId = Named.FileAPI $ do
pubNodes <- runDBQuery publicNodes pubNodes <- runDBQuery publicNodes
-- TODO optimize with SQL -- TODO optimize with SQL
case Set.member nId pubNodes of (if Set.member nId pubNodes
False -> serverError $ err405 { errBody = "Not allowed" } then fileApi nId
True -> fileApi nId else serverError $ err405 { errBody = "Not allowed" })
------------------------------------------------------------------------- -------------------------------------------------------------------------
...@@ -61,7 +62,7 @@ filterPublicDatas :: [(Node HyperdataFolder, Maybe Int)] ...@@ -61,7 +62,7 @@ filterPublicDatas :: [(Node HyperdataFolder, Maybe Int)]
filterPublicDatas datas = filterPublicDatas datas =
map (\(n,mi) -> map (\(n,mi) ->
let mi' = UnsafeMkNodeId <$> mi in let mi' = UnsafeMkNodeId <$> mi in
( _node_id n, (n, maybe [] (:[]) mi' )) ( _node_id n, (n, maybeToList mi' ))
) datas ) datas
& Map.fromListWith (\(n1,i1) (_n2,i2) -> (n1, i1 <> i2)) & Map.fromListWith (\(n1,i1) (_n2,i2) -> (n1, i1 <> i2))
& Map.filter (not . null . snd) & Map.filter (not . null . snd)
...@@ -72,28 +73,29 @@ publicNodes :: HasNodeError err ...@@ -72,28 +73,29 @@ publicNodes :: HasNodeError err
publicNodes = do publicNodes = do
candidates <- filterPublicDatas <$> selectPublicNodes candidates <- filterPublicDatas <$> selectPublicNodes
pure $ Set.fromList pure $ Set.fromList
$ List.concat $ concatMap (\(n, ns) -> _node_id n : ns) candidates
$ map (\(n, ns) -> (_node_id n) : ns) candidates
-- http://localhost:8008/api/v1.0/node/23543/file/download<Paste> -- http://localhost:8008/api/v1.0/node/23543/file/download<Paste>
-- http://localhost:8000/images/Gargantextuel-212x300.jpg -- http://localhost:8000/images/Gargantextuel-212x300.jpg
toPublicData :: Text -> (Node HyperdataFolder, [NodeId]) -> Maybe PublicData toPublicData :: BaseUrl -> (Node HyperdataFolder, [NodeId]) -> Maybe PublicData
toPublicData base (n , mn) = do toPublicData baseUrl (n , mn) = do
title <- (hd ^? (_Just . hf_data . cf_title)) title <- hd ^? (_Just . hf_data . cf_title)
abstract <- (hd ^? (_Just . hf_data . cf_desc )) abstract <- hd ^? (_Just . hf_data . cf_desc )
img <- (Just $ url' mn) -- "images/Gargantextuel-212x300.jpg" img <- Just $ url' mn -- "images/Gargantextuel-212x300.jpg"
url <- (Just $ url' mn) url <- Just $ url' mn
date <- Just (show $ utc2year (n^.node_date)) date <- Just (show $ utc2year (n^.node_date))
database <- (hd ^? (_Just . hf_data . cf_query)) database <- hd ^? (_Just . hf_data . cf_query)
author <- (hd ^? (_Just . hf_data . cf_authors)) author <- hd ^? (_Just . hf_data . cf_authors)
pure $ PublicData { .. } pure $ PublicData { .. }
where where
hd = head hd = head
$ filter (\(HyperdataField cd _ _) -> cd == JSON) $ filter (\(HyperdataField cd _ _) -> cd == JSON)
$ n^. (node_hyperdata . hc_fields) $ n^. (node_hyperdata . hc_fields)
url' :: [NodeId] -> Text path :: [NodeId] -> Text
url' mn' = base path mn' = "/api/v1.0"
<> "/public/" <> "/public/"
<> (show $ (maybe 0 unNodeId $ head mn')) <> show (maybe 0 unNodeId (head mn'))
<> "/file/download" <> "/file/download"
url' :: [NodeId] -> Text
url' mn' = T.pack $ showBaseUrl $ baseUrl { baseUrlPath = T.unpack $ path mn' }
...@@ -38,7 +38,7 @@ import Gargantext.API.Errors.Types ...@@ -38,7 +38,7 @@ import Gargantext.API.Errors.Types
import Gargantext.API.Ngrams.Prelude (getNgramsList) import Gargantext.API.Ngrams.Prelude (getNgramsList)
import Gargantext.API.Ngrams.Types (NgramsList) import Gargantext.API.Ngrams.Types (NgramsList)
import Gargantext.API.Node.Document.Export (get_document_json) import Gargantext.API.Node.Document.Export (get_document_json)
import Gargantext.API.Node.Document.Export.Types import Gargantext.API.Node.Document.Export.Types ( DocumentExport(_de_documents) )
import Gargantext.API.Prelude (IsGargServer) import Gargantext.API.Prelude (IsGargServer)
import Gargantext.API.Routes.Client (remoteImportClient) import Gargantext.API.Routes.Client (remoteImportClient)
import Gargantext.API.Routes.Named.Remote qualified as Named import Gargantext.API.Routes.Named.Remote qualified as Named
......
...@@ -53,7 +53,7 @@ import Gargantext.Core.Config.Worker (WorkerSettings) ...@@ -53,7 +53,7 @@ import Gargantext.Core.Config.Worker (WorkerSettings)
import Gargantext.Prelude import Gargantext.Prelude
import Network.HTTP.Client qualified as HTTP import Network.HTTP.Client qualified as HTTP
import Servant.Auth.Server (JWTSettings) import Servant.Auth.Server (JWTSettings)
import Servant.Client (BaseUrl(..), Scheme(Http), parseBaseUrl) import Servant.Client (BaseUrl(..))
import Toml.Schema import Toml.Schema
import Toml.Schema.FromValue (typeError) import Toml.Schema.FromValue (typeError)
...@@ -142,10 +142,8 @@ instance ToTable GargConfig where ...@@ -142,10 +142,8 @@ instance ToTable GargConfig where
mkProxyUrl :: GargConfig -> BaseUrl mkProxyUrl :: GargConfig -> BaseUrl
mkProxyUrl GargConfig{..} = mkProxyUrl GargConfig{ _gc_frontend_config = cfg } =
case parseBaseUrl (T.unpack $ _fc_url _gc_frontend_config) of (_fc_external_url cfg) { baseUrlPort = _msProxyPort $ _fc_microservices cfg }
Nothing -> BaseUrl Http "localhost" 80 ""
Just bh -> bh { baseUrlPort = _msProxyPort $ _fc_microservices _gc_frontend_config }
class HasConfig env where class HasConfig env where
......
...@@ -27,13 +27,14 @@ module Gargantext.Core.Config.Types ...@@ -27,13 +27,14 @@ module Gargantext.Core.Config.Types
, f_istex_url , f_istex_url
, PortNumber , PortNumber
, FrontendConfig(..) , FrontendConfig(..)
, fc_url , fc_external_url
, fc_internal_url
, fc_backend_name , fc_backend_name
, fc_url_backend_api , fc_directory
, fc_cors , fc_cors
, fc_microservices , fc_microservices
, fc_appPort
, fc_cookie_settings , fc_cookie_settings
, getPublicUrl
, defaultCookieSettings , defaultCookieSettings
, MicroServicesProxyStatus(..) , MicroServicesProxyStatus(..)
, microServicesProxyStatus , microServicesProxyStatus
...@@ -63,7 +64,7 @@ import Database.PostgreSQL.Simple qualified as PGS ...@@ -63,7 +64,7 @@ import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.Prelude import Gargantext.Prelude
import Servant.Auth.Server (CookieSettings(..), JWTSettings, XsrfCookieSettings(..), defaultJWTSettings, readKey, writeKey) import Servant.Auth.Server (CookieSettings(..), JWTSettings, XsrfCookieSettings(..), defaultJWTSettings, readKey, writeKey)
import Servant.Auth.Server qualified as SAuth import Servant.Auth.Server qualified as SAuth
import Servant.Client.Core (BaseUrl, parseBaseUrl, showBaseUrl) import Servant.Client.Core (BaseUrl(..), parseBaseUrl, showBaseUrl)
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import Toml import Toml
import Toml.Schema import Toml.Schema
...@@ -199,35 +200,49 @@ defaultCookieSettings = SAuth.defaultCookieSettings { cookieXsrfSetting = Just x ...@@ -199,35 +200,49 @@ defaultCookieSettings = SAuth.defaultCookieSettings { cookieXsrfSetting = Just x
-- TODO jwtSettings = defaultJWTSettings -- TODO jwtSettings = defaultJWTSettings
data FrontendConfig = data FrontendConfig =
FrontendConfig { _fc_url :: !Text FrontendConfig { _fc_external_url :: !BaseUrl
, _fc_internal_url :: !BaseUrl
, _fc_directory :: !FilePath
, _fc_backend_name :: !Text , _fc_backend_name :: !Text
, _fc_url_backend_api :: !Text
, _fc_cors :: !CORSSettings , _fc_cors :: !CORSSettings
, _fc_microservices :: !MicroServicesSettings , _fc_microservices :: !MicroServicesSettings
, _fc_appPort :: !PortNumber
, _fc_cookie_settings :: !CookieSettings , _fc_cookie_settings :: !CookieSettings
} }
deriving (Generic, Show) deriving (Generic, Show)
instance FromValue FrontendConfig where instance FromValue FrontendConfig where
fromValue = parseTableFromValue $ do fromValue = parseTableFromValue $ do
_fc_url <- reqKey "url" _fc_external_url_txt <- reqKey "external_url"
_fc_external_url <-
case parseBaseUrl (T.unpack _fc_external_url_txt) of
Nothing -> fail "cannot parse fc_external_url"
Just b -> pure b
_fc_internal_url_txt <- reqKey "internal_url"
_fc_internal_url <-
case parseBaseUrl (T.unpack _fc_internal_url_txt) of
Nothing -> fail "cannot parse fc_internal_url"
Just b -> pure b
_fc_directory <- reqKey "directory"
_fc_backend_name <- reqKey "backend_name" _fc_backend_name <- reqKey "backend_name"
_fc_url_backend_api <- reqKey "url_backend_api"
_fc_cors <- reqKey "cors" _fc_cors <- reqKey "cors"
_fc_microservices <- reqKey "microservices" _fc_microservices <- reqKey "microservices"
let _fc_appPort = 3000
return $ FrontendConfig { _fc_cookie_settings = defaultCookieSettings, .. } return $ FrontendConfig { _fc_cookie_settings = defaultCookieSettings, .. }
instance ToValue FrontendConfig where instance ToValue FrontendConfig where
toValue = defaultTableToValue toValue = defaultTableToValue
instance ToTable FrontendConfig where instance ToTable FrontendConfig where
toTable (FrontendConfig { .. }) = table [ "url" .= _fc_url toTable (FrontendConfig { .. }) = table
[ "external_url" .= (T.pack $ showBaseUrl _fc_external_url)
, "internal_url" .= (T.pack $ showBaseUrl _fc_internal_url)
, "directory" .= _fc_directory
, "backend_name" .= _fc_backend_name , "backend_name" .= _fc_backend_name
, "url_backend_api" .= _fc_url_backend_api
, "cors" .= _fc_cors , "cors" .= _fc_cors
, "microservices" .= _fc_microservices ] , "microservices" .= _fc_microservices ]
makeLenses ''FrontendConfig makeLenses ''FrontendConfig
getPublicUrl :: FrontendConfig -> Text
getPublicUrl (FrontendConfig { .. }) = T.pack $ showBaseUrl _fc_external_url
data MicroServicesProxyStatus data MicroServicesProxyStatus
= PXY_enabled PortNumber = PXY_enabled PortNumber
| PXY_disabled | PXY_disabled
......
...@@ -16,7 +16,7 @@ import Control.Monad.Trans.Control (MonadBaseControl) ...@@ -16,7 +16,7 @@ import Control.Monad.Trans.Control (MonadBaseControl)
import Data.List qualified as List import Data.List qualified as List
import Data.Text (splitOn) import Data.Text (splitOn)
import Gargantext.Core.Config (gc_frontend_config, HasConfig(..)) import Gargantext.Core.Config (gc_frontend_config, HasConfig(..))
import Gargantext.Core.Config.Types (fc_url, fc_backend_name) import Gargantext.Core.Config.Types (fc_backend_name, getPublicUrl)
import Gargantext.Core.Config.Mail (gargMail, GargMail(..), MailConfig) import Gargantext.Core.Config.Mail (gargMail, GargMail(..), MailConfig)
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Database.Schema.User (UserLight(..)) import Gargantext.Database.Schema.User (UserLight(..))
...@@ -75,7 +75,7 @@ mail mailCfg model = do ...@@ -75,7 +75,7 @@ mail mailCfg model = do
(m,u) = email_to model (m,u) = email_to model
subject = email_subject model subject = email_subject model
body = emailWith (ServerAddress (view (gc_frontend_config . fc_backend_name) cfg) body = emailWith (ServerAddress (view (gc_frontend_config . fc_backend_name) cfg)
(view (gc_frontend_config . fc_url) cfg)) model (getPublicUrl $ view gc_frontend_config cfg)) model
liftBase $ gargMail mailCfg (GargMail { gm_to = m liftBase $ gargMail mailCfg (GargMail { gm_to = m
, gm_name = Just u , gm_name = Just u
, gm_subject = subject , gm_subject = subject
......
[frontend] [frontend]
url = "http://localhost" external_url = "http://localhost"
internal_url = "http://localhost"
directory = "./purescript-gargantext/dist"
backend_name = "localhost" backend_name = "localhost"
url_backend_api = "http://localhost:8008/api/v1.0"
jwt_settings = "TODO" jwt_settings = "TODO"
[frontend.cors] [frontend.cors]
......
...@@ -24,7 +24,7 @@ import Gargantext.API.Admin.EnvTypes (Env (..), env_dispatcher) ...@@ -24,7 +24,7 @@ import Gargantext.API.Admin.EnvTypes (Env (..), env_dispatcher)
import Gargantext.API.Errors.Types import Gargantext.API.Errors.Types
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.Core.Config hiding (jwtSettings) import Gargantext.Core.Config hiding (jwtSettings)
import Gargantext.Core.Config.Types (fc_appPort, jwtSettings) import Gargantext.Core.Config.Types (jwtSettings, fc_external_url, fc_internal_url)
import Gargantext.Core.Notifications (withNotifications) import Gargantext.Core.Notifications (withNotifications)
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Database.Action.Flow import Gargantext.Database.Action.Flow
...@@ -37,7 +37,7 @@ import Gargantext.Database.Prelude ...@@ -37,7 +37,7 @@ import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node (getOrMkList) import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..)) import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..))
import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp) import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
import Gargantext.Prelude hiding (catches, Handler) import Gargantext.Prelude hiding (catches, to, Handler)
import Gargantext.System.Logging import Gargantext.System.Logging
import Network.HTTP.Client.TLS (newTlsManager) import Network.HTTP.Client.TLS (newTlsManager)
import Network.HTTP.Types import Network.HTTP.Types
...@@ -48,6 +48,7 @@ import Network.Wai.Handler.Warp.Internal ...@@ -48,6 +48,7 @@ import Network.Wai.Handler.Warp.Internal
import Network.WebSockets qualified as WS import Network.WebSockets qualified as WS
import Prelude hiding (show) import Prelude hiding (show)
import Servant.Auth.Client () import Servant.Auth.Client ()
import Servant.Client.Core (baseUrlPort)
import Test.Database.Setup (withTestDB) import Test.Database.Setup (withTestDB)
import Test.Database.Types import Test.Database.Types
import UnliftIO qualified import UnliftIO qualified
...@@ -72,7 +73,9 @@ newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> ...@@ -72,7 +73,9 @@ newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port ->
newTestEnv testEnv logger port = do newTestEnv testEnv logger port = do
!manager_env <- newTlsManager !manager_env <- newTlsManager
let config_env = test_config testEnv & (gc_frontend_config . fc_appPort) .~ port let config_env = test_config testEnv
& (gc_frontend_config . fc_external_url) %~ (\b -> b { baseUrlPort = port })
& (gc_frontend_config . fc_internal_url) %~ (\b -> b { baseUrlPort = port })
-- dbParam <- pure $ testEnvToPgConnectionInfo testEnv -- dbParam <- pure $ testEnvToPgConnectionInfo testEnv
-- !pool <- newPool dbParam -- !pool <- newPool dbParam
......
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