Merge branch 'dev' into 145-graphExplorerSearch

b7c7b416 · Przemyslaw Kaminski · 8c570825 · 6023449c · b7c7b416 · 8c570825
Commit b7c7b416 authored Oct 20, 2022 by Przemyslaw Kaminski
66 changed files
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
+## Version 0.0.6.8
+* [BACK][FEAT][Flexible job queue system](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/109)
+* [FRONT][FEAT][Doc View, Histogram click on bar -&gt; select documents by Date (#430)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/430)
+* [BACK][OPTIM][Ngrams Table, queries optimization (#144)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/144)
+* [BACK][FIX] SQL error disconnection
+* [FRONT][UPGRADE][Upgrade PS to 0.15 (#395)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/395)
+* [FRONT][GRAPH][Filtering edge weight bring back new edges (#442)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/442)
+* [FRONT][GRAPH][Louvain clustering on filtered graph (#418)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/418)
+* [FRONT][GRAPH][GraphExplorer Node size slider (#215)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/215)
+* [FRONT][GRAPH][Graph Explorer : link filtering does not impact spatialization (#243)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/243)
+## Version 0.0.6.7.1
+* [FRONT][FIX][[maplist upload] bugged modal after upload (#440)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/440)
+* [BACK][OPTIM][Ngrams Table, queries optimization (#144)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/144)
+* [BACK][CONFIG] gargantext.ini needs new field
+                BACKEND_NAME = THE INSTANCE NAME
 ## Version 0.0.6.7
 * [GRAPH][FIX] Nodes with one edge only are removed now
 * [FRONT][GRAPH] Option to chose the clustering method is not shown any more.

--- a/bin/gargantext-client/Auth.hs
+++ b/bin/gargantext-client/Auth.hs
-module Auth where
-import Prelude
-import Core
-import Options
-import Control.Monad.IO.Class
-import Data.Text.Encoding (encodeUtf8)
-import Options.Generic
-import Servant.Client
-import qualified Servant.Auth.Client as SA
-import Gargantext.API.Client
-import qualified Gargantext.API.Admin.Auth.Types as Auth
-import qualified Gargantext.Core.Types.Individu  as Auth
-import qualified Gargantext.Database.Admin.Types.Node as Node
-- | Authenticate and use the resulting Token to perform
--   auth-restricted actions
-withAuthToken
-  :: ClientOpts -- ^ source of user/pass data
-  -> (SA.Token -> Node.NodeId -> ClientM a) -- ^ do something once authenticated
-  -> ClientM a
-withAuthToken opts act
-  -- both user and password CLI arguments passed
-  | Helpful (Just usr) <- user opts
-  , Helpful (Just pw)  <- pass opts = do
-      authRes <- postAuth (Auth.AuthRequest usr (Auth.GargPassword pw))
-      case Auth._authRes_valid authRes of
-        -- authentication failed, this function critically needs it to
-        -- be able to run the action, so we abort
-        Nothing -> problem $
-          "invalid auth response: " ++
-          maybe "" (show . Auth._authInv_message)
-                   (Auth._authRes_inval authRes)
-        -- authentication went through, we can run the action
-        Just (Auth.AuthValid tok tree_id _uid) -> do
-          let tok' = SA.Token (encodeUtf8 tok)
-          whenVerbose opts $ do
-            liftIO . putStrLn $ "[Debug] Authenticated: token=" ++ show tok ++
-                                ", tree_id=" ++ show tree_id
-          act tok' tree_id
-  -- user and/or pass CLI arguments not passed
-  | otherwise =
-      problem "auth-protected actions require --user and --pass"
--- a/bin/gargantext-client/Core.hs
+++ b/bin/gargantext-client/Core.hs
-module Core (problem, whenVerbose) where
-import Prelude
-import Options
-import Options.Generic
-import Control.Exception
-import Control.Monad
-import Control.Monad.Catch
-import Servant.Client
-newtype GargClientException = GCE String
-instance Show GargClientException where
-  show (GCE s) = "Garg client exception: " ++ s
-instance Exception GargClientException
-- | Abort with a message
-problem :: String -> ClientM a
-problem = throwM . GCE
-- | Only run the given computation when the @--verbose@ flag is
--   passed.
-whenVerbose :: Monad m => ClientOpts -> m () -> m ()
-whenVerbose opts act = when (unHelpful $ verbose opts) act
--- a/bin/gargantext-client/Main.hs
+++ b/bin/gargantext-client/Main.hs
-module Main where
-import Control.Monad
-import Network.HTTP.Client
-import Options
-import Options.Generic
-import Prelude
-import Script (script)
-import Servant.Client
-main :: IO ()
-main = do
-  -- we parse CLI options
-  opts@(ClientOpts (Helpful uri) _ _ (Helpful verb)) <- getRecord "Gargantext client"
-  mgr <- newManager defaultManagerSettings
-  burl <- parseBaseUrl uri
-  when verb $ do
-    putStrLn $ "[Debug] user: " ++ maybe "<none>" show (unHelpful $ user opts)
-    putStrLn $ "[Debug] backend: " ++ show burl
-  -- we run 'script' from the Script module, reporting potential errors
-  res <- runClientM (script opts) (mkClientEnv mgr burl)
-  case res of
-    Left err -> putStrLn $ "[Client error] " ++ show err
-    Right a  -> print a
--- a/bin/gargantext-client/Options.hs
+++ b/bin/gargantext-client/Options.hs
-{-# LANGUAGE TypeOperators #-}
-module Options where
-import Prelude
-import Options.Generic
-- | Some general options to be specified on the command line.
-data ClientOpts = ClientOpts
-  { url     :: String <?> "URL to gargantext backend"
-  , user    :: Maybe Text <?> "(optional) username for auth-restricted actions"
-  , pass    :: Maybe Text <?> "(optional) password for auth-restricted actions"
-  , verbose :: Bool   <?> "Enable verbose output"
-  } deriving (Generic, Show)
-instance ParseRecord ClientOpts
--- a/bin/gargantext-client/Script.hs
+++ b/bin/gargantext-client/Script.hs
-module Script (script) where
-import Auth
-import Control.Monad.IO.Class
-import Core
-import Gargantext.API.Client
-import Options
-import Prelude
-import Servant.Client
-import Tracking
-- | An example script. Tweak, rebuild and re-run the executable to see the
--   effect of your changes. You can hit any gargantext endpoint in the body
--   of 'script' using the many (many!) client functions exposed by the
--   'Gargantext.API.Client' module.
--
--   Don't forget to pass @--user@ and @--pass@ if you're using 'withAuthToken'.
-script :: ClientOpts -> ClientM ()
-script opts = do
-  -- we start by asking the backend for its version
-  ver <- getBackendVersion
-  liftIO . putStrLn $ "Backend version: " ++ show ver
-  -- next we authenticate using the credentials given on the command line
-  -- (through --user and --pass), erroring out loudly if the auth creds don't
-  -- go through, running the continuation otherwise.
-  withAuthToken opts $ \tok userNode -> do
-    liftIO . putStrLn $ "user node: " ++ show userNode
-    steps <-
-      -- we run a few client computations while tracking some EKG metrics
-      -- (any RTS stats or routing-related data), which means that we sample the
-      -- metrics at the beginning, the end, and in between each pair of steps.
-      tracking opts ["rts.gc.bytes_allocated"]
-        [ ("get roots", do
-              roots <- getRoots tok
-              liftIO . putStrLn $ "roots: " ++ show roots
-          )
-        , ("get user node detail", do
-              userNodeDetail <- getNode tok userNode
-              liftIO . putStrLn $ "user node details: " ++ show userNodeDetail
-          )
-        ]
-    -- we pretty print the values we sampled for all metrics and the
-    -- results of all the steps
-    whenVerbose opts (ppTracked steps)
--- a/bin/gargantext-client/Tracking.hs
+++ b/bin/gargantext-client/Tracking.hs
-{-# LANGUAGE TupleSections #-}
-module Tracking
-  ( tracking
-  , ppTracked
-  , EkgMetric
-  , Step
-  ) where
-import Core
-import Options
-import Prelude
-import Control.Monad.IO.Class
-import Data.List (intersperse)
-import Data.Text (Text)
-import Servant.Client
-import System.Metrics.Json (Value)
-import Gargantext.API.Client
-import qualified Data.Text as T
-- | e.g @["rts", "gc", "bytes_allocated"]@
-type EkgMetric = [Text]
-- | Any textual description of a step
-type Step      = Text
-- | Track EKG metrics before/after running a bunch of computations
--   that can talk to the backend.
-tracking
-  :: ClientOpts
-  -> [Text] -- ^ e.g @["rts.gc.bytes_allocated"]@
-  -> [(Step, ClientM a)]
-  -> ClientM [Either [(EkgMetric, Value)] (Step, a)]
-- no steps, nothing to do
-tracking _    _   []    = return []
-- no metrics to track, we just run the steps
-tracking _    []  steps = traverse runStep steps
-- metrics to track: we intersperse metric fetching and steps,
-- starting and ending with metric fetching
-tracking opts ms' steps = mix (Left <$> fetchMetrics) (map runStep steps)
-  where fetchMetrics :: ClientM [(EkgMetric, Value)]
-        fetchMetrics = flip traverse ms $ \metric -> do
-          whenVerbose opts $
-            liftIO . putStrLn $ "[Debug] metric to track: " ++ T.unpack (T.intercalate "." metric)
-          dat <- (metric,) <$> getMetricSample metric
-          whenVerbose opts $
-            liftIO . putStrLn $ "[Debug] metric pulled: " ++ show dat
-          return dat
-        mix :: ClientM a -> [ClientM a] -> ClientM [a]
-        mix x xs = sequence $ [x] ++ intersperse x xs ++ [x]
-        ms = map (T.splitOn ".") ms'
-- ^ A trivial function to print results of steps and sampled metrics
-ppTracked :: Show a => [Either [(EkgMetric, Value)] (Step, a)] -> ClientM ()
-ppTracked [] = return ()
-ppTracked (Right (step, a) : rest) = do
-  liftIO . putStrLn $ "[step: " ++ T.unpack step ++ "] returned: " ++ show a
-  ppTracked rest
-ppTracked (Left ms : rest) = do
-  liftIO . putStrLn $ unlines
-    [ T.unpack (T.intercalate "." metric) ++ " = " ++ show val
-    | (metric, val) <- ms
-    ]
-  ppTracked rest
-runStep :: (Step, ClientM a) -> ClientM (Either e (Step, a))
-runStep (step, act) = Right . (step,) <$> act
--- a/devops/postgres/upgrade/0.0.6.7.2.sql
+++ b/devops/postgres/upgrade/0.0.6.7.2.sql
+-- Adding index to improve ngrams_table query
+create index node_node_ngrams_weight_idx on node_node_ngrams(weight);
--- a/gargantext.cabal
+++ b/gargantext.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 name:           gargantext
-version: 0.0.6.7
+version:        0.0.6.8
 synopsis:       Search, map, share
 description:    Please see README.md
 category:       Data
@@ -44,14 +44,20 @@ library
      Gargantext.API.Admin.Auth.Types
      Gargantext.API.Admin.Types
      Gargantext.API.Prelude
-      Gargantext.API.Client
      Gargantext.Core
      Gargantext.Core.NodeStory
-      Gargantext.Core.Methods.Distances
+      Gargantext.Core.Methods.Similarities
      Gargantext.Core.Types
      Gargantext.Core.Types.Individu
      Gargantext.Core.Types.Main
      Gargantext.Core.Utils.Prefix
+      Gargantext.Utils.Jobs
+      Gargantext.Utils.Jobs.API
+      Gargantext.Utils.Jobs.Map
+      Gargantext.Utils.Jobs.Monad
+      Gargantext.Utils.Jobs.Queue
+      Gargantext.Utils.Jobs.Settings
+      Gargantext.Utils.Jobs.State
      Gargantext.Utils.SpacyNLP
      Gargantext.Database.Action.Flow
      Gargantext.Database.Action.Flow.Types
@@ -156,14 +162,14 @@ library
      Gargantext.Core.Flow.Types
      Gargantext.Core.Mail
      Gargantext.Core.Mail.Types
-      Gargantext.Core.Methods.Distances.Accelerate.Conditional
-      Gargantext.Core.Methods.Distances.Accelerate.Distributional
-      Gargantext.Core.Methods.Distances.Accelerate.SpeGen
-      Gargantext.Core.Methods.Distances.Conditional
-      Gargantext.Core.Methods.Distances.Distributional
      Gargantext.Core.Methods.Graph.BAC.Proxemy
      Gargantext.Core.Methods.Graph.MaxClique
      Gargantext.Core.Methods.Matrix.Accelerate.Utils
+      Gargantext.Core.Methods.Similarities.Accelerate.Conditional
+      Gargantext.Core.Methods.Similarities.Accelerate.Distributional
+      Gargantext.Core.Methods.Similarities.Accelerate.SpeGen
+      Gargantext.Core.Methods.Similarities.Conditional
+      Gargantext.Core.Methods.Similarities.Distributional
      Gargantext.Core.NodeStoryFile
      Gargantext.Core.Statistics
      Gargantext.Core.Text.Convert
@@ -477,6 +483,7 @@ library
    , singletons
    , split
    , stemmer
+    , stm
    , swagger2
    , taggy-lens
    , tagsoup
@@ -610,55 +617,6 @@ executable gargantext-cli
    , vector
  default-language: Haskell2010
-executable gargantext-client
-  main-is: Main.hs
-  other-modules:
-      Auth
-      Core
-      Options
-      Script
-      Tracking
-      Paths_gargantext
-  hs-source-dirs:
-      bin/gargantext-client
-  default-extensions:
-      DataKinds
-      DeriveGeneric
-      FlexibleContexts
-      FlexibleInstances
-      GeneralizedNewtypeDeriving
-      MultiParamTypeClasses
-      NamedFieldPuns
-      NoImplicitPrelude
-      OverloadedStrings
-      RankNTypes
-      RecordWildCards
-      DataKinds
-      DeriveGeneric
-      FlexibleContexts
-      FlexibleInstances
-      GeneralizedNewtypeDeriving
-      MultiParamTypeClasses
-      NamedFieldPuns
-      NoImplicitPrelude
-      OverloadedStrings
-      RankNTypes
-      RecordWildCards
-  ghc-options: -Wall -Wall -threaded -rtsopts -with-rtsopts=-N -O2 -Wmissing-signatures
-  build-depends:
-      base
-    , ekg-json
-    , exceptions
-    , extra
-    , gargantext
-    , http-client
-    , optparse-generic
-    , servant
-    , servant-auth-client
-    , servant-client
-    , text
-  default-language: Haskell2010
 executable gargantext-import
  main-is: Main.hs
  other-modules:
@@ -901,3 +859,33 @@ test-suite garg-test
    , time
    , unordered-containers
  default-language: Haskell2010
+test-suite jobqueue-test
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  other-modules:
+      Paths_gargantext
+  hs-source-dirs:
+      tests/queue
+  default-extensions:
+      DataKinds
+      DeriveGeneric
+      FlexibleContexts
+      FlexibleInstances
+      GeneralizedNewtypeDeriving
+      MultiParamTypeClasses
+      NamedFieldPuns
+      NoImplicitPrelude
+      OverloadedStrings
+      RankNTypes
+      RecordWildCards
+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      async
+    , base
+    , extra
+    , gargantext
+    , hspec
+    , stm
+    , text
+  default-language: Haskell2010
--- a/gargantext.ini_toModify
+++ b/gargantext.ini_toModify
@@ -3,6 +3,9 @@
 # Main url serving the FrontEnd
 URL = http://localhost
+# The instance name
+BACKEND_NAME = localhost
 # Main API url serving the BackEnd
 URL_BACKEND_API = http://localhost:8008/api/v1.0

--- a/package.yaml
+++ b/package.yaml
@@ -6,7 +6,7 @@ name: gargantext
 #         | | | +-----  Layers * : New versions with API additions
 #         | | | | +---  Layers * : New versions without API breaking changes
 #         | | | | |
-version: '0.0.6.7'
+version: '0.0.6.8'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data
@@ -68,14 +68,20 @@ library:
  - Gargantext.API.Admin.Auth.Types
  - Gargantext.API.Admin.Types
  - Gargantext.API.Prelude
-  - Gargantext.API.Client
  - Gargantext.Core
  - Gargantext.Core.NodeStory
-  - Gargantext.Core.Methods.Distances
+  - Gargantext.Core.Methods.Similarities
  - Gargantext.Core.Types
  - Gargantext.Core.Types.Individu
  - Gargantext.Core.Types.Main
  - Gargantext.Core.Utils.Prefix
+  - Gargantext.Utils.Jobs
+  - Gargantext.Utils.Jobs.API
+  - Gargantext.Utils.Jobs.Map
+  - Gargantext.Utils.Jobs.Monad
+  - Gargantext.Utils.Jobs.Queue
+  - Gargantext.Utils.Jobs.Settings
+  - Gargantext.Utils.Jobs.State
  - Gargantext.Utils.SpacyNLP
  - Gargantext.Database.Action.Flow
  - Gargantext.Database.Action.Flow.Types
@@ -262,6 +268,7 @@ library:
  - singletons # (IGraph)
  - split
  - stemmer
+  - stm
  - swagger2
  - taggy-lens
  - tagsoup
@@ -347,42 +354,6 @@ executables:
      - unordered-containers
      - full-text-search
-  gargantext-client:
-    main: Main.hs
-    source-dirs: bin/gargantext-client
-    ghc-options:
-    - -Wall
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    - -O2
-    - -Wmissing-signatures
-    default-extensions:
-    - DataKinds
-    - DeriveGeneric
-    - FlexibleContexts
-    - FlexibleInstances
-    - GeneralizedNewtypeDeriving
-    - MultiParamTypeClasses
-    - NamedFieldPuns
-    - NoImplicitPrelude
-    - OverloadedStrings
-    - RankNTypes
-    - RecordWildCards
-    dependencies:
-    - base
-    - extra
-    - servant
-    - text
-    - optparse-generic
-    - exceptions
-    - servant-client
-    - servant-auth-client
-    - gargantext
-    - ekg-json
-    - http-client
  gargantext-phylo:
    main: Main.hs
    source-dirs: bin/gargantext-phylo
@@ -533,6 +504,19 @@ tests:
     - duckling
     - text
     - unordered-containers
+   jobqueue-test:
+     main: Main.hs
+     source-dirs: tests/queue
+     ghc-options:
+     - -threaded
+     - -rtsopts
+     - -with-rtsopts=-N
+     dependencies:
+     - base
+     - gargantext
+     - hspec
+     - async
+     - stm
 #  garg-doctest:
 #    main: Main.hs
 #    source-dirs: src-doctest

--- a/src-test/Graph/Clustering.hs
+++ b/src-test/Graph/Clustering.hs
--- a/src/Gargantext/API.hs
+++ b/src/Gargantext/API.hs
@@ -44,11 +44,11 @@ import Data.Validity
 import GHC.Base (Applicative)
 import GHC.Generics (Generic)
 import Gargantext.API.Admin.Auth.Types (AuthContext)
+import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Admin.Settings (newEnv)
 import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings)
 import Gargantext.API.EKG
 import Gargantext.API.Ngrams (saveNodeStoryImmediate)
-import Gargantext.API.Prelude
 import Gargantext.API.Routes
 import Gargantext.API.Server (server)
 import Gargantext.Core.NodeStory
@@ -207,7 +207,7 @@ serverGargAdminAPI =  roots
 --gargMock = mock apiGarg Proxy
 ---------------------------------------------------------------------
-makeApp :: (Typeable env, EnvC env) => env -> IO Application
+makeApp :: Env -> IO Application
 makeApp env = do
  serv <- server env
  (ekgStore, ekgMid) <- newEkgStore api

--- a/src/Gargantext/API/Admin/Auth.hs
+++ b/src/Gargantext/API/Admin/Auth.hs
@@ -47,16 +47,16 @@ import Data.UUID.V4 (nextRandom)
 import GHC.Generics (Generic)
 import Servant
 import Servant.Auth.Server
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
 --import qualified Text.Blaze.Html5.Attributes as HA
 import qualified Gargantext.Prelude.Crypto.Auth as Auth
 import Gargantext.API.Admin.Auth.Types
+import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types
 import Gargantext.API.Job (jobLogSuccess)
-import Gargantext.API.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC, GargServer, _ServerError)
+import Gargantext.API.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC, GargServer, _ServerError, GargM, GargError)
 import Gargantext.Core.Mail (MailModel(..), mail)
 import Gargantext.Core.Mail.Types (HasMail, mailSettings)
 import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
@@ -69,6 +69,7 @@ import Gargantext.Database.Query.Tree.Root (getRoot)
 import Gargantext.Database.Schema.Node (NodePoly(_node_id))
 import Gargantext.Prelude hiding (reverse)
 import Gargantext.Prelude.Crypto.Pass.User (gargPass)
+import Gargantext.Utils.Jobs (serveJobsAPI)
 ---------------------------------------------------
@@ -266,12 +267,10 @@ generateForgotPasswordUUID = do
 type ForgotPasswordAsyncAPI = Summary "Forgot password asnc"
                              :> AsyncJobs JobLog '[JSON] ForgotPasswordAsyncParams JobLog
-forgotPasswordAsync :: GargServer ForgotPasswordAsyncAPI
+forgotPasswordAsync :: ServerT ForgotPasswordAsyncAPI (GargM Env GargError)
 forgotPasswordAsync =
-  serveJobsAPI $
+  serveJobsAPI ForgotPasswordJob $ \p log' ->
-    JobFunction (\p log' ->
+    forgotPasswordAsync' p (liftBase . log')
-                   forgotPasswordAsync' p (liftBase . log')
-                )
 forgotPasswordAsync' :: (FlowCmdM env err m)
  => ForgotPasswordAsyncParams

--- a/src/Gargantext/API/Admin/EnvTypes.hs
+++ b/src/Gargantext/API/Admin/EnvTypes.hs
@@ -5,6 +5,9 @@
 module Gargantext.API.Admin.EnvTypes where
 import Control.Lens
+import Control.Monad.Except
+import Control.Monad.Reader
+import Data.Monoid
 import Data.Pool (Pool)
 import Database.PostgreSQL.Simple (Connection)
 import GHC.Generics (Generic)
@@ -16,6 +19,7 @@ import qualified Servant.Job.Core
 import Gargantext.API.Admin.Types
 import Gargantext.API.Admin.Orchestrator.Types
+import Gargantext.API.Prelude (GargError)
 import Gargantext.Core.NodeStory
 import Gargantext.Core.Mail.Types (HasMail, mailSettings)
 import Gargantext.Database.Prelude (HasConnectionPool(..), HasConfig(..))
@@ -23,6 +27,27 @@ import Gargantext.Prelude
 import Gargantext.Prelude.Config (GargConfig(..))
 import Gargantext.Prelude.Mail.Types (MailConfig)
+import qualified Gargantext.Utils.Jobs.Monad as Jobs
+data GargJob
+  = TableNgramsJob
+  | ForgotPasswordJob
+  | UpdateNgramsListJobJSON
+  | UpdateNgramsListJobCSV
+  | AddContactJob
+  | AddFileJob
+  | DocumentFromWriteNodeJob
+  | UpdateNodeJob
+  | UploadFrameCalcJob
+  | UploadDocumentJob
+  | NewNodeJob
+  | AddCorpusQueryJob
+  | AddCorpusFormJob
+  | AddCorpusFileJob
+  | AddAnnuaireFormJob
+  | RecomputeGraphJob
+  deriving (Show, Eq, Ord, Enum, Bounded)
 data Env = Env
  { _env_settings  :: !Settings
  , _env_logger    :: !LoggerSet
@@ -31,6 +56,7 @@ data Env = Env
  , _env_manager   :: !Manager
  , _env_self_url  :: !BaseUrl
  , _env_scrapers  :: !ScrapersEnv
+  , _env_jobs      :: !(Jobs.JobEnv GargJob (Dual [JobLog]) JobLog)
  , _env_config    :: !GargConfig
  , _env_mail      :: !MailConfig
  }
@@ -62,13 +88,15 @@ instance HasSettings Env where
 instance HasMail Env where
  mailSettings = env_mail
 instance Servant.Job.Core.HasEnv Env (Job JobLog JobLog) where
  _env = env_scrapers . Servant.Job.Core._env
 instance HasJobEnv Env JobLog JobLog where
  job_env = env_scrapers
+instance Jobs.MonadJob (ReaderT Env (ExceptT GargError IO)) GargJob (Dual [JobLog]) JobLog where
+  getJobEnv = asks (view env_jobs)
 data MockEnv = MockEnv
  { _menv_firewall :: !FireWall
  }

--- a/src/Gargantext/API/Admin/Settings.hs
+++ b/src/Gargantext/API/Admin/Settings.hs
@@ -47,6 +47,9 @@ import Gargantext.Database.Prelude (databaseParameters)
 import Gargantext.Prelude
 -- import Gargantext.Prelude.Config (gc_repofilepath)
 import qualified Gargantext.Prelude.Mail as Mail
+import qualified Gargantext.Utils.Jobs       as Jobs
+import qualified Gargantext.Utils.Jobs.Monad as Jobs
+import qualified Gargantext.Utils.Jobs.Queue as Jobs
 devSettings :: FilePath -> IO Settings
 devSettings jwkFile = do
@@ -177,12 +180,19 @@ newEnv port file = do
    panic "TODO: conflicting settings of port"
  config_env    <- readConfig file
+  prios         <- Jobs.readPrios (file <> ".jobs")
+  let prios' = Jobs.applyPrios prios Jobs.defaultPrios
+  putStrLn $ "Overrides: " <> show prios
+  putStrLn $ "New priorities: " <> show prios'
  self_url_env  <- parseBaseUrl $ "http://0.0.0.0:" <> show port
  dbParam       <- databaseParameters file
  pool          <- newPool dbParam
  --nodeStory_env <- readNodeStoryEnv (_gc_repofilepath config_env)
  nodeStory_env <- readNodeStoryEnv pool
  scrapers_env  <- newJobEnv defaultSettings manager_env
+  secret        <- Jobs.genSecret
+  jobs_env      <- Jobs.newJobEnv (Jobs.defaultJobSettings 1 secret) prios' manager_env
  logger        <- newStderrLoggerSet defaultBufSize
  config_mail   <- Mail.readConfig file
@@ -193,6 +203,7 @@ newEnv port file = do
    , _env_nodeStory = nodeStory_env
    , _env_manager   = manager_env
    , _env_scrapers  = scrapers_env
+    , _env_jobs      = jobs_env
    , _env_self_url  = self_url_env
    , _env_config    = config_env
    , _env_mail      = config_mail

--- a/src/Gargantext/API/Client.hs
+++ b/src/Gargantext/API/Client.hs
--- a/src/Gargantext/API/Ngrams.hs
+++ b/src/Gargantext/API/Ngrams.hs
@@ -95,6 +95,7 @@ import Data.Text (Text, isInfixOf, unpack, pack)
 import Data.Text.Lazy.IO as DTL
 import Formatting (hprint, int, (%))
 import GHC.Generics (Generic)
+import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Job
@@ -105,7 +106,7 @@ import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, TODO, assertValid, HasInvalidError)
 import Gargantext.API.Ngrams.Tools
 import Gargantext.Database.Action.Flow.Types
-import Gargantext.Database.Action.Metrics.NgramsByContext (getOccByNgramsOnlyFast')
+import Gargantext.Database.Action.Metrics.NgramsByContext (getOccByNgramsOnlyFast)
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Types.Node (NodeType(..))
 import Gargantext.Database.Prelude (HasConnectionPool(..), HasConfig)
@@ -118,7 +119,7 @@ import Gargantext.Prelude hiding (log)
 import Gargantext.Prelude.Clock (hasTime, getTime)
 import Prelude (error)
 import Servant hiding (Patch)
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+import Gargantext.Utils.Jobs (serveJobsAPI)
 import System.IO (stderr)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
@@ -581,10 +582,9 @@ getTableNgrams _nType nId tabType listId limit_ offset
      let ngrams_terms = table ^.. each . ne_ngrams
      -- printDebug "ngrams_terms" ngrams_terms
      t1 <- getTime
-      occurrences <- getOccByNgramsOnlyFast' nId
+      occurrences <- getOccByNgramsOnlyFast nId
                                             listId
                                            ngramsType
-                                            ngrams_terms
      --printDebug "occurrences" occurrences
      t2 <- getTime
      liftBase $ hprint stderr
@@ -644,19 +644,15 @@ scoresRecomputeTableNgrams nId tabType listId = do
    setScores :: forall t. Each t t NgramsElement NgramsElement => t -> m t
    setScores table = do
-      let ngrams_terms = table ^.. each . ne_ngrams
+      occurrences <- getOccByNgramsOnlyFast nId
-      occurrences <- getOccByNgramsOnlyFast' nId
                                             listId
                                            ngramsType
-                                            ngrams_terms
      let
        setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
      pure $ table & each %~ setOcc
 -- APIs
 -- TODO: find a better place for the code above, All APIs stay here
@@ -779,28 +775,23 @@ getTableNgramsDoc dId tabType listId limit_ offset listType minSize maxSize orde
-apiNgramsTableCorpus :: ( GargServerC env err m
+apiNgramsTableCorpus :: NodeId -> ServerT TableNgramsApi (GargM Env GargError)
-                        )
-                     => NodeId -> ServerT TableNgramsApi m
 apiNgramsTableCorpus cId =  getTableNgramsCorpus       cId
                       :<|> tableNgramsPut
                       :<|> scoresRecomputeTableNgrams cId
                       :<|> getTableNgramsVersion      cId
                       :<|> apiNgramsAsync             cId
-apiNgramsTableDoc :: ( GargServerC env err m
+apiNgramsTableDoc :: DocId -> ServerT TableNgramsApi (GargM Env GargError)
-                     )
-                  => DocId -> ServerT TableNgramsApi m
 apiNgramsTableDoc dId =  getTableNgramsDoc          dId
                    :<|> tableNgramsPut
                    :<|> scoresRecomputeTableNgrams dId
                    :<|> getTableNgramsVersion      dId
                    :<|> apiNgramsAsync             dId
-apiNgramsAsync :: NodeId -> GargServer TableNgramsAsyncApi
+apiNgramsAsync :: NodeId -> ServerT TableNgramsAsyncApi (GargM Env GargError)
 apiNgramsAsync _dId =
-  serveJobsAPI $
+  serveJobsAPI TableNgramsJob $ \i log ->
-    JobFunction $ \i log ->
      let
        log' x = do
          printDebug "tableNgramsPostChartsAsync" x

--- a/src/Gargantext/API/Ngrams/List.hs
+++ b/src/Gargantext/API/Ngrams/List.hs
@@ -23,13 +23,14 @@ import Data.Maybe (catMaybes, fromMaybe)
 import Data.Set (Set)
 import Data.Text (Text, concat, pack, splitOn)
 import Data.Vector (Vector)
+import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Ngrams (setListNgrams)
 import Gargantext.API.Ngrams.List.Types
 import Gargantext.API.Ngrams.Prelude (getNgramsList)
 import Gargantext.API.Ngrams.Tools (getTermsWith)
 import Gargantext.API.Ngrams.Types
-import Gargantext.API.Prelude (GargServer)
+import Gargantext.API.Prelude (GargServer, GargM, GargError)
 import Gargantext.API.Types
 import Gargantext.Core.NodeStory
 import Gargantext.Core.Text.Terms (ExtractedNgrams(..))
@@ -46,8 +47,9 @@ import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Node (_node_parent_id)
 import Gargantext.Database.Types (Indexed(..))
 import Gargantext.Prelude
+import Gargantext.Utils.Jobs (serveJobsAPI)
 import Servant
-import Servant.Job.Async
+-- import Servant.Job.Async
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.Csv as Csv
 import qualified Data.HashMap.Strict as HashMap
@@ -75,7 +77,7 @@ type JSONAPI = Summary "Update List"
          :> "async"
            :> AsyncJobs JobLog '[FormUrlEncoded] WithFile JobLog
-jsonApi :: GargServer JSONAPI
+jsonApi :: ServerT JSONAPI (GargM Env GargError)
 jsonApi = postAsync
 ----------------------
@@ -88,7 +90,7 @@ type CSVAPI = Summary "Update List (legacy v3 CSV)"
          :> "async"
            :> AsyncJobs JobLog '[FormUrlEncoded] WithTextFile JobLog
-csvApi :: GargServer CSVAPI
+csvApi :: ServerT CSVAPI (GargM Env GargError)
 csvApi = csvPostAsync
 ------------------------------------------------------------------------
@@ -188,15 +190,14 @@ type PostAPI = Summary "Update List"
        :> "async"
        :> AsyncJobs JobLog '[FormUrlEncoded] WithFile JobLog
-postAsync :: GargServer JSONAPI
+postAsync :: ListId -> ServerT PostAPI (GargM Env GargError)
 postAsync lId =
-  serveJobsAPI $
+  serveJobsAPI UpdateNgramsListJobJSON $ \f log' ->
-    JobFunction (\f log' ->
      let
        log'' x = do
          -- printDebug "postAsync ListId" x
          liftBase $ log' x
-      in postAsync' lId f log'')
+      in postAsync' lId f log''
 postAsync' :: FlowCmdM env err m
          => ListId
@@ -291,10 +292,9 @@ csvPost l m  = do
  pure True
 ------------------------------------------------------------------------
-csvPostAsync :: GargServer CSVAPI
+csvPostAsync :: ServerT CSVAPI (GargM Env GargError)
 csvPostAsync lId =
-  serveJobsAPI $
+  serveJobsAPI UpdateNgramsListJobCSV $ \f@(WithTextFile ft _ n) log' -> do
-    JobFunction $ \f@(WithTextFile ft _ n) log' -> do
      let log'' x = do
            printDebug "[csvPostAsync] filetype" ft
            printDebug "[csvPostAsync] name" n

--- a/src/Gargantext/API/Ngrams/Tools.hs
+++ b/src/Gargantext/API/Ngrams/Tools.hs
@@ -187,14 +187,44 @@ getCoocByNgrams' f (Diagonal diag) m =
                                 <$> (fmap f $ HM.lookup t1 m)
                                 <*> (fmap f $ HM.lookup t2 m)
               )
-              | (t1,t2) <- if diag then
+              | (t1,t2) <- if diag
-                             [ (x,y) | x <- ks, y <- ks, x <= y] -- TODO if we keep a Data.Map here it might be
+                              then [ (x,y) | x <- ks, y <- ks, x <= y]
-                                                                 -- more efficient to enumerate all the y <= x.
+                                   -- TODO if we keep a Data.Map here it might be
-                           else
+                                   -- more efficient to enumerate all the y <= x.
-                             listToCombi identity ks
+                              else
+                                listToCombi identity ks
              ]
-  where ks = HM.keys m
+  where 
+    ks = HM.keys m
+-- TODO k could be either k1 or k2 here
+getCoocByNgrams'' :: (Hashable k, Ord k, Ord contexts)
+                  => Diagonal
+                  -> (contextA -> Set contexts, contextB -> Set contexts)
+                  -> (HashMap k contextA, HashMap k contextB)
+                  -> HashMap (k, k) Int
+getCoocByNgrams'' (Diagonal diag) (f1,f2) (m1,m2) =
+  HM.fromList [( (t1,t2)
+               , maybe 0 Set.size $ Set.intersection
+                                 <$> (fmap f1 $ HM.lookup t1 m1)
+                                 <*> (fmap f2 $ HM.lookup t2 m2)
+               )
+              | (t1,t2) <- if diag
+                              then
+                                [ (x,y) | x <- ks1, y <- ks2, x <= y]
+                                   -- TODO if we keep a Data.Map here it might be
+                                   -- more efficient to enumerate all the y <= x.
+                              else
+                                [ (x,y) | x <- ks1, y <- ks2, x < y]
+                                -- TODO check optim
+                                -- listToCombi identity ks1
+              ]
+  where 
+    ks1 = HM.keys m1
+    ks2 = HM.keys m2
 ------------------------------------------

--- a/src/Gargantext/API/Node.hs
+++ b/src/Gargantext/API/Node.hs
@@ -36,6 +36,7 @@ import Data.Text (Text())
 import GHC.Generics (Generic)
 import Gargantext.API.Admin.Auth (withAccess)
 import Gargantext.API.Admin.Auth.Types (PathId(..))
+import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Metrics
 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
 import Gargantext.API.Ngrams.Types (TabType(..))
@@ -196,10 +197,10 @@ nodeAPI :: forall proxy a.
       ) => proxy a
         -> UserId
         -> NodeId
-         -> GargServer (NodeAPI a)
+         -> ServerT (NodeAPI a) (GargM Env GargError)
 nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI'
  where
-    nodeAPI' :: GargServer (NodeAPI a)
+    nodeAPI' :: ServerT (NodeAPI a) (GargM Env GargError)
    nodeAPI' =  getNodeWith   id' p
           :<|> rename        id'
           :<|> postNode  uId id'

--- a/src/Gargantext/API/Node/Contact.hs
+++ b/src/Gargantext/API/Node/Contact.hs
@@ -30,14 +30,14 @@ import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Servant
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
+import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Node
-import Gargantext.API.Prelude (GargServer, simuLogs)
+import Gargantext.API.Prelude (GargError, GargM, simuLogs)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Text.Terms (TermType(..))
 import Gargantext.Core.Types.Individu (User(..))
@@ -48,6 +48,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude (($), liftBase, (.), printDebug, pure)
 import qualified Gargantext.Utils.Aeson as GUA
+import Gargantext.Utils.Jobs (serveJobsAPI)
 ------------------------------------------------------------------------
 type API = "contact" :> Summary "Contact endpoint"
@@ -56,7 +57,7 @@ type API = "contact" :> Summary "Contact endpoint"
            :> NodeNodeAPI HyperdataContact
-api :: UserId -> CorpusId -> GargServer API
+api :: UserId -> CorpusId -> ServerT API (GargM Env GargError)
 api uid cid =  (api_async   (RootId (NodeId                   uid)) cid)
          :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) uid   cid)
@@ -70,16 +71,14 @@ data AddContactParams = AddContactParams         { firstname :: !Text, lastname
    deriving (Generic)
 ----------------------------------------------------------------------
-api_async :: User -> NodeId -> GargServer API_Async
+api_async :: User -> NodeId -> ServerT API_Async (GargM Env GargError)
 api_async u nId =
-  serveJobsAPI $
+  serveJobsAPI AddContactJob $ \p log ->
-    JobFunction (\p log ->
      let
        log' x = do
          printDebug "addContact" x
          liftBase $ log x
      in addContact u nId p (liftBase . log')
-      )
 addContact :: (HasSettings env, FlowCmdM env err m)
    => User

--- a/src/Gargantext/API/Node/Document/Export.hs
+++ b/src/Gargantext/API/Node/Document/Export.hs
@@ -40,7 +40,7 @@ getDocumentsJSON :: UserId
 getDocumentsJSON uId pId = do
  mcId <- getClosestParentIdByType pId NodeCorpus
  let cId = maybe (panic "[G.A.N.D.Export] Node has no parent") identity mcId
-  docs <- runViewDocuments cId False Nothing Nothing Nothing Nothing
+  docs <- runViewDocuments cId False Nothing Nothing Nothing Nothing Nothing
  pure $ DocumentExport { _de_documents = mapFacetDoc <$> docs
                        , _de_garg_version = T.pack $ showVersion PG.version }
  where

--- a/src/Gargantext/API/Node/DocumentUpload.hs
+++ b/src/Gargantext/API/Node/DocumentUpload.hs
@@ -10,9 +10,9 @@ import Data.Aeson
 import Data.Swagger (ToSchema)
 import GHC.Generics (Generic)
 import Servant
-import Servant.Job.Async
 import qualified Data.Text as T
+import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Job (jobLogSuccess)
 import Gargantext.API.Prelude
@@ -28,14 +28,15 @@ import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
 import Gargantext.Prelude
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus(..))
+import Gargantext.Utils.Jobs (serveJobsAPI)
 data DocumentUpload = DocumentUpload
  { _du_abstract :: T.Text
  , _du_authors  :: T.Text
  , _du_sources  :: T.Text
-  , _du_title    :: T.Text 
+  , _du_title    :: T.Text
-  , _du_date     :: T.Text 
+  , _du_date     :: T.Text
  }
  deriving (Generic)
@@ -65,12 +66,10 @@ type API = Summary " Document upload"
           :> "async"
           :> AsyncJobs JobLog '[JSON] DocumentUpload JobLog
-api :: UserId -> NodeId -> GargServer API
+api :: UserId -> NodeId -> ServerT API (GargM Env GargError)
 api uId nId =
-  serveJobsAPI $
+  serveJobsAPI UploadDocumentJob $ \q log' -> do
-    JobFunction (\q log' -> do
      documentUploadAsync uId nId q (liftBase . log')
-    )
 documentUploadAsync :: (FlowCmdM env err m)
               => UserId
@@ -99,8 +98,8 @@ documentUpload nId doc = do
  let cId = case mcId of
        Just c  -> c
        Nothing -> panic $ T.pack $ "[G.A.N.DU] Node has no corpus parent: " <> show nId
-  (theFullDate, (year, month, day)) <- liftBase $ dateSplit EN 
+  (theFullDate, (year, month, day)) <- liftBase $ dateSplit EN
                                                        $ Just
                                                        $ view du_date doc <> "T:0:0:0"
@@ -123,9 +122,7 @@ documentUpload nId doc = do
                             , _hd_publication_minute = Nothing
                             , _hd_publication_second = Nothing
                             , _hd_language_iso2 = Just $ T.pack $ show EN }
  docIds <- insertMasterDocs (Nothing :: Maybe HyperdataCorpus) (Multi EN) [hd]
  _ <- Doc.add cId docIds
  pure docIds
--- a/src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
+++ b/src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
@@ -22,10 +22,11 @@ import Data.Aeson
 import Data.Either (Either(..), rights)
 import Data.Swagger
 import qualified Data.Text as T
+import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Job (jobLogSuccess, jobLogFailTotalWithMessage)
-import Gargantext.API.Prelude (GargServer)
+import Gargantext.API.Prelude (GargM, GargError)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Text.Corpus.Parsers.FrameWrite
 import Gargantext.Core.Text.Terms (TermType(..))
@@ -39,9 +40,9 @@ import Gargantext.Database.Query.Table.Node (getChildrenByType, getClosestParent
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import qualified Gargantext.Defaults as Defaults
 import Gargantext.Prelude
+import Gargantext.Utils.Jobs (serveJobsAPI)
 import GHC.Generics (Generic)
 import Servant
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
 ------------------------------------------------------------------------
 type API = Summary " Documents from Write nodes."
@@ -55,15 +56,13 @@ instance ToJSON Params where
  toJSON = genericToJSON defaultOptions
 instance ToSchema Params
 ------------------------------------------------------------------------
-api :: UserId -> NodeId -> GargServer API
+api :: UserId -> NodeId -> ServerT API (GargM Env GargError)
 api uId nId =
-  serveJobsAPI $
+  serveJobsAPI DocumentFromWriteNodeJob $ \p log'' ->
-    JobFunction (\p log'' ->
      let
        log' x = do
          liftBase $ log'' x
      in documentsFromWriteNodes uId nId p (liftBase . log')
-      )
 documentsFromWriteNodes :: (HasSettings env, FlowCmdM env err m)
    => UserId

--- a/src/Gargantext/API/Node/File.hs
+++ b/src/Gargantext/API/Node/File.hs
@@ -11,7 +11,6 @@ import Data.Swagger
 import Data.Text
 import GHC.Generics (Generic)
 import Servant
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BSL
 import qualified Data.MIME.Types as DMT
@@ -19,6 +18,7 @@ import qualified Gargantext.Database.GargDB as GargDB
 import qualified Network.HTTP.Media as M
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
+import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Node.Types
 import Gargantext.API.Prelude
@@ -31,6 +31,7 @@ import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
+import Gargantext.Utils.Jobs (serveJobsAPI)
 import Data.Either
 data RESPONSE deriving Typeable
@@ -99,15 +100,14 @@ type FileAsyncApi = Summary "File Async Api"
                 :> "add"
                 :> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
-fileAsyncApi :: UserId -> NodeId -> GargServer FileAsyncApi
+fileAsyncApi :: UserId -> NodeId -> ServerT FileAsyncApi (GargM Env GargError)
 fileAsyncApi uId nId =
-  serveJobsAPI $
+  serveJobsAPI AddFileJob $ \i l ->
-    JobFunction (\i l ->
      let
        log' x = do
          printDebug "addWithFile" x
          liftBase $ l x
-      in addWithFile uId nId i log')
+      in addWithFile uId nId i log'
 addWithFile :: (HasSettings env, FlowCmdM env err m)

--- a/src/Gargantext/API/Node/FrameCalcUpload.hs
+++ b/src/Gargantext/API/Node/FrameCalcUpload.hs
@@ -14,9 +14,9 @@ import GHC.Generics (Generic)
 import Network.HTTP.Client (newManager, httpLbs, parseRequest, responseBody)
 import Network.HTTP.Client.TLS (tlsManagerSettings)
 import Servant
-import Servant.Job.Async
 import Web.FormUrlEncoded (FromForm)
+import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Job (jobLogInit, jobLogSuccess, jobLogFail)
 import Gargantext.API.Node.Corpus.New (addToCorpusWithForm)
@@ -31,6 +31,7 @@ import Gargantext.Database.Prelude (HasConfig)
 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, getNodeWith)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
+import Gargantext.Utils.Jobs (serveJobsAPI)
 data FrameCalcUpload = FrameCalcUpload ()
  deriving (Generic)
@@ -46,12 +47,11 @@ type API = Summary " FrameCalc upload"
           :> "async"
           :> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
-api :: UserId -> NodeId -> GargServer API
+api :: UserId -> NodeId -> ServerT API (GargM Env GargError)
 api uId nId =
-  serveJobsAPI $ 
+  serveJobsAPI UploadFrameCalcJob $ \p logs ->
-    JobFunction (\p logs ->
+    frameCalcUploadAsync uId nId p (liftBase . logs) (jobLogInit 5)
-                   frameCalcUploadAsync uId nId p (liftBase . logs) (jobLogInit 5)
-                )
 frameCalcUploadAsync :: (HasConfig env, FlowCmdM env err m)

--- a/src/Gargantext/API/Node/Get.hs
+++ b/src/Gargantext/API/Node/Get.hs
@@ -18,10 +18,6 @@ Polymorphic Get Node API
 module Gargantext.API.Node.Get
      where
-- import Gargantext.API.Admin.Types (HasSettings)
-- import Servant.Job.Async (JobFunction(..), serveJobsAPI)
-- import Test.QuickCheck (elements)
-- import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Data.Aeson
 import Data.Swagger
 import GHC.Generics (Generic)
@@ -30,7 +26,7 @@ import Test.QuickCheck.Arbitrary
 import Gargantext.API.Prelude
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (JSONB{-, getNodeWith-})
+import Gargantext.Database.Prelude (JSONB)
 import Gargantext.Prelude
 ------------------------------------------------------------------------

--- a/src/Gargantext/API/Node/New.hs
+++ b/src/Gargantext/API/Node/New.hs
@@ -26,11 +26,11 @@ import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
 import Servant
-import Servant.Job.Async
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 import Web.FormUrlEncoded          (FromForm, ToForm)
+import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Prelude
 import Gargantext.Database.Action.Flow.Types
@@ -41,6 +41,7 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Table.Node.User
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
+import Gargantext.Utils.Jobs (serveJobsAPI)
 ------------------------------------------------------------------------
 data PostNode = PostNode { pn_name     :: Text
@@ -73,10 +74,11 @@ type PostNodeAsync = Summary "Post Node"
   :> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
-postNodeAsyncAPI :: UserId -> NodeId -> GargServer PostNodeAsync
+postNodeAsyncAPI
+  :: UserId -> NodeId -> ServerT PostNodeAsync (GargM Env GargError)
 postNodeAsyncAPI uId nId =
-  serveJobsAPI $
+  serveJobsAPI NewNodeJob $ \p logs ->
-    JobFunction (\p logs -> postNodeAsync uId nId p (liftBase . logs))
+    postNodeAsync uId nId p (liftBase . logs)
 ------------------------------------------------------------------------
 postNodeAsync :: FlowCmdM env err m

--- a/src/Gargantext/API/Node/Update.hs
+++ b/src/Gargantext/API/Node/Update.hs
@@ -21,16 +21,17 @@ import Data.Aeson
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Swagger
 import GHC.Generics (Generic)
+import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Ngrams.List (reIndexWith)
 --import Gargantext.API.Ngrams.Types (TabType(..))
-import Gargantext.API.Prelude (GargServer, simuLogs)
+import Gargantext.API.Prelude (GargM, GargError, simuLogs)
-import Gargantext.Core.Methods.Distances (GraphMetric(..))
+import Gargantext.Core.Methods.Similarities (GraphMetric(..))
 import Gargantext.Core.Types.Main (ListType(..))
 import Gargantext.Core.Viz.Graph (Strength)
 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
-import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..))
+import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
 import Gargantext.Core.Viz.Phylo (PhyloSubConfig(..), subConfig2config)
 import Gargantext.Core.Viz.Phylo.API.Tools (flowPhyloAPI)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
@@ -43,9 +44,9 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Ngrams (NgramsType(NgramsTerms))
 import Gargantext.Database.Schema.Node (node_parent_id)
 import Gargantext.Prelude (Bool(..), Ord, Eq, (<$>), ($), liftBase, (.), printDebug, pure, show, cs, (<>), panic, (<*>))
+import Gargantext.Utils.Jobs (serveJobsAPI)
 import Prelude (Enum, Bounded, minBound, maxBound)
 import Servant
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 import qualified Data.Set                    as Set
@@ -62,7 +63,10 @@ data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: !Method      }
                      | UpdateNodeParamsGraph { methodGraphMetric        :: !GraphMetric
                                              , methodGraphClustering    :: !PartitionMethod
+                                              , methodGraphBridgeness    :: !BridgenessMethod
                                              , methodGraphEdgesStrength :: !Strength
+                                              , methodGraphNodeType1     :: !NgramsType
+                                              , methodGraphNodeType2     :: !NgramsType
                                              }
                      | UpdateNodeParamsTexts { methodTexts :: !Granularity }
@@ -88,16 +92,14 @@ data Charts = Sources | Authors | Institutes | Ngrams | All
    deriving (Generic, Eq, Ord, Enum, Bounded)
 ------------------------------------------------------------------------
-api :: UserId -> NodeId -> GargServer API
+api :: UserId -> NodeId -> ServerT API (GargM Env GargError)
 api uId nId =
-  serveJobsAPI $
+  serveJobsAPI UpdateNodeJob $ \p log'' ->
-    JobFunction (\p log'' ->
      let
        log' x = do
          printDebug "updateNode" x
          liftBase $ log'' x
      in updateNode uId nId p (liftBase . log')
-      )
 updateNode :: (HasSettings env, FlowCmdM env err m)
    => UserId
@@ -105,16 +107,16 @@ updateNode :: (HasSettings env, FlowCmdM env err m)
    -> UpdateNodeParams
    -> (JobLog -> m ())
    -> m JobLog
-updateNode uId nId (UpdateNodeParamsGraph metric method strength) logStatus = do
+updateNode uId nId (UpdateNodeParamsGraph metric partitionMethod bridgeMethod strength nt1 nt2) logStatus = do
  logStatus JobLog { _scst_succeeded = Just 1
                   , _scst_failed    = Just 0
                   , _scst_remaining = Just 1
                   , _scst_events    = Just []
                   }
-  printDebug "Computing graph: " method
+  -- printDebug "Computing graph: " method
-  _ <- recomputeGraph uId nId method (Just metric) (Just strength) True
+  _ <- recomputeGraph uId nId partitionMethod bridgeMethod (Just metric) (Just strength) nt1 nt2 True
-  printDebug "Graph computed: " method
+  -- printDebug "Graph computed: " method
  pure  JobLog { _scst_succeeded = Just 2
               , _scst_failed    = Just 0
@@ -274,7 +276,7 @@ instance ToSchema  UpdateNodeParams
 instance Arbitrary UpdateNodeParams where
  arbitrary = do
    l <- UpdateNodeParamsList  <$> arbitrary
-    g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary
+    g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
    t <- UpdateNodeParamsTexts <$> arbitrary
    b <- UpdateNodeParamsBoard <$> arbitrary
    elements [l,g,t,b]

--- a/src/Gargantext/API/Prelude.hs
+++ b/src/Gargantext/API/Prelude.hs
@@ -40,6 +40,7 @@ import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
 import Gargantext.Database.Query.Tree
 import Gargantext.Prelude
+import qualified Gargantext.Utils.Jobs.Monad as Jobs
 import Servant
 import Servant.Job.Async
 import Servant.Job.Core (HasServerError(..), serverError)
@@ -108,6 +109,7 @@ data GargError
  | GargInvalidError Validation
  | GargJoseError    Jose.Error
  | GargServerError  ServerError
+  | GargJobError     Jobs.JobError
  deriving (Show, Typeable)
 makePrisms ''GargError

--- a/src/Gargantext/API/Routes.hs
+++ b/src/Gargantext/API/Routes.hs
@@ -25,11 +25,11 @@ import Data.Validity
 import Servant
 import Servant.Auth as SA
 import Servant.Auth.Swagger ()
-import Servant.Job.Async
 import Servant.Swagger.UI
 import Gargantext.API.Admin.Auth (ForgotPasswordAPI, ForgotPasswordAsyncAPI, withAccess)
 import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, AuthenticatedUser(..), PathId(..))
+import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
 import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
 import Gargantext.API.Context
 import Gargantext.API.Count  (CountAPI, count, Query)
@@ -44,6 +44,7 @@ import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (HasConfig(..))
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (gc_max_docs_scrapers)
+import Gargantext.Utils.Jobs (serveJobsAPI)
 import qualified Gargantext.API.GraphQL                    as GraphQL
 import qualified Gargantext.API.Ngrams.List                as List
 import qualified Gargantext.API.Node.Contact               as Contact
@@ -219,7 +220,8 @@ serverGargAdminAPI =  roots
                 :<|> nodesAPI
-serverPrivateGargAPI' :: AuthenticatedUser -> GargServer GargPrivateAPI'
+serverPrivateGargAPI'
+  :: AuthenticatedUser -> ServerT GargPrivateAPI' (GargM Env GargError)
 serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
       =  serverGargAdminAPI
     :<|> nodeAPI     (Proxy :: Proxy HyperdataAny)      uid
@@ -272,47 +274,35 @@ waitAPI n = do
  pure $ "Waited: " <> (cs $ show n)
 ----------------------------------------
-addCorpusWithQuery :: User -> GargServer New.AddWithQuery
+addCorpusWithQuery :: User -> ServerT New.AddWithQuery (GargM Env GargError)
 addCorpusWithQuery user cid =
-  serveJobsAPI $
+  serveJobsAPI AddCorpusQueryJob $ \q log' -> do
-    JobFunction (\q log' -> do
+    limit <- view $ hasConfig . gc_max_docs_scrapers
-      limit <- view $ hasConfig . gc_max_docs_scrapers
+    New.addToCorpusWithQuery user cid q (Just limit) (liftBase . log')
-      New.addToCorpusWithQuery user cid q (Just limit) (liftBase . log')
      {- let log' x = do
        printDebug "addToCorpusWithQuery" x
        liftBase $ log x
      -}
-      )
-{-
+addCorpusWithForm :: User -> ServerT New.AddWithForm (GargM Env GargError)
-addWithFile :: GargServer New.AddWithFile
-addWithFile cid i f =
-  serveJobsAPI $
-    JobFunction (\_i log -> New.addToCorpusWithFile cid i f (liftBase . log))
-}
-addCorpusWithForm :: User -> GargServer New.AddWithForm
 addCorpusWithForm user cid =
-  serveJobsAPI $
+  serveJobsAPI AddCorpusFormJob $ \i log' ->
-    JobFunction (\i log' ->
      let
        log'' x = do
          printDebug "[addToCorpusWithForm] " x
          liftBase $ log' x
-      in New.addToCorpusWithForm user cid i log'' (jobLogInit 3))
+      in New.addToCorpusWithForm user cid i log'' (jobLogInit 3)
-addCorpusWithFile :: User -> GargServer New.AddWithFile
+addCorpusWithFile :: User -> ServerT New.AddWithFile (GargM Env GargError)
 addCorpusWithFile user cid =
-  serveJobsAPI $
+  serveJobsAPI AddCorpusFileJob $ \i log' ->
-    JobFunction (\i log' ->
      let
        log'' x = do
          printDebug "[addToCorpusWithFile]" x
          liftBase $ log' x
-      in New.addToCorpusWithFile user cid i log'')
+      in New.addToCorpusWithFile user cid i log''
-addAnnuaireWithForm :: GargServer Annuaire.AddWithForm
+addAnnuaireWithForm :: ServerT Annuaire.AddWithForm (GargM Env GargError)
 addAnnuaireWithForm cid =
-  serveJobsAPI $
+  serveJobsAPI AddAnnuaireFormJob $ \i log' ->
-    JobFunction (\i log' -> Annuaire.addToAnnuaireWithForm cid i (liftBase . log'))
+    Annuaire.addToAnnuaireWithForm cid i (liftBase . log')
--- a/src/Gargantext/API/Server.hs
+++ b/src/Gargantext/API/Server.hs
@@ -17,7 +17,6 @@ module Gargantext.API.Server where
 import Control.Lens ((^.))
 import Control.Monad.Except (withExceptT)
 import Control.Monad.Reader (runReaderT)
-import Data.Aeson
 import Data.Text (Text)
 import Data.Version (showVersion)
 import Servant
@@ -29,6 +28,7 @@ import qualified Gargantext.API.Public      as Public
 import Gargantext.API.Admin.Auth.Types (AuthContext)
 import Gargantext.API.Admin.Auth (auth, forgotPassword, forgotPasswordAsync)
+import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Admin.FrontEnd (frontEndServer)
 import qualified Gargantext.API.GraphQL as GraphQL
 import Gargantext.API.Prelude
@@ -41,7 +41,7 @@ import Gargantext.Prelude
 import Gargantext.Prelude.Config (gc_url_backend_api)
-serverGargAPI :: ToJSON err => Text -> GargServerM env err GargAPI
+serverGargAPI :: Text -> ServerT GargAPI (GargM Env GargError)
 serverGargAPI baseUrl -- orchestrator
       =  auth
     :<|> forgotPassword
@@ -56,7 +56,7 @@ serverGargAPI baseUrl -- orchestrator
    gargVersion = pure (cs $ showVersion PG.version)
 -- | Server declarations
-server :: forall env. (Typeable env, EnvC env) => env -> IO (Server API)
+server :: Env -> IO (Server API)
 server env = do
  -- orchestrator <- scrapyOrchestrator env
  pure $  swaggerSchemaUIServer swaggerDoc
@@ -72,7 +72,7 @@ server env = do
            GraphQL.api
     :<|> frontEndServer
  where
-    transform :: forall a. GargM env GargError a -> Handler a
+    transform :: forall a. GargM Env GargError a -> Handler a
    transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)

--- a/src/Gargantext/API/Table.hs
+++ b/src/Gargantext/API/Table.hs
@@ -61,6 +61,7 @@ type TableApi = Summary "Table API"
              :> QueryParam "offset" Int
              :> QueryParam "orderBy" OrderBy
              :> QueryParam "query" Text
+              :> QueryParam "year" Text
              :> Get    '[JSON] (HashedResponse FacetTableResult)
            :<|> Summary "Table API (POST)"
              :> ReqBody '[JSON] TableQuery
@@ -106,14 +107,16 @@ getTableApi :: NodeId
            -> Maybe Int
            -> Maybe OrderBy
            -> Maybe Text
+            -> Maybe Text
            -> Cmd err (HashedResponse FacetTableResult)
-getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery = do
+getTableApi cId tabType _mListId mLimit mOffset mOrderBy mQuery mYear = do
  printDebug "[getTableApi] mQuery" mQuery
-  t <- getTable cId tabType mOffset mLimit mOrderBy mQuery
+  printDebug "[getTableApi] mYear" mYear
+  t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
  pure $ constructHashedResponse t
 postTableApi :: NodeId -> TableQuery -> Cmd err FacetTableResult
-postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing
+postTableApi cId (TableQuery o l order ft "") = getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing Nothing
 postTableApi cId (TableQuery o l order ft q) = case ft of
      Docs  -> searchInCorpus' cId False [q] (Just o) (Just l) (Just order)
      Trash -> searchInCorpus' cId True [q] (Just o) (Just l) (Just order)
@@ -121,7 +124,7 @@ postTableApi cId (TableQuery o l order ft q) = case ft of
 getTableHashApi :: NodeId -> Maybe TabType -> Cmd err Text
 getTableHashApi cId tabType = do
-  HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing
+  HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing Nothing
  pure h
 searchInCorpus' :: CorpusId
@@ -143,10 +146,11 @@ getTable :: NodeId
         -> Maybe Limit
         -> Maybe OrderBy
         -> Maybe Text
+         -> Maybe Text
         -> Cmd err FacetTableResult
-getTable cId ft o l order query = do
+getTable cId ft o l order query year = do
-  docs      <- getTable' cId ft o l order query
+  docs      <- getTable' cId ft o l order query year
-  docsCount <- runCountDocuments cId (ft == Just Trash) query
+  docsCount <- runCountDocuments cId (ft == Just Trash) query year
  pure $ TableResult { tr_docs = docs, tr_count = docsCount }
 getTable' :: NodeId
@@ -155,11 +159,12 @@ getTable' :: NodeId
          -> Maybe Limit
          -> Maybe OrderBy
          -> Maybe Text
+          -> Maybe Text
          -> Cmd err [FacetDoc]
-getTable' cId ft o l order query =
+getTable' cId ft o l order query year =
  case ft of
-    (Just Docs)      -> runViewDocuments cId False o l order query
+    (Just Docs)      -> runViewDocuments cId False o l order query year 
-    (Just Trash)     -> runViewDocuments cId True  o l order query
+    (Just Trash)     -> runViewDocuments cId True  o l order query year
    (Just MoreFav)   -> moreLike cId o l order IsFav
    (Just MoreTrash) -> moreLike cId o l order IsTrash
    x     -> panic $ "not implemented in getTable: " <> (cs $ show x)

--- a/src/Gargantext/API/ThrowAll.hs
+++ b/src/Gargantext/API/ThrowAll.hs
@@ -18,12 +18,12 @@ module Gargantext.API.ThrowAll where
 import Control.Monad.Except (MonadError(..))
 import Control.Lens ((#))
-import Data.Aeson
 import Servant
 import Servant.Auth.Server (AuthResult(..))
 import Gargantext.Prelude
-import Gargantext.API.Prelude (GargServerM, _ServerError)
+import Gargantext.API.Admin.EnvTypes (Env)
+import Gargantext.API.Prelude
 import Gargantext.API.Routes (GargPrivateAPI, serverPrivateGargAPI')
 class ThrowAll' e a | a -> e where
@@ -46,7 +46,8 @@ instance {-# OVERLAPPING #-} ThrowAll' e b => ThrowAll' e (a -> b) where
 instance {-# OVERLAPPABLE #-} (MonadError e m) => ThrowAll' e (m a) where
  throwAll' = throwError
-serverPrivateGargAPI :: ToJSON err => GargServerM env err GargPrivateAPI
+serverPrivateGargAPI
+  :: ServerT GargPrivateAPI (GargM Env GargError)
 serverPrivateGargAPI (Authenticated auser) = serverPrivateGargAPI' auser
 serverPrivateGargAPI _                     = throwAll' (_ServerError # err401)
 -- Here throwAll' requires a concrete type for the monad.
--- a/src/Gargantext/Core/Mail.hs
+++ b/src/Gargantext/Core/Mail.hs
@@ -17,7 +17,7 @@ import Data.Text (Text, unlines, splitOn)
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Schema.User (UserLight(..))
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (gc_url)
+import Gargantext.Prelude.Config (gc_url, gc_backend_name)
 import Gargantext.Database.Prelude
 -- import Gargantext.Prelude.Config (gc_url)
 import Gargantext.Prelude.Mail (gargMail, GargMail(..))
@@ -34,7 +34,9 @@ data SendEmail    = SendEmail Bool
 type EmailAddress  = Text
 type Name          = Text
-type ServerAddress = Text
+data ServerAddress = ServerAddress { sa_name :: Text
+                                   , sa_url  :: Text
+                                   }
 data MailModel = Invitation { invitation_user :: NewUser GargPassword }
               | PassUpdate { passUpdate_user :: NewUser GargPassword }
@@ -50,7 +52,7 @@ mail mailCfg model = do
  let
    (m,u)   = email_to         model
    subject = email_subject    model
-    body    = emailWith (view gc_url cfg)    model
+    body    = emailWith (ServerAddress (view gc_backend_name cfg) (view gc_url cfg)) model
  liftBase $ gargMail mailCfg (GargMail { gm_to = m
                                        , gm_name = Just u
                                        , gm_subject = subject
@@ -76,14 +78,14 @@ email_to' (NewUser u m _) = (m,u)
 ------------------------------------------------------------------------
 bodyWith :: ServerAddress -> MailModel -> [Text]
-bodyWith server (Invitation u) = [ "Congratulation, you have been granted a user account to test the"
+bodyWith server@(ServerAddress name _url) (Invitation u) = [ "Congratulation, you have been granted a user account to test the"
-                                 , "new GarganText platform!"
+                                 , "new GarganText platform called " <> name <> " !"
                                 ] <> (email_credentials server u)
 bodyWith server (PassUpdate u) = [ "Your account password have been updated on the GarganText platform!"
                                 ] <> (email_credentials server u)
-bodyWith server (MailInfo _ _) = [ "Your last analysis is over on the server: " <> server]
+bodyWith (ServerAddress _ url) (MailInfo _ _) = [ "Your last analysis is over on the server: " <> url]
 bodyWith _server (ForgotPassword { user = UserLight { userLight_forgot_password_uuid = Nothing }}) =
  [ "Cannot send you link to forgot password, no UUID" ]
 bodyWith server (ForgotPassword { user = UserLight { userLight_forgot_password_uuid = Just uuid }}) =
@@ -91,7 +93,7 @@ bodyWith server (ForgotPassword { user = UserLight { userLight_forgot_password_u
  , forgot_password_link server uuid ]
 forgot_password_link :: ServerAddress -> Text -> Text
-forgot_password_link server uuid = server <> "/#/forgotPassword?uuid=" <> uuid <> "&server=" <> encodeText server
+forgot_password_link (ServerAddress _ server) uuid = server <> "/#/forgotPassword?uuid=" <> uuid <> "&server=" <> encodeText server
 ------------------------------------------------------------------------
 email_subject :: MailModel -> Text
@@ -102,7 +104,7 @@ email_subject (ForgotPassword _) = "[GarganText] Forgot Password"
 email_credentials :: ServerAddress -> NewUser GargPassword -> [Text]
-email_credentials server (NewUser u _ (GargPassword p)) =
+email_credentials (ServerAddress _ server) (NewUser u _ (GargPassword p)) =
          [ ""
          , "You can log in to: " <> server
          , "Your username is: "  <> u
@@ -113,22 +115,20 @@ email_credentials server (NewUser u _ (GargPassword p)) =
 email_disclaimer :: [Text]
 email_disclaimer =
            [ ""
-            , "If you log in you agree with the following terms of use:"
-            , "          https://gitlab.iscpif.fr/humanities/tofu/tree/master"
-            , ""
-            , ""
            , "/!\\ Please note that your account is opened for beta tester only. Hence"
            , "we cannot guarantee neither the perenniality nor the stability of the"
            , "service at this stage. It is therefore advisable to back up important"
            , "data regularly."
            , ""
-            , "/!\\ Gargantext is an academic service supported by ISC-PIF partners."
+            , "/!\\ Gargantext is an academic service supported by CNRS/ISC-PIF partners."
            , "In case of congestion on this service, access to members of the ISC-PIF"
            , "partners will be privileged."
            , ""
+            , "If you log in you agree with the following terms of use:"
+            , "     https://gitlab.iscpif.fr/humanities/tofu/tree/master"
+            , ""
            , "Your feedback will be valuable for further development of the platform,"
            , "do not hesitate to contact us and to contribute on our forum:"
-            , ""
            , "     https://discourse.iscpif.fr/c/gargantext"
            , ""
            ]

--- a/src/Gargantext/Core/Methods/Graph/MaxClique.hs
+++ b/src/Gargantext/Core/Methods/Graph/MaxClique.hs
@@ -62,7 +62,7 @@ import Data.Set (fromList, toList, isSubsetOf)
 import Data.Graph.Inductive hiding (Graph, neighbors, subgraph, (&))
 import Gargantext.Core.Viz.Graph.FGL (Graph_Undirected, degree, neighbors, mkGraphUfromEdges)
 import Gargantext.Core.Viz.Graph.Tools (cooc2graph',cooc2graph'', Threshold)
-import Gargantext.Core.Methods.Distances (Distance)
+import Gargantext.Core.Methods.Similarities (Similarity)
 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex)
 import Gargantext.Core.Viz.Phylo
 -- import Debug.Trace (trace)
@@ -70,9 +70,9 @@ type Graph = Graph_Undirected
 type Neighbor = Node
 -- | getMaxCliques
-- TODO chose distance order
+-- TODO chose similarity order
-getMaxCliques :: Ord a => MaxCliqueFilter -> Distance -> Threshold -> Map (a, a) Int -> [[a]]
+getMaxCliques :: Ord a => MaxCliqueFilter -> Similarity -> Threshold -> Map (a, a) Int -> [[a]]
 getMaxCliques f d t m = map fromIndices $ getMaxCliques' t m'
  where
    m'          = toIndex to m

--- a/src/Gargantext/Core/Methods/Distances.hs
+++ b/src/Gargantext/Core/Methods/Distances.hs
 {-|
-Module      : Gargantext.Graph.Distances
+Module      : Gargantext.Graph.Similarities
-Description : Distance management tools
+Description : Similarity management tools
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
@@ -11,32 +11,32 @@ Portability : POSIX
 {-# LANGUAGE Strict            #-}
-module Gargantext.Core.Methods.Distances
+module Gargantext.Core.Methods.Similarities
  where
 import Data.Aeson
 import Data.Array.Accelerate (Matrix)
 import Data.Swagger
 import GHC.Generics (Generic)
-import Gargantext.Core.Methods.Distances.Accelerate.Conditional (measureConditional)
+import Gargantext.Core.Methods.Similarities.Accelerate.Conditional (measureConditional)
-import Gargantext.Core.Methods.Distances.Accelerate.Distributional (logDistributional)
+import Gargantext.Core.Methods.Similarities.Accelerate.Distributional (logDistributional)
 import Gargantext.Prelude (Ord, Eq, Int, Double, Show)
 import Prelude (Enum, Bounded, minBound, maxBound)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 ------------------------------------------------------------------------
-data Distance = Conditional | Distributional
+data Similarity = Conditional | Distributional
  deriving (Show, Eq)
-measure :: Distance -> Matrix Int -> Matrix Double
+measure :: Similarity -> Matrix Int -> Matrix Double
 measure Conditional    x = measureConditional x
 measure Distributional x = y
  where
    y = logDistributional x
 ------------------------------------------------------------------------
-withMetric :: GraphMetric -> Distance
+withMetric :: GraphMetric -> Similarity
 withMetric Order1 = Conditional
 withMetric Order2 = Distributional

--- a/src/Gargantext/Core/Methods/Distances/Accelerate/Conditional.hs
+++ b/src/Gargantext/Core/Methods/Distances/Accelerate/Conditional.hs
 {-|
-Module      : Gargantext.Core.Methods.Distances.Accelerate.Conditional
+Module      : Gargantext.Core.Methods.Similarities.Accelerate.Conditional
 Description : 
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -20,7 +20,7 @@ See Gargantext.Core.Methods.Graph.Accelerate)
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns        #-}
-module Gargantext.Core.Methods.Distances.Accelerate.Conditional
+module Gargantext.Core.Methods.Similarities.Accelerate.Conditional
  where
 -- import qualified Data.Foldable as P (foldl1)
@@ -28,7 +28,7 @@ module Gargantext.Core.Methods.Distances.Accelerate.Conditional
 import Data.Array.Accelerate
 import Data.Array.Accelerate.Interpreter (run)
 import Gargantext.Core.Methods.Matrix.Accelerate.Utils
-import Gargantext.Core.Methods.Distances.Accelerate.SpeGen
+import Gargantext.Core.Methods.Similarities.Accelerate.SpeGen
 import qualified Gargantext.Prelude as P

--- a/src/Gargantext/Core/Methods/Distances/Accelerate/Distributional.hs
+++ b/src/Gargantext/Core/Methods/Distances/Accelerate/Distributional.hs
 {-|
-Module      : Gargantext.Core.Methods.Distances.Accelerate.Distributional
+Module      : Gargantext.Core.Methods.Similarities.Accelerate.Distributional
 Description :
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -8,7 +8,7 @@ Stability   : experimental
 Portability : POSIX
-* Distributional Distance metric
+* Distributional Similarity metric
 __Definition :__ Distributional metric is a relative metric which depends on the
 selected list, it represents structural equivalence of mutual information.
@@ -41,7 +41,7 @@ where $n_{ij}$ is the cooccurrence between term $i$ and term $j$
 {-# LANGUAGE ViewPatterns        #-}
 {-# LANGUAGE GADTs               #-}
-module Gargantext.Core.Methods.Distances.Accelerate.Distributional
+module Gargantext.Core.Methods.Similarities.Accelerate.Distributional
  where
 -- import qualified Data.Foldable as P (foldl1)

--- a/src/Gargantext/Core/Methods/Distances/Accelerate/SpeGen.hs
+++ b/src/Gargantext/Core/Methods/Distances/Accelerate/SpeGen.hs
 {-|
-Module      : Gargantext.Core.Methods.Distances.Accelerate.SpeGen
+Module      : Gargantext.Core.Methods.Similarities.Accelerate.SpeGen
 Description : 
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -20,7 +20,7 @@ See Gargantext.Core.Methods.Graph.Accelerate)
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns        #-}
-module Gargantext.Core.Methods.Distances.Accelerate.SpeGen
+module Gargantext.Core.Methods.Similarities.Accelerate.SpeGen
  where
 -- import qualified Data.Foldable as P (foldl1)

--- a/src/Gargantext/Core/Methods/Distances/Conditional.hs
+++ b/src/Gargantext/Core/Methods/Distances/Conditional.hs
 {-|
-Module      : Gargantext.Core.Methods.Distances
+Module      : Gargantext.Core.Methods.Similarities
 Description : 
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -12,7 +12,7 @@ Motivation and definition of the @Conditional@ distance.
 {-# LANGUAGE BangPatterns      #-}
 {-# LANGUAGE Strict            #-}
-module Gargantext.Core.Methods.Distances.Conditional
+module Gargantext.Core.Methods.Similarities.Conditional
  where
 import Control.DeepSeq (NFData)

--- a/src/Gargantext/Core/Methods/Distances/Distributional.hs
+++ b/src/Gargantext/Core/Methods/Distances/Distributional.hs
 {-|
-Module      : Gargantext.Core.Methods.Distances.Distributional
+Module      : Gargantext.Core.Methods.Similarities.Distributional
 Description :
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
@@ -14,7 +14,7 @@ Motivation and definition of the @Distributional@ distance.
 {-# LANGUAGE Strict            #-}
-module Gargantext.Core.Methods.Distances.Distributional
+module Gargantext.Core.Methods.Similarities.Distributional
  where
 import Data.Matrix hiding (identity)

--- a/src/Gargantext/Core/NodeStory.hs
+++ b/src/Gargantext/Core/NodeStory.hs
@@ -455,7 +455,7 @@ insertArchiveList c nodeId a = do
  where
    query :: PGS.Query
    query = [sql| INSERT INTO node_stories(node_id, version, ngrams_type_id, ngrams_id, ngrams_repo_element)
-                    SELECT ?, ?, ?, ngrams.id, ? FROM ngrams WHERE terms = ? |]
+                    SELECT * WHERE EXISTS (SELECT ?, ?, ?, ngrams.id, ? FROM ngrams WHERE terms = ?) |]
 deleteArchiveList :: PGS.Connection -> NodeId -> ArchiveList -> IO ()
 deleteArchiveList c nodeId a = do

--- a/src/Gargantext/Core/Text/Metrics.hs
+++ b/src/Gargantext/Core/Text/Metrics.hs
@@ -23,7 +23,7 @@ import Data.Map (Map)
 import Data.Monoid (Monoid, mempty)
 import Data.HashMap.Strict (HashMap)
 import Data.Semigroup (Semigroup)
-import Gargantext.Core.Methods.Distances.Accelerate.SpeGen
+import Gargantext.Core.Methods.Similarities.Accelerate.SpeGen
 import Gargantext.Core.Statistics (pcaReduceTo, Dimension(..))
 import Gargantext.Core.Viz.Graph.Index
 import Gargantext.Prelude

--- a/src/Gargantext/Core/Text/Metrics/CharByChar.hs
+++ b/src/Gargantext/Core/Text/Metrics/CharByChar.hs
@@ -39,7 +39,7 @@ import Gargantext.Prelude
 -- starting as an API rexporting main functions of the great lib
 -- text-metrics of Mark Karpov
-- | Levenshtein Distance
+-- | Levenshtein Similarity
 -- In information theory, Linguistics and computer science, 
 -- the Levenshtein distance is a string metric for measuring 
 -- the difference between two sequences.
@@ -86,7 +86,7 @@ overlap = DTM.overlap
 jaccard :: Text -> Text -> Ratio Int
 jaccard = DTM.jaccard
-- | Hamming Distance
+-- | Hamming Similarity
 -- In information theory, the Hamming distance between two strings of
 -- equal length is the number of positions at which the corresponding
 -- symbols are different. In other words, it measures the minimum number of

--- a/src/Gargantext/Core/Viz/Graph.hs
+++ b/src/Gargantext/Core/Viz/Graph.hs
--- a/src/Gargantext/Core/Viz/Graph/API.hs
+++ b/src/Gargantext/Core/Viz/Graph/API.hs
@@ -23,10 +23,11 @@ import Data.Swagger
 import Data.Text hiding (head)
 import Debug.Trace (trace)
 import GHC.Generics (Generic)
+import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Prelude
-import Gargantext.Core.Methods.Distances (Distance(..), GraphMetric(..), withMetric)
+import Gargantext.Core.Methods.Similarities (Similarity(..), GraphMetric(..), withMetric)
 import Gargantext.Core.NodeStory
 import Gargantext.Core.Types.Main
 import Gargantext.Core.Viz.Graph
@@ -46,8 +47,9 @@ import Gargantext.Database.Query.Table.Node.User (getNodeUser)
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Prelude
+import Gargantext.Utils.Jobs (serveJobsAPI)
 import Servant
-import Servant.Job.Async
+import Servant.Job.Async (AsyncJobsAPI)
 import Servant.XML
 import qualified Data.HashMap.Strict as HashMap
@@ -72,7 +74,7 @@ instance FromJSON GraphVersions
 instance ToJSON GraphVersions
 instance ToSchema GraphVersions
-graphAPI :: UserId -> NodeId -> GargServer GraphAPI
+graphAPI :: UserId -> NodeId -> ServerT GraphAPI (GargM Env GargError)
 graphAPI u n = getGraph         u n
          :<|> graphAsync       u n
          :<|> graphClone       u n
@@ -99,13 +101,14 @@ getGraph _uId nId = do
  listId <- defaultList cId
  repo <- getRepo [listId]
-  -- TODO Distance in Graph params
+  -- TODO Similarity in Graph params
  case graph of
    Nothing     -> do
        let defaultMetric          = Order1
        let defaultPartitionMethod = Spinglass
        let defaultEdgesStrength   = Strong
-        graph' <- computeGraph cId defaultPartitionMethod (withMetric defaultMetric) defaultEdgesStrength NgramsTerms repo
+        let defaultBridgenessMethod = BridgenessMethod_Basic
+        graph' <- computeGraph cId defaultPartitionMethod defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
        mt     <- defaultGraphMetadata cId "Title" repo defaultMetric defaultEdgesStrength
        let
          graph'' = set graph_metadata (Just mt) graph'
@@ -123,20 +126,23 @@ recomputeGraph :: FlowCmdM env err m
               => UserId
               -> NodeId
               -> PartitionMethod
+               -> BridgenessMethod
               -> Maybe GraphMetric
               -> Maybe Strength
+               -> NgramsType
+               -> NgramsType
               -> Bool
               -> m Graph
-recomputeGraph _uId nId method maybeDistance maybeStrength force = do
+recomputeGraph _uId nId partitionMethod bridgeMethod maybeSimilarity maybeStrength nt1 nt2 force = do
  nodeGraph <- getNodeWith nId (Proxy :: Proxy HyperdataGraph)
  let
    graph  = nodeGraph ^. node_hyperdata . hyperdataGraph
    camera = nodeGraph ^. node_hyperdata . hyperdataCamera
    graphMetadata = graph ^? _Just . graph_metadata . _Just
    listVersion   = graph ^? _Just . graph_metadata . _Just . gm_list . lfg_version
-    graphMetric   = case maybeDistance of
+    graphMetric   = case maybeSimilarity of
                      Nothing -> graph ^? _Just . graph_metadata . _Just . gm_metric
-                      _       -> maybeDistance
+                      _       -> maybeSimilarity
    similarity = case graphMetric of
                   Nothing -> withMetric Order1
                   Just m  -> withMetric m
@@ -155,14 +161,14 @@ recomputeGraph _uId nId method maybeDistance maybeStrength force = do
  let v   = repo ^. unNodeStory . at listId . _Just . a_version
  let computeG mt = do
-        !g <- computeGraph cId method similarity strength NgramsTerms repo
+        !g <- computeGraph cId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo
        let g' = set graph_metadata mt g
        _nentries <- updateHyperdata nId (HyperdataGraph (Just g') camera)
        pure g'
  case graph of
    Nothing     -> do
-      mt     <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeDistance) strength
+      mt     <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeSimilarity) strength
      g <- computeG $ Just mt
      pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" g
    Just graph' -> if (listVersion == Just v) && (not force)
@@ -172,34 +178,54 @@ recomputeGraph _uId nId method maybeDistance maybeStrength force = do
                       pure $ trace "[G.V.G.API] Graph exists, recomputing" g
+-- TODO remove repo
 computeGraph :: FlowCmdM env err m
             => CorpusId
             -> PartitionMethod
-             -> Distance
+             -> BridgenessMethod
+             -> Similarity
             -> Strength
-             -> NgramsType
+             -> (NgramsType, NgramsType)
             -> NodeListStory
             -> m Graph
-computeGraph cId method d strength nt repo = do
+computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo = do
-  lId  <- defaultList cId
+  -- Getting the Node parameters
+  lId  <- defaultList corpusId
  lIds <- selectNodesWithUsername NodeList userMaster
-  let ngs = filterListWithRoot [MapTerm]
-          $ mapTermListRoot [lId] nt repo
-  !myCooc <- HashMap.filter (>1) -- Removing the hapax (ngrams with 1 cooc)
-         <$> getCoocByNgrams (Diagonal True)
-         <$> groupNodesByNgrams ngs
-         <$> getContextsByNgramsOnlyUser cId (lIds <> [lId]) nt (HashMap.keys ngs)
-  graph <- liftBase $ cooc2graphWith method d 0 strength myCooc
+  -- Getting the Ngrams to compute with and grouping it according to the lists
+  let 
-  --listNgrams <- getListNgrams [lId] nt
+    groupedContextsByNgrams nt corpusId' (lists_master, lists_user) = do
-  --let graph' = mergeGraphNgrams graph (Just listNgrams)
+      let
-  -- saveAsFileDebug "/tmp/graphWithNodes" graph'
+        ngs = filterListWithRoot [MapTerm] $ mapTermListRoot lists_user nt repo
+      groupNodesByNgrams ngs <$> getContextsByNgramsOnlyUser corpusId'
+                                     (lists_user <> lists_master) nt (HashMap.keys ngs)
+  -- Optim if nt1 == nt2 : do not compute twice
+  (m1,m2) <- do
+    m1 <- groupedContextsByNgrams nt1 corpusId (lIds, [lId])
+    if nt1 == nt2
+      then 
+        pure (m1,m1)
+      else do
+        m2 <- groupedContextsByNgrams nt2 corpusId (lIds, [lId])
+        pure (m1,m2)
+            -- Removing the hapax (ngrams with 1 cooc)
+  let !myCooc = HashMap.filter (>1)
+              $ getCoocByNgrams'' (Diagonal True) (identity, identity) (m1,m2)
+  -- TODO MultiPartite Here
+  graph <- liftBase
+        $ cooc2graphWith partitionMethod bridgeMethod (MultiPartite (Partite (HashMap.keysSet m1) nt1)
+                                              (Partite (HashMap.keysSet m2) nt2)
+                                              )
+                                similarity 0 strength myCooc
  pure graph
 defaultGraphMetadata :: HasNodeError err
                     => CorpusId
                     -> Text
@@ -231,16 +257,17 @@ type GraphAsyncAPI = Summary "Recompute graph"
                     :> AsyncJobsAPI JobLog () JobLog
-graphAsync :: UserId -> NodeId -> GargServer GraphAsyncAPI
+graphAsync :: UserId -> NodeId -> ServerT GraphAsyncAPI (GargM Env GargError)
 graphAsync u n =
-  serveJobsAPI $
+  serveJobsAPI RecomputeGraphJob $ \_ log' ->
-    JobFunction (\_ log' -> graphRecompute u n (liftBase . log'))
+    graphRecompute u n (liftBase . log')
 --graphRecompute :: UserId
 --               -> NodeId
 --               -> (JobLog -> GargNoServer ())
 --               -> GargNoServer JobLog
+-- TODO get Graph Metadata to recompute
 graphRecompute :: FlowCmdM env err m
               => UserId
               -> NodeId
@@ -252,7 +279,7 @@ graphRecompute u n logStatus = do
                   , _scst_remaining = Just 1
                   , _scst_events    = Just []
                   }
-  _g <- recomputeGraph u n Spinglass Nothing Nothing False
+  _g <- recomputeGraph u n Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
  pure  JobLog { _scst_succeeded = Just 1
               , _scst_failed    = Just 0
               , _scst_remaining = Just 0
@@ -307,7 +334,7 @@ recomputeVersions :: FlowCmdM env err m
                  => UserId
                  -> NodeId
                  -> m Graph
-recomputeVersions uId nId = recomputeGraph uId nId Spinglass Nothing Nothing False
+recomputeVersions uId nId = recomputeGraph uId nId Spinglass BridgenessMethod_Basic Nothing Nothing NgramsTerms NgramsTerms False
 ------------------------------------------------------------
 graphClone :: UserId

--- a/src/Gargantext/Core/Viz/Graph/Bridgeness.hs
+++ b/src/Gargantext/Core/Viz/Graph/Bridgeness.hs
@@ -7,62 +7,83 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
-Let be a graph with partitions (from Louvain algo), Bridgeness uniformly
+Let be a graph Bridgeness filters inter-communities links in two ways.
+If the partitions are known, filtering is uniform to expose the communities clearly for the beginners.
+But 
+uniformly
 filters inter-communities links.
-TODO rewrite Bridgeness with "equivalence structurale" metrics (Confluence)
 TODO use Map LouvainNodeId (Map LouvainNodeId)
 -}
+{-# LANGUAGE BangPatterns #-}
 module Gargantext.Core.Viz.Graph.Bridgeness -- (bridgeness)
  where
-import Data.List (concat, sortOn)
+import Gargantext.Core.Methods.Similarities (Similarity(..))
+-- import Data.IntMap (IntMap)
 import Data.Map (Map, fromListWith, lookup, toList, mapWithKey, elems)
 import Data.Maybe (catMaybes)
 import Data.Ord (Down(..))
+import Debug.Trace (trace)
 import Gargantext.Prelude
 import Graph.Types (ClusterNode(..))
-import qualified Data.Map as DM
+-- import qualified Data.IntMap as IntMap
+import qualified Data.List   as List
+import qualified Data.Map    as Map
+import qualified Data.Set    as Set
 ----------------------------------------------------------------------
-type Partitions a = Map (Int, Int) Double -> IO [a]
+type Partitions = Map (Int, Int) Double -> IO [ClusterNode]
 ----------------------------------------------------------------------
-class ToComId a where
+nodeId2comId :: ClusterNode -> (NodeId, CommunityId)
-  nodeId2comId :: a -> (NodeId,CommunityId)
+nodeId2comId (ClusterNode i1 i2) = (i1, i2)
 type NodeId        = Int
 type CommunityId   = Int
----------------------------------------------------------------------
-instance ToComId ClusterNode where
-  nodeId2comId (ClusterNode i1 i2) = (i1, i2)
 ----------------------------------------------------------------------
 ----------------------------------------------------------------------
-type Bridgeness = Double
+data Bridgeness = Bridgeness_Basic { bridgeness_partitions :: [ClusterNode]
+                                   , bridgeness_filter     :: Double
-bridgeness :: ToComId a => Bridgeness
+                                   }
-           -> [a]
+                | Bridgeness_Advanced { bridgeness_similarity :: Similarity
-           -> Map (NodeId, NodeId) Double
+                                      , bridgness_confluence  :: Confluence
-           -> Map (NodeId, NodeId) Double
+                                      }
-bridgeness = bridgeness' nodeId2comId
+type Confluence = Map (NodeId, NodeId) Double
-bridgeness' :: (a -> (Int, Int))
-           -> Bridgeness
+bridgeness :: Bridgeness
-           -> [a]
+            -> Map (NodeId, NodeId) Double
-           -> Map (Int, Int) Double
+            -> Map (NodeId, NodeId) Double
-           -> Map (Int, Int) Double
+bridgeness (Bridgeness_Advanced sim c) m = Map.fromList
-bridgeness' f b ns = DM.fromList
+                $ map (\(ks, (v1,_v2)) -> (ks,v1))
-                   . concat
+                $ List.take (if sim == Conditional then 2*n else 3*n)
-                   . DM.elems
+                $ List.sortOn (Down . (snd . snd))
-                   . filterComs b
+                $ Map.toList
-                   . groupEdges (DM.fromList $ map f ns)
+                $ trace ("bridgeness3 m c" <> show (m,c)) $ Map.intersectionWithKey (\k v1 v2 -> trace ("intersectionWithKey " <> (show (k, v1, v2))) (v1, v2)) m c
+  where
+    !m' = Map.toList m
+    n :: Int
+    !n = trace ("bridgeness m size: " <> (show $ List.length m'))
+       $ round
+       $ (fromIntegral $ List.length m') / (log $ fromIntegral nodesNumber :: Double)
+    nodesNumber :: Int
+    nodesNumber = Set.size $ Set.fromList $ as <> bs
+      where
+        (as, bs) = List.unzip $ Map.keys m
+bridgeness (Bridgeness_Basic ns b) m = Map.fromList
+                                     $ List.concat
+                                     $ Map.elems
+                                     $ filterComs b
+                                     $ groupEdges (Map.fromList $ map nodeId2comId ns) m
 groupEdges :: (Ord a, Ord b1)
           => Map b1 a
@@ -71,7 +92,7 @@ groupEdges :: (Ord a, Ord b1)
 groupEdges m = fromListWith (<>)
             . catMaybes
             . map (\((n1,n2), d)
-                     -> let 
+                     -> let
                          n1n2_m = (,) <$> lookup n1 m <*> lookup n2 m
                          n1n2_d = Just [((n1,n2),d)]
                        in (,) <$> n1n2_m <*> n1n2_d
@@ -79,19 +100,57 @@ groupEdges m = fromListWith (<>)
             . toList
 -- | TODO : sortOn Confluence
-filterComs :: (Ord n1, Eq n2) 
+filterComs :: (Ord n1, Eq n2)
           => p
           -> Map (n2, n2) [(a3, n1)]
           -> Map (n2, n2) [(a3, n1)]
-filterComs _b m = DM.filter (\n -> length n > 0) $ mapWithKey filter' m
+filterComs _b m = Map.filter (\n -> length n > 0) $ mapWithKey filter' m
  where
    filter' (c1,c2) a
      | c1 == c2  = a
      -- TODO use n here
-      | otherwise = take 1 $ sortOn (Down . snd) a
+      | otherwise = take 1 $ List.sortOn (Down . snd) a
           where
            _n :: Int
            _n = round $ 100 * a' / t
            a'= fromIntegral $ length a
            t :: Double
-            t = fromIntegral $ length $ concat $ elems m
+            t = fromIntegral $ length $ List.concat $ elems m
+--------------------------------------------------------------
+-- Utils
+{--
+map2intMap :: Map (Int, Int) a -> IntMap (IntMap a)
+map2intMap m = IntMap.fromListWith (<>)
+             $ map (\((k1,k2), v) -> if k1 < k2
+                                   then (k1, IntMap.singleton k2 v)
+                                   else (k2, IntMap.singleton k1 v)
+                    )
+             $ Map.toList m
+look :: (Int,Int) -> IntMap (IntMap a) -> Maybe a
+look (k1,k2) m = if k1 < k2
+                    then case (IntMap.lookup k1 m) of
+                           Just m' -> IntMap.lookup k2 m'
+                           _       -> Nothing
+                    else look (k2,k1) m
+{-
+Compute the median of a list
+From:  https://hackage.haskell.org/package/dsp-0.2.5.1/docs/src/Numeric.Statistics.Median.html
+Compute the center of the list in a more lazy manner
+and thus halves memory requirement.
+-}
+median :: (Ord a, Fractional a) => [a] -> a
+median [] = panic "medianFast: empty list has no median"
+median zs =
+   let recurse (x0:_)    (_:[])   = x0
+       recurse (x0:x1:_) (_:_:[]) = (x0+x1)/2
+       recurse (_:xs)    (_:_:ys) = recurse xs ys
+       recurse _ _  =
+          panic "median: this error cannot occur in the way 'recurse' is called"
+   in  recurse zs zs
+-}
--- a/src/Gargantext/Core/Viz/Graph/Index.hs
+++ b/src/Gargantext/Core/Viz/Graph/Index.hs
 {-|
-Module      : Gargantext.Graph.Distances.Utils
+Module      : Gargantext.Graph.Similarities.Utils
 Description : Tools to compute distances from Cooccurrences
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3

--- a/src/Gargantext/Core/Viz/Graph/Tools.hs
+++ b/src/Gargantext/Core/Viz/Graph/Tools.hs
@@ -22,14 +22,15 @@ import Data.Swagger hiding (items)
 import GHC.Float (sin, cos)
 import GHC.Generics (Generic)
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
-import Gargantext.Core.Methods.Distances (Distance(..), measure)
+import Gargantext.Core.Methods.Similarities (Similarity(..), measure)
-import Gargantext.Core.Methods.Distances.Conditional (conditional)
+import Gargantext.Core.Methods.Similarities.Conditional (conditional)
 import Gargantext.Core.Statistics
 import Gargantext.Core.Viz.Graph
-import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Partitions, ToComId(..))
+import Gargantext.Core.Viz.Graph.Bridgeness (bridgeness, Bridgeness(..), Partitions, nodeId2comId)
 import Gargantext.Core.Viz.Graph.Index (createIndices, toIndex, map2mat, mat2map, Index, MatrixShape(..))
 import Gargantext.Core.Viz.Graph.Tools.IGraph (mkGraphUfromEdges, spinglass)
 import Gargantext.Core.Viz.Graph.Tools.Infomap (infomap)
+import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Core.Viz.Graph.Utils (edgesFilter, nodesFilter)
 import Gargantext.Prelude
 import Graph.Types (ClusterNode)
@@ -40,6 +41,7 @@ import qualified Data.HashMap.Strict      as HashMap
 import qualified Data.List                as List
 import qualified Data.Map                 as Map
 import qualified Data.Set                 as Set
+import qualified Data.HashSet             as HashSet
 import qualified Data.Text                as Text
 import qualified Data.Vector.Storable     as Vec
 import qualified Graph.BAC.ProxemyOptim   as BAC
@@ -55,6 +57,14 @@ instance ToSchema  PartitionMethod
 instance Arbitrary PartitionMethod where
  arbitrary = elements [ minBound .. maxBound ]
+data BridgenessMethod = BridgenessMethod_Basic | BridgenessMethod_Advanced
+    deriving (Generic, Eq, Ord, Enum, Bounded, Show)
+instance FromJSON  BridgenessMethod
+instance ToJSON    BridgenessMethod
+instance ToSchema  BridgenessMethod
+instance Arbitrary BridgenessMethod where
+  arbitrary = elements [ minBound .. maxBound ]
 -------------------------------------------------------------
 defaultClustering :: Map (Int, Int) Double -> IO [ClusterNode]
@@ -65,7 +75,7 @@ defaultClustering x = spinglass 1 x
 type Threshold = Double
-cooc2graph' :: Ord t => Distance
+cooc2graph' :: Ord t => Similarity
                     -> Double
                     -> Map (t, t) Int
                     -> Map (Index, Index) Double
@@ -87,26 +97,30 @@ cooc2graph' distance threshold myCooc
 -- coocurrences graph computation
 cooc2graphWith :: PartitionMethod
-               -> Distance
+               -> BridgenessMethod
+               -> MultiPartite
+               -> Similarity
               -> Threshold
               -> Strength
               -> HashMap (NgramsTerm, NgramsTerm) Int
               -> IO Graph
 cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
 cooc2graphWith Confluence= cooc2graphWith' (\x -> pure $ BAC.defaultClustering x)
-cooc2graphWith Infomap   = cooc2graphWith' (infomap "--silent --two-level -N2")
+cooc2graphWith Infomap   = cooc2graphWith' (infomap "-v -N2")
+--cooc2graphWith Infomap   = cooc2graphWith' (infomap "--silent --two-level -N2")
                        -- TODO: change these options, or make them configurable in UI?
-cooc2graphWith' :: ToComId a
+cooc2graphWith' :: Partitions
-               => Partitions a
+                -> BridgenessMethod
-               -> Distance
+                -> MultiPartite
-               -> Threshold
+                -> Similarity
-               -> Strength
+                -> Threshold
-               -> HashMap (NgramsTerm, NgramsTerm) Int
+                -> Strength
-               -> IO Graph
+                -> HashMap (NgramsTerm, NgramsTerm) Int
-cooc2graphWith' doPartitions distance threshold strength myCooc = do
+                -> IO Graph
-  let (distanceMap, diag, ti) = doDistanceMap distance threshold strength myCooc
+cooc2graphWith' doPartitions bridgenessMethod multi similarity threshold strength myCooc = do
+  let (distanceMap, diag, ti) = doSimilarityMap similarity threshold strength myCooc
  distanceMap `seq` diag `seq` ti `seq` return ()
 --{- -- Debug
@@ -122,19 +136,18 @@ cooc2graphWith' doPartitions distance threshold strength myCooc = do
                                , "Tutorial: link todo"
                                ]
  length partitions `seq` return ()
  let
-    nodesApprox :: Int
+    !confluence' = BAC.computeConfluences 3 (Map.keys distanceMap) True
-    nodesApprox = n'
+    !bridgeness' = if bridgenessMethod == BridgenessMethod_Basic
-      where
+                      then bridgeness (Bridgeness_Basic partitions 1.0) distanceMap
-        (as, bs) = List.unzip $ Map.keys distanceMap
+                      else bridgeness (Bridgeness_Advanced similarity confluence') distanceMap
-        n' = Set.size $ Set.fromList $ as <> bs
-    !bridgeness' = bridgeness (fromIntegral nodesApprox) partitions distanceMap
+  pure $ data2graph multi ti diag bridgeness' confluence' partitions
-    !confluence' = BAC.computeConfluences 3 (Map.keys bridgeness') True
-  pure $ data2graph ti diag bridgeness' confluence' partitions
 type Reverse = Bool
-doDistanceMap :: Distance
+doSimilarityMap :: Similarity
              -> Threshold
              -> Strength
              -> HashMap (NgramsTerm, NgramsTerm) Int
@@ -142,7 +155,7 @@ doDistanceMap :: Distance
                 , Map (Index, Index) Int
                 , Map NgramsTerm Index
                 )
-doDistanceMap Distributional threshold strength myCooc = (distanceMap, toIndex ti diag, ti)
+doSimilarityMap Distributional threshold strength myCooc = (distanceMap, toIndex ti diag, ti)
  where
    -- TODO remove below
    (diag, theMatrix) = Map.partitionWithKey (\(x,y) _ -> x == y)
@@ -168,11 +181,11 @@ doDistanceMap Distributional threshold strength myCooc = (distanceMap, toIndex t
                $ (\m -> m `seq` Map.filter (> threshold) m)
                $ similarities `seq` mat2map similarities
-doDistanceMap Conditional threshold strength myCooc = (distanceMap, toIndex ti myCooc', ti)
+doSimilarityMap Conditional threshold strength myCooc = (distanceMap, toIndex ti myCooc', ti)
  where
    myCooc' = Map.fromList $ HashMap.toList myCooc
    (ti, _it) = createIndices myCooc'
-    links = round (let n :: Double = fromIntegral (Map.size ti) in n * log n)
+    links = round (let n :: Double = fromIntegral (Map.size ti) in n * (log n)^(2::Int))
    distanceMap = toIndex ti
                $ Map.fromList
                $ List.take links
@@ -184,36 +197,45 @@ doDistanceMap Conditional threshold strength myCooc = (distanceMap, toIndex ti m
 ----------------------------------------------------------
 -- | From data to Graph
 type Occurrences      = Int
-data2graph :: ToComId a 
+nodeTypeWith :: MultiPartite -> NgramsTerm -> NgramsType
-           => Map NgramsTerm Int
+nodeTypeWith (MultiPartite (Partite s1 t1) (Partite _s2 t2)) t =
+  if HashSet.member t s1
+     then t1
+     else t2
+data2graph :: MultiPartite
+           -> Map NgramsTerm Int
           -> Map (Int, Int) Occurrences
           -> Map (Int, Int) Double
           -> Map (Int, Int) Double
-           -> [a]
+           -> [ClusterNode]
           -> Graph
-data2graph labels' occurences bridge conf partitions = Graph { _graph_nodes = nodes
+data2graph multi labels' occurences bridge conf partitions =
-                                                             , _graph_edges = edges
+  Graph { _graph_nodes = nodes
-                                                             , _graph_metadata = Nothing
+        , _graph_edges = edges
-                                                             }
+        , _graph_metadata = Nothing
-  where
+        }
+   where
    nodes = map (setCoord ForceAtlas labels bridge)
          [ (n, Node { node_size    = maybe 0 identity (Map.lookup (n,n) occurences)
-                     , node_type    = Terms -- or Unknown
+                     , node_type    = nodeTypeWith multi label
-                     , node_id      = cs (show n)
+                     , node_id      = (cs . show) n
-                     , node_label   = unNgramsTerm l
+                     , node_label   = unNgramsTerm label
                     , node_x_coord = 0
                     , node_y_coord = 0
-                     , node_attributes = Attributes { clust_default = fromMaybe 0
+                     , node_attributes =
-                                                       (Map.lookup n community_id_by_node_id)
+                              Attributes { clust_default = fromMaybe 0
-                                                    }
+                                                           (Map.lookup n community_id_by_node_id)
+                                         }
                     , node_children = []
                     }
               )
-            | (l, n) <- labels
+            | (label, n) <- labels
            , Set.member n toKeep
            ]
@@ -302,7 +324,7 @@ layout m n gen = maybe (panic "") identity $ Map.lookup n $ coord
 -----------------------------------------------------------------------------
 -- MISC Tools
-cooc2graph'' :: Ord t => Distance
+cooc2graph'' :: Ord t => Similarity
                      -> Double
                      -> Map (t, t) Int
                      -> Map (Index, Index) Double

--- a/src/Gargantext/Core/Viz/Phylo/PhyloMaker.hs
+++ b/src/Gargantext/Core/Viz/Phylo/PhyloMaker.hs
@@ -21,7 +21,7 @@ import Data.Vector (Vector)
 import Debug.Trace (trace)
 import Prelude (floor)
-import Gargantext.Core.Methods.Distances (Distance(Conditional))
+import Gargantext.Core.Methods.Similarities (Similarity(Conditional))
 import Gargantext.Core.Methods.Graph.MaxClique (getMaxCliques)
 import Gargantext.Core.Text.Context (TermList)
 import Gargantext.Core.Text.Metrics.FrequentItemSet (fisWithSizePolyMap, fisWithSizePolyMap', Size(..))

--- a/src/Gargantext/Core/Viz/Phylo/SynchronicClustering.hs
+++ b/src/Gargantext/Core/Viz/Phylo/SynchronicClustering.hs
@@ -210,8 +210,8 @@ synchronicClustering phylo =
     in toNextScale phylo $ levelUpAncestors $ concat newBranches'
-- synchronicDistance :: Phylo -> Level -> String
+-- synchronicSimilarity :: Phylo -> Level -> String
-- synchronicDistance phylo lvl = 
+-- synchronicSimilarity phylo lvl = 
 --     foldl' (\acc branch -> 
 --              acc <> (foldl' (\acc' period ->
 --                               acc' <> let prox  = phyloProximity $ getConfig phylo

--- a/src/Gargantext/Database/Action/Learn.hs
+++ b/src/Gargantext/Database/Action/Learn.hs
@@ -44,10 +44,10 @@ getPriors :: HasDBid NodeType => FavOrTrash -> CorpusId -> Cmd err (Events Bool)
 getPriors ft cId = do
  docs_fav   <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 2)
-              <$> runViewDocuments cId False Nothing Nothing Nothing Nothing
+              <$> runViewDocuments cId False Nothing Nothing Nothing Nothing Nothing
  docs_trash <- List.take (List.length docs_fav)
-            <$> runViewDocuments cId True Nothing Nothing Nothing Nothing
+            <$> runViewDocuments cId True Nothing Nothing Nothing Nothing Nothing
  let priors = priorEventsWith text (fav2bool ft) (  List.zip (repeat False) docs_fav
@@ -62,7 +62,7 @@ moreLikeWith :: HasDBid NodeType
 moreLikeWith cId o l order ft priors = do
  docs_test  <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 1)
-            <$> runViewDocuments cId False o Nothing order Nothing
+            <$> runViewDocuments cId False o Nothing order Nothing Nothing
  let results = map fst
       $ filter ((==) (Just $ not $ fav2bool ft) . snd)

--- a/src/Gargantext/Database/Action/Metrics/NgramsByContext.hs
+++ b/src/Gargantext/Database/Action/Metrics/NgramsByContext.hs
@@ -20,7 +20,6 @@ module Gargantext.Database.Action.Metrics.NgramsByContext
 --import Data.Map.Strict.Patch (PatchMap, Replace, diff)
 import Data.HashMap.Strict (HashMap)
 import Data.Map (Map)
-import Data.Maybe (catMaybes)
 import Data.Set (Set)
 import Data.Text (Text)
 import Data.Tuple.Extra (first, second, swap)
@@ -31,8 +30,7 @@ import Gargantext.Core
 import Gargantext.Data.HashMap.Strict.Utils as HM
 import Gargantext.Database.Admin.Types.Node (ListId, CorpusId, NodeId(..), ContextId, MasterCorpusId, NodeType(NodeDocument), UserCorpusId, DocId)
 import Gargantext.Database.Prelude (Cmd, runPGSQuery)
-import Gargantext.Database.Query.Table.Ngrams (selectNgramsId)
+import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..))
-import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..), NgramsId)
 import Gargantext.Prelude
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Map as Map
@@ -107,48 +105,42 @@ getOccByNgramsOnlyFast_withSample cId int nt ngs =
  HM.fromListWith (+) <$> selectNgramsOccurrencesOnlyByContextUser_withSample cId int nt ngs
-getOccByNgramsOnlyFast' :: CorpusId
+getOccByNgramsOnlyFast :: CorpusId
                       -> ListId
                       -> NgramsType
-                       -> [NgramsTerm]
                       -> Cmd err (HashMap NgramsTerm Int)
-getOccByNgramsOnlyFast' cId lId nt tms = do -- trace (show (cId, lId)) $
+getOccByNgramsOnlyFast cId lId nt = do
-  mapNgramsIds <- selectNgramsId $ map unNgramsTerm tms
+    HM.fromList <$> map (\(t,n) -> (NgramsTerm t, round n)) <$> run cId lId nt
-  HM.fromListWith (+) <$> catMaybes
-                      <$> map (\(nId, s) -> (,) <$> (NgramsTerm <$> (Map.lookup nId mapNgramsIds)) <*> (Just $ round s) )
-                      <$> run cId lId nt (Map.keys mapNgramsIds)
    where
      run :: CorpusId
           -> ListId
           -> NgramsType
-           -> [NgramsId]
+           -> Cmd err [(Text, Double)]
-           -> Cmd err [(NgramsId, Double)]
+      run cId' lId' nt' = runPGSQuery query
-      run cId' lId' nt' tms' = runPGSQuery query
+                ( cId'
-                ( Values fields ((DPS.Only) <$> tms')
-                , cId'
                , lId'
                , ngramsTypeId nt'
                )
-      fields = [QualifiedIdentifier Nothing "int4"]
      query :: DPS.Query
      query = [sql|
-        WITH input_ngrams(id) AS (?)
+              SELECT ng.terms
+                 --  , ng.id
-        SELECT ngi.id, nng.weight FROM nodes_contexts nc
+                     , round(nng.weight)
-        JOIN node_node_ngrams nng ON nng.node1_id = nc.node_id
+                 -- , ns.version
-        JOIN input_ngrams ngi ON nng.ngrams_id = ngi.id
+                 -- , nng.ngrams_type
-          WHERE nng.node1_id = ?
+                 -- , ns.ngrams_type_id
-          AND nng.node2_id = ?
+                FROM ngrams   ng
-          AND nng.ngrams_type = ?
+                JOIN node_stories       ns ON ng.id = ns.ngrams_id
-          AND nc.category > 0
+                JOIN node_node_ngrams   nng ON ns.node_id   = nng.node2_id
-        GROUP BY ngi.id, nng.weight
+                WHERE nng.node1_id        = ?
+                      AND nng.node2_id    = ?
+                      AND nng.ngrams_type = ?
+                      AND nng.ngrams_id = ng.id
+                      AND nng.ngrams_type = ns.ngrams_type_id
+                ORDER BY ng.id ASC;
        |]
 selectNgramsOccurrencesOnlyByContextUser_withSample :: HasDBid NodeType
@@ -188,6 +180,43 @@ queryNgramsOccurrencesOnlyByContextUser_withSample = [sql|
      GROUP BY cng.node_id, ng.terms
  |]
+selectNgramsOccurrencesOnlyByContextUser_withSample' :: HasDBid NodeType
+                                      => CorpusId
+                                      -> Int
+                                      -> NgramsType
+                                      -> Cmd err [(NgramsTerm, Int)]
+selectNgramsOccurrencesOnlyByContextUser_withSample' cId int nt =
+  fmap (first NgramsTerm) <$>
+  runPGSQuery queryNgramsOccurrencesOnlyByContextUser_withSample
+                ( int
+                , toDBid NodeDocument
+                , cId
+                , cId
+                , ngramsTypeId nt
+                )
+queryNgramsOccurrencesOnlyByContextUser_withSample' :: DPS.Query
+queryNgramsOccurrencesOnlyByContextUser_withSample' = [sql|
+  WITH contexts_sample AS (SELECT c.id FROM contexts c TABLESAMPLE SYSTEM_ROWS (?)
+                          JOIN nodes_contexts nc ON c.id = nc.context_id
+                            WHERE c.typename  = ?
+                            AND nc.node_id = ?)
+  SELECT ng.terms, COUNT(cng.context_id) FROM context_node_ngrams cng
+    JOIN ngrams ng      ON cng.ngrams_id = ng.id
+    JOIN node_stories ns ON ns.ngrams_id = ng.id
+    JOIN nodes_contexts nc ON nc.context_id   = cng.context_id
+    JOIN contexts_sample c ON nc.context_id   = c.id
+    WHERE nc.node_id      = ? -- CorpusId
+      AND cng.ngrams_type = ? -- NgramsTypeId
+      AND nc.category     > 0
+      GROUP BY ng.id
+  |]
 ------------------------------------------------------------------------
 getContextsByNgramsOnlyUser :: HasDBid NodeType

--- a/src/Gargantext/Database/Query/Facet.hs
+++ b/src/Gargantext/Database/Query/Facet.hs
@@ -301,26 +301,28 @@ runViewDocuments :: HasDBid NodeType
                 -> Maybe Limit
                 -> Maybe OrderBy
                 -> Maybe Text
+                 -> Maybe Text
                 -> Cmd err [FacetDoc]
-runViewDocuments cId t o l order query = do
+runViewDocuments cId t o l order query year = do
    printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery
    runOpaQuery $ filterWith o l order sqlQuery
  where
-    sqlQuery = viewDocuments cId t (toDBid NodeDocument) query
+    sqlQuery = viewDocuments cId t (toDBid NodeDocument) query year
-runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Cmd err Int
+runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
-runCountDocuments cId t mQuery = do
+runCountDocuments cId t mQuery mYear = do
  runCountOpaQuery sqlQuery
  where
-    sqlQuery = viewDocuments cId t (toDBid NodeDocument) mQuery
+    sqlQuery = viewDocuments cId t (toDBid NodeDocument) mQuery mYear
 viewDocuments :: CorpusId
              -> IsTrash
              -> NodeTypeId
              -> Maybe Text
+              -> Maybe Text
              -> Select FacetDocRead
-viewDocuments cId t ntId mQuery = viewDocumentsQuery cId t ntId mQuery >>> proc (c, nc) -> do
+viewDocuments cId t ntId mQuery mYear = viewDocumentsQuery cId t ntId mQuery mYear >>> proc (c, nc) -> do
  returnA  -< FacetDoc { facetDoc_id         = _cs_id        c
                       , facetDoc_created    = _cs_date      c
                       , facetDoc_title      = _cs_name      c
@@ -334,8 +336,9 @@ viewDocumentsQuery :: CorpusId
                   -> IsTrash
                   -> NodeTypeId
                   -> Maybe Text
+                   -> Maybe Text
                   -> Select (ContextSearchRead, NodeContextRead)
-viewDocumentsQuery cId t ntId mQuery = proc () -> do
+viewDocumentsQuery cId t ntId mQuery mYear = proc () -> do
  c  <- queryContextSearchTable -< ()
  nc <- queryNodeContextTable   -< ()
  restrict -< c^.cs_id         .== nc^.nc_context_id
@@ -346,14 +349,20 @@ viewDocumentsQuery cId t ntId mQuery = proc () -> do
  let
    query         = (fromMaybe "" mQuery)
+    year          = (fromMaybe "" mYear)
    iLikeQuery    = T.intercalate "" ["%", query, "%"]
    abstractLHS h = fromNullable (sqlStrictText "")
                  $ toNullable h .->> (sqlStrictText "abstract")
+    yearLHS h     = fromNullable (sqlStrictText "")
+                  $ toNullable h .->> (sqlStrictText "publication_year")
  restrict -<
    if query == "" then sqlBool True
      else  ((c^.cs_name) `ilike` (sqlStrictText iLikeQuery))
        .|| ((abstractLHS (c^.cs_hyperdata)) `ilike` (sqlStrictText iLikeQuery))
+  restrict -<
+    if year == "" then sqlBool True
+      else (yearLHS (c^.cs_hyperdata)) .== (sqlStrictText year)
  returnA -< (c, nc)

--- a/src/Gargantext/Database/Schema/Ngrams.hs
+++ b/src/Gargantext/Database/Schema/Ngrams.hs
@@ -23,20 +23,21 @@ module Gargantext.Database.Schema.Ngrams
 import Codec.Serialise (Serialise())
 import Control.Lens (over)
 import Control.Monad (mzero)
-import Data.Maybe (fromMaybe)
-import Data.HashMap.Strict (HashMap)
-import Data.Hashable (Hashable)
 import Data.Aeson
 import Data.Aeson.Types (toJSONKeyText)
+import Data.HashMap.Strict (HashMap)
+import Data.Hashable (Hashable)
 import Data.Map (fromList, lookup)
-import Database.PostgreSQL.Simple.FromField (returnError, ResultError(..))
+import Data.Maybe (fromMaybe)
 import Data.Text (Text, splitOn, pack, strip)
+import Database.PostgreSQL.Simple.FromField (returnError, ResultError(..))
+import Gargantext.Core (HasDBid(..))
 import Gargantext.Core.Types (TODO(..), Typed(..))
+import Gargantext.Database.Schema.Prelude
+import Gargantext.Database.Types
 import Gargantext.Prelude
 import Servant (FromHttpApiData(..), Proxy(..), ToHttpApiData(..))
-import Gargantext.Core (HasDBid(..))
+import Test.QuickCheck (elements)
-import Gargantext.Database.Types
-import Gargantext.Database.Schema.Prelude
 import Text.Read (read)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.HashMap.Strict as HashMap
@@ -84,11 +85,26 @@ ngramsTable = Table "ngrams" (pNgramsDb NgramsDB { _ngrams_id    = optionalTable
 -- ngrams in text    fields of documents has Terms   Type (i.e. either title or abstract)
 data NgramsType = Authors | Institutes | Sources | NgramsTerms
  deriving (Eq, Show, Read, Ord, Enum, Bounded, Generic)
 instance Serialise NgramsType
 instance FromJSON NgramsType
+  where
+    parseJSON (String "Authors")    = pure Authors
+    parseJSON (String "Institutes") = pure Institutes
+    parseJSON (String "Sources")    = pure Sources
+    parseJSON (String "Terms")      = pure NgramsTerms
+    parseJSON _                     = mzero
 instance FromJSONKey NgramsType where
   fromJSONKey = FromJSONKeyTextParser (parseJSON . String)
 instance ToJSON NgramsType
+  where
+    toJSON Authors     = String "Authors"
+    toJSON Institutes  = String "Institutes"
+    toJSON Sources     = String "Sources"
+    toJSON NgramsTerms = String "Terms"
 instance ToJSONKey NgramsType where
   toJSONKey = toJSONKeyText (pack . show)
 instance FromHttpApiData NgramsType where
@@ -97,6 +113,9 @@ instance ToHttpApiData NgramsType where
  toUrlPiece = pack . show
 instance ToParamSchema NgramsType where
  toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
+instance Arbitrary NgramsType where
+  arbitrary = elements [ minBound .. maxBound ]
 -- map NgramsType to its assigned id
 instance FromField NgramsType where
  fromField fld mdata =

--- a/src/Gargantext/Utils/Jobs.hs
+++ b/src/Gargantext/Utils/Jobs.hs
+module Gargantext.Utils.Jobs where
+import Control.Monad.Except
+import Control.Monad.Reader
+import Prelude
+import System.Directory (doesFileExist)
+import Text.Read (readMaybe)
+import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Admin.Orchestrator.Types (JobLog)
+import Gargantext.API.Prelude
+import qualified Gargantext.Utils.Jobs.API as API
+import Gargantext.Utils.Jobs.Map
+import Gargantext.Utils.Jobs.Monad
+import qualified Servant.Job.Async as SJ
+jobErrorToGargError
+  :: JobError -> GargError
+jobErrorToGargError = GargJobError
+serveJobsAPI
+  :: Foldable callbacks
+  => GargJob
+  -> (input -> Logger JobLog -> GargM Env GargError JobLog)
+  -> JobsServerAPI ctI ctO callbacks input
+serveJobsAPI t f = API.serveJobsAPI ask t jobErrorToGargError $ \env i l -> do
+  putStrLn ("Running job of type: " ++ show t)
+  runExceptT $ runReaderT (f i l) env
+type JobsServerAPI ctI ctO callbacks input =
+  SJ.AsyncJobsServerT' ctI ctO callbacks JobLog input JobLog
+                       (GargM Env GargError)
+parseGargJob :: String -> Maybe GargJob
+parseGargJob s = case s of
+  "tablengrams" -> Just TableNgramsJob
+  "forgotpassword" -> Just ForgotPasswordJob
+  "updatengramslistjson" -> Just UpdateNgramsListJobJSON
+  "updatengramslistcsv" -> Just UpdateNgramsListJobCSV
+  "addcontact" -> Just AddContactJob
+  "addfile" -> Just AddFileJob
+  "documentfromwritenode" -> Just DocumentFromWriteNodeJob
+  "updatenode" -> Just UpdateNodeJob
+  "updateframecalc" -> Just UploadFrameCalcJob
+  "updatedocument" -> Just UploadDocumentJob
+  "newnode" -> Just NewNodeJob
+  "addcorpusquery" -> Just AddCorpusQueryJob
+  "addcorpusform" -> Just AddCorpusFormJob
+  "addcorpusfile" -> Just AddCorpusFileJob
+  "addannuaireform" -> Just AddAnnuaireFormJob
+  "recomputegraph" -> Just RecomputeGraphJob
+  _ -> Nothing
+parsePrios :: [String] -> IO [(GargJob, Int)]
+parsePrios []       = return []
+parsePrios (x : xs) = (:) <$> go x <*> parsePrios xs
+  where go s = case break (=='=') s of
+          ([], _) -> error "parsePrios: empty jobname?"
+          (prop, valS)
+            | Just val <- readMaybe (tail valS)
+            , Just j   <- parseGargJob prop -> return (j, val)
+            | otherwise                  -> error $
+              "parsePrios: invalid input. " ++ show (prop, valS)
+readPrios :: FilePath -> IO [(GargJob, Int)]
+readPrios fp = do
+  exists <- doesFileExist fp
+  case exists of
+    False -> do
+      putStrLn $
+        "Warning: " ++ fp ++ " doesn't exist, using default job priorities."
+      return []
+    True -> parsePrios . lines =<< readFile fp
--- a/src/Gargantext/Utils/Jobs/API.hs
+++ b/src/Gargantext/Utils/Jobs/API.hs
+{-# LANGUAGE TypeFamilies, ScopedTypeVariables #-}
+module Gargantext.Utils.Jobs.API where
+import Control.Concurrent
+import Control.Concurrent.Async
+import Control.Exception
+import Control.Lens
+import Control.Monad
+import Control.Monad.Except
+import Data.Aeson (ToJSON)
+import Data.Monoid
+import Data.Kind (Type)
+import Prelude
+import Servant.API
+import Gargantext.Utils.Jobs.Map
+import Gargantext.Utils.Jobs.Monad
+import qualified Data.Text as T
+import qualified Servant.Client as C
+import qualified Servant.Job.Async as SJ
+import qualified Servant.Job.Client as SJ
+import qualified Servant.Job.Types as SJ
+serveJobsAPI
+  :: ( Ord t, Exception e, MonadError e m
+     , MonadJob m t (Dual [event]) output
+     , ToJSON e, ToJSON event, ToJSON output
+     , Foldable callback
+     )
+  => m env
+  -> t
+  -> (JobError -> e)
+  -> (env -> input -> Logger event -> IO (Either e output))
+  -> SJ.AsyncJobsServerT' ctI ctO callback event input output m
+serveJobsAPI getenv t joberr f
+     = newJob getenv t f (SJ.JobInput undefined Nothing)
+  :<|> newJob getenv t f
+  :<|> serveJobAPI t joberr
+serveJobAPI
+  :: forall (m :: Type -> Type) e t event output.
+     (Ord t, MonadError e m, MonadJob m t (Dual [event]) output)
+  => t
+  -> (JobError -> e)
+  -> SJ.JobID 'SJ.Unsafe
+  -> SJ.AsyncJobServerT event output m
+serveJobAPI t joberr jid' = wrap' (killJob t)
+                       :<|> wrap' pollJob
+                       :<|> wrap (waitJob joberr)
+  where wrap
+          :: forall a.
+             (SJ.JobID 'SJ.Safe -> JobEntry (SJ.JobID 'SJ.Safe) (Dual [event]) output -> m a)
+          -> m a
+        wrap g = do
+          jid <- handleIDError joberr (checkJID jid')
+          job <- maybe (throwError $ joberr UnknownJob) pure =<< findJob jid
+          g jid job
+        wrap' g limit offset = wrap (g limit offset)
+newJob
+  :: ( Ord t, Exception e, MonadJob m t (Dual [event]) output
+     , ToJSON e, ToJSON event, ToJSON output
+     , Foldable callbacks
+     )
+  => m env
+  -> t
+  -> (env -> input -> Logger event -> IO (Either e output))
+  -> SJ.JobInput callbacks input
+  -> m (SJ.JobStatus 'SJ.Safe event)
+newJob getenv jobkind f input = do
+  je <- getJobEnv
+  env <- getenv
+  let postCallback m = forM_ (input ^. SJ.job_callback) $ \url ->
+        C.runClientM (SJ.clientMCallback m)
+                     (C.mkClientEnv (jeManager je) (url  ^. SJ.base_url))
+      pushLog logF e = do
+        postCallback (SJ.mkChanEvent e)
+        logF e
+      f' inp logF = do
+        r <- f env inp (pushLog logF . Dual . (:[]))
+        case r of
+          Left e  -> postCallback (SJ.mkChanError e) >> throwIO e
+          Right a -> postCallback (SJ.mkChanResult a) >> return a
+  jid <- queueJob jobkind (input ^. SJ.job_input) f'
+  return (SJ.JobStatus jid [] SJ.IsPending Nothing)
+pollJob
+  :: MonadJob m t (Dual [event]) output
+  => Maybe SJ.Limit
+  -> Maybe SJ.Offset
+  -> SJ.JobID 'SJ.Safe
+  -> JobEntry (SJ.JobID 'SJ.Safe) (Dual [event]) output
+  -> m (SJ.JobStatus 'SJ.Safe event)
+pollJob limit offset jid je = do
+  (Dual logs, status, merr) <- case jTask je of
+    QueuedJ _    -> pure (mempty, SJ.IsPending, Nothing)
+    RunningJ rj  -> (,,) <$> liftIO (rjGetLog rj)
+                         <*> pure SJ.IsRunning
+                         <*> pure Nothing
+    DoneJ ls r ->
+      let st = either (const SJ.IsFailure) (const SJ.IsFinished) r
+          me = either (Just . T.pack . show) (const Nothing) r
+      in pure (ls, st, me)
+  pure $ SJ.jobStatus jid limit offset logs status merr
+waitJob
+  :: (MonadError e m, MonadJob m t (Dual [event]) output)
+  => (JobError -> e)
+  -> SJ.JobID 'SJ.Safe
+  -> JobEntry (SJ.JobID 'SJ.Safe) (Dual [event]) output
+  -> m (SJ.JobOutput output)
+waitJob joberr jid je = do
+  r <- case jTask je of
+    QueuedJ _qj -> do
+      m <- getJobsMap
+      erj <- waitTilRunning
+      case erj of
+        Left res -> return res
+        Right rj -> do
+          (res, _logs) <- liftIO (waitJobDone jid rj m)
+          return res
+    RunningJ rj -> do
+      m <- getJobsMap
+      (res, _logs) <- liftIO (waitJobDone jid rj m)
+      return res
+    DoneJ _ls res -> return res
+  either (throwError . joberr . JobException) (pure . SJ.JobOutput) r
+  where waitTilRunning =
+          findJob jid >>= \mjob -> case mjob of
+            Nothing -> error "impossible"
+            Just je' -> case jTask je' of
+              QueuedJ _qj -> do
+                liftIO $ threadDelay 50000 -- wait 50ms
+                waitTilRunning
+              RunningJ rj -> return (Right rj)
+              DoneJ _ls res -> return (Left res)
+killJob
+  :: (Ord t, MonadJob m t (Dual [event]) output)
+  => t
+  -> Maybe SJ.Limit
+  -> Maybe SJ.Offset
+  -> SJ.JobID 'SJ.Safe
+  -> JobEntry (SJ.JobID 'SJ.Safe) (Dual [event]) output
+  -> m (SJ.JobStatus 'SJ.Safe event)
+killJob t limit offset jid je = do
+  (Dual logs, status, merr) <- case jTask je of
+    QueuedJ _ -> do
+      removeJob True t jid
+      return (mempty, SJ.IsKilled, Nothing)
+    RunningJ rj -> do
+      liftIO $ cancel (rjAsync rj)
+      lgs <- liftIO (rjGetLog rj)
+      removeJob False t jid
+      return (lgs, SJ.IsKilled, Nothing)
+    DoneJ lgs r -> do
+      let st = either (const SJ.IsFailure) (const SJ.IsFinished) r
+          me = either (Just . T.pack . show) (const Nothing) r
+      removeJob False t jid
+      pure (lgs, st, me)
+  pure $ SJ.jobStatus jid limit offset logs status merr
--- a/src/Gargantext/Utils/Jobs/Map.hs
+++ b/src/Gargantext/Utils/Jobs/Map.hs
+{-# LANGUAGE GADTs #-}
+module Gargantext.Utils.Jobs.Map where
+import Control.Concurrent
+import Control.Concurrent.Async
+import Control.Concurrent.STM
+import Control.Exception
+import Control.Monad
+import Data.Map (Map)
+import Data.Time.Clock
+import Prelude
+import qualified Data.Map as Map
+import Gargantext.Utils.Jobs.Settings
+-- | (Mutable) 'Map' containing job id -> job info mapping.
+newtype JobMap jid w a = JobMap
+  { jobMap :: TVar (Map jid (JobEntry jid w a))
+  }
+-- | Information associated to a job ID
+data JobEntry jid w a = JobEntry
+  { jID           :: jid
+  , jTask         :: J w a
+  , jTimeoutAfter :: Maybe UTCTime
+  , jRegistered   :: UTCTime
+  , jStarted      :: Maybe UTCTime
+  , jEnded        :: Maybe UTCTime
+  }
+-- | A job computation, which has a different representation depending on the
+--   status of the job.
+--
+--   A queued job consists of the input to the computation and the computation.
+--   A running job consists of an 'Async' as well as an action to get the current logs.
+--   A done job consists of the result of the computation and the final logs.
+data J w a
+  = QueuedJ (QueuedJob w a)
+  | RunningJ (RunningJob w a)
+  | DoneJ w (Either SomeException a)
+-- | An unexecuted job is an input paired with a computation
+--   to run with it. Input type is "hidden" to
+--   be able to store different job types together.
+data QueuedJob w r where
+  QueuedJob :: a -> (a -> Logger w -> IO r) -> QueuedJob w r
+-- | A running job points to the async computation for the job and provides a
+--   function to peek at the current logs.
+data RunningJob w a = RunningJob
+  { rjAsync  :: Async a
+  , rjGetLog :: IO w
+  }
+-- | A @'Logger' w@ is a function that can do something with "messages" of type
+--   @w@ in IO.
+type Logger w = w -> IO ()
+newJobMap :: IO (JobMap jid w a)
+newJobMap = JobMap <$> newTVarIO Map.empty
+-- | Lookup a job by ID
+lookupJob
+  :: Ord jid
+  => jid
+  -> JobMap jid w a
+  -> IO (Maybe (JobEntry jid w a))
+lookupJob jid (JobMap mvar) = Map.lookup jid <$> readTVarIO mvar
+-- | Ready to use GC thread
+gcThread :: Ord jid => JobSettings -> JobMap jid w a -> IO ()
+gcThread js (JobMap mvar) = go
+  where go = do
+          now <- getCurrentTime
+          candidateEntries <- Map.filter (expired now) <$> readTVarIO mvar
+          forM_ candidateEntries $ \je -> do
+            mrunningjob <- atomically $ do
+              case jTask je of
+                RunningJ rj -> modifyTVar' mvar (Map.delete (jID je))
+                            >> return (Just rj)
+                _ -> return Nothing
+            case mrunningjob of
+              Nothing -> return ()
+              Just a  -> killJ a
+          threadDelay (jsGcPeriod js * 1000000)
+          go
+        expired now jobentry = case jTimeoutAfter jobentry of
+          Just t -> now >= t
+          _      -> False
+-- | Make a 'Logger' that 'mappend's monoidal values in a 'TVar'.
+jobLog :: Semigroup w => TVar w -> Logger w -- w -> IO ()
+jobLog logvar = \w -> atomically $ modifyTVar' logvar (\old_w -> old_w <> w)
+-- | Generating new 'JobEntry's.
+addJobEntry
+  :: Ord jid
+  => jid
+  -> a
+  -> (a -> Logger w -> IO r)
+  -> JobMap jid w r
+  -> IO (JobEntry jid w r)
+addJobEntry jid input f (JobMap mvar) = do
+  now <- getCurrentTime
+  let je = JobEntry
+        { jID = jid
+        , jTask = QueuedJ (QueuedJob input f)
+        , jRegistered = now
+        , jTimeoutAfter = Nothing
+        , jStarted = Nothing
+        , jEnded = Nothing
+        }
+  atomically $ modifyTVar' mvar (Map.insert jid je)
+  return je
+deleteJob :: Ord jid => jid -> JobMap jid w a -> STM ()
+deleteJob jid (JobMap mvar) = modifyTVar' mvar (Map.delete jid)
+runJob
+  :: (Ord jid, Monoid w)
+  => jid
+  -> QueuedJob w a
+  -> JobMap jid w a
+  -> JobSettings
+  -> IO (RunningJob w a)
+runJob jid qj (JobMap mvar) js = do
+  rj <- runJ qj
+  now <- getCurrentTime
+  atomically $ modifyTVar' mvar $
+    flip Map.adjust jid $ \je ->
+     je { jTask = RunningJ rj
+        , jStarted = Just now
+        , jTimeoutAfter = Just $ addUTCTime (fromIntegral (jsJobTimeout js)) now
+        }
+  return rj
+waitJobDone
+  :: Ord jid
+  => jid
+  -> RunningJob w a
+  -> JobMap jid w a
+  -> IO (Either SomeException a, w)
+waitJobDone jid rj (JobMap mvar) = do
+  r <- waitJ rj
+  now <- getCurrentTime
+  logs <- rjGetLog rj
+  atomically $ modifyTVar' mvar $
+    flip Map.adjust jid $ \je ->
+      je { jEnded = Just now, jTask = DoneJ logs r }
+  return (r, logs)
+-- | Turn a queued job into a running job by setting up the logging of @w@s and
+--   firing up the async action.
+runJ :: Monoid w => QueuedJob w a -> IO (RunningJob w a)
+runJ (QueuedJob a f) = do
+  logs <- newTVarIO mempty
+  act <- async $ f a (jobLog logs)
+  let readLogs = readTVarIO logs
+  return (RunningJob act readLogs)
+-- | Wait for a running job to return (blocking).
+waitJ :: RunningJob w a -> IO (Either SomeException a)
+waitJ (RunningJob act _) = waitCatch act
+-- | Poll a running job to see if it's done.
+pollJ :: RunningJob w a -> IO (Maybe (Either SomeException a))
+pollJ (RunningJob act _) = poll act
+-- | Kill a running job by cancelling the action.
+killJ :: RunningJob w a -> IO  ()
+killJ (RunningJob act _) = cancel act
--- a/src/Gargantext/Utils/Jobs/Monad.hs
+++ b/src/Gargantext/Utils/Jobs/Monad.hs
+{-# LANGUAGE MultiWayIf, FunctionalDependencies, MultiParamTypeClasses #-}
+module Gargantext.Utils.Jobs.Monad where
+import Gargantext.Utils.Jobs.Settings
+import Gargantext.Utils.Jobs.Map
+import Gargantext.Utils.Jobs.Queue
+import Gargantext.Utils.Jobs.State
+import Control.Concurrent.STM
+import Control.Exception
+import Control.Monad.Except
+import Data.Map (Map)
+import Data.Time.Clock
+import Network.HTTP.Client (Manager)
+import Prelude
+import qualified Servant.Job.Core as SJ
+import qualified Servant.Job.Types as SJ
+data JobEnv t w a = JobEnv
+  { jeSettings :: JobSettings
+  , jeState    :: JobsState t w a
+  , jeManager  :: Manager
+  }
+newJobEnv
+  :: (EnumBounded t, Monoid w)
+  => JobSettings
+  -> Map t Prio
+  -> Manager
+  -> IO (JobEnv t w a)
+newJobEnv js prios mgr = JobEnv js <$> newJobsState js prios <*> pure mgr
+type NumRunners = Int
+defaultJobSettings :: NumRunners -> SJ.SecretKey -> JobSettings
+defaultJobSettings numRunners k = JobSettings
+  { jsNumRunners = numRunners
+  , jsJobTimeout = 30 * 60 -- 30 minutes
+  , jsIDTimeout  = 30 * 60 -- 30 minutes
+  , jsGcPeriod   =  1 * 60 -- 1 minute
+  , jsSecretKey  = k
+  }
+genSecret :: IO SJ.SecretKey
+genSecret = SJ.generateSecretKey
+class MonadIO m => MonadJob m t w a | m -> t w a where
+  getJobEnv :: m (JobEnv t w a)
+getJobsSettings :: MonadJob m t w a => m JobSettings
+getJobsSettings = jeSettings <$> getJobEnv
+getJobsState :: MonadJob m t w a => m (JobsState t w a)
+getJobsState = jeState <$> getJobEnv
+getJobsMap :: MonadJob m t w a => m (JobMap (SJ.JobID 'SJ.Safe) w a)
+getJobsMap = jobsData <$> getJobsState
+getJobsQueue :: MonadJob m t w a => m (Queue t (SJ.JobID 'SJ.Safe))
+getJobsQueue = jobsQ <$> getJobsState
+queueJob
+  :: (MonadJob m t w a, Ord t)
+  => t
+  -> i
+  -> (i -> Logger w -> IO a)
+  -> m (SJ.JobID 'SJ.Safe)
+queueJob jobkind input f = do
+  js <- getJobsSettings
+  st <- getJobsState
+  liftIO (pushJob jobkind input f js st)
+findJob
+  :: MonadJob m t w a
+  => SJ.JobID 'SJ.Safe
+  -> m (Maybe (JobEntry (SJ.JobID 'SJ.Safe) w a))
+findJob jid = do
+  jmap <- getJobsMap
+  liftIO $ lookupJob jid jmap
+data JobError
+  = InvalidIDType
+  | IDExpired
+  | InvalidMacID
+  | UnknownJob
+  | JobException SomeException
+  deriving Show
+checkJID
+  :: MonadJob m t w a
+  => SJ.JobID 'SJ.Unsafe
+  -> m (Either JobError (SJ.JobID 'SJ.Safe))
+checkJID (SJ.PrivateID tn n t d) = do
+  now <- liftIO getCurrentTime
+  js <- getJobsSettings
+  if | tn /= "job" -> return (Left InvalidIDType)
+     | now > addUTCTime (fromIntegral $ jsIDTimeout js) t -> return (Left IDExpired)
+     | d /= SJ.macID tn (jsSecretKey js) t n -> return (Left InvalidMacID)
+     | otherwise -> return $ Right (SJ.PrivateID tn n t d)
+withJob
+  :: MonadJob m t w a
+  => SJ.JobID 'SJ.Unsafe
+  -> (SJ.JobID 'SJ.Safe -> JobEntry (SJ.JobID 'SJ.Safe) w a -> m r)
+  -> m (Either JobError (Maybe r))
+withJob jid f = do
+  r <- checkJID jid
+  case r of
+    Left e -> return (Left e)
+    Right jid' -> do
+      mj <- findJob jid'
+      case mj of
+        Nothing -> return (Right Nothing)
+        Just j  -> Right . Just <$> f jid' j
+handleIDError
+  :: MonadError e m
+  => (JobError -> e)
+  -> m (Either JobError a)
+  -> m a
+handleIDError toE act = act >>= \r -> case r of
+  Left err -> throwError (toE err)
+  Right a  -> return a
+removeJob
+  :: (Ord t, MonadJob m t w a)
+  => Bool -- is it queued (and we have to remove jid from queue)
+  -> t
+  -> SJ.JobID 'SJ.Safe
+  -> m ()
+removeJob queued t jid = do
+  q <- getJobsQueue
+  m <- getJobsMap
+  liftIO . atomically $ do
+    when queued $
+      deleteQueue t jid q
+    deleteJob jid m
--- a/src/Gargantext/Utils/Jobs/Queue.hs
+++ b/src/Gargantext/Utils/Jobs/Queue.hs
+{-# LANGUAGE ConstraintKinds, TypeFamilies, ScopedTypeVariables #-}
+module Gargantext.Utils.Jobs.Queue where
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Exception
+import Data.Function
+import Data.List
+import Data.Ord
+import Data.Maybe
+import Prelude
+import System.IO
+import qualified Data.Map as Map
+import qualified Data.Vector as Vector
+type EnumBounded t = (Ord t, Enum t, Bounded t)
+data Q a = Q [a] [a] !Int
+emptyQ :: Q a
+emptyQ = Q [] [] 0
+singletonQ :: a -> Q a
+singletonQ a = Q [a] [] 1
+snocQ :: a -> Q a -> Q a
+snocQ a (Q xs ys sz) = Q xs (a:ys) (sz+1)
+normalizeQ :: Q a -> Q a
+normalizeQ (Q [] ys sz) = Q (reverse ys) [] sz
+normalizeQ q            = q
+deleteQ :: Eq a => a -> Q a -> Q a
+deleteQ x (Q xs ys sz) = Q xs' ys' sz'
+  where (xs_num_x, xs') = go xs (0, [])
+        (ys_num_x, ys') = go ys (0, [])
+        sz'             = sz - xs_num_x - ys_num_x
+        go [] (n, bs) = (n, reverse bs)
+        go (a:as) (n, bs)
+          | a == x = go as (n+1, bs)
+          | otherwise = go as (n, a:bs)
+popQ :: Q a -> Maybe (a, Q a)
+popQ q@(Q as bs sz) = case as of
+  x:xs -> Just (x, Q xs bs (sz-1))
+  _    -> case normalizeQ q of
+    Q (x:xs) ys sz' -> Just (x, Q xs ys (sz'-1))
+    _               -> Nothing
+sizeQ :: Q a -> Int
+sizeQ (Q _ _ sz) = sz
+peekQ :: Q a -> Maybe a
+peekQ (Q _ _ 0) = Nothing
+peekQ q = case normalizeQ q of
+  Q (x:_) _ _ -> Just x
+  _           -> Nothing
+dropQ :: Q a -> Q a
+dropQ (Q [] [] _) = Q [] [] 0
+dropQ (Q (_x:xs) ys sz) = Q xs ys (sz-1)
+dropQ q@(Q [] _ _) = dropQ (normalizeQ q)
+-- | A priority is just a number. The greater, the earlier the job will get picked.
+type Prio = Int
+applyPrios
+  :: Ord t
+  => [(t, Prio)] -> Map.Map t Prio -> Map.Map t Prio
+applyPrios changes prios = foldl' (\m (t, p) -> Map.insert t p m) prios changes
+-- | A queue with different kinds of values, described by @t@, where each
+--   kind can have a higher or lower priority than other kinds, as described
+--   by the 'queuePrios' field.
+data Queue t a = Queue
+  { queueData    :: Vector.Vector (TVar (Q a))
+  , queueIndices :: Map.Map t Int -- indices into queueData
+  , queuePrios   :: Map.Map t Prio
+  }
+-- | Default priorities for the enumeration of job types @t@: everyone at 0.
+defaultPrios :: EnumBounded t => Map.Map t Prio
+defaultPrios = Map.fromList [ (t, 0) | t <- [minBound..maxBound] ]
+-- | Create a new queue that'll apply the given priorities
+newQueue :: EnumBounded t => Map.Map t Prio -> IO (Queue t a)
+newQueue prios = do
+  let allTs = [ minBound .. maxBound ]
+      indices = Map.fromList (zip allTs [0..])
+      n = Map.size indices
+  vars <- Vector.replicateM n (newTVarIO emptyQ)
+  return $ Queue vars indices prios
+-- | Add a new element to the queue, with the given kind.
+addQueue :: Ord t => t -> a -> Queue t a -> IO ()
+addQueue jobkind a q = case Map.lookup jobkind (queueIndices q) of
+  Just i -> atomically $ modifyTVar (queueData q Vector.! i) (snocQ a)
+  Nothing -> error "addQueue: couldn't find queue for given job kind"
+deleteQueue :: (Eq a, Ord t) => t -> a -> Queue t a -> STM ()
+deleteQueue jobkind a q = case Map.lookup jobkind (queueIndices q) of
+  Just i -> modifyTVar (queueData q Vector.! i) (deleteQ a)
+  Nothing -> error "deleteQueue: queue type not found?!"
+type Picker a = [(a, STM ())] -> STM (a, STM ())
+-- | Figure out the candidates for being popped from the various queues.
+--   We always look at highest priority queues first, and will pick between
+--   equal priority items of different queues (candidates, elements of the
+--   returned lists) by choosing the one that was queued first.
+popQueue :: forall a t. Ord t => Picker a -> Queue t a -> IO (Maybe a)
+popQueue picker q = atomically $ select prioLevels
+  where -- TODO: cache this in the 'Queue' data structure?
+        prioLevels :: [[(t, Prio)]]
+        prioLevels = groupBy ((==) `on` snd) . sortOn (Down . snd) $
+          Map.toList (queuePrios q)
+        select :: [[(t, Prio)]] -> STM (Maybe a)
+        select [] = return Nothing
+        select (level:levels) = do
+          mres <- selectLevel level
+          case mres of
+            Nothing  -> select levels
+            Just res -> return (Just res)
+        selectLevel :: [(t, Prio)] -> STM (Maybe a)
+        selectLevel xs = do
+          let indices = catMaybes $ map (flip Map.lookup (queueIndices q) . fst) xs
+              queues  = map (queueData q Vector.!) indices
+              go qvar = readTVar qvar >>= \qu ->
+                return (peekQ qu, modifyTVar' qvar dropQ)
+          mtopItems <- catMaybesFst <$> traverse go queues
+          case mtopItems of
+            Nothing -> return Nothing
+            Just [] -> return Nothing
+            Just topItems -> do
+              (earliestItem, popItem) <- picker topItems
+              popItem
+              return (Just earliestItem)
+        catMaybesFst ((Nothing, _b) : xs) = catMaybesFst xs
+        catMaybesFst ((Just a, b) : xs) = ((a, b) :) <$> catMaybesFst xs
+        catMaybesFst [] = Just []
+-- | A ready-to-use runner that pops the highest priority item off the queue
+--   and processes it using the given function.
+queueRunner :: Ord t => Picker a -> (a -> IO ()) -> Queue t a -> IO ()
+queueRunner picker f q = go
+  where go = do
+          mres <- popQueue picker q
+          case mres of
+            Just a -> f a `catch` exc
+            Nothing -> return ()
+          threadDelay 5000 -- 5ms
+          go
+        exc :: SomeException -> IO ()
+        exc e = hPutStrLn stderr ("Queue runner exception: " ++ show e)
+-- | Create a queue and @n@ runner actions for it, with the given priorities
+--   for the runners to apply when picking a new item.
+newQueueWithRunners
+  :: EnumBounded t
+  => Int -- ^ number of runners
+  -> Map.Map t Prio -- ^ priorities
+  -> Picker a  -- ^ how to pick between equal priority items
+  -> (a -> IO ()) -- ^ what to do with each item
+  -> IO (Queue t a, [IO ()])
+newQueueWithRunners n prios picker f = do
+  q <- newQueue prios
+  let runners = replicate n (queueRunner picker f q)
+  return (q, runners)
--- a/src/Gargantext/Utils/Jobs/Settings.hs
+++ b/src/Gargantext/Utils/Jobs/Settings.hs
+module Gargantext.Utils.Jobs.Settings where
+import Prelude
+import qualified Servant.Job.Core as SJ
+-- | A few control knobs for the job system.
+data JobSettings = JobSettings
+  { jsNumRunners :: Int
+  , jsJobTimeout :: Int -- in seconds. TODO: timeout per job type? Map t Int
+  , jsIDTimeout  :: Int -- in seconds, how long a job ID is valid
+  , jsGcPeriod   :: Int -- in seconds, how long between each GC
+  , jsSecretKey  :: SJ.SecretKey
+  }
--- a/src/Gargantext/Utils/Jobs/State.hs
+++ b/src/Gargantext/Utils/Jobs/State.hs
+module Gargantext.Utils.Jobs.State where
+import Gargantext.Utils.Jobs.Map
+import Gargantext.Utils.Jobs.Queue
+import Gargantext.Utils.Jobs.Settings
+import Control.Concurrent.Async
+import Control.Concurrent.STM
+import Control.Monad
+import Data.List
+import Data.Map (Map)
+import Data.Maybe
+import Data.Ord
+import Data.Proxy
+import Data.Time.Clock
+import Prelude
+import qualified Data.Map as Map
+import qualified Servant.Job.Core as SJ
+import qualified Servant.Job.Types as SJ
+type IDGenerator = TVar Int
+data JobsState t w a = JobsState
+  { jobsData  :: JobMap (SJ.JobID 'SJ.Safe) w a
+  , jobsQ     :: Queue t (SJ.JobID 'SJ.Safe)
+  , jobsIdGen :: IDGenerator
+  , jsGC      :: Async ()
+  , jsRunners :: [Async ()]
+  }
+nextID :: JobSettings -> JobsState t w a -> IO (SJ.JobID 'SJ.Safe)
+nextID js st = do
+  now <- getCurrentTime
+  n <- atomically $ stateTVar (jobsIdGen st) $ \i -> (i, i+1)
+  return $ SJ.newID (Proxy :: Proxy "job") (jsSecretKey js) now n
+newJobsState
+  :: forall t w a.
+     (EnumBounded t, Monoid w)
+  => JobSettings
+  -> Map t Prio
+  -> IO (JobsState t w a)
+newJobsState js prios = do
+  jmap <- newJobMap
+  idgen <- newTVarIO 0
+  (q, runners) <- newQueueWithRunners (jsNumRunners js) prios (picker jmap) $ \jid -> do
+    mje <- lookupJob jid jmap
+    case mje of
+      Nothing -> return ()
+      Just je -> case jTask je of
+        QueuedJ qj -> do
+          rj <- runJob jid qj jmap js
+          (_res, _logs) <- waitJobDone jid rj jmap
+          return ()
+        _ -> return ()
+  putStrLn $ "Starting " ++ show (jsNumRunners js) ++ " job runners."
+  gcAsync <- async $ gcThread js jmap
+  runnersAsyncs <- traverse async runners
+  return (JobsState jmap q idgen gcAsync runnersAsyncs)
+  where picker
+          :: JobMap (SJ.JobID 'SJ.Safe) w a
+          -> Picker (SJ.JobID 'SJ.Safe)
+        picker (JobMap jmap) xs = do
+          jinfos <- fmap catMaybes . forM xs $ \(jid, popjid) -> do
+            mje <- Map.lookup jid <$> readTVar jmap
+            case mje of
+              Nothing -> return Nothing
+              Just je -> return $ Just (jid, popjid, jRegistered je)
+          let (jid, popjid, _) = minimumBy (comparing _3) jinfos
+          return (jid, popjid)
+        _3 (_, _, c) = c
+pushJob
+  :: Ord t
+  => t
+  -> a
+  -> (a -> Logger w -> IO r)
+  -> JobSettings
+  -> JobsState t w r
+  -> IO (SJ.JobID 'SJ.Safe)
+pushJob jobkind input f js st@(JobsState jmap jqueue _idgen _ _) = do
+  jid <- nextID js st
+  _je <- addJobEntry jid input f jmap
+  addQueue jobkind jid jqueue
+  return jid
--- a/stack.yaml
+++ b/stack.yaml
@@ -33,7 +33,7 @@ ghc-options:
 extra-deps:
 - git: https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude.git
-  commit: 08096a4913572cf22762fa77613340207ec6d9fd
+  commit: 03c3c381ba9df6da02a7a3c8d7b78cde9a380d04
 - git: https://gitlab.iscpif.fr/gargantext/gargantext-graph.git
  commit: 588e104fe7593210956610cab0041fd16584a4ce
  # Data Mining Libs
@@ -85,9 +85,8 @@ extra-deps:
 #- arxiv-0.0.3@sha256:02de1114091d11f1f3ab401d104d125ad4301260806feb7f63b3dcefc7db88cf,1588
  # NP libs
-  #- git: https://github.com/np/servant-job.git # waiting for PR
 - git: https://github.com/alpmestan/servant-job.git
-  commit: ceb251b91e8ec1804198422a3cdbdab08d843b79
+  commit: b4182487cfe479777c11ca19f3c0d47840b376f6
  #- git: https://github.com/np/patches-map
 - git: https://github.com/delanoe/patches-map
  commit: 76cae88f367976ff091e661ee69a5c3126b94694

--- a/tests/queue/Main.hs
+++ b/tests/queue/Main.hs
+{-# LANGUAGE ScopedTypeVariables #-}
+module Main where
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Monad
+import Data.Either
+import Data.List
+import Prelude
+import Test.Hspec
+import Gargantext.Utils.Jobs.Map
+import Gargantext.Utils.Jobs.Monad
+import Gargantext.Utils.Jobs.Queue (applyPrios, defaultPrios)
+import Gargantext.Utils.Jobs.State
+data JobT = A | B deriving (Eq, Ord, Show, Enum, Bounded)
+data Counts = Counts { countAs :: Int, countBs :: Int }
+  deriving (Eq, Show)
+inc, dec :: JobT -> Counts -> Counts
+inc A cs = cs { countAs = countAs cs + 1 }
+inc B cs = cs { countBs = countBs cs + 1 }
+dec A cs = cs { countAs = countAs cs - 1 }
+dec B cs = cs { countBs = countBs cs - 1 }
+jobDuration, initialDelay :: Int
+jobDuration = 100000
+initialDelay = 20000
+testMaxRunners :: IO ()
+testMaxRunners = do
+  -- max runners = 2 with default settings
+  k <- genSecret
+  let settings = defaultJobSettings 2 k
+  st :: JobsState JobT [String] () <- newJobsState settings defaultPrios
+  runningJs <- newTVarIO []
+  let j num _inp _l = do
+        atomically $ modifyTVar runningJs (\xs -> ("Job #" ++ show num) : xs)
+        threadDelay jobDuration
+        atomically $ modifyTVar runningJs (\xs -> filter (/=("Job #" ++ show num)) xs)
+      jobs = [ j n | n <- [1..4::Int] ]
+  _jids <- forM jobs $ \f -> pushJob A () f settings st
+  threadDelay initialDelay
+  r1 <- readTVarIO runningJs
+  sort r1 `shouldBe` ["Job #1", "Job #2"]
+  threadDelay jobDuration
+  r2 <- readTVarIO runningJs
+  sort r2 `shouldBe` ["Job #3", "Job #4"]
+  threadDelay jobDuration
+  r3 <- readTVarIO runningJs
+  r3 `shouldBe` []
+testPrios :: IO ()
+testPrios = do
+  k <- genSecret
+  let settings = defaultJobSettings 2 k
+  st :: JobsState JobT [String] () <- newJobsState settings $
+    applyPrios [(B, 10)] defaultPrios -- B has higher priority
+  runningJs <- newTVarIO (Counts 0 0)
+  let j jobt _inp _l = do
+        atomically $ modifyTVar runningJs (inc jobt)
+        threadDelay jobDuration
+        atomically $ modifyTVar runningJs (dec jobt)
+      jobs = [ (A, j A)
+             , (A, j A)
+             , (B, j B)
+             , (B, j B)
+             ]
+  _jids <- forM jobs $ \(t, f) -> do
+    pushJob t () f settings st
+  threadDelay initialDelay
+  r1 <- readTVarIO runningJs
+  r1 `shouldBe` (Counts 0 2)
+  threadDelay jobDuration
+  r2 <- readTVarIO runningJs
+  r2 `shouldBe` (Counts 2 0)
+  threadDelay jobDuration
+  r3 <- readTVarIO runningJs
+  r3 `shouldBe` (Counts 0 0)
+testExceptions :: IO ()
+testExceptions = do
+  k <- genSecret
+  let settings = defaultJobSettings 2 k
+  st :: JobsState JobT [String] () <- newJobsState settings defaultPrios
+  jid <- pushJob A ()
+    (\_inp _log -> readFile "/doesntexist.txt" >>= putStrLn)
+    settings st
+  threadDelay initialDelay
+  mjob <- lookupJob jid (jobsData st)
+  case mjob of
+    Nothing ->  error "boo"
+    Just je ->  case jTask je of
+      DoneJ _ r -> isLeft r `shouldBe` True
+      _         -> error "boo2"
+  return ()
+testFairness :: IO ()
+testFairness = do
+  k <- genSecret
+  let settings = defaultJobSettings 2 k
+  st :: JobsState JobT [String] () <- newJobsState settings defaultPrios
+  runningJs <- newTVarIO (Counts 0 0)
+  let j jobt _inp _l = do
+        atomically $ modifyTVar runningJs (inc jobt)
+        threadDelay jobDuration
+        atomically $ modifyTVar runningJs (dec jobt)
+      jobs = [ (A, j A)
+             , (A, j A)
+             , (B, j B)
+             , (A, j A)
+             , (A, j A)
+             ]
+  _jids <- forM jobs $ \(t, f) -> do
+    pushJob t () f settings st
+  threadDelay initialDelay
+  r1 <- readTVarIO runningJs
+  r1 `shouldBe` (Counts 2 0)
+  threadDelay jobDuration
+  r2 <- readTVarIO runningJs
+  r2 `shouldBe` (Counts 1 1) -- MOST IMPORTANT CHECK: the B got picked after the
+                             -- two As, because it was inserted right after them
+                             -- and has equal priority.
+  threadDelay jobDuration
+  r3 <- readTVarIO runningJs
+  r3 `shouldBe` (Counts 1 0)
+  threadDelay jobDuration
+  r4 <- readTVarIO runningJs
+  r4 `shouldBe` (Counts 0 0)
+main :: IO ()
+main = hspec $ do
+  describe "job queue" $ do
+    it "respects max runners limit" $
+      testMaxRunners
+    it "respects priorities" $
+      testPrios
+    it "can handle exceptions" $
+      testExceptions
+    it "fairly picks equal-priority-but-different-kind jobs" $
+      testFairness