Verified Commit 69ed7b65 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into 341-dev-websockets

parents 1f747d2e 0e037e1f
## Version 0.0.7.1.9
* [BACK][FIX][Write Frame microservice proxy improvements (#364)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/364)
* [BACK][FIX][Integrate `servant-routes` in the codebase (#350)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/350)
* [BACK][FIX][[Documentation] Improve README (#365)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/365)
* [BACK][FIX][Improving message error from the TSV import (#361)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/361)
## Version 0.0.7.1.8
* [BACK][FEAT][[Graph explorer] Search and associated documents (#262)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/262) (Backend Part).
......
......@@ -7,12 +7,10 @@
#### Table of Contents
1. [About the project](#about)
2. [Installation](#install)
3. [Initialization](#init)
4. [Launch & develop GarganText](#launch)
5. [Uses cases](#use-cases)
6. [GraphQL](#graphql)
7. [PostgreSQL](#postgresql)
2. [Installation and development](#install)
3. [Uses cases](#use-cases)
4. [GraphQL](#graphql)
5. [PostgreSQL](#postgresql)
## About the project <a name="about"></a>
......@@ -23,219 +21,112 @@ This software is free (as "Libre" in French) software, developed by the CNRS Com
GarganText Project: this repo builds the backend for the frontend server built by [backend](https://gitlab.iscpif.fr/gargantext/haskell-gargantext).
## Installation <a name="install"></a>
## Installation and development <a name="install"></a>
Disclaimer: since this project is still in development, this document remains in progress. Please report and improve this documentation if you encounter any issues.
#### Prerequisites
### Prerequisites
- Install:
- [git](https://git-scm.com/book/en/v2/Getting-Started-Installing-Git)
- [curl](https://everything.curl.dev/index.html)
- Clone the project.
```shell
git clone https://gitlab.iscpif.fr/gargantext/haskell-gargantext.git
cd haskell-gargantext
```
### Installation
You must have the following installed:
This project can be built with either Stack or Cabal. We keep up-to-date the `cabal.project` (which allows us
to build with `cabal` by default) but we support `stack` thanks to thanks to
[cabal2stack](https://github.com/iconnect/cabal2stack), which allows us to generate a valid `stack.yaml` from
a `cabal.project`. Due to the fact gargantext requires a particular set of system dependencies (C++ libraries,
toolchains, etc) we use [nix](https://nixos.org/) to setup an environment with all the required system
dependencies, in a sandboxed and isolated fashion.
- [Git](https://git-scm.com/book/en/v2/Getting-Started-Installing-Git)
- [Curl](https://everything.curl.dev/index.html)
- [Nix](https://nixos.org/download/)
- [Docker Compose](https://docs.docker.com/compose/install/)
#### Install Nix
### Building
As said, Gargantext requires [Nix](https://github.com/NixOS/nix) to provide system dependencies (for example, C libraries), but its use is limited to that. In order to install [Nix](https://nixos.org/download.html):
#### Clone the projects
Clone both the backend (`haskell-gargantext`), and the frontend (`purescript-gargantext`) at the root of the backend.
```shell
sh <(curl -L https://nixos.org/nix/install) --daemon
```
Verify the installation is complete with
```shell
nix-env --version
nix-env (Nix) 2.19.2
git clone https://gitlab.iscpif.fr/gargantext/haskell-gargantext.git
cd haskell-gargantext
git clone https://gitlab.iscpif.fr/gargantext/purescript-gargantext.git
cd ..
```
**Important:** Before building the project with either `stack` or `cabal` you need to be in the correct Nix shell, which will fetch all the required system dependencies. To do so, just type **inside your haskell-gargantext folder**:
#### Enter a Nix shell
Enter a Nix shell. This will take a long time the first time you run it:
```shell
nix-shell
```
This will take a bit of time as it has to download/build the dependencies, but this will be needed only the first time.
### Build: choose cabal (new) or stack (old)
#### With Cabal (recommanded)
##### Turning off optimization flags
Create a `cabal.project.local` file (don't commit it to git!):
```
package gargantext
ghc-options: -fwrite-ide-info -hiedir=".stack-work/hiedb" -O0
package gargantext-admin
ghc-options: -O0
package gargantext-cli
ghc-options: -O0
package gargantext-db-obfuscation
ghc-options: -O0
package gargantext-import
ghc-options: -O0
package gargantext-init
ghc-options: -O0
You can exit a Nix shell at any point with `exit`.
package gargantext-invitations
ghc-options: -O0
In what follows, many commands need to be executed from within the Nix shell. To make that clear, those will be prefixed with `n$`, *but you must not actually type `n$` before the commands*.
package gargantext-phylo
ghc-options: -O0
package gargantext-server
ghc-options: -O0
package gargantext-upgrade
ghc-options: -O0
package gargantext-graph
ghc-options: -O0
package hmatrix
ghc-options: -O0
package sparse-linear
ghc-options: -O0
```
##### Building
First, into `nix-shell`:
If for some reason you do not want to enter a Nix shell, you can still run a command from outside:
```shell
cabal update
cabal install
nix-shell --run "my command"
```
is equivalent to running `my command` from within a Nix shell.
Alternatively, if you want to run the command "from the outside", in your current shell:
#### Disable optimization flags
```
nix-shell --run "cabal update"
nix-shell --run "cabal install"
Make a file `cabal.project.local` that will tell Cabal to turn off optimizations:
```shell
cp cabal.project.local_toCopy cabal.project.local
```
#### With Stack
#### Install backend dependencies
Install [Stack (or Haskell Tool Stack)](https://docs.haskellstack.org/en/stable/):
*Note: This project can be built with either stack or cabal. We keep the `cabal.project` up-to-date, which allows us to build with cabal by default but we support stack thanks to thanks to `cabal2stack`, which allows us to generate a valid `stack.yaml` from a `cabal.project`. Due to the fact gargantext requires a particular set of system dependencies (C++ libraries, toolchains, etc) we use nix to setup an environment with all the required system dependencies, in a sandboxed and isolated fashion.*
```shell
curl -sSL https://get.haskellstack.org/ | sh
```
*This documentation shows how to build with cabal. For information related to stack, see `docs/using_stack.md`.*
Verify the installation is complete with
**From within the Nix shell**, run:
```shell
stack --version
Version 2.9.1
n$ cabal update
n$ cabal install
```
NOTE: Default build (with optimizations) requires large amounts of RAM (16GB at least). To avoid heavy compilation times and swapping out your machine, it is recommended to `stack build` with the `--fast` flag, i.e.:
#### Build the backend and frontend
```shell
stack build --fast
./bin/install
cd purescript-gargantext/
./bin/install
cd ..
```
### Initializing and running
#### Keeping the stack.yaml updated with the cabal.project
(Section for Developers using stack only)
Once you have a valid version of `stack`, building requires generating a valid `stack.yaml`.
This can be obtained by installing `cabal2stack`:
#### Start containers for database and NLP software bricks
```shell
git clone https://github.com/iconnect/cabal2stack.git
cd cabal2stack
cd devops/docker
docker compose up
```
Then, depending on what build system you are using, either build with `cabal install --overwrite-policy=always` or `stack install`.
The initialization schema should be loaded automatically from `devops/postgres/schema.sql`.
And finally:
#### Create configuration file
```shell
cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml
stack build
```
The good news is that you don't have to do all of this manually; during development, after modifying the
`cabal.project`, it's enough to do:
```shell
./bin/update-project-dependencies
```
## Initialization <a name="init"></a>
#### 1. Docker-compose will configure your database and some NLP bricks (such as CoreNLP):
First install docker-compose on your system and then:
``` sh
docker compose up
```
Initialization schema should be loaded automatically (from `devops/postgres/schema.sql`).
##### (Optional) If using stack, then install:
``` sh
stack install
```
#### 2. Copy the configuration file:
``` sh
cp gargantext.ini_toModify gargantext.ini
```
> Do not worry, `.gitignore` avoids adding this file to the repository by mistake, then you can change the passwords in gargantext.ini safely.
#### 3. A user have to be created first as instance:
In your nix-shell
``` sh
gargantext-cli init --ini-path "gargantext.ini"
```
Now, `user1` is created with password `1resu`
#### 4. Clone FRONTEND repository:
> `.gitignore` excludes this file, so you don't need to worry about committing it by mistake, and you can change the passwords in `gargantext.ini` safely.
From the Backend root folder (haskell-gargantext):
#### Create master user
From within the Nix shell:
```shell
git clone https://gitlab.iscpif.fr/gargantext/purescript-gargantext.git
cd purescript-gargantext
./install
n$ gargantext-cli init --ini-path gargantext.ini
```
&nbsp;
## Launch & develop GarganText <a name="launch"></a>
> **Note:** here, the method with Cabal is used as default
The master user's name is automatically set to `gargantua`, but you will be prompted for their password and email address.
#### Running
From the Backend root folder (haskell-gargantext):
``` shell
./start
# The start script runs following commands:
# - `./bin/install` to update and build the project
# - `docker compose up` to run the Docker for postgresql from devops/docker folder
# - `cabal run gargantext-server -- --ini gargantext.ini --run Prod` to run other services through `nix-shell`
From inside a Nix shell:
```shell
n$ cabal run gargantext-server -- --ini gargantext.ini --run Prod
```
For frontend development and compilation, see the [Frontend Readme.md](https://gitlab.iscpif.fr/gargantext/purescript-gargantext#dev)
If you are working on the backend, you might want to use the `./start` script: it rebuilds the backend, starts the docker containers, and launches the Gargantext server at once.
### Running tests
......@@ -391,7 +282,6 @@ Maybe you need to change the port to 5433 for database connection in your gargan
## `haskell-language-server`
If you want to use `haskell-language-server` for GHC 9.4.7, install it
......
......@@ -4,6 +4,7 @@ module CLI.Admin (
, adminCmd
) where
import CLI.Parsers
import CLI.Types
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
......@@ -18,8 +19,8 @@ import Options.Applicative
import Prelude (String)
adminCLI :: AdminArgs -> IO ()
adminCLI (AdminArgs iniPath mails) = do
withDevEnv iniPath $ \env -> do
adminCLI (AdminArgs iniPath settingsPath mails) = do
withDevEnv iniPath settingsPath $ \env -> do
x <- runCmdDev env ((newUsers $ NE.map cs (NE.fromList mails)) :: Cmd'' DevEnv BackendInternalError (NonEmpty UserId))
putStrLn (show x :: Text)
......@@ -28,10 +29,7 @@ adminCmd = command "admin" (info (helper <*> fmap CLISub admin_p) (progDesc "Cre
admin_p :: Parser CLICmd
admin_p = fmap CCMD_admin $ AdminArgs
<$> ( strOption ( long "ini-path"
<> metavar "FILEPATH"
<> help "Location of the .ini path"
) )
<$> ini_p <*> settings_p
<*> ( option (maybeReader emails_p) ( long "emails"
<> metavar "email1,email2,..."
<> help "A comma-separated list of emails."
......
......@@ -18,6 +18,7 @@ Import a corpus binary.
module CLI.Import where
import CLI.Parsers
import CLI.Types
import Gargantext.API.Admin.EnvTypes (DevEnv(..), DevJobHandle(..))
import Gargantext.API.Dev (withDevEnv, runCmdGargDev)
......@@ -26,6 +27,7 @@ import Gargantext.API.Node () -- instances
import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Types.Query
import Gargantext.Database.Action.Flow (flowCorpusFile, flowAnnuaire, TermType(..))
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Node (CorpusId)
......@@ -33,13 +35,12 @@ import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpu
import Gargantext.Prelude
import Gargantext.Utils.Jobs.Monad ( MonadJobStatus, JobHandle )
import Options.Applicative
import qualified Data.Text as T
import Prelude (String)
import Gargantext.Core.Types.Query
import qualified Data.Text as T
importCLI :: ImportArgs -> IO ()
importCLI (ImportArgs fun user name iniPath limit corpusPath) = do
importCLI (ImportArgs fun user name iniPath settingsPath limit corpusPath) = do
let
tt = Multi EN
format = TsvGargV3
......@@ -53,7 +54,7 @@ importCLI (ImportArgs fun user name iniPath limit corpusPath) = do
annuaire :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
annuaire = flowAnnuaire (MkCorpusUserNormalCorpusName (UserName $ cs user) "Annuaire") (Multi EN) corpusPath DevJobHandle
withDevEnv iniPath $ \env -> do
withDevEnv iniPath settingsPath $ \env -> do
void $ case fun of
IF_corpus
-> runCmdGargDev env corpus
......@@ -75,8 +76,9 @@ import_p = fmap CCMD_import $ ImportArgs
) )
<*> ( option str ( long "user") )
<*> ( option str ( long "name") )
<*> ( option str ( long "ini" <> help "Path to the .ini file.") )
<*> (fmap Limit ( option auto ( long "ini" <> metavar "INT" <> help "The limit for the query") ))
<*> ini_p
<*> settings_p
<*> (fmap Limit ( option auto ( long "limit" <> metavar "INT" <> help "The limit for the query") ))
<*> ( option str ( long "corpus-path" <> help "Path to corpus file") )
function_p :: String -> Either String ImportFunction
......
......@@ -15,36 +15,38 @@ Initialise the Gargantext dataset.
module CLI.Init where
import CLI.Parsers
import CLI.Types
import Data.List.NonEmpty qualified as NE
import Gargantext.API.Admin.Settings
import Gargantext.API.Admin.Types
import Gargantext.API.Dev (withDevEnv, runCmdDev)
import Gargantext.API.Errors.Types
import Gargantext.API.Node () -- instances only
import Gargantext.Core.Config (GargConfig(..), readConfig)
import Gargantext.Core.Types.Individu (User(..), arbitraryNewUsers, NewUser(..), arbitraryUsername, GargPassword(..))
import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (DBCmd')
import Gargantext.Database.Prelude (DBCmd)
import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Database.Query.Table.User (insertNewUsers, )
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserMaster))
import Gargantext.Prelude
import Gargantext.Core.Config (GargConfig(..), readConfig)
import Gargantext.API.Admin.Types
import Gargantext.Database.Prelude (DBCmd')
import CLI.Types
import Options.Applicative
initCLI :: InitArgs -> IO ()
initCLI (InitArgs iniPath) = do
initCLI (InitArgs iniPath settingsPath) = do
putStrLn ("Enter master user (gargantua) _password_ :" :: Text)
password <- getLine
putStrLn ("Enter master user (gargantua) _email_ :" :: Text)
email <- getLine
cfg <- readConfig iniPath
cfg <- readConfig (_IniFile iniPath)
let secret = _gc_secretkey cfg
let createUsers :: forall env. HasSettings env => DBCmd' env BackendInternalError Int64
......@@ -67,7 +69,7 @@ initCLI (InitArgs iniPath) = do
_triggers <- initLastTriggers masterListId
pure (masterUserId, masterRootId, masterCorpusId, masterListId)
withDevEnv iniPath $ \env -> do
withDevEnv iniPath settingsPath $ \env -> do
_ <- runCmdDev env (initFirstTriggers secret :: DBCmd BackendInternalError [Int64])
_ <- runCmdDev env createUsers
x <- runCmdDev env initMaster
......@@ -79,7 +81,4 @@ initCmd = command "init" (info (helper <*> fmap CLISub init_p) (progDesc "Initia
init_p :: Parser CLICmd
init_p = fmap CCMD_init $ InitArgs
<$> ( strOption ( long "ini-path"
<> metavar "FILEPATH"
<> help "Location of the .ini path"
) )
<$> ini_p <*> settings_p
......@@ -14,7 +14,9 @@ Portability : POSIX
module CLI.Invitations where
import CLI.Parsers
import CLI.Types
import Gargantext.API.Admin.Settings
import Gargantext.API.Admin.Types
import Gargantext.API.Dev (withDevEnv, runCmdDev)
import Gargantext.API.Errors.Types
......@@ -22,18 +24,18 @@ import Gargantext.API.Node () -- instances only
import Gargantext.API.Node.Share qualified as Share
import Gargantext.API.Node.Share.Types qualified as Share
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CET
import Gargantext.Core.Config (readConfig)
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Prelude (CmdRandom)
import Gargantext.Prelude
import Gargantext.Core.Config (readConfig)
import Options.Applicative
import Prelude (String)
import Gargantext.Core.Types
invitationsCLI :: InvitationsArgs -> IO ()
invitationsCLI (InvitationsArgs iniPath user node_id email) = do
_cfg <- readConfig iniPath
invitationsCLI (InvitationsArgs iniPath settingsPath user node_id email) = do
_cfg <- readConfig (_IniFile iniPath)
let invite :: ( HasSettings env
, CmdRandom env BackendInternalError m
......@@ -41,7 +43,7 @@ invitationsCLI (InvitationsArgs iniPath user node_id email) = do
, CET.HasCentralExchangeNotification env ) => m Int
invite = Share.api (UserName $ cs user) node_id (Share.ShareTeamParams $ cs email)
withDevEnv iniPath $ \env -> do
withDevEnv iniPath settingsPath $ \env -> do
void $ runCmdDev env invite
invitationsCmd :: HasCallStack => Mod CommandFields CLI
......@@ -49,10 +51,8 @@ invitationsCmd = command "invitations" (info (helper <*> fmap CLISub invitations
invitations_p :: Parser CLICmd
invitations_p = fmap CCMD_invitations $ InvitationsArgs
<$> ( strOption ( long "ini-path"
<> metavar "FILEPATH"
<> help "Location of the .ini path"
) )
<$> ini_p
<*> settings_p
<*> ( strOption ( long "user" ) )
<*> ( option (eitherReader node_p) ( long "node-id" <> metavar "POSITIVE-INT" <> help "The node ID.") )
<*> ( strOption ( long "email" <> help "The email address.") )
......
{-| Common parsers for the CLI. -}
module CLI.Parsers where
import Prelude
import Gargantext.API.Admin.Settings
import Options.Applicative
ini_p :: Parser IniFile
ini_p = maybe (IniFile "gargantext.ini") IniFile <$>
optional ( strOption ( long "ini-path"
<> metavar "FILEPATH"
<> help "Location of the .ini file"
) )
settings_p :: Parser SettingsFile
settings_p = maybe (SettingsFile "gargantext-settings.toml") SettingsFile <$>
optional ( strOption ( long "settings-path"
<> metavar "FILEPATH"
<> help "Location of the gargantext-settings toml file"
) )
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module CLI.Server.Routes (
routesCLI
, routesCmd
) where
import CLI.Types
import Data.Aeson.Encode.Pretty
import Data.ByteString qualified as B
import Data.ByteString.Lazy qualified as BL
import Gargantext.API.Routes.Named
import Options.Applicative
import Prelude
import Servant.API
import Servant.API.Routes
import Servant.Auth qualified as Servant
routesCmd :: Mod CommandFields CLI
routesCmd = command "routes" (info (helper <*> (fmap CLISub $ fmap CCMD_routes routesParser))
(progDesc "Server routes related commands."))
routesParser :: Parser CLIRoutes
routesParser = hsubparser (
(command "list" (info (helper <*> list_p)
(progDesc "List all the available routes, computed by the Routes types."))) <>
(command "export" (info (helper <*> export_p)
(progDesc "Exports all the routes into a file, for golden-diff testing.")))
)
list_p :: Parser CLIRoutes
list_p = pure CLIR_list
export_p :: Parser CLIRoutes
export_p = CLIR_export <$>
strOption ( long "file" <> metavar "output.json" <> help "Export the routes to a file." )
instance HasRoutes api => HasRoutes (Servant.Auth xs a :> api) where
getRoutes = getRoutes @api
instance HasRoutes Raw where
getRoutes = []
routesCLI :: CLIRoutes -> IO ()
routesCLI = \case
CLIR_list
-> printRoutes @(NamedRoutes API)
(CLIR_export filePath)
-> B.writeFile filePath . BL.toStrict $ encodePretty (getRoutes @(NamedRoutes API))
......@@ -3,9 +3,10 @@ module CLI.Types where
import Data.String
import Data.Text (Text)
import Gargantext.API.Admin.Settings
import Gargantext.Core.Types (NodeId)
import Gargantext.Core.Types.Query
import Prelude
import Gargantext.Core.Types (NodeId)
newtype CorpusFile = CorpusFile { _CorpusFile :: FilePath }
deriving (Show, Eq, IsString)
......@@ -25,7 +26,8 @@ data ObfuscateDBArgs = ObfuscateDBArgs {
} deriving (Show, Eq)
data AdminArgs = AdminArgs
{ iniPath :: !FilePath
{ iniPath :: !IniFile
, settingsPath :: !SettingsFile
, emails :: [String]
} deriving (Show, Eq)
......@@ -39,17 +41,20 @@ data ImportArgs = ImportArgs
{ imp_function :: !ImportFunction
, imp_user :: !Text
, imp_name :: !Text
, imp_ini :: !FilePath
, imp_ini :: !IniFile
, imp_settings :: !SettingsFile
, imp_limit :: !Limit
, imp_corpus_path :: !FilePath
} deriving (Show, Eq)
data InitArgs = InitArgs
{ init_ini :: !FilePath
{ init_ini :: !IniFile
, init_settings :: !SettingsFile
} deriving (Show, Eq)
data InvitationsArgs = InvitationsArgs
{ inv_path :: !FilePath
{ inv_path :: !IniFile
, inv_settings :: !SettingsFile
, inv_user :: !Text
, inv_node_id :: !NodeId
, inv_email :: !Text
......@@ -60,7 +65,8 @@ data PhyloArgs = PhyloArgs
} deriving (Show, Eq)
data UpgradeArgs = UpgradeArgs
{ upgrade_ini :: !FilePath
{ upgrade_ini :: !IniFile
, upgrade_settings :: !SettingsFile
} deriving (Show, Eq)
data GoldenFileDiffArgs = GoldenFileDiffArgs
......@@ -68,6 +74,11 @@ data GoldenFileDiffArgs = GoldenFileDiffArgs
, gdf_actual :: !FilePath
} deriving (Show, Eq)
data CLIRoutes
= CLIR_list
| CLIR_export FilePath
deriving (Show, Eq)
data CLICmd
= CCMD_clean_csv_corpus
| CCMD_filter_terms_and_cooc !CorpusFile !TermListFile !OutputFile
......@@ -80,6 +91,7 @@ data CLICmd
| CCMD_phylo_profile
| CCMD_upgrade !UpgradeArgs
| CCMD_golden_file_diff !GoldenFileDiffArgs
| CCMD_routes !CLIRoutes
deriving (Show, Eq)
data CLI =
......
......@@ -17,16 +17,18 @@ Upgrade a gargantext node.
module CLI.Upgrade where
import CLI.Types
import CLI.Parsers
import Data.List qualified as List (cycle, concat, take, unlines)
import Gargantext.API.Admin.Settings
import Gargantext.API.Dev (withDevEnv)
import Gargantext.API.Node () -- instances only
import Gargantext.Prelude
import Gargantext.Core.Config (GargConfig(..), readConfig)
import Prelude qualified
import Gargantext.Prelude
import Options.Applicative
import Prelude qualified
upgradeCLI :: UpgradeArgs -> IO ()
upgradeCLI (UpgradeArgs iniPath) = do
upgradeCLI (UpgradeArgs iniPath settingsFile) = do
let ___ = putStrLn ((List.concat
$ List.take 72
......@@ -45,10 +47,10 @@ upgradeCLI (UpgradeArgs iniPath) = do
_ok <- getLine
cfg <- readConfig iniPath
cfg <- readConfig (_IniFile iniPath)
let _secret = _gc_secretkey cfg
withDevEnv iniPath $ \_env -> do
withDevEnv iniPath settingsFile $ \_env -> do
-- _ <- runCmdDev env addIndex
-- _ <- runCmdDev env refreshIndex
......@@ -95,7 +97,5 @@ upgradeCmd = command "upgrade" (info (helper <*> fmap CLISub upgrade_p) (progDes
upgrade_p :: Parser CLICmd
upgrade_p = fmap CCMD_upgrade $ UpgradeArgs
<$> ( strOption ( long "ini-path"
<> metavar "FILEPATH"
<> help "Location of the .ini path"
) )
<$> ini_p
<*> settings_p
......@@ -24,13 +24,14 @@ import CLI.ObfuscateDB (obfuscateDB, obfuscateDBCmd)
import CLI.Types
import Options.Applicative
import CLI.Admin (adminCLI, adminCmd)
import CLI.FileDiff (fileDiffCLI, fileDiffCmd)
import CLI.Import (importCLI, importCmd)
import CLI.Init (initCLI, initCmd)
import CLI.Invitations (invitationsCLI, invitationsCmd)
import CLI.Phylo (phyloCLI, phyloCmd)
import CLI.Phylo.Profile (phyloProfileCLI, phyloProfileCmd)
import CLI.Server.Routes (routesCLI, routesCmd)
import CLI.Upgrade (upgradeCLI, upgradeCmd)
import CLI.FileDiff (fileDiffCLI, fileDiffCmd)
runCLI :: CLI -> IO ()
runCLI = \case
......@@ -56,6 +57,9 @@ runCLI = \case
-> upgradeCLI args
CLISub (CCMD_golden_file_diff args)
-> fileDiffCLI args
CLISub (CCMD_routes args)
-> routesCLI args
main :: IO ()
main = runCLI =<< execParser opts
......@@ -76,5 +80,6 @@ allOptions = subparser (
phyloCmd <>
phyloProfileCmd <>
upgradeCmd <>
fileDiffCmd
fileDiffCmd <>
routesCmd
)
......@@ -24,12 +24,14 @@ module Main where
import Data.Text (unpack)
import Data.Version (showVersion)
import GHC.IO.Encoding
import Gargantext.API (startGargantext) -- , startGargantextMock)
import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Admin.Settings
import Gargantext.Prelude
import Gargantext.System.Logging
import GHC.IO.Encoding
import Options.Generic
import Prelude (String)
import System.Exit (exitSuccess)
import qualified Paths_gargantext as PG -- cabal magic build module
......@@ -45,6 +47,8 @@ data MyOptions w =
<?> "By default: 8008"
, ini :: w ::: Maybe Text
<?> "Ini-file path of gargantext.ini"
, settings :: w ::: Maybe String
<?> "By default: gargantext-settings.toml"
, version :: w ::: Bool
<?> "Show version number and exit"
}
......@@ -60,7 +64,7 @@ main = withLogger () $ \ioLogger -> do
setLocaleEncoding utf8
currentLocale <- getLocaleEncoding
MyOptions myMode myPort myIniFile myVersion <- unwrapRecord
MyOptions myMode myPort myIniFile mb_settingsFile myVersion <- unwrapRecord
"Gargantext server"
---------------------------------------------------------------
if myVersion then do
......@@ -75,12 +79,16 @@ main = withLogger () $ \ioLogger -> do
myIniFile' = case myIniFile of
Nothing -> panicTrace "[ERROR] gargantext.ini needed"
Just i -> IniFile $ unpack i
settingsFile = SettingsFile $ case mb_settingsFile of
Nothing -> "gargantext-settings.toml"
Just i -> i
---------------------------------------------------------------
let start = case myMode of
Mock -> panicTrace "[ERROR] Mock mode unsupported"
_ -> startGargantext myMode myPort' (unpack myIniFile')
_ -> startGargantext myMode myPort' myIniFile' settingsFile
logMsg ioLogger INFO $ "Starting with " <> show myMode <> " mode."
logMsg ioLogger INFO $ "Machine locale: " <> show currentLocale
start
......
......@@ -18,8 +18,8 @@ fi
# with the `sha256sum` result calculated on the `cabal.project` and
# `cabal.project.freeze`. This ensures the files stay deterministic so that CI
# cache can kick in.
expected_cabal_project_hash="e1739caac7fc663496c2cd55f9068a7c52c3cbaae389a49aa961f962ed8439f4"
expected_cabal_project_freeze_hash="6a2e5baca97c36d2ed2f398de43df393763ee01bbd676a50da89067b8f830fe9"
expected_cabal_project_hash="eccf547470d723a7dbd9e5bc271f1925f9f6e2cf9092f367275bde3657b3c2cf"
expected_cabal_project_freeze_hash="db651e03c16a9bbc4493bbd3d6244d7196b72a0e39f3245a1734742b89a037ce"
cabal --store-dir=$STORE_DIR v2-build --dry-run
cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml
......
......@@ -180,6 +180,11 @@ source-repository-package
location: https://github.com/adinapoli/http-reverse-proxy.git
tag: c90b7bc55b0e628d0b71ccee4e222833a19792f8
source-repository-package
type: git
location: https://github.com/fpringle/servant-routes.git
tag: 7694f62af6bc1596d754b42af16da131ac403b3a
allow-older: *
allow-newer: *
......
......@@ -351,6 +351,7 @@ constraints: any.Cabal ==3.8.1.0,
any.memory ==0.18.0,
memory +support_bytestring +support_deepseq,
any.microlens ==0.4.13.1,
any.microlens-th ==0.4.3.14,
any.microstache ==1.0.2.3,
any.mime-mail ==0.5.1,
any.mime-types ==0.1.2.0,
......@@ -508,6 +509,7 @@ constraints: any.Cabal ==3.8.1.0,
any.servant-job ==0.2.0.0,
any.servant-multipart ==0.12.1,
any.servant-multipart-api ==0.12.1,
any.servant-routes ==0.1.0.0,
any.servant-server ==0.20,
any.servant-swagger ==1.2,
any.servant-swagger-ui ==0.3.5.5.0.0,
......
package gargantext
ghc-options: -fwrite-ide-info -hiedir=".stack-work/hiedb" -O0
package gargantext-admin
ghc-options: -O0
package gargantext-cli
ghc-options: -O0
package gargantext-db-obfuscation
ghc-options: -O0
package gargantext-import
ghc-options: -O0
package gargantext-init
ghc-options: -O0
package gargantext-invitations
ghc-options: -O0
package gargantext-phylo
ghc-options: -O0
package gargantext-server
ghc-options: -O0
package gargantext-upgrade
ghc-options: -O0
package gargantext-graph
ghc-options: -O0
package hmatrix
ghc-options: -O0
package sparse-linear
ghc-options: -O0
# Building Gargantext using the Stack tool
Those are the instructions for developers who wish to build Gargantext using stack instead of cabal.
## Prerequisites
You need [Stack](https://docs.haskellstack.org/en/stable/) (obviously). You can install it with:
```shell
curl -sSL https://get.haskellstack.org/ | sh
```
Check that the installation is complete with:
```shell
stack --version
Version 2.9.1
```
## Building and setting up
To build with stack, follow the instructions in `README.md`, with the following changes:
- Replace the `cabal update` and `cabal install` commands with (still from within a Nix shell!):
```shell
stack build --fast
```
*Note: The default build (with optimizations) requires large amounts of RAM (16GB at least). The (recommended) `--fast` flag is here to avoid heavy compilation times and swapping out your machine; just omit it if you want to build with optimizations.*
- After you have run the `docker compose up` command, install with
```shell
stack install
```
## Keeping the stack.yaml updated with the cabal.project
Once you have a valid version of stack, building requires generating a valid `stack.yaml`. This can be obtained by installing `cabal2stack`:
```shell
git clone https://github.com/iconnect/cabal2stack.git
cd cabal2stack
```
Then, depending on what build system you are using, either build with `cabal install --overwrite-policy=always` or `stack install`.
And finally:
```shell
cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml
stack build
```
The good news is you don't have to do all of this manually; during development, after modifying `cabal.project`, it's enough to run:
```shell
./bin/update-project-dependencies
```
......@@ -5,7 +5,7 @@ cabal-version: 3.4
-- see: https://github.com/sol/hpack
name: gargantext
version: 0.0.7.1.8
version: 0.0.7.1.9
synopsis: Search, map, share
description: Please see README.md
category: Data
......@@ -49,6 +49,7 @@ data-files:
test-data/phylo/phylo2dot2json.golden.json
test-data/stemming/lancaster.txt
test-data/test_config.ini
test-data/gargantext-settings.toml
gargantext-settings.toml
.clippy.dhall
......@@ -660,6 +661,7 @@ library
, servant-flatten ^>= 0.2
, servant-job >= 0.2.0.0
, servant-multipart ^>= 0.12.1
, servant-routes < 0.2
, servant-server >= 0.18.3 && < 0.20
, servant-swagger >= 1.2
, servant-swagger-ui ^>= 0.3.5.3.5.0
......@@ -726,9 +728,11 @@ executable gargantext-cli
CLI.Init
CLI.Invitations
CLI.ObfuscateDB
CLI.Parsers
CLI.Phylo
CLI.Phylo.Common
CLI.Phylo.Profile
CLI.Server.Routes
CLI.Types
CLI.Upgrade
CLI.Utils
......@@ -737,6 +741,7 @@ executable gargantext-cli
bin/gargantext-cli
build-depends:
aeson ^>= 1.5.6.0
, aeson-pretty
, async ^>= 2.2.4
, bytestring ^>= 0.10.12.0
, cassava ^>= 0.5.2.0
......@@ -753,6 +758,9 @@ executable gargantext-cli
, parallel ^>= 3.2.2.0
, postgresql-simple ^>= 0.6.4
, protolude ^>= 0.3.3
, servant
, servant-auth
, servant-routes < 0.2
, shelly
, split ^>= 0.2.3.4
, text ^>= 1.2.4.1
......@@ -843,6 +851,7 @@ test-suite garg-test-tasty
Test.Parsers.Date
Test.Parsers.Types
Test.Parsers.WOS
Test.Server.ReverseProxy
Test.Types
Test.Utils
Test.Utils.Crypto
......@@ -906,6 +915,7 @@ test-suite garg-test-tasty
, servant-websockets >= 2.0.0 && < 2.1
, shelly >= 1.9 && < 2
, stm ^>= 2.5.0.1
, streaming-commons
, split
, tasty ^>= 1.4.2.1
, tasty-golden
......@@ -920,6 +930,7 @@ test-suite garg-test-tasty
, tree-diff
, unordered-containers ^>= 0.2.16.0
, unicode-collation >= 0.1.3.6
, unliftio
, validity ^>= 0.11.0.1
, vector ^>= 0.12.3.0
, wai
......@@ -932,6 +943,7 @@ test-suite garg-test-hspec
type: exitcode-stdio-1.0
main-is: drivers/hspec/Main.hs
other-modules:
Paths_gargantext
Test.API
Test.API.Authentication
Test.API.Errors
......@@ -946,9 +958,9 @@ test-suite garg-test-hspec
Test.Database.Operations.NodeStory
Test.Database.Setup
Test.Database.Types
Test.Utils
Test.Server.ReverseProxy
Test.Types
Paths_gargantext
Test.Utils
hs-source-dirs:
test
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
......@@ -1001,6 +1013,7 @@ test-suite garg-test-hspec
, servant-websockets >= 2.0.0 && < 2.1
, shelly >= 1.9 && < 2
, stm ^>= 2.5.0.1
, streaming-commons
, tasty ^>= 1.4.2.1
, tasty-hspec
, tasty-hunit
......@@ -1011,6 +1024,7 @@ test-suite garg-test-hspec
, time ^>= 1.9.3
, tmp-postgres >= 1.34.1 && < 1.35
, tree-diff
, unliftio
, unordered-containers ^>= 0.2.16.0
, validity ^>= 0.11.0.1
, wai
......
......@@ -44,7 +44,7 @@ import Data.Text.IO (putStrLn)
import Data.Validity
import Gargantext.API.Admin.Auth.Types (AuthContext)
import Gargantext.API.Admin.EnvTypes (Env, Mode(..))
import Gargantext.API.Admin.Settings (newEnv)
import Gargantext.API.Admin.Settings (newEnv, IniFile(..), SettingsFile)
import Gargantext.API.Admin.Settings.CORS
import Gargantext.API.Admin.Settings.MicroServices
import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings, corsSettings, microservicesSettings)
......@@ -69,9 +69,9 @@ import System.Cron.Schedule qualified as Cron
-- import System.FilePath
-- | startGargantext takes as parameters port number and Ini file.
startGargantext :: Mode -> PortNumber -> FilePath -> IO ()
startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
env <- newEnv logger port file
startGargantext :: Mode -> PortNumber -> IniFile -> SettingsFile -> IO ()
startGargantext mode port iniFile settingsFile = withLoggerHoisted mode $ \logger -> do
env <- newEnv logger port iniFile settingsFile
let proxyPort = env ^. settings.microservicesSettings.msProxyPort
runDbCheck env
portRouteInfo port proxyPort
......@@ -90,7 +90,7 @@ startGargantext mode port file = withLoggerHoisted mode $ \logger -> do
case r of
Right True -> pure ()
_ -> panicTrace $
"You must run 'gargantext-init " <> pack file <>
"You must run 'gargantext-init " <> pack (_IniFile iniFile) <>
"' before running gargantext-server (only the first time)."
portRouteInfo :: PortNumber -> PortNumber -> IO ()
......
......@@ -54,12 +54,21 @@ import System.IO (hClose)
import System.IO.Temp (withTempFile)
devSettings :: FilePath -> IO Settings
devSettings jwkFile = do
newtype JwkFile = JwkFile { _JwkFile :: FilePath }
deriving (Show, Eq, IsString)
newtype SettingsFile = SettingsFile { _SettingsFile :: FilePath }
deriving (Show, Eq, IsString)
newtype IniFile = IniFile { _IniFile :: FilePath }
deriving (Show, Eq, IsString)
devSettings :: JwkFile -> SettingsFile -> IO Settings
devSettings (JwkFile jwkFile) (SettingsFile settingsFile) = do
jwkExists <- doesFileExist jwkFile
when (not jwkExists) $ writeKey jwkFile
jwk <- readKey jwkFile
GargTomlSettings{..} <- loadGargTomlSettings
GargTomlSettings{..} <- loadGargTomlSettings settingsFile
pure $ Settings
{ _corsSettings = _gargCorsSettings
, _microservicesSettings = _gargMicroServicesSettings
......@@ -173,13 +182,13 @@ readRepoEnv repoDir = do
pure $ RepoEnv { _renv_var = mvar, _renv_saver = saver, _renv_lock = lock }
--}
devJwkFile :: FilePath
devJwkFile = "dev.jwk"
devJwkFile :: JwkFile
devJwkFile = JwkFile "dev.jwk"
newEnv :: Logger (GargM Env BackendInternalError) -> PortNumber -> FilePath -> IO Env
newEnv logger port file = do
newEnv :: Logger (GargM Env BackendInternalError) -> PortNumber -> IniFile -> SettingsFile -> IO Env
newEnv logger port (IniFile file) settingsFile = do
!manager_env <- newTlsManager
!settings' <- devSettings devJwkFile <&> appPort .~ port -- TODO read from 'file'
!settings' <- devSettings devJwkFile settingsFile <&> appPort .~ port -- TODO read from 'file'
when (port /= settings' ^. appPort) $
panicTrace "TODO: conflicting settings of port"
......
......@@ -7,7 +7,6 @@ import Gargantext.API.Admin.Settings.CORS
import Gargantext.API.Admin.Settings.MicroServices
import Gargantext.Prelude (panicTrace)
import Gargantext.System.Logging
import Paths_gargantext
import Prelude
import Toml
import Servant.Client.Core.BaseUrl
......@@ -40,9 +39,8 @@ addProxyToAllowedOrigins stgs =
in cors { _corsAllowedOrigins = origins <> Prelude.map mkUrl origins }
-- | Loads the 'CORSSettings' from the 'toml' file.
loadGargTomlSettings :: IO GargTomlSettings
loadGargTomlSettings = do
tomlFile <- getDataFileName "gargantext-settings.toml"
loadGargTomlSettings :: FilePath -> IO GargTomlSettings
loadGargTomlSettings tomlFile = do
tomlRes <- Toml.decodeFileEither settingsCodec tomlFile
case tomlRes of
Left errs -> do
......
......@@ -2,6 +2,7 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
module Gargantext.API.Auth.PolicyCheck (
AccessCheck(..)
......@@ -34,12 +35,13 @@ import Gargantext.Database.Query.Tree.Root
import Gargantext.Core.Config (GargConfig(..))
import Prelude
import Servant
import Servant.API.Routes
import Servant.Auth.Server.Internal.AddSetCookie
import Servant.Client.Core
import Servant.Ekg
import Servant.Server.Internal.Delayed
import Servant.Server.Internal.DelayedIO
import qualified Servant.Swagger as Swagger
import Servant.Client.Core
import Servant.Swagger qualified as Swagger
-------------------------------------------------------------------------------
-- Types
......@@ -203,6 +205,11 @@ instance HasClient m sub => HasClient m (PolicyChecked sub) where
hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl
instance (HasRoutes subApi) => HasRoutes (PolicyChecked subApi) where
getRoutes =
let apiRoutes = getRoutes @subApi
in apiRoutes
-------------------------------------------------------------------------------
-- Utility functions
-------------------------------------------------------------------------------
......
......@@ -17,7 +17,7 @@ import Control.Monad (fail)
import Data.Pool (withResource)
import Database.PostgreSQL.Simple qualified as PGS
import Gargantext.API.Admin.EnvTypes ( DevEnv(..), Mode(Dev) )
import Gargantext.API.Admin.Settings ( devJwkFile, devSettings, newPool )
import Gargantext.API.Admin.Settings ( devJwkFile, devSettings, newPool, SettingsFile (..), IniFile (..) )
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Prelude ( GargM )
import Gargantext.Core.NLP (nlpServerMap)
......@@ -30,10 +30,9 @@ import Gargantext.Core.Config.NLP qualified as NLP
import Gargantext.System.Logging ( withLoggerHoisted )
import Servant ( ServerError )
type IniPath = FilePath
-------------------------------------------------------------------
withDevEnv :: IniPath -> (DevEnv -> IO a) -> IO a
withDevEnv iniPath k = withLoggerHoisted Dev $ \logger -> do
withDevEnv :: IniFile -> SettingsFile -> (DevEnv -> IO a) -> IO a
withDevEnv (IniFile iniPath) settingsFile k = withLoggerHoisted Dev $ \logger -> do
env <- newDevEnv logger
k env -- `finally` cleanEnv env
......@@ -44,7 +43,7 @@ withDevEnv iniPath k = withLoggerHoisted Dev $ \logger -> do
--nodeStory_env <- fromDBNodeStoryEnv (_gc_repofilepath cfg)
pool <- newPool dbParam
nodeStory_env <- fromDBNodeStoryEnv pool
setts <- devSettings devJwkFile
setts <- devSettings devJwkFile settingsFile
mail <- Mail.readConfig iniPath
nlp_config <- NLP.readConfig iniPath
pure $ DevEnv
......@@ -57,9 +56,15 @@ withDevEnv iniPath k = withLoggerHoisted Dev $ \logger -> do
, _dev_env_nlp = nlpServerMap nlp_config
}
defaultIniFile :: IniFile
defaultIniFile = IniFile "gargantext.ini"
defaultSettingsFile :: SettingsFile
defaultSettingsFile = SettingsFile "gargantext-settings.toml"
-- | Run Cmd Sugar for the Repl (GHCI)
runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a
runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
runCmdRepl f = withDevEnv defaultIniFile defaultSettingsFile $ \env -> runCmdDev env f
runCmdReplServantErr :: Cmd'' DevEnv ServerError a -> IO a
runCmdReplServantErr = runCmdRepl
......@@ -83,7 +88,7 @@ runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
runCmdDevServantErr = runCmdDev
runCmdReplEasy :: Cmd'' DevEnv BackendInternalError a -> IO a
runCmdReplEasy f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
runCmdReplEasy f = withDevEnv defaultIniFile defaultSettingsFile $ \env -> runCmdDev env f
-- | Execute a function that takes PSQL.Connection from the DB pool as
-- first parameter.
......
......@@ -13,13 +13,11 @@ module Gargantext.API.Routes.Named.Private (
, NodeAPIEndpoint(..)
, MembersAPI(..)
, IsGenericNodeRoute(..)
, NotesProxy(..)
) where
import Data.Kind
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics
import GHC.TypeLits
import Gargantext.API.Admin.Auth.Types
......@@ -98,12 +96,6 @@ data GargPrivateAPI' mode = GargPrivateAPI'
} deriving Generic
data NotesProxy mode = NotesProxy
{ noteProxyEp :: mode :- Capture "frameId" T.Text
:> Raw
} deriving Generic
data GargAdminAPI mode = GargAdminAPI
{ rootsEp :: mode :- "user" :> Summary "First user endpoint" :> NamedRoutes Roots
, adminNodesAPI :: mode :- "nodes" :> Summary "Nodes endpoint"
......
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Gargantext.API.Routes.Types where
import Control.Lens
import Data.ByteString (ByteString)
import Data.List qualified as L
import Data.Proxy
import Data.Set qualified as Set
import Gargantext.API.Errors
import Network.Wai
import Network.Wai hiding (responseHeaders)
import Prelude
import Servant.Client
import Servant.API.Routes
import Servant.Client hiding (responseHeaders)
import Servant.Ekg
import Servant.Server
import Servant.Server.Internal.Delayed
import Servant.Server.Internal.DelayedIO
import Servant.API.Routes.Route
import Servant.API.Routes.Internal.Response (unResponses)
data WithCustomErrorScheme a
......@@ -37,3 +44,10 @@ instance HasClient m sub => HasClient m (WithCustomErrorScheme sub) where
clientWithRoute m _ req _mgr = clientWithRoute m (Proxy :: Proxy sub) req
hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl
instance (HasRoutes subApi) => HasRoutes (WithCustomErrorScheme subApi) where
getRoutes =
let apiRoutes = getRoutes @subApi
errHeader = mkHeaderRep @"X-Garg-Error-Scheme" @ByteString
addHeader rt = rt & routeResponse . unResponses . traversed . responseHeaders %~ Set.insert errHeader
in addHeader <$> apiRoutes
......@@ -9,15 +9,15 @@ import Data.HashMap.Strict as HM
import Data.Text as T
import Data.Text.IO as T
import Data.Time.Clock.POSIX (getPOSIXTime)
import Gargantext.API.Routes.Named.EKG
import Network.Wai
import Protolude
import Servant
import Servant.Auth
import Servant.Ekg
import System.Metrics
import qualified System.Metrics.Json as J
import Gargantext.API.Routes.Named.EKG
import Servant.Server.Generic
import System.Metrics
import System.Metrics.Json qualified as J
ekgServer :: FilePath -> Store -> EkgAPI AsServer
......
......@@ -9,19 +9,22 @@ Portability : POSIX
-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
module Gargantext.API.ThrowAll where
module Gargantext.API.ThrowAll (
throwAllRoutes
, serverPrivateGargAPI
) where
import Control.Lens ((#))
import Data.ByteString.Char8 qualified as C8
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.EnvTypes (Env)
import Gargantext.API.Errors.Types
......@@ -29,31 +32,60 @@ import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Private qualified as Named
import Gargantext.API.Server.Named.Private qualified as Named
import Gargantext.Database.Admin.Types.Node (UserId (..))
import Gargantext.Prelude
import Gargantext.Prelude hiding (Handler)
import Network.HTTP.Types.Status (Status(..))
import Network.Wai (responseLBS)
import Servant
import Servant.API.Generic ()
import Servant.Auth.Server (AuthResult(..))
import Servant.Server.Generic (AsServerT)
import Servant.API.Generic ()
-- | Slightly more general version of the 'ThrowAll' typeclass from Servant,
-- that works on a generic error.
class ThrowAll' e a where
throwAll' :: e -> a -> a
instance (ThrowAll' e a, ThrowAll' e b) => ThrowAll' e (a :<|> b) where
throwAll' e (s1 :<|> s2) = throwAll' e s1 :<|> throwAll' e s2
throwAll' :: forall err m routes. ( MonadError err m
, HasServerError err
instance ThrowAll' e b => ThrowAll' e (a -> b) where
throwAll' e f = \x -> throwAll' e (f x)
instance ( MonadError e m
, GenericServant routes (AsServerT m)
, HasServer (NamedRoutes routes) '[]
, Generic (routes (AsServerT m))
) => err
-> routes (AsServerT m)
-> routes (AsServerT m)
throwAll' errCode server =
hoistServer (Proxy @(NamedRoutes routes)) f server
) => ThrowAll' e (routes (AsServerT m)) where
throwAll' errCode server = hoistServer (Proxy @(NamedRoutes routes)) f server
where
f :: forall a. m a -> m a
f = const (throwError errCode)
-- Common instances
instance (ThrowAll' ServerError (Handler a)) where
throwAll' e _ = throwError e
instance (ThrowAll' ServerError (Tagged Handler Application)) where
throwAll' ServerError{..} (Tagged _) =
Tagged $ \_ mkResponse -> mkResponse (responseLBS (Status errHTTPCode (C8.pack errReasonPhrase)) errHeaders errBody)
throwAllRoutes :: ( MonadError e m
, Generic (routes (AsServerT m))
, GenericServant routes (AsServerT m)
, ThrowAll' e (routes (AsServerT m))
, ThrowAll' e (ToServant routes (AsServerT m))
)
=> e
-> routes (AsServerT m)
-> routes (AsServerT m)
throwAllRoutes err = fromServant . throwAll' err . toServant
serverPrivateGargAPI :: Named.GargPrivateAPI (AsServerT (GargM Env BackendInternalError))
serverPrivateGargAPI = Named.GargPrivateAPI $ \case
(Authenticated auser) -> Named.serverPrivateGargAPI' auser
-- In the code below we just needed a mock 'AuthenticatedUser' to make the type check, but
-- they will never be evaluated.
_ -> throwAll' (_ServerError # err401)
_ -> throwAllRoutes (_ServerError # err401)
$ Named.serverPrivateGargAPI' (AuthenticatedUser 0 (UnsafeMkUserId 0))
-- Here throwAll' requires a concrete type for the monad.
......@@ -3,12 +3,19 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Gargantext.MicroServices.ReverseProxy (
microServicesProxyApp
-- * Internals
, removeFromReferer
, ReverseProxyAPI(..)
, NotesProxy(..)
, FrameId(..)
) where
import Prelude
......@@ -25,21 +32,34 @@ import GHC.Generics
import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Admin.Settings.MicroServices
import Gargantext.API.Admin.Types
import Gargantext.API.Routes.Named.Private
import Gargantext.API.ThrowAll (throwAllRoutes)
import Gargantext.API.Types (HTML)
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Prelude
import Gargantext.Core.Config (gc_frame_write_url)
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Prelude hiding (Handler)
import Network.HTTP.ReverseProxy
import Network.HTTP.Types (hCacheControl, RequestHeaders, hReferer, ResponseHeaders, Header)
import Network.HTTP.Types.Header (hHost)
import Network.Wai (Request, rawPathInfo, requestHeaders)
import Servant hiding (Header)
import Servant.Auth.Server
import Servant.Auth.Swagger ()
import Servant.Client.Core.BaseUrl
import Servant.Server.Generic
import Text.RE.Replace hiding (Capture)
import Text.RE.TDFA.ByteString
import Text.RawString.QQ (r)
import Gargantext.API.Admin.Auth.Types (AuthContext)
import Servant.Auth.Server.Internal.AddSetCookie
import Network.Wai
-- See https://github.com/haskell-servant/servant/issues/1601#issue-1338013029
instance {-# OVERLAPPING #-}
( AddSetCookies ('S n) a a
, AddSetCookies ('S n) b b'
)
=> AddSetCookies ('S n) (a :<|> b) (a :<|> b') where
addSetCookies cookies ( a :<|> b) = addSetCookies cookies a :<|> addSetCookies cookies b
--
-- Types
......@@ -48,6 +68,9 @@ import Text.RawString.QQ (r)
newtype FrameId = FrameId { _FrameId :: T.Text }
deriving (Show, Eq, Ord)
instance ToHttpApiData FrameId where
toUrlPiece = toUrlPiece . _FrameId
-- | The service type that our microservices proxy will handle. At the moment
-- we support only the \"notes\" one.
data ServiceType
......@@ -85,7 +108,7 @@ fwdPort = baseUrlPort . _ProxyDestination
data ReverseProxyAPI mode = ReverseProxyAPI
{ -- | The proxy routes for the \"notes\" microservice (e.g. \"write.frame.gargantext.org\").
notesServiceProxy :: mode :- "notes" :> NamedRoutes NotesProxy
notesServiceProxy :: mode :- "notes" :> MkProtectedAPI (NamedRoutes NotesProxy)
-- | proxy everything else. CAREFUL! This has to be the last route, as it will always match.
, proxyPassAll :: mode :- Raw
......@@ -124,11 +147,18 @@ data SocketIOProxy mode = SocketIOProxy
--
microServicesProxyApp :: Env -> Application
microServicesProxyApp env = genericServe (server env)
microServicesProxyApp env = genericServeTWithContext id (server env) cfg
where
cfg :: Context AuthContext
cfg = env ^. settings . jwtSettings
:. env ^. settings . cookieSettings
:. EmptyContext
server :: Env -> ReverseProxyAPI AsServer
server :: Env -> ReverseProxyAPI (AsServerT Handler)
server env = ReverseProxyAPI {
notesServiceProxy = notesProxyImplementation env
notesServiceProxy = \case
(Authenticated _autUser) -> notesProxyImplementation env
_ -> throwAllRoutes err401 $ notesProxyImplementation env
, proxyPassAll = proxyPassServer ST_notes env
}
......
......@@ -108,6 +108,10 @@
git: "https://github.com/delanoe/patches-map"
subdirs:
- .
- commit: 7694f62af6bc1596d754b42af16da131ac403b3a
git: "https://github.com/fpringle/servant-routes.git"
subdirs:
- .
- commit: 23be4130804d86979eaee5caffe323a1c7f2b0d6
git: "https://github.com/garganscript/nanomsg-haskell"
subdirs:
......
[cors]
allowed-origins = [
"https://demo.gargantext.org"
, "https://formation.gargantext.org"
, "https://academia.sub.gargantext.org"
, "https://cnrs.gargantext.org"
, "https://imt.sub.gargantext.org"
, "https://helloword.gargantext.org"
, "https://complexsystems.gargantext.org"
, "https://europa.gargantext.org"
, "https://earth.sub.gargantext.org"
, "https://health.sub.gargantext.org"
, "https://msh.sub.gargantext.org"
, "https://dev.sub.gargantext.org"
, "http://localhost:8008"
]
use-origins-for-hosts = true
[microservices]
proxy-port = 8009
......@@ -53,7 +53,6 @@ mkUrl _port urlPiece =
clientRoutes :: API (AsClientT ClientM)
clientRoutes = genericClient
-- This is for Servant.Client requests
auth_api :: AuthRequest -> ClientM AuthResponse
auth_api = clientRoutes & apiWithCustomErrorScheme
......
......@@ -3,9 +3,8 @@
module Test.API.Setup where
-- import Gargantext.Prelude (printDebug)
import Control.Concurrent (forkIO, killThread)
import Control.Exception (bracket)
import Control.Concurrent.Async qualified as Async
import Control.Concurrent.MVar
import Control.Lens
import Control.Monad.Reader
import Gargantext.API (makeApp)
......@@ -17,6 +16,9 @@ import Gargantext.API.Prelude
import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
import Gargantext.Core.AsyncUpdates.Dispatcher qualified as D
import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DT
import Gargantext.Core.Config
import Gargantext.Core.Config.Mail qualified as Mail
import Gargantext.Core.Config.NLP qualified as NLP
import Gargantext.Core.NLP
import Gargantext.Core.NodeStory
import Gargantext.Core.Types.Individu
......@@ -28,9 +30,7 @@ import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(..))
import Gargantext.Core.Config
import Gargantext.Core.Config.Mail qualified as Mail
import Gargantext.Core.Config.NLP qualified as NLP
import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
import Gargantext.System.Logging
import Gargantext.Utils.Jobs qualified as Jobs
import Gargantext.Utils.Jobs.Monad qualified as Jobs
......@@ -38,20 +38,25 @@ import Gargantext.Utils.Jobs.Queue qualified as Jobs
import Gargantext.Utils.Jobs.Settings qualified as Jobs
import Network.HTTP.Client.TLS (newTlsManager)
import Network.Wai (Application)
import Network.Wai.Handler.Warp (runSettingsSocket)
import Network.Wai.Handler.Warp qualified as Warp
import Network.Wai.Handler.Warp.Internal
import Prelude
import Servant.Auth.Client ()
import Servant.Client
import Servant.Job.Async qualified as ServantAsync
import Test.Database.Setup (withTestDB, fakeIniPath, testEnvToPgConnectionInfo)
import Test.Database.Setup (withTestDB, fakeIniPath, testEnvToPgConnectionInfo, fakeSettingsPath)
import Test.Database.Types
import qualified UnliftIO
import Data.Streaming.Network (bindPortTCP)
newTestEnv :: TestEnv -> Logger (GargM Env BackendInternalError) -> Warp.Port -> IO Env
newTestEnv testEnv logger port = do
file <- fakeIniPath
settingsP <- SettingsFile <$> fakeSettingsPath
!manager_env <- newTlsManager
!settings' <- devSettings devJwkFile <&> appPort .~ port
!settings' <- devSettings devJwkFile settingsP <&> appPort .~ port
!config_env <- readConfig file
prios <- withLogger () $ \ioLogger -> Jobs.readPrios ioLogger (file <> ".jobs")
......@@ -92,10 +97,8 @@ newTestEnv testEnv logger port = do
-- , _env_dispatcher = dispatcher
}
withGargApp :: Application -> (Warp.Port -> IO ()) -> IO ()
withGargApp app action = do
Warp.testWithApplication (pure app) action
-- | Run the gargantext server on a random port, picked by Warp, which allows
-- for concurrent tests to be executed in parallel, if we need to.
withTestDBAndPort :: (((TestEnv, Warp.Port), Application) -> IO ()) -> IO ()
withTestDBAndPort action =
withTestDB $ \testEnv -> do
......@@ -124,8 +127,25 @@ withTestDBAndPort action =
app <- withLoggerHoisted Mock $ \ioLogger -> do
env <- newTestEnv testEnv ioLogger 8080
makeApp env
withGargApp app $ \port ->
action ((testEnv, port), app)
Warp.testWithApplication (pure app) $ \port -> action ((testEnv, port), app)
-- | Starts the backend server /and/ the microservices proxy, the former at
-- a random port, the latter at a predictable port.
withBackendServerAndProxy :: (((TestEnv, Warp.Port, Warp.Port)) -> IO ()) -> IO ()
withBackendServerAndProxy action =
withTestDB $ \testEnv -> do
gargApp <- withLoggerHoisted Mock $ \ioLogger -> do
env <- newTestEnv testEnv ioLogger 8080
makeApp env
proxyApp <- withLoggerHoisted Mock $ \ioLogger -> do
env <- newTestEnv testEnv ioLogger 8080
pure $ microServicesProxyApp env
Warp.testWithApplication (pure gargApp) $ \serverPort ->
testWithApplicationOnPort (pure proxyApp) proxyPort $
action (testEnv, serverPort, proxyPort)
where
proxyPort = 8090
setupEnvironment :: TestEnv -> IO ()
setupEnvironment env = flip runReaderT env $ runTestMonad $ do
......@@ -147,3 +167,40 @@ createAliceAndBob testEnv = do
void $ new_user nur1
void $ new_user nur2
-- | A version of 'withApplication' that allows supplying a user-specified port
-- so that we are sure that our garg apps will run on the same port as specified
-- in the 'Env' settings.
testWithApplicationOnPort :: IO Application -> Warp.Port -> IO a -> IO a
testWithApplicationOnPort mkApp userPort action = do
app <- mkApp
started <- mkWaiter
let appSettings =
Warp.defaultSettings
{ settingsBeforeMainLoop =
notify started () >> settingsBeforeMainLoop Warp.defaultSettings
, settingsPort = userPort
}
sock <- bindPortTCP userPort "127.0.0.1"
result <-
Async.race
(runSettingsSocket appSettings sock app)
(waitFor started >> action)
case result of
Left () -> UnliftIO.throwString "Unexpected: runSettingsSocket exited"
Right x -> return x
data Waiter a = Waiter
{ notify :: a -> IO ()
, waitFor :: IO a
}
mkWaiter :: IO (Waiter a)
mkWaiter = do
mvar <- newEmptyMVar
return
Waiter
{ notify = putMVar mvar
, waitFor = readMVar mvar
}
......@@ -2,6 +2,7 @@
module Test.Database.Setup (
withTestDB
, fakeIniPath
, fakeSettingsPath
, testEnvToPgConnectionInfo
) where
......@@ -35,6 +36,9 @@ dbName = "gargandb_test"
fakeIniPath :: IO FilePath
fakeIniPath = getDataFileName "test-data/test_config.ini"
fakeSettingsPath :: IO FilePath
fakeSettingsPath = getDataFileName "test-data/gargantext-settings.toml"
gargDBSchema :: IO FilePath
gargDBSchema = getDataFileName "devops/postgres/schema.sql"
......@@ -74,7 +78,7 @@ setup = do
bootstrapDB db pool gargConfig
ugen <- emptyCounter
test_nodeStory <- fromDBNodeStoryEnv pool
stgs <- devSettings devJwkFile
stgs <- devSettings devJwkFile =<< (SettingsFile <$> fakeSettingsPath)
withLoggerHoisted Mock $ \logger -> do
pure $ TestEnv { test_db = DBHandle pool db
, test_config = gargConfig
......
module Test.Server.ReverseProxy where
import Data.Function ((&))
import Gargantext.MicroServices.ReverseProxy
import Network.HTTP.Client
import Network.HTTP.Types.Status
import Prelude
import Servant.Auth.Client (Token(..))
import Servant.Client
import Servant.Client.Generic (genericClient)
import Test.API.Setup (setupEnvironment, withBackendServerAndProxy, createAliceAndBob)
import Test.Hspec
import Gargantext.Core.Types.Individu (GargPassword(..))
import Gargantext.API.Admin.Auth.Types
import Test.API.Authentication (auth_api)
import Control.Lens ((^.))
import Test.API.Routes (toServantToken)
reverseProxyClient :: ReverseProxyAPI (AsClientT ClientM)
reverseProxyClient = genericClient
tests :: Spec
tests = describe "Microservices proxy" $ do
writeFrameTests
writeFrameTests :: Spec
writeFrameTests = sequential $ aroundAll withBackendServerAndProxy $ do
describe "Prelude" $ do
it "setup DB triggers" $ \(testEnv, _, _) -> setupEnvironment testEnv
describe "Write Frame Reverse Proxy" $ do
it "should disallow unauthenticated requests" $ \(_testEnv, _serverPort, proxyPort) -> do
baseUrl <- parseBaseUrl "http://localhost"
manager <- newManager defaultManagerSettings
let clientEnv prt = mkClientEnv manager (baseUrl { baseUrlPort = prt })
result <- runClientM (reverseProxyClient & notesServiceProxy
& ($ (Token "bogus"))
& notesEp
& ($ (FrameId "abcdef"))
& ($ "GET")
) (clientEnv proxyPort)
case result of
Right response
-> responseStatusCode response `shouldBe` status401
Left (FailureResponse _ response)
-> responseStatusCode response `shouldBe` status401
Left err
-> fail (show err)
it "should allow authenticated requests" $ \(testEnv, serverPort, proxyPort) -> do
-- Let's create the Alice user.
createAliceAndBob testEnv
baseUrl <- parseBaseUrl "http://localhost"
manager <- newManager defaultManagerSettings
let clientEnv prt = mkClientEnv manager (baseUrl { baseUrlPort = prt })
let authPayload = AuthRequest "alice@gargan.text" (GargPassword "alice")
result0 <- runClientM (auth_api authPayload) (clientEnv serverPort)
case result0 of
Left err -> fail (show err)
Right autRes -> do
result <- runClientM (reverseProxyClient & notesServiceProxy
& ($ (toServantToken $ autRes ^. authRes_token))
& notesEp
& ($ (FrameId "abcdef"))
& ($ "GET")
) (clientEnv proxyPort)
-- The actual request to the reverse proxy might fail (because our
-- environment is not setup correctly, for example) but crucially here
-- we want to test that with a valid authentication we don't hit the
-- 401 error.
case result of
Right response
-> responseStatusCode response `shouldNotBe` status401
Left (FailureResponse _ response)
-> responseStatusCode response `shouldNotBe` status401
Left err
-> fail (show err)
......@@ -16,6 +16,7 @@ import System.Process
import Test.Hspec
import qualified Data.Text as T
import qualified Test.API as API
import qualified Test.Server.ReverseProxy as ReverseProxy
import qualified Test.Database.Operations as DB
......@@ -72,5 +73,6 @@ main = do
bracket startNotifications stopNotifications $ \_ -> do
bracket startCoreNLPServer stopCoreNLPServer $ \_ -> hspec $ do
API.tests
ReverseProxy.tests
DB.tests
DB.nodeStoryTests
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