[MERGE]

.envrc

 use_nix
+export LANG=C.UTF-8

.gitignore

@@ -38,3 +38,5 @@ repos
 repo.json*
 tmp*repo*json
 data
+
+devops/docker/js-cache

CODE_OF_CONDUCT.md

-# Contributor Covenant Code of Conduct
-
-## Our Pledge
-
-In the interest of fostering an open and welcoming environment, we as
-contributors and maintainers pledge to making participation in our project and
-our community a harassment-free experience for everyone, regardless of age, body
-size, disability, ethnicity, gender identity and expression, level of experience,
-nationality, personal appearance, race, religion, or sexual identity and
-orientation.
-
-## Our Standards
-
-Examples of behavior that contributes to creating a positive environment
-include:
-
-* Using welcoming and inclusive language
-* Being respectful of differing viewpoints and experiences
-* Gracefully accepting constructive criticism
-* Focusing on what is best for the community
-* Showing empathy towards other community members
-
-Examples of unacceptable behavior by participants include:
-
-* The use of sexualized language or imagery and unwelcome sexual attention or
-advances
-* Trolling, insulting/derogatory comments, and personal or political attacks
-* Public or private harassment
-* Publishing others' private information, such as a physical or electronic
-  address, without explicit permission
-* Other conduct which could reasonably be considered inappropriate in a
-  professional setting
-
-## Our Responsibilities
-
-Project maintainers are responsible for clarifying the standards of acceptable
-behavior and are expected to take appropriate and fair corrective action in
-response to any instances of unacceptable behavior.
-
-Project maintainers have the right and responsibility to remove, edit, or
-reject comments, commits, code, wiki edits, issues, and other contributions
-that are not aligned to this Code of Conduct, or to ban temporarily or
-permanently any contributor for other behaviors that they deem inappropriate,
-threatening, offensive, or harmful.
-
-## Scope
-
-This Code of Conduct applies both within project spaces and in public spaces
-when an individual is representing the project or its community. Examples of
-representing a project or community include using an official project e-mail
-address, posting via an official social media account, or acting as an appointed
-representative at an online or offline event. Representation of a project may be
-further defined and clarified by project maintainers.
-
-## Enforcement
-
-Instances of abusive, harassing, or otherwise unacceptable behavior may be
-reported by contacting the project team at [sos AT gargantext DOT org]. All
-complaints will be reviewed and investigated and will result in a response that
-is deemed necessary and appropriate to the circumstances. The project team is
-obligated to maintain confidentiality with regard to the reporter of an incident.
-Further details of specific enforcement policies may be posted separately.
-
-Project maintainers who do not follow or enforce the Code of Conduct in good
-faith may face temporary or permanent repercussions as determined by other
-members of the project's leadership.
-
-## Attribution
-
-This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4,
-available at [http://contributor-covenant.org/version/1/4][version]
-
-[homepage]: http://contributor-covenant.org
-[version]: http://contributor-covenant.org/version/1/4/
+# GarganText "Code of Conduct"
+
+The GarganText Project, the contributors of the GarganText eco-system,
+have adopted a code of conduct for participants to any modes of
+communication within the project.
+
+## Be respectful
+
+In a project the size of GarganText, inevitably there will be people
+with whom you may disagree, or find it difficult to cooperate. Accept
+that, but even so, remain respectful. Disagreement is no excuse for poor
+behaviour or personal attacks, and a community in which people feel
+threatened is not a healthy community.
+
+## Assume good faith
+
+GarganText Contributors have many ways of reaching our common goal of
+a free digital ecosystem which may differ from your ways. Assume that
+other people are working towards this goal.
+
+Note that many of our Contributors are not native English speakers
+or may have different cultural backgrounds.
+
+## Be collaborative
+
+GarganText is a large and complex project; there is always more to
+learn within GarganText. It's good to ask for help when you need it.
+Similarly, offers for help should be seen in the context of our shared
+goal of improving GarganText.
+
+When you make something for the benefit of the project, be willing
+to explain to others how it works, so that they can build on your work
+to make it even better.
+
+## Try to be concise
+
+Keep in mind that what you write once will be read by many others
+persons. Writing a short email means people can understand the
+conversation as efficiently as possible. When a long explanation is
+necessary, consider adding a summary.
+
+Try to bring new arguments to a conversation so that each comment
+adds something unique to the thread, keeping in mind that the rest of
+the thread still contains the other messages with arguments that have
+already been made.
+
+Try to stay on topic, especially in discussions that are already
+fairly large.
+
+## Be open
+
+Most ways of communication used within GarganText allow for public and
+private communication. You should preferably use public methods of
+communication for GarganText-related messages, unless posting something
+sensitive.
+
+This applies to messages for help or GarganText-related support,
+too; not only is a public support request much more likely to
+result in an answer to your question, it also makes sure that any
+inadvertent mistakes made by people answering your question will be
+more easily detected and corrected.
+
+While this code of conduct should be adhered to by participants,
+we recognize that sometimes people may have a bad day, or be unaware
+of some of the guidelines in this code of conduct. When that happens,
+you may reply to them and point out this code of conduct. Such messages
+may be in public or in private, whatever is most appropriate. However,
+regardless of whether the message is public or not, it should still
+adhere to the relevant parts of this code of conduct; in particular, it
+should not be abusive or disrespectful. Assume good faith; it is more
+likely that participants are unaware of their bad behaviour than that
+they intentionally try to degrade the quality of the discussion.
+
+Serious or persistent offenders will be temporarily or permanently
+banned from communicating through GarganText's ecosystem. Complaints
+should be made (in private) to the administrators of the GarganText
+communication forum in question. To find contact information for these
+administrators, please see the page on GarganText's organizational
+structure.

CONTRIBUTING.md

 # Contributing
 
-## Main repo
+## Code contribution
 
-https://gitlab.iscpif.fr/gargantext/haskell-gargantext
+We use Git to share and merge our code.
 
+## Style
 
-## Stack by default
+We are using the common Haskell Style: 
+https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md
 
-stack install
-
-
-## REPL
-
-stack ghci at the root of the project (it will load right paths of
-static resources).
+## Code Of Conduct
 
+Be constructive as sharing our code of conduct

bin/backup

+#!/bin/bash
+
+# 0 3 * * * pg_dump --dbname=$MYDB | gzip > ~/backup/db/$(date +%Y-%m-%d).psql.gz
+
+if [[ $1 == "" || $2 == "" ]]
+then echo "USAGE : ./bin/backup gargantext.ini backup_directory"
+else 
+
+INIFILE=$1
+
+getter () {
+  grep $1 $INIFILE | sed "s/^.*= //"
+}
+
+USER=$(getter "DB_USER")
+NAME=$(getter "DB_NAME")
+PASS=$(getter "DB_PASS")
+HOST=$(getter "DB_HOST")
+PORT=$(getter "DB_PORT")
+
+
+GARGDB="postgresql://${USER}:${PASS}@${HOST}:${PORT}/${NAME}"
+
+#echo "backuping $GARGDB"
+pg_dump --dbname=$GARGDB | gzip > $2/$(date +%Y-%m-%d).garg_dump.gz
+
+
+fi

bin/gargantext-cli/CleanCsvCorpus.hs

@@ -40,7 +40,7 @@ main = do
   --let q = ["water", "scarcity", "morocco", "shortage","flood"]
   let q = ["gratuit", "gratuité", "culture", "culturel"]
 
-  eDocs <- CSV.readFile rPath
+  eDocs <- CSV.readCSVFile rPath
   case eDocs of
     Right (h, csvDocs) -> do
       putStrLn $ "Number of documents before:" <> show (V.length csvDocs)

bin/gargantext-cli/Main.hs

@@ -26,8 +26,8 @@ import Data.ByteString.Lazy (writeFile)
 import Data.Either (Either(..))
 import Data.List (cycle, concat, unwords)
 import Data.List.Split (chunksOf)
-import Data.Map (Map)
-import qualified Data.Map    as DM
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict    as DM
 import Data.Text (pack, Text)
 import qualified Data.Text as DT
 import Data.Tuple.Extra (both)
@@ -42,7 +42,7 @@ import Gargantext.Core.Types
 import Gargantext.Core.Text.Terms
 import Gargantext.Core.Text.Context
 import Gargantext.Core.Text.Terms.WithList
-import Gargantext.Core.Text.Corpus.Parsers.CSV (readFile, csv_title, csv_abstract, csv_publication_year, unIntOrDec, fromMIntOrDec, defaultYear)
+import Gargantext.Core.Text.Corpus.Parsers.CSV (readCSVFile, csv_title, csv_abstract, csv_publication_year, unIntOrDec, fromMIntOrDec, defaultYear)
 import Gargantext.Core.Text.List.Formats.CSV (csvMapTermList)
 import Gargantext.Core.Text.Terms (terms)
 import Gargantext.Core.Text.Metrics.Count (coocOnContexts, Coocs)
@@ -86,7 +86,7 @@ main = do
   [corpusFile, termListFile, outputFile] <- getArgs
 
   --corpus :: IO (DM.IntMap [[Text]])
-  eCorpusFile <- readFile corpusFile
+  eCorpusFile <- readCSVFile corpusFile
   case eCorpusFile of
     Right cf -> do
       let corpus = DM.fromListWith (<>)
@@ -142,8 +142,8 @@ terms' pats txt = pure $ concat $ extractTermsWithList pats txt
 
 testCorpus :: [(Int, [Text])]
 testCorpus = [ (1998, [pack "The beees"])
-             , (1999, [ pack "The bees and the flowers" 
-                      --, pack "The bees and the flowers" 
+             , (1999, [ pack "The bees and the flowers"
+                      --, pack "The bees and the flowers"
                       ])
              ]
 
@@ -151,4 +151,3 @@ testTermList :: TermList
 testTermList = [ ([pack "bee"], [[pack "bees"]])
                , ([pack "flower"], [[pack "flowers"]])
                ]
-

bin/gargantext-client/Auth.hs

-module Auth where
-
-import Prelude
-import Data.Maybe
-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) -> 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"

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

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

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

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)

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

bin/gargantext-import/Main.hs

@@ -35,7 +35,7 @@ import Gargantext.Database.Admin.Types.Hyperdata (toHyperdataDocument)
 import Gargantext.Database.Admin.Types.Node (CorpusId)
 import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Prelude
-import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..))
+import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..))
 
 main :: IO ()
 main = do
@@ -51,10 +51,10 @@ main = do
       Nothing -> panic $ "Cannot read limit: " <> (Text.pack limit)
       Just l  -> l
     corpus :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
-    corpus = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) limit' tt  format corpusPath Nothing (\_ -> pure ())
+    corpus = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) limit' tt  format Plain corpusPath Nothing (\_ -> pure ())
 
     corpusCsvHal :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
-    corpusCsvHal = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) limit' tt CsvHal corpusPath Nothing (\_ -> pure ())
+    corpusCsvHal = flowCorpusFile (UserName $ cs user) (Left (cs name :: Text)) limit' tt CsvHal Plain corpusPath Nothing (\_ -> pure ())
 
     annuaire :: forall m. FlowCmdM DevEnv GargError m => m CorpusId
     annuaire = flowAnnuaire (UserName $ cs user) (Left "Annuaire") (Multi EN) corpusPath (\_ -> pure ())
@@ -78,7 +78,7 @@ main = do
     _ <- if fun == "corpusCsvHal"
           then runCmdDev env corpusCsvHal
           else pure 0 --(cs "false")
- 
+
     _ <- if fun == "annuaire"
             then runCmdDev env annuaire
             else pure 0

bin/gargantext-invitations/Main.hs

+{-|
+Module      : Main.hs
+Description : GarganText Mailing Invitations
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+
+ -}
+
+{-# LANGUAGE Strict            #-}
+
+module Main where
+
+import Data.Either (Either(..))
+import Gargantext.API.Dev (withDevEnv, runCmdDev)
+import Gargantext.API.Node () -- instances only
+import Gargantext.API.Prelude (GargError)
+import Gargantext.Core.Types.Individu (User(..), arbitraryNewUsers, NewUser(..), arbitraryUsername, GargPassword(..))
+import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMk_RootWithCorpus)
+import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
+import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude (CmdR)
+import Gargantext.Database.Query.Table.Node (getOrMkList)
+import Gargantext.Database.Query.Table.User (insertNewUsers, )
+import Gargantext.Prelude
+import Gargantext.Prelude.Config (GargConfig(..), readConfig)
+import Prelude (getLine, read)
+import System.Environment (getArgs)
+import Gargantext.Database.Action.User.New (newUsers)
+import Gargantext.Core.Types.Individu (User(..))
+import qualified Gargantext.API.Node.Share as Share
+
+main :: IO ()
+main = do
+  params@[iniPath,user,node_id,email] <- getArgs
+
+  _ <- if length params /= 4
+      then panic "USAGE: ./gargantext-init gargantext.ini username node_id student@university.edu"
+      else pure ()
+
+  cfg       <- readConfig         iniPath
+
+  let invite :: CmdR GargError Int
+      invite = Share.api (UserName $ cs user) (NodeId $ (read node_id :: Int)) (Share.ShareTeamParams $ cs email)
+
+  withDevEnv iniPath $ \env -> do
+    _ <- runCmdDev env invite
+    pure ()

bin/gargantext-phylo/Main.hs

@@ -30,7 +30,7 @@ import GHC.IO (FilePath)
 import Gargantext.API.Ngrams.Prelude (toTermList)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Text.Context (TermList)
-import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..),parseFile)
+import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..), parseFile)
 import Gargantext.Core.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year, csv_publication_month, csv_publication_day, csv'_source, csv'_title, csv'_abstract, csv'_publication_year, csv'_publication_month, csv'_publication_day, csv'_weight)
 import Gargantext.Core.Text.List.Formats.CSV (csvMapTermList)
 import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, extractTermsWithList)
@@ -94,7 +94,7 @@ wosToDocs limit patterns time path = do
         <$> mapConcurrently (\file ->
               filter (\d -> (isJust $ _hd_publication_year d)
                          && (isJust $ _hd_title d))
-                <$> fromRight [] <$> parseFile WOS (path <> file) ) files
+                <$> fromRight [] <$> parseFile WOS Plain (path <> file) ) files
 
 
 -- To transform a Csv file into a list of Document
@@ -109,7 +109,7 @@ csvToDocs parser patterns time path =
                                        (termsInText patterns $ (csv_title row) <> " " <> (csv_abstract row))
                                        Nothing
                                        []
-                     ) <$> snd <$> either (\err -> panic $ cs $ "CSV error" <> (show err)) identity <$> Csv.readFile path
+                     ) <$> snd <$> either (\err -> panic $ cs $ "CSV error" <> (show err)) identity <$> Csv.readCSVFile path
     Csv' limit -> Vector.toList
       <$> Vector.take limit
       <$> Vector.map (\row -> Document (toPhyloDate  (csv'_publication_year row) (csv'_publication_month row) (csv'_publication_day row) time)

bin/gargantext-server/Main.hs

@@ -80,4 +80,3 @@ main = do
 
   putStrLn $ "Starting with " <> show myMode <> " mode."
   start
-

bin/gargantext-upgrade/Main.hs

@@ -24,6 +24,7 @@ import Gargantext.API.Admin.EnvTypes (DevEnv)
 import Gargantext.API.Dev (withDevEnv, runCmdDev)
 import Gargantext.API.Node () -- instances only
 import Gargantext.API.Prelude (GargError)
+import Gargantext.API.Ngrams.Tools (migrateFromDirToDb)
 import Gargantext.Core (HasDBid(toDBid))
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Flow (getOrMk_RootWithCorpus)
@@ -32,7 +33,6 @@ import Gargantext.Database.Admin.Trigger.Init
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
 import Gargantext.Database.Admin.Types.Node (NodeType(NodeDocument, NodeContact))
 import Gargantext.Database.Prelude (Cmd'', Cmd, execPGSQuery)
-import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (GargConfig(..), readConfig)
 import Prelude (getLine)
@@ -42,10 +42,13 @@ import qualified Data.List as List (cycle, concat, take, unlines)
 main :: IO ()
 main = do
 
-  let ___ = putStrLn $ List.concat $ List.take 72 $ List.cycle ["_"]
+  let ___ = putStrLn
+          $ List.concat
+          $ List.take 72
+          $ List.cycle ["_"]
 
   ___
-  putStrLn "GarganText upgrade to version 0.0.5"
+  putStrLn "GarganText upgrade to version 0.0.6"
   ___
 
   params@[iniPath] <- getArgs
@@ -57,42 +60,17 @@ main = do
            [ "Your Database defined in gargantext.ini will be upgraded."
            , "We stronlgy recommend you to make a backup using pg_dump."
            , ""
-           , "If you encounter issues, please report your bugs here:"
-           , "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/101"
-           , ""
            , "Press ENTER if you want to continue, CTRL+C if you want to stop."
            ]
-  
+
   _ok  <- getLine
 
   cfg       <- readConfig         iniPath
-  let secret = _gc_secretkey cfg
-
-  let
-    contextsTriggers :: Cmd GargError ()
-    contextsTriggers = do
-      (masterUserId, _masterRootId, masterCorpusId)
-                  <- getOrMk_RootWithCorpus (UserName userMaster)
-                                            (Left corpusMasterName)
-                                            (Nothing :: Maybe HyperdataCorpus)
-      masterListId <- getOrMkList masterCorpusId masterUserId
-      _triggers    <- initLastTriggers masterListId
-      pure ()
-
+  let _secret = _gc_secretkey cfg
 
   withDevEnv iniPath $ \env -> do
     -- First upgrade the Database Schema
-    _ <- runCmdDev env sqlSchema
-
-    -- Then upgrade the triggers
-    _ <- runCmdDev env (initFirstTriggers secret :: Cmd GargError [Int64])
-    _ <- runCmdDev env (contextsTriggers         :: Cmd GargError ())
-
-   -- Move nodes to contexts table 
-    _ <- runCmdDev env sqlNodes2Contexts
-
-   -- Update the hashes
-    _ <- runCmdDev env sqlUpdateTriggerHash
+    _ <- runCmdDev env (migrateFromDirToDb :: Cmd GargError ())
 
     ___
     putStrLn "Uprade done with success !"
@@ -100,7 +78,7 @@ main = do
     pure ()
 
 
-
+{-
 sqlUpdateTriggerHash :: Cmd'' DevEnv IOException Int64
 sqlUpdateTriggerHash = do
   execPGSQuery query ()
@@ -284,5 +262,4 @@ sqlSchema = do
 
   |]
 
-
-
+-}

bin/gargantext_stop

 #!/bin/bash
 
 tmux kill-session -t gargantext
+
+docker ps -a | grep garg | awk '{print $1}' | while read p; do
+ docker stop $p && docker rm $p
+done

bin/gargantext_tmux

@@ -3,4 +3,5 @@
 tmux new -d -s gargantext './server' \; \
             split-window -h -d 'cd ./purescript-gargantext ; ./server' \; \
             select-pane -t 1 \; \
-            split-window -d    'cd deps/CoreNLP ; ./startServer.sh' \; \
+            split-window -d    'cd deps/nlp/CoreNLP ; ./startServer.sh' \; \
+            split-window -d    'cd deps/nlp/spacy-server ; source env/bin/activate ; ./server' \; \

bin/install

 #!/bin/bash
 
 #stack install --nix --profile --test --fast --no-install-ghc --skip-ghc-check
-stack install --nix --test --no-install-ghc --skip-ghc-check
+
+if [[ $1 == "dev" ]] ;
+  then
+    echo "DEV install"
+    env LANG=C.UTF-8 stack install --nix --no-install-ghc --skip-ghc-check --no-haddock-deps
+  else
+    echo "PROD install (with documentation)" 
+    env LANG=C.UTF-8 stack install --haddock --nix --test --no-install-ghc --skip-ghc-check --no-haddock-deps
+fi

bin/psql

 #!/bin/bash
 
+
+if [[ $1 == "" ]]
+then echo "USAGE : ./psql gargantext.ini"
+else 
+
 INIFILE=$1
 
 getter () {
   grep $1 $INIFILE | sed "s/^.*= //"
 }
 
-connect () {
 USER=$(getter "DB_USER")
 NAME=$(getter "DB_NAME")
 PASS=$(getter "DB_PASS")
 HOST=$(getter "DB_HOST")
 PORT=$(getter "DB_PORT")
+
+# "postgresql://${USER}:${PASS}@${HOST}:${PORT}/${NAME}"
+
+GARGDB="postgresql://${USER}:${PASS}@${HOST}:${PORT}/${NAME}"
+
+#echo "connecting to $GARGDB"
+
 psql "postgresql://${USER}:${PASS}@${HOST}:${PORT}/${NAME}"
-}
 
-if [[ $1 == "" ]]
-then echo "USAGE : ./psql gargantext.ini"
-else connect $INIFILE
 fi
 
 

cabal.project

-packages: .
-
-allow-newer: base, accelerate, servant, time, classy-prelude
-
--- Patches
-source-repository-package
-  type: git
-  location: https://github.com/alpmestan/servant-job.git
-  tag: ceb251b91e8ec1804198422a3cdbdab08d843b79
-
-source-repository-package
-  type: git
-  location: https://github.com/alpmestan/ekg-json.git
-  tag: fd7e5d7325939103cd87d0dc592faf644160341c
-
-source-repository-package
-  type: git
-  location: https://github.com/haskell-servant/servant.git
-  tag: c2af6e775d1d36f2011d43aff230bb502f8fba63
-  subdir: servant/
-          servant-server/
-          servant-client-core/
-          servant-client/
-          servant-auth/servant-auth/
-          servant-auth/servant-auth-client/
-          servant-auth/servant-auth-server/
-
-source-repository-package
-  type: git
-  location: https://github.com/delanoe/patches-map.git
-  tag: 76cae88f367976ff091e661ee69a5c3126b94694
-
-source-repository-package
-  type: git
-  location: https://gitlab.iscpif.fr/gargantext/patches-class.git
-  tag: 271ba32d6c940029dc653354dd7974a819f48e77
-
-source-repository-package
-  type: git
-  location: https://gitlab.iscpif.fr/cgenie/haskell-gargantext-prelude.git
-  tag: 6bfdb29e9a576472c7fd7ebe648ad101e5b3927f
-
--- External Data API connectors
-source-repository-package
-  type: git
-  location: https://gitlab.iscpif.fr/gargantext/crawlers/pubmed.git
-  tag: 9cdba6423decad5acfacb0f274212fd8723ce734
-
-source-repository-package
-  type: git
-  location: https://gitlab.iscpif.fr/gargantext/crawlers/isidore.git
-  tag: 3db385e767d2100d8abe900833c6e7de3ac55e1b
-
-source-repository-package
-  type: git
-  location: https://gitlab.iscpif.fr/gargantext/crawlers/istex.git
-  tag: daeae80365250c4bd539f0a65e271f9aa37f731f
-
-source-repository-package
-  type: git
-  location: https://gitlab.iscpif.fr/gargantext/crawlers/hal.git
-  tag: 020f5f9b308f5c23c925aedf5fb11f8b4728fb19
-
--- Graphs
-source-repository-package
-  type: git
-  location: https://github.com/alpmestan/haskell-igraph.git
-  tag: 9f55eb36639c8e0965c8bc539a57738869f33e9a
-
--- Data mining
-source-repository-package
-  type: git
-  location: https://github.com/delanoe/data-time-segment.git
-  tag: 10a416b9f6c443866b36479c3441ebb3bcdeb7ef
-
-source-repository-package
-  type: git
-  location: https://gitlab.iscpif.fr/gargantext/hlcm.git
-  tag: 6f0595d2421005837d59151a8b26eee83ebb67b5
-
-source-repository-package
-  type: git
-  location: https://github.com/delanoe/hstatistics.git
-  tag: 90eef7604bb230644c2246eccd094d7bfefcb135
-
-source-repository-package
-  type: git
-  location: https://github.com/paulrzcz/HSvm.git
-  tag: 3fe28b683aba5ddf05e3b5f8eced0bd05c5a29f9
-
--- servant
-source-repository-package
-  type: git
-  location: https://github.com/delanoe/servant-static-th.git
-  tag: 8cb8aaf2962ad44d319fcea48442e4397b3c49e8
-
--- source-repository-package
---   type: git
---   location: https://github.com/alpmestan/servant-job.git
---   tag: e9a4c57ca3ddee450627ed251df942effb27e4be
-
--- Database libraries
-source-repository-package
-  type: git
-  location: https://github.com/delanoe/haskell-opaleye.git
-  tag: 756cb90f4ce725463d957bc899d764e0ed73738c
-
-source-repository-package
-  type: git
-  location: https://github.com/delanoe/hsparql.git
-  tag: 308c74b71a1abb0a91546fa57d353131248e3a7f
-
-source-repository-package
-  type: git
-  location: https://github.com/alpmestan/rdf4h.git
-  tag: fc24987d3af348a677748f226e48d64779a694e9
-
-
--- Accelerate
-source-repository-package
-  type: git
-  location: https://gitlab.iscpif.fr/anoe/accelerate.git
-  tag: f5c0e0071ec7b6532f9a9cd3eb33d14f340fbcc9
-
-source-repository-package
-  type: git
-  location: https://gitlab.iscpif.fr/anoe/accelerate-utility.git
-  tag: 83ada76e78ac10d9559af8ed6bd4064ec81308e4
-
-
--- Wikidata 
-source-repository-package
-  type: git
-  location: https://github.com/rspeer/wikiparsec.git
-  tag: 9637a82344bb70f7fa8f02e75db3c081ccd434ce
-
-
-constraints: unordered-containers==0.2.14.*,
-             servant-ekg==0.3.1,
-             time==1.9.3,
-             stm==2.5.0.1

devops/docker/Dockerfile-ihaskell

+FROM gibiansky/ihaskell
+
+USER 0
+
+# gargantext stuff
+RUN apt-get update && \
+    apt-get install -y libblas-dev \
+    libbz2-dev \
+    libcairo2-dev \
+    libgsl-dev \
+    liblapack-dev \
+    liblzma-dev \
+    libmagic-dev \
+    libpq-dev \
+    librust-pangocairo-dev \
+    lzma-dev \
+    libzmq3-dev \
+    pkg-config    && \
+    rm -rf /var/lib/apt/lists/*
+
+# ADD . /home/joyvan/src
+# RUN chown -R 1000 /home/joyvan/src
+
+USER 1000
+
+# WORKDIR /home/joyvan/src
+# RUN stack install --fast
+
+RUN stack install aeson aeson-lens aeson-pretty array \
+    blaze-html blaze-markup bytestring \
+    conduit conduit-extra containers \
+    deepseq directory duckling \
+    ekg-core ekg-json exceptions \
+    fgl filepath formatting \
+    hashable hsparql http-api-data http-client http-client-tls http-conduit \
+    ini json-stream lens monad-control monad-logger \
+    morpheus-graphql morpheus-graphql-app morpheus-graphql-core morpheus-graphql-subscriptions \
+    mtl natural-transformation opaleye pandoc parallel parsec rdf4h \
+    postgresql-simple profunctors protolude semigroups \
+    servant servant-auth servant-auth-swagger servant-server \
+    tagsoup template-haskell time transformers transformers-base \
+    tuple unordered-containers uuid vector \
+    wai wai-app-static wai-cors wai-extra wai-websockets warp wreq \
+    xml-conduit xml-types yaml zip zlib --fast
+
+#CMD ["jupyter", "notebook", "--ip", "0.0.0.0"]
+CMD ["stack", "exec", "jupyter", "--", "notebook", "--ip", "0.0.0.0"]
+

devops/docker/bin/mvDockerData

+#!/bin/bash
+
+
+sudo service docker stop
+
+echo "{ \"data-root\": \"$1\" }"  > /etc/docker/daemon.json
+
+sudo mkdir -p $1
+sudo apt update && sudo apt -y install rsync
+sudo rsync -aP /var/lib/docker/ $1
+sudo mv /var/lib/docker /var/lib/docker.old
+
+sudo service docker start
+
+

devops/docker/docker-compose.yaml

 version: '3'
 
 services:
+  #postgres11:
+  #  #image: 'postgres:latest'
+  #  image: 'postgres:11'
+  #  network_mode: host
+  #  #command: ["postgres", "-c", "log_statement=all"]
+  #  #ports:
+  #    #- 5432:5432
+  #  environment:
+  #    POSTGRES_USER: gargantua
+  #    POSTGRES_PASSWORD: C8kdcUrAQy66U
+  #    POSTGRES_DB: gargandbV5
+  #  volumes:
+  #    - garg-pgdata:/var/lib/postgresql/data
+  #    - ../:/gargantext
+  #    - ../dbs:/dbs
+  #    - ../postgres/schema.sql:/docker-entrypoint-initdb.d/schema.sql:ro
+
   postgres:
     #image: 'postgres:latest'
-    image: 'postgres:11'
+    image: 'postgres:14'
+    shm_size: 1g  # https://stackoverflow.com/a/56754077
     network_mode: host
+    #command: ["postgres", "-c", "log_statement=all"]
     #ports:
-      #- 5432:5432
+    #  - 5432:5432
     environment:
       POSTGRES_USER: gargantua
       POSTGRES_PASSWORD: C8kdcUrAQy66U
       POSTGRES_DB: gargandbV5
     volumes:
-      - garg-pgdata:/var/lib/postgresql/data
+      - garg-pgdata14:/var/lib/postgresql/data
       - ../:/gargantext
       - ../dbs:/dbs
       - ../postgres/schema.sql:/docker-entrypoint-initdb.d/schema.sql:ro
@@ -35,5 +54,14 @@ services:
     ports:
       - 9000:9000
 
+  johnsnownlp:
+    image: 'johnsnowlabs/nlp-server:latest'
+    volumes:
+      - js-cache:/home/johnsnowlabs/cache_pretrained
+    ports:
+      - 5000:5000
+
 volumes:
-  garg-pgdata:
+  #garg-pgdata:
+  garg-pgdata14:
+  js-cache:

devops/docker/install_docker

+#!/bin/bash
+
+
+
+sudo apt-get update
+
+sudo apt-get install \
+    ca-certificates \
+    curl \
+    gnupg \
+    lsb-release
+
+curl -fsSL https://download.docker.com/linux/debian/gpg | sudo gpg --dearmor -o /usr/share/keyrings/docker-archive-keyring.gpg
+
+echo \
+  "deb [arch=$(dpkg --print-architecture) signed-by=/usr/share/keyrings/docker-archive-keyring.gpg] https://download.docker.com/linux/debian \
+  $(lsb_release -cs) stable" | sudo tee /etc/apt/sources.list.d/docker.list > /dev/null
+
+sudo apt-get update
+
+sudo apt-get install docker-ce docker-ce-cli containerd.io
+
+# specific to our LAL config
+sudo adduser debian docker
+
+

devops/docker/install_docker.sh

+#!/bin/bash
+
+
+
+ sudo apt-get update
+
+ sudo apt-get install \
+    ca-certificates \
+    curl \
+    gnupg \
+    lsb-release
+
+
+sudo mkdir -p /etc/apt/keyrings
+curl -fsSL https://download.docker.com/linux/debian/gpg | sudo gpg --dearmor -o /etc/apt/keyrings/docker.gpg
+
+
+ echo \
+  "deb [arch=$(dpkg --print-architecture) signed-by=/etc/apt/keyrings/docker.gpg] https://download.docker.com/linux/debian \
+  $(lsb_release -cs) stable" | sudo tee /etc/apt/sources.list.d/docker.list > /dev/null
+
+
+sudo apt-get update
+sudo apt-get install docker-ce docker-ce-cli containerd.io docker-compose-plugin
+
+sudo adduser debian docker

devops/nginx/index.html

+<!DOCTYPE html>
+<html>
+<head>
+<title>Welcome to GarganText!</title>
+<style>
+    body {
+        width: 35em;
+        margin: 0 auto;
+        font-family: Tahoma, Verdana, Arial, sans-serif;
+    }
+</style>
+</head>
+<body>
+<img class="" src="https://dl.gargantext.org/Gargantext_Logo_V4.png" alt="image alt" title="Garg Logo" width="300">
+<h1>Welcome</h1>
+<p>If you see this page then the GarganText Server is under maintenance to take care of your data.</p>
+
+<p>With the current upgrade we will be back with a more powerful environment!</p>
+
+<p><em>For any question keep in touch by email at: contact AT gargantext DOT org</em></p>
+
+<p><em>Thank you for using GarganText.</em></p>
+<p> Best regards from the GarganText team</p>
+</body>
+</html>

devops/postgres/schema.sql

@@ -17,6 +17,7 @@ CREATE TABLE public.auth_user (
     is_staff     BOOLEAN NOT NULL,
     is_active    BOOLEAN NOT NULL,
     date_joined  TIMESTAMP with time zone DEFAULT now() NOT NULL,
+    forgot_password_uuid TEXT,
     PRIMARY KEY (id)
 );
 ALTER TABLE public.auth_user OWNER TO gargantua;
@@ -135,16 +136,27 @@ CREATE TABLE public.nodes_nodes (
 ALTER TABLE public.nodes_nodes OWNER TO gargantua;
 
 
+
 -- To attach contexts to a Corpus
 CREATE TABLE public.nodes_contexts (
+    id SERIAL                          ,
     node_id    INTEGER NOT NULL REFERENCES public.nodes(id)    ON DELETE CASCADE,
     context_id INTEGER NOT NULL REFERENCES public.contexts(id) ON DELETE CASCADE,
     score    REAL    ,
     category INTEGER ,
-    PRIMARY KEY (node_id, context_id)
+    PRIMARY KEY (id)
 );
 ALTER TABLE public.nodes_contexts OWNER TO gargantua;
 
+CREATE TABLE public.nodescontexts_nodescontexts (
+    nodescontexts1 INTEGER NOT NULL REFERENCES public.nodes_contexts(id) ON DELETE CASCADE,
+    nodescontexts2 INTEGER NOT NULL REFERENCES public.nodes_contexts(id) ON DELETE CASCADE,
+
+    PRIMARY KEY (nodescontexts1, nodescontexts2)
+);
+ALTER TABLE public.nodescontexts_nodescontexts OWNER TO gargantua;
+
+
 ---------------------------------------------------------------
 CREATE TABLE public.context_node_ngrams (
     context_id    INTEGER NOT NULL REFERENCES public.contexts (id) ON DELETE CASCADE,
@@ -152,12 +164,13 @@ CREATE TABLE public.context_node_ngrams (
     ngrams_id     INTEGER NOT NULL REFERENCES public.ngrams   (id) ON DELETE CASCADE,
     ngrams_type   INTEGER  ,
     weight double precision,
+    doc_count     INTEGER DEFAULT 0,
     PRIMARY KEY (context_id, node_id, ngrams_id, ngrams_type)
   );
 ALTER TABLE public.context_node_ngrams OWNER TO gargantua;
 
 CREATE TABLE public.context_node_ngrams2 (
-    context_id      INTEGER NOT NULL REFERENCES public.contexts  (id)       ON DELETE CASCADE,
+    context_id      INTEGER NOT NULL REFERENCES public.contexts     (id) ON DELETE CASCADE,
     nodengrams_id   INTEGER NOT NULL REFERENCES public.node_ngrams  (id) ON DELETE CASCADE,
     weight double   precision,
     PRIMARY KEY (context_id, nodengrams_id)
@@ -185,8 +198,6 @@ PRIMARY KEY (node_id, nodengrams_id)
 ALTER TABLE public.node_node_ngrams2 OWNER TO gargantua;
 
 
-
-
 --------------------------------------------------------------
 
 --CREATE TABLE public.nodes_ngrams_repo (
@@ -209,6 +220,39 @@ CREATE TABLE public.rights (
 ALTER TABLE public.rights OWNER TO gargantua;
 
 ------------------------------------------------------------
+-- Node Story
+
+CREATE TABLE public.node_stories (
+  id SERIAL,
+  node_id INTEGER NOT NULL,
+  version INTEGER NOT NULL,
+  ngrams_type_id INTEGER NOT NULL,
+  ngrams_id INTEGER NOT NULL,
+  --children TEXT[],
+  ngrams_repo_element jsonb DEFAULT '{}'::jsonb NOT NULL,
+  PRIMARY KEY (id),
+  FOREIGN KEY (node_id) REFERENCES public.nodes(id) ON DELETE CASCADE,
+  FOREIGN KEY (ngrams_id) REFERENCES public.ngrams(id) ON DELETE CASCADE
+);
+ALTER TABLE public.node_stories OWNER TO gargantua;
+
+CREATE UNIQUE INDEX ON public.node_stories USING btree (node_id, ngrams_type_id, ngrams_id);
+
+
+create table public.node_story_archive_history (
+  id SERIAL,
+  node_id INTEGER NOT NULL,
+  ngrams_type_id INTEGER NOT NULL,
+  ngrams_id INTEGER NOT NULL,
+  patch jsonb DEFAULT '{}'::jsonb NOT NULL,
+  version INTEGER NOT NULL DEFAULT 0,
+  PRIMARY KEY (id),
+  FOREIGN KEY (node_id) REFERENCES public.nodes(id) ON DELETE CASCADE,
+  FOREIGN KEY (ngrams_id) REFERENCES public.ngrams(id) ON DELETE CASCADE
+);
+ALTER TABLE public.node_story_archive_history OWNER TO gargantua;
+
+
 ------------------------------------------------------------
 -- INDEXES
 CREATE INDEX        ON public.auth_user USING btree (username varchar_pattern_ops);
@@ -230,7 +274,7 @@ CREATE INDEX        ON public.contexts USING btree (id, typename, date DESC);
 CREATE INDEX        ON public.contexts USING btree (typename, id);
 CREATE UNIQUE INDEX ON public.contexts USING btree (hash_id);
 
-
+CREATE INDEX ON public.nodescontexts_nodescontexts USING btree (nodescontexts1, nodescontexts2);
 -- CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqId'::text)));
 -- CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqIdBdd'::text)));
 -- CREATE UNIQUE INDEX ON public.nodes USING btree (typename, parent_id, ((hyperdata ->> 'uniqId'::text)));
@@ -249,6 +293,7 @@ CREATE UNIQUE INDEX ON public.node_ngrams USING btree (node_id,node_subtype, ngr
 CREATE UNIQUE INDEX ON public.nodes_nodes  USING btree (node1_id, node2_id);
 CREATE INDEX        ON public.nodes_nodes  USING btree (node1_id, node2_id, category);
 
+
 -- To make the links between Corpus Node and its contexts
 CREATE UNIQUE INDEX ON public.nodes_contexts  USING btree (node_id, context_id);
 CREATE INDEX        ON public.nodes_contexts  USING btree (node_id, context_id, category);
@@ -290,4 +335,3 @@ CREATE OR REPLACE function node_pos(int, int) returns bigint
 
 --drop index node_by_pos;
 --create index node_by_pos on nodes using btree(node_pos(id,typename));
-

devops/postgres/tools/removeUnusedDocuments.sql

 
 WITH repeated AS
-  ( select nn.node2_id AS id, count(*) AS c
-    FROM nodes_nodes nn 
-    GROUP BY nn.node2_id
+  ( 
+    select nn.context_id AS id, count(*) AS c
+    FROM nodes_contexts nn 
+    GROUP BY nn.context_id
   )
 
-DELETE FROM nodes n 
+DELETE FROM contexts c
 USING repeated r
 WHERE
-n.id = r.id
-AND r.c <= 1
-AND n.typename = 4
+c.id = r.id
+AND r.c = 1
+AND c.typename = 4
 ; 
 

devops/postgres/upgrade/0.0.5.7.7.sql

+
+ALTER TABLE nodes_contexts DROP CONSTRAINT nodes_contexts_pkey;
+ALTER TABLE nodes_contexts ADD COLUMN id SERIAL PRIMARY KEY ;
+
+CREATE TABLE public.nodescontexts_nodescontexts (
+    nodescontexts1 INTEGER NOT NULL REFERENCES public.nodes_contexts(id) ON DELETE CASCADE,
+    nodescontexts2 INTEGER NOT NULL REFERENCES public.nodes_contexts(id) ON DELETE CASCADE,
+
+    PRIMARY KEY (nodescontexts1, nodescontexts2)
+);
+ALTER TABLE public.nodescontexts_nodescontexts OWNER TO gargantua;
+
+CREATE INDEX ON public.nodescontexts_nodescontexts USING btree (nodescontexts1, nodescontexts2)
+

devops/postgres/upgrade/0.0.5.7.8.sql

+ALTER TABLE auth_user ADD COLUMN forgot_password_uuid text;

devops/postgres/upgrade/0.0.5.8.9.5.sql

+update contexts c set parent_id = id where parent_id is NULL;

devops/postgres/upgrade/0.0.6.0.sql

+create table public.node_stories (
+  id SERIAL,
+  node_id INTEGER NOT NULL,
+  archive jsonb DEFAULT '{}'::jsonb NOT NULL,
+  PRIMARY KEY (id),
+  FOREIGN KEY (node_id) REFERENCES public.nodes(id) ON DELETE CASCADE
+);
+ALTER TABLE public.node_stories OWNER TO gargantua;
+
+CREATE UNIQUE INDEX ON public.node_stories USING btree (node_id);
+
+
+
+create table public.node_story_archive_history (
+  id SERIAL,
+  node_id INTEGER NOT NULL,
+  ngrams_type_id INTEGER NOT NULL,
+  ngrams_id INTEGER NOT NULL,
+  patch jsonb DEFAULT '{}'::jsonb NOT NULL,
+  PRIMARY KEY (id),
+  FOREIGN KEY (node_id) REFERENCES public.nodes(id) ON DELETE CASCADE,
+  FOREIGN KEY (ngrams_id) REFERENCES public.ngrams(id) ON DELETE CASCADE
+);
+ALTER TABLE public.node_story_archive_history OWNER TO gargantua;
+
+
+-- INSERT INTO node_story_archive_history (node_id, ngrams_type_id, patch) SELECT t.node_id, t.ngrams_type_id, t.patch FROM
+-- (
+-- WITH q AS (SELECT node_id, history.*, row_number() over (ORDER BY node_id) AS sid
+-- FROM node_stories,
+-- jsonb_to_recordset(archive->'history') AS history("Authors" jsonb, "Institutes" jsonb, "NgramsTerms" jsonb, "Sources" jsonb))
+
+-- (SELECT node_id, sid, 1 AS ngrams_type_id, "Authors" AS patch FROM q WHERE "Authors" IS NOT NULL)
+-- UNION (SELECT node_id, sid, 2 AS ngrams_type_id, "Institutes" AS patch FROM q WHERE "Institutes" IS NOT NULL)
+-- UNION (SELECT node_id, sid, 4 AS ngrams_type_id, "NgramsTerms" AS patch FROM q WHERE "NgramsTerms" IS NOT NULL)
+-- UNION (SELECT node_id, sid, 3 AS ngrams_type_id, "Sources" AS patch FROM q WHERE "Sources" IS NOT NULL)
+-- ORDER BY node_id, ngrams_type_id, sid
+-- ) AS t;

devops/postgres/upgrade/0.0.6.1.sql

+-- Start a new transaction. In case data migration goes wrong, we are
+-- back to our original table.
+BEGIN;
+
+-- we will migrate data here
+-- rename old table and create a new one
+
+ALTER TABLE public.node_stories RENAME TO node_stories_old;
+
+CREATE TABLE public.node_stories (
+  id SERIAL,
+  node_id INTEGER NOT NULL,
+  version INTEGER NOT NULL,
+  ngrams_type_id INTEGER NOT NULL,
+  ngrams_id INTEGER NOT NULL,
+  --children TEXT[],
+  ngrams_repo_element jsonb DEFAULT '{}'::jsonb NOT NULL,
+  PRIMARY KEY (id),
+  FOREIGN KEY (node_id) REFERENCES public.nodes(id) ON DELETE CASCADE,
+  FOREIGN KEY (ngrams_id) REFERENCES public.ngrams(id) ON DELETE CASCADE
+);
+ALTER TABLE public.node_stories OWNER TO gargantua;
+
+CREATE UNIQUE INDEX ON public.node_stories USING btree (node_id, ngrams_type_id, ngrams_id);
+
+-- Authors (ngrams_type_id = 1), see G.D.S.Ngrams.hs -> ngramsTypeId
+INSERT INTO public.node_stories
+  (node_id, version, ngrams_type_id, ngrams_id, ngrams_repo_element)
+  SELECT node_id, (archive->'version')::int, 1, ngrams.id, j.value
+    FROM node_stories_old
+    CROSS JOIN jsonb_each(archive->'state'->'Authors') AS j
+    JOIN ngrams ON terms = j.key;
+-- we will leave children for later, small steps
+-- INSERT INTO public.node_stories
+--   (node_id, version, ngrams_type_id, ngrams_id, children, ngrams_repo_element)
+--   SELECT node_id, (archive->'version')::int, 1, ngrams.id, c.children, (j.value - 'children')
+--     FROM node_stories_old
+--     CROSS JOIN jsonb_each(archive->'state'->'Authors') AS j
+--     CROSS JOIN LATERAL (SELECT array_agg(d.elem) AS children FROM jsonb_array_elements_text(j.value->'children') AS d(elem)) AS c
+--     JOIN ngrams ON terms = j.key;
+
+-- Institutes (ngrams_type_id = 2)
+INSERT INTO public.node_stories
+  (node_id, version, ngrams_type_id, ngrams_id, ngrams_repo_element)
+  SELECT node_id, (archive->'version')::int, 2, ngrams.id, j.value
+    FROM node_stories_old
+    CROSS JOIN jsonb_each(archive->'state'->'Institutes') AS j
+  JOIN ngrams ON terms = j.key;
+-- Sources (ngrams_type_id = 3)
+INSERT INTO public.node_stories
+  (node_id, version, ngrams_type_id, ngrams_id, ngrams_repo_element)
+  SELECT node_id, (archive->'version')::int, 3, ngrams.id, j.value
+    FROM node_stories_old
+    CROSS JOIN jsonb_each(archive->'state'->'Sources') AS j
+    JOIN ngrams ON terms = j.key;
+-- NgramsTerms (ngrams_type_id = 4)
+INSERT INTO public.node_stories
+  (node_id, version, ngrams_type_id, ngrams_id, ngrams_repo_element)
+  SELECT node_id, (archive->'version')::int, 4, ngrams.id, j.value
+    FROM node_stories_old
+    CROSS JOIN jsonb_each(archive->'state'->'NgramsTerms') AS j
+    JOIN ngrams ON terms = j.key;
+
+-- finally, write out the stuff
+COMMIT;

devops/postgres/upgrade/0.0.6.2.sql

+ALTER TABLE node_story_archive_history
+  ADD COLUMN version INTEGER NOT NULL DEFAULT 0;

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);

devops/postgres/upgrade/0.0.6.7.3_undo.sql

+ALTER TABLE context_node_ngrams
+  DROP COLUMN doc_count ;

devops/postgres/upgrade/0.0.6.8.3.sql

+ALTER TABLE context_node_ngrams
+  ADD COLUMN doc_count INTEGER DEFAULT 0;

devops/postgres/upgrade/0.0.6.9.4.sql

+
+UPDATE auth_user old SET email = LOWER(new.email) 
+FROM auth_user new
+WHERE old.email = new.email
+
+
+

devops/upgrade/0.0.6.1.sh

+#!/bin/bash
+
+# To be executed at the root of the project
+# To upgrade from 0.0.5.9 to 0.0.6.2
+sudo apt update
+sudo apt -yy upgrade
+
+sudo sed -i "s/buster/bullseye/g" /etc/apt/sources.list
+sudo apt update
+sudo apt -yy dist-upgrade
+
+##############################################################
+# BACKUP
+sudo -i -u postgres bash << EOF 
+pg_dumpall > /tmp/backup.dump
+EOF
+##############################################################
+
+sudo sed -i "s/bullseye/bookworm/g" /etc/apt/sources.list
+sudo apt update
+sudo apt -yy dist-upgrade
+sudo apt install -y postgresql-14 libpq-dev
+sudo apt remove --purge postgresql-11 postgresql-13
+sudo apt autoremove
+
+##############################################################
+# BACKUP
+sudo -i -u postgres bash << EOF 
+psql < /tmp/backup.dump
+EOF
+
+##############################################################
+# DB CONFIG
+sed -i "s/DB_PORT = 5432/DB_PORT = 5434/" gargantext.ini
+
+# be sure the DB password is the right one
+DBPASS=$(grep "DB_PASS" gargantext.ini | sed "s/^.*= //")
+echo $DBPASS
+
+sudo -i -u postgres psql << EOF 
+ALTER ROLE gargantua password '${DBPASS}';
+EOF
+
+##############################################################
+# Make sure compilation is ok
+git pull origin dev
+./bin/install
+
+##############################################################
+# Database upgrade
+echo "0.0.6.0 SQL upgrade"
+./bin/psql gargantext.ini < devops/postgres/upgrade/0.0.6.0.sql
+
+echo "0.0.6.1 SQL upgrade"
+./bin/psql gargantext.ini < devops/postgres/upgrade/0.0.6.1.sql
+
+echo "0.0.6.2 SQL upgrade"
+./bin/psql gargantext.ini < devops/postgres/upgrade/0.0.6.2.sql
+
+echo "Executing script haskell upgrade"
+~/.local/bin/gargantext-upgrade gargantext.ini
+
+echo "Upgrade is over"
+
+

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
 
@@ -19,6 +22,7 @@ DATA_FILEPATH = FILEPATH_TO_CHANGE
 # Data path to local files (do not use quotes)
 REPO_FILEPATH = FILEPATH_TO_CHANGE
 
+PUBMED_API_KEY = ENTER_PUBMED_API_KEY
 
 
 # [external]
@@ -36,6 +40,10 @@ FRAME_ISTEX_URL  = URL_TO_CHANGE
 MAX_DOCS_PARSERS = 1000000
 MAX_DOCS_SCRAPERS = 10000
 
+# in seconds
+JS_JOB_TIMEOUT = 1800
+JS_ID_TIMEOUT = 1800
+
 [server]
 # Server config (TODO connect in ReaderMonad)
 ALLOWED_ORIGIN = http://localhost

nix/pinned-22.05.nix

+import (builtins.fetchGit {
+  name = "nixos-22.05";
+  url = "https://github.com/nixos/nixpkgs";
+  ref = "refs/heads/nixos-22.05";
+  rev = "ce6aa13369b667ac2542593170993504932eb836";
+})

nix/pkgs.nix

-{ pkgs ? import ./pinned-21.05.nix {} }:
+{ pkgs ? import ./pinned-22.05.nix {} }:
 
 rec {
   inherit pkgs;
-  ghc = pkgs.haskell.compiler.ghc8104;
+  ghc = pkgs.haskell.compiler.ghc8107;
   hsBuildInputs = [
     ghc
     pkgs.cabal-install
   ];
   nonhsBuildInputs = with pkgs; [
     bzip2
+    czmq
     docker-compose
     git
     gmp
@@ -16,6 +17,7 @@ rec {
     #haskell-language-server
     hlint
     igraph
+    libffi
     liblapack
     lzma
     pcre
@@ -29,7 +31,10 @@ rec {
     expat
     icu
     graphviz
-  ];
+    llvm_9
+  ] ++ ( lib.optionals stdenv.isDarwin [
+       darwin.apple_sdk.frameworks.Accelerate
+       ]);
   libPaths = pkgs.lib.makeLibraryPath nonhsBuildInputs;
   shellHook = ''
     export LD_LIBRARY_PATH="${pkgs.gfortran7.cc.lib}:${libPaths}:$LD_LIBRARY_PATH"

package.yaml

 name: gargantext
-version: '0.0.5.6.7'
+
+#         +------------ Layer 3
+#         | +--+------- Layer 2
+#         | | +-------- Layer 1  : New versions with API changes
+#         | | | +-----  Layers * : New versions with API additions
+#         | | | | +---  Layers * : New versions without API breaking changes
+#         | | | | |
+version: '0.0.6.9.5'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data
@@ -25,6 +32,7 @@ default-extensions:
   - OverloadedStrings
   - RankNTypes
   - RecordWildCards
+  - StrictData
 data-files:
   - ekg-assets/index.html
   - ekg-assets/monitor.js
@@ -47,70 +55,84 @@ library:
   exposed-modules:
   - Gargantext
   - Gargantext.API
+  - Gargantext.API.Admin.Auth.Types
+  - Gargantext.API.Admin.EnvTypes
+  - Gargantext.API.Admin.Settings
+  - Gargantext.API.Admin.Types
   - Gargantext.API.Dev
   - Gargantext.API.HashedResponse
-  - Gargantext.API.Node
-  - Gargantext.API.Node.File
   - Gargantext.API.Ngrams
+  - Gargantext.API.Ngrams.Prelude
   - Gargantext.API.Ngrams.Tools
   - Gargantext.API.Ngrams.Types
-  - Gargantext.API.Ngrams.Prelude
-  - Gargantext.API.Admin.Settings
-  - Gargantext.API.Admin.EnvTypes
-  - Gargantext.API.Admin.Auth.Types
-  - Gargantext.API.Admin.Types
+  - Gargantext.API.Node
+  - Gargantext.API.Node.File
+  - Gargantext.API.Node.Share
   - Gargantext.API.Prelude
-  - Gargantext.API.Client
   - Gargantext.Core
+  - Gargantext.Core.Methods.Similarities
   - Gargantext.Core.NodeStory
-  - Gargantext.Core.Methods.Distances
-  - Gargantext.Core.Types
-  - Gargantext.Core.Types.Individu
-  - Gargantext.Core.Types.Main
-  - Gargantext.Core.Utils.Prefix
-  - Gargantext.Database.Action.Flow
-  - Gargantext.Database.Action.Flow.Types
-  - Gargantext.Database.Action.User.New
-  - Gargantext.Database.Query.Table.User
-  - Gargantext.Database.Query.Table.Node
-  - Gargantext.Database.Query.Table.Node.UpdateOpaleye
-  - Gargantext.Database.Query.Table.NgramsPostag
-  - Gargantext.Database.Schema.Ngrams
-  - Gargantext.Database.Prelude
-  - Gargantext.Database.Admin.Trigger.Init
-  - Gargantext.Database.Admin.Config
-  - Gargantext.Database.Admin.Types.Hyperdata
-  - Gargantext.Database.Admin.Types.Node
   - Gargantext.Core.Text
   - Gargantext.Core.Text.Context
-  - Gargantext.Core.Text.Corpus.Parsers
-  - Gargantext.Core.Text.Corpus.Parsers.Date.Parsec
   - Gargantext.Core.Text.Corpus.API
+  - Gargantext.Core.Text.Corpus.Parsers
   - Gargantext.Core.Text.Corpus.Parsers.CSV
+  - Gargantext.Core.Text.Corpus.Parsers.Date.Parsec
   - Gargantext.Core.Text.List.Formats.CSV
   - Gargantext.Core.Text.Metrics
-  - Gargantext.Core.Text.Metrics.TFICF
   - Gargantext.Core.Text.Metrics.CharByChar
   - Gargantext.Core.Text.Metrics.Count
+  - Gargantext.Core.Text.Metrics.TFICF
+  - Gargantext.Core.Text.Prepare
   - Gargantext.Core.Text.Search
   - Gargantext.Core.Text.Terms
+  - Gargantext.Core.Text.Terms.Eleve
   - Gargantext.Core.Text.Terms.Mono
   - Gargantext.Core.Text.Terms.Multi.Lang.En
   - Gargantext.Core.Text.Terms.Multi.Lang.Fr
   - Gargantext.Core.Text.Terms.Multi.RAKE
   - Gargantext.Core.Text.Terms.WithList
+  - Gargantext.Core.Types
+  - Gargantext.Core.Types.Individu
+  - Gargantext.Core.Types.Main
+  - Gargantext.Core.Utils
+  - Gargantext.Core.Utils.Prefix
   - Gargantext.Core.Viz.Graph
+  - Gargantext.Core.Viz.Graph.Index
   - Gargantext.Core.Viz.Graph.Tools
   - Gargantext.Core.Viz.Graph.Tools.IGraph
-  - Gargantext.Core.Viz.Graph.Index
+  - Gargantext.Core.Viz.Graph.Types
   - Gargantext.Core.Viz.Phylo
   - Gargantext.Core.Viz.Phylo.API
   - Gargantext.Core.Viz.Phylo.API.Tools
+  - Gargantext.Core.Viz.Phylo.PhyloExport
   - Gargantext.Core.Viz.Phylo.PhyloMaker
   - Gargantext.Core.Viz.Phylo.PhyloTools
-  - Gargantext.Core.Viz.Phylo.PhyloExport
   - Gargantext.Core.Viz.Phylo.SynchronicClustering
   - Gargantext.Core.Viz.Types
+  - Gargantext.Database.Action.Flow
+  - Gargantext.Database.Action.Flow.Types
+  - Gargantext.Database.Action.User.New
+  - Gargantext.Database.Admin.Config
+  - Gargantext.Database.Admin.Trigger.Init
+  - Gargantext.Database.Admin.Types.Hyperdata
+  - Gargantext.Database.Admin.Types.Node
+  - Gargantext.Database.Prelude
+  - Gargantext.Database.Query.Table.NgramsPostag
+  - Gargantext.Database.Query.Table.Node
+  - Gargantext.Database.Query.Table.Node.UpdateOpaleye
+  - Gargantext.Database.Query.Table.User
+  - Gargantext.Database.Schema.Ngrams
+  - Gargantext.Defaults
+  - 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.Utils.Tuple
   dependencies:
   - HSvm
   - KMP
@@ -120,6 +142,7 @@ library:
   - Unique
   - accelerate
   - accelerate-arithmetic
+  - accelerate-llvm-native
   - accelerate-utility
   - aeson
   - aeson-lens
@@ -143,6 +166,7 @@ library:
   - conduit-extra
   - containers
   - contravariant
+  - crawlerArxiv
   - crawlerHAL
   - crawlerISTEX
   - crawlerIsidore
@@ -169,6 +193,7 @@ library:
   - hashable
   - haskell-igraph
   - hlcm
+  - hsinfomap
   - hsparql
   - hstatistics
   - http-api-data
@@ -178,11 +203,14 @@ library:
   - http-media
   - http-types
   - hxt
+  - ihaskell
   - ini
   - insert-ordered-containers
   - jose
   - json-stream
   - lens
+  - lifted-base
+  - listsafe
   - located-base
   - logging-effect
   - matrix
@@ -236,7 +264,6 @@ library:
   - servant-mock
   - servant-multipart
   - servant-server
-  - servant-static-th
   - servant-swagger
   - servant-swagger-ui
   - servant-xml
@@ -244,6 +271,7 @@ library:
   - singletons # (IGraph)
   - split
   - stemmer
+  - stm
   - swagger2
   - taggy-lens
   - tagsoup
@@ -260,6 +288,7 @@ library:
   - unordered-containers
   - utf8-string
   - uuid
+  - uri-encode
   - validity
   - vector
   - wai
@@ -328,42 +357,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
@@ -421,6 +414,21 @@ executables:
       - gargantext-prelude
       - base
 
+  gargantext-invitations:
+    main: Main.hs
+    source-dirs: bin/gargantext-invitations
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    - -O2
+    - -Wmissing-signatures
+    dependencies:
+      - gargantext
+      - gargantext-prelude
+      - base
+
+
   gargantext-upgrade:
     main: Main.hs
     source-dirs: bin/gargantext-upgrade
@@ -499,6 +507,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

server

@@ -4,6 +4,10 @@ FOLDER="logs"
 FILE=$(date +%Y%m%d%H%M.log)
 LOGFILE=$FOLDER"/"$FILE
 
+#BIN="/home/anoe/projets/gargantext-hs/.stack-work/docker/_home/.local/bin/gargantext-server"
+#BIN="~/.local/bin/gargantext-server"
+
 mkdir -p $FOLDER
 
-~/.local/bin/gargantext-server --ini gargantext.ini --run Dev +RTS > $LOGFILE 2>&1 & tail -F $LOGFILE # -p
+env LANG=en_US.UTF-8 ~/.local/bin/gargantext-server --ini gargantext.ini --run Dev +RTS > $LOGFILE 2>&1 & tail -F $LOGFILE # -p
+#env LANG=en_US.UTF-8 stack --docker exec gargantext-server -- --ini gargantext.ini --run Dev +RTS > $LOGFILE 2>&1 & tail -F $LOGFILE # -p

shell.nix

 { pkgs ? import ./nix/pkgs.nix {} }:
-let 
+let
   myBuildInputs = [
     pkgs.pkgs.docker-compose
     pkgs.pkgs.haskell-language-server
     pkgs.pkgs.stack
   ];
-in  
+in
 pkgs.pkgs.mkShell {
   name = pkgs.shell.name;
   shellHook = pkgs.shell.shellHook;

src-test/Core/Text.hs

-
 {-|
 Module      : Graph.Clustering
 Description : Basic tests to avoid quick regression

src-test/Core/Text/Examples.hs

@@ -28,7 +28,7 @@ module Core.Text.Examples
 
 {-
 import Data.Array.Accelerate (toList, Matrix)
-import Data.Map (Map)
+import Data.Map.Strict (Map)
 import Data.Ord (Down(..))
 import Data.Text (Text)
 import Data.Tuple.Extra (both)
@@ -43,7 +43,7 @@ import Gargantext.Core.Viz.Graph.Index
 import Gargantext.Prelude
 import qualified Data.Array.Accelerate as DAA
 import qualified Data.List as List
-import qualified Data.Map  as Map
+import qualified Data.Map.Strict  as Map
 import qualified Data.Text as Text
 
 -- | Sentences
@@ -100,11 +100,11 @@ ex_cooc = cooc <$> ex_terms
 -- | Tests the specificity and genericity
 --
 -- >>> ex_cooc_mat
--- (fromList [(["glass"],0),(["spoon"],1),(["table"],2),(["wine"],3)],Matrix (Z :. 4 :. 4) 
+-- (fromList [(["glass"],0),(["spoon"],1),(["table"],2),(["wine"],3)],Matrix (Z :. 4 :. 4)
 --   [ 4, 0, 0, 0,
 --     1, 2, 0, 0,
 --     3, 2, 4, 0,
---     3, 1, 2, 3],Matrix (Z :. 4 :. 4) 
+--     3, 1, 2, 3],Matrix (Z :. 4 :. 4)
 --   [ 1.0, 0.25, 0.75, 0.75,
 --     0.0,  1.0,  1.0,  0.5,
 --     0.0,  0.0,  1.0,  0.5,

src-test/Core/Text/Flow.hs

@@ -95,4 +95,3 @@ textFlow' termType contexts = do
   g <- cooc2graph myCooc2
   pure g
 -}
-

src-test/Core/Utils.hs

+{-|
+Module      : Core.Utils
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+module Core.Utils where
+
+import Test.Hspec
+
+import Gargantext.Prelude
+
+import Gargantext.Core.Utils
+
+-- | Core.Utils tests
+test :: IO ()
+test = hspec $ do
+  describe "check if groupWithCounts works" $ do
+    it "simple integer array" $ do
+      (groupWithCounts [1, 2, 3, 1, 2, 3]) `shouldBe` [(1, 2), (2, 2), (3, 2)]
+
+    it "string" $ do
+      (groupWithCounts "abccba") `shouldBe` [('a', 2), ('b', 2), ('c', 2)]

src-test/Main.hs

@@ -11,6 +11,8 @@ Portability : POSIX
 
 import Gargantext.Prelude
 import Gargantext.Core (Lang(..))
+
+import qualified Core.Utils as Utils
 --import qualified Ngrams.Lang.Fr as Fr
 --import qualified Ngrams.Lang as Lang
 import qualified Ngrams.Lang.Occurrences as Occ
@@ -22,11 +24,12 @@ import qualified Utils.Crypto            as Crypto
 
 main :: IO ()
 main = do
+  Utils.test
 --    Occ.parsersTest
 --    Lang.ngramsExtractionTest FR
 --    Lang.ngramsExtractionTest EN
 --    Metrics.main
-  Graph.test 
+  Graph.test
   PD.testFromRFC3339
 --    GD.test
   Crypto.test

src-test/Utils/Crypto.hs

-
 {-|
 Module      : Utils.Crypto
-Description : 
+Description :
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
@@ -43,4 +42,3 @@ test = hspec $ do
     let hash2 = hash (["b","a"] :: [Text])
     it "compare" $ do
       hash1 `shouldBe` hash2
-

src/Gargantext/API.hs

@@ -31,24 +31,28 @@ Pouillard (who mainly made it).
 module Gargantext.API
       where
 
-import Control.Exception (finally)
+import Control.Exception (catch, finally, SomeException)
 import Control.Lens
+import Control.Monad.Except
 import Control.Monad.Reader (runReaderT)
+import Data.Either
 import Data.List (lookup)
+import Data.Text (pack)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Text.IO (putStrLn)
 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 (saveNodeStory)
-import Gargantext.API.Prelude
+import Gargantext.API.Ngrams (saveNodeStoryImmediate)
 import Gargantext.API.Routes
 import Gargantext.API.Server (server)
 import Gargantext.Core.NodeStory
+import qualified Gargantext.Database.Prelude as DB
 import Gargantext.Prelude hiding (putStrLn)
 import Network.HTTP.Types hiding (Query)
 import Network.Wai
@@ -66,11 +70,21 @@ data Mode = Dev | Mock | Prod
 startGargantext :: Mode -> PortNumber -> FilePath -> IO ()
 startGargantext mode port file = do
   env <- newEnv port file
+  runDbCheck env
   portRouteInfo port
   app <- makeApp env
   mid <- makeDevMiddleware mode
   run port (mid app) `finally` stopGargantext env
 
+  where runDbCheck env = do
+          r <- runExceptT (runReaderT DB.dbCheck env) `catch`
+            (\(_ :: SomeException) -> return $ Right False)
+          case r of
+            Right True -> return ()
+            _ -> panic $
+              "You must run 'gargantext-init " <> pack file <>
+              "' before running gargantext-server (only the first time)."
+
 portRouteInfo :: PortNumber -> IO ()
 portRouteInfo port = do
   putStrLn "      ----Main Routes-----      "
@@ -78,10 +92,10 @@ portRouteInfo port = do
   putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 
 -- TODO clean this Monad condition (more generic) ?
-stopGargantext :: HasNodeStorySaver env => env -> IO ()
+stopGargantext :: HasNodeStoryImmediateSaver env => env -> IO ()
 stopGargantext env = do
   putStrLn "----- Stopping gargantext -----"
-  runReaderT saveNodeStory env
+  runReaderT saveNodeStoryImmediate env
 
 {-
 startGargantextMock :: PortNumber -> IO ()
@@ -117,9 +131,9 @@ makeMockApp env = do
             blocking <- fireWall req (env ^. menv_firewall)
             case blocking  of
                 True  -> app req resp
-                False -> resp ( responseLBS status401 [] 
+                False -> resp ( responseLBS status401 []
                               "Invalid Origin or Host header")
-        
+
     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
             { corsOrigins        = Nothing --  == /*
@@ -135,7 +149,7 @@ makeMockApp env = do
 
     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
     --          $ Warp.defaultSettings
-    
+
     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
     pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
 -}
@@ -149,7 +163,7 @@ makeDevMiddleware mode = do
 --            blocking <- fireWall req (env ^. menv_firewall)
 --            case blocking  of
 --                True  -> app req resp
---                False -> resp ( responseLBS status401 [] 
+--                False -> resp ( responseLBS status401 []
 --                              "Invalid Origin or Host header")
 --
     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
@@ -193,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

src/Gargantext/API/Admin/Auth.hs

@@ -22,25 +22,39 @@ TODO-ACCESS Critical
 
 {-# LANGUAGE MonoLocalBinds      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators      #-}
 
 module Gargantext.API.Admin.Auth
   ( auth
+  , forgotPassword
+  , forgotPasswordAsync
   , withAccess
+  , ForgotPasswordAPI
+  , ForgotPasswordAsyncParams
+  , ForgotPasswordAsyncAPI
   )
   where
 
-import Control.Lens (view)
+--import Control.Monad.Logger.Aeson
+--import qualified Text.Blaze.Html5.Attributes as HA
+import Control.Lens (view, (#))
+import Data.Aeson
+import Data.Swagger (ToSchema(..))
+import Data.Text (Text)
 import Data.Text.Lazy (toStrict)
-import Data.Text.Lazy.Encoding (decodeUtf8)
-import Servant
-import Servant.Auth.Server
-import qualified Gargantext.Prelude.Crypto.Auth as Auth
-
+import Data.UUID (UUID, fromText, toText)
+import Data.UUID.V4 (nextRandom)
+import GHC.Generics (Generic)
 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.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC)
-import Gargantext.Core.Mail.Types (HasMail)
+import Gargantext.API.Job (jobLogSuccess)
+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(..))
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId)
 import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool, HasConfig)
 import Gargantext.Database.Query.Table.User
@@ -48,6 +62,13 @@ import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
 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)
+import Servant
+import Servant.Auth.Server
+import qualified Data.Text as Text
+import qualified Data.Text.Lazy.Encoding as LE
+import qualified Gargantext.Prelude.Crypto.Auth as Auth
 
 ---------------------------------------------------
 
@@ -59,7 +80,7 @@ makeTokenForUser uid = do
   jwtS <- view $ settings . jwtSettings
   e <- liftBase $ makeJWT (AuthenticatedUser uid) jwtS Nothing
   -- TODO-SECURITY here we can implement token expiration ^^.
-  either joseError (pure . toStrict . decodeUtf8) e
+  either joseError (pure . toStrict . LE.decodeUtf8) e
   -- TODO not sure about the encoding...
 
 checkAuthRequest :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env)
@@ -70,7 +91,7 @@ checkAuthRequest u (GargPassword p) = do
   candidate <- head <$> getUsersWith u
   case candidate of
     Nothing -> pure InvalidUser
-    Just (UserLight _id _u _email h) ->
+    Just (UserLight { userLight_password = GargPassword h, .. }) ->
       case Auth.checkPassword (Auth.mkPassword p) (Auth.PasswordHash h) of
         Auth.PasswordCheckFail    -> pure InvalidPassword
         Auth.PasswordCheckSuccess -> do
@@ -79,7 +100,7 @@ checkAuthRequest u (GargPassword p) = do
             Nothing  -> pure InvalidUser
             Just uid -> do
               token <- makeTokenForUser uid
-              pure $ Valid token uid
+              pure $ Valid token uid userLight_id
 
 auth :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env)
      => AuthRequest -> Cmd' env err AuthResponse
@@ -88,7 +109,7 @@ auth (AuthRequest u p) = do
   case checkAuthRequest' of
     InvalidUser     -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid user")
     InvalidPassword -> pure $ AuthResponse Nothing (Just $ AuthInvalid "Invalid password")
-    Valid to trId   -> pure $ AuthResponse (Just $ AuthValid to trId) Nothing
+    Valid to trId uId   -> pure $ AuthResponse (Just $ AuthValid to trId uId) Nothing
 
 --type instance BasicAuthCfg = BasicAuthData -> IO (AuthResult AuthenticatedUser)
 
@@ -134,3 +155,136 @@ User can create Team in Teams Folder.
 User can invite User in Team as NodeNode only if Team in his parents.
 All users can access to the Team folder as if they were owner.
 -}
+
+newtype ForgotPasswordAsyncParams =
+  ForgotPasswordAsyncParams { email :: Text }
+  deriving (Generic, Show)
+instance FromJSON ForgotPasswordAsyncParams where
+  parseJSON = genericParseJSON defaultOptions
+instance ToJSON ForgotPasswordAsyncParams where
+  toJSON = genericToJSON defaultOptions
+instance ToSchema ForgotPasswordAsyncParams
+
+type ForgotPasswordAPI = Summary "Forgot password POST API"
+                           :> ReqBody '[JSON] ForgotPasswordRequest
+                           :> Post '[JSON] ForgotPasswordResponse
+                         :<|> Summary "Forgot password GET API"
+                           :> QueryParam "uuid" Text
+                           :> Get '[JSON] ForgotPasswordGet
+
+
+forgotPassword :: GargServer ForgotPasswordAPI
+     -- => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
+forgotPassword = forgotPasswordPost :<|> forgotPasswordGet
+
+forgotPasswordPost :: ( HasConnectionPool env, HasConfig env, HasMail env)
+     => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
+forgotPasswordPost (ForgotPasswordRequest email) = do
+  us <- getUsersWithEmail (Text.toLower email)
+  case us of
+    [u] -> forgotUserPassword u
+    _ -> pure ()
+
+  -- NOTE Sending anything else here could leak information about
+  -- users' emails
+  pure $ ForgotPasswordResponse "ok"
+
+forgotPasswordGet :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env, HasServerError err)
+     => Maybe Text -> Cmd' env err ForgotPasswordGet
+forgotPasswordGet Nothing = pure $ ForgotPasswordGet ""
+forgotPasswordGet (Just uuid) = do
+  let mUuid = fromText uuid
+  case mUuid of
+    Nothing -> throwError $ _ServerError # err404 { errBody = "Not found" }
+    Just uuid' -> do
+      -- fetch user
+      us <- getUsersWithForgotPasswordUUID uuid'
+      case us of
+        [u] -> forgotPasswordGetUser u
+        _ -> throwError $ _ServerError # err404 { errBody = "Not found" }
+
+---------------------
+
+forgotPasswordGetUser :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env, HasServerError err)
+     => UserLight -> Cmd' env err ForgotPasswordGet
+forgotPasswordGetUser (UserLight { .. }) = do
+  -- pick some random password
+  password <- liftBase gargPass
+
+  -- set it as user's password
+  hashed <- liftBase $ Auth.hashPassword $ Auth.mkPassword password
+  let hashed' = Auth.unPasswordHash hashed
+  let userPassword = UserLight { userLight_password = GargPassword hashed', .. }
+  _ <- updateUserPassword userPassword
+
+  -- display this briefly in the html
+
+  -- clear the uuid so that the page can't be refreshed
+  _ <- updateUserForgotPasswordUUID $ UserLight { userLight_forgot_password_uuid = Nothing, .. }
+
+  pure $ ForgotPasswordGet password
+
+forgotUserPassword :: (HasConnectionPool env, HasConfig env, HasMail env)
+     => UserLight -> Cmd' env err ()
+forgotUserPassword (UserLight { .. }) = do
+  --printDebug "[forgotUserPassword] userLight_id" userLight_id
+  --logDebug $ "[forgotUserPassword]" :# ["userLight_id" .= userLight_id]
+  -- generate uuid for email
+  uuid <- generateForgotPasswordUUID
+
+  let userUUID = UserLight { userLight_forgot_password_uuid = Just $ toText uuid, .. }
+
+  -- save user with that uuid
+  _ <- updateUserForgotPasswordUUID userUUID
+
+  -- send email with uuid link
+  cfg <- view $ mailSettings
+  mail cfg (ForgotPassword { user = userUUID })
+
+  -- on uuid link enter: change user password and present it to the
+  -- user
+
+  pure ()
+
+--------------------------
+
+-- Generate a unique (in whole DB) UUID for passwords.
+generateForgotPasswordUUID :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => Cmd' env err UUID
+generateForgotPasswordUUID = do
+  uuid <- liftBase $ nextRandom
+  us <- getUsersWithForgotPasswordUUID uuid
+  case us of
+    [] -> pure uuid
+    _ -> generateForgotPasswordUUID
+
+----------------------------
+
+-- NOTE THe async endpoint is better for the "forget password"
+-- request, because the delay in email sending etc won't reveal to
+-- malicious users emails of our users in the db
+type ForgotPasswordAsyncAPI = Summary "Forgot password asnc"
+                              :> AsyncJobs JobLog '[JSON] ForgotPasswordAsyncParams JobLog
+
+forgotPasswordAsync :: ServerT ForgotPasswordAsyncAPI (GargM Env GargError)
+forgotPasswordAsync =
+  serveJobsAPI ForgotPasswordJob $ \p log' ->
+    forgotPasswordAsync' p (liftBase . log')
+
+forgotPasswordAsync' :: (FlowCmdM env err m)
+  => ForgotPasswordAsyncParams
+  -> (JobLog -> m ())
+  -> m JobLog
+forgotPasswordAsync' (ForgotPasswordAsyncParams { email }) logStatus = do
+  let jobLog = JobLog { _scst_succeeded = Just 1
+                      , _scst_failed    = Just 0
+                      , _scst_remaining = Just 1
+                      , _scst_events    = Just []
+                      }
+  logStatus jobLog
+
+  -- printDebug "[forgotPasswordAsync'] email" email
+
+  _ <- forgotPasswordPost $ ForgotPasswordRequest { _fpReq_email = email }
+
+  pure $ jobLogSuccess jobLog

src/Gargantext/API/Admin/Auth/Types.hs

@@ -23,7 +23,7 @@ import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 import Gargantext.Core.Types.Individu (Username, GargPassword(..), arbitraryUsername, arbitraryPassword)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Admin.Types.Node (NodeId(..), ListId, DocId)
+import Gargantext.Database.Admin.Types.Node (NodeId(..), ListId, DocId, UserId)
 import Gargantext.Prelude hiding (reverse)
 
 ---------------------------------------------------
@@ -45,13 +45,14 @@ data AuthInvalid = AuthInvalid { _authInv_message :: Text }
 
 data AuthValid = AuthValid { _authVal_token   :: Token
                            , _authVal_tree_id :: TreeId
+                           , _authVal_user_id :: UserId
                            }
   deriving (Generic)
 
 type Token  = Text
 type TreeId = NodeId
 
-data CheckAuth = InvalidUser | InvalidPassword | Valid Token TreeId
+data CheckAuth = InvalidUser | InvalidPassword | Valid Token TreeId UserId
   deriving (Eq)
 
 newtype AuthenticatedUser = AuthenticatedUser
@@ -99,9 +100,34 @@ $(deriveJSON (unPrefix "_authVal_") ''AuthValid)
 instance ToSchema AuthValid where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_authVal_")
 instance Arbitrary AuthValid where
-  arbitrary = elements [ AuthValid to tr
+  arbitrary = elements [ AuthValid to tr u
                        | to <- ["token0", "token1"]
                        , tr <- [1..3]
+                       , u <-  [1..3]
                        ]
 
-data PathId = PathNode NodeId | PathNodeNode ListId DocId
+data PathId = PathNode NodeId | PathNodeNode ListId DocId
\ No newline at end of file
+
+
+---------------------------
+
+type Email = Text
+type Password = Text
+
+data ForgotPasswordRequest = ForgotPasswordRequest { _fpReq_email :: Email }
+  deriving (Generic )
+$(deriveJSON (unPrefix "_fpReq_") ''ForgotPasswordRequest)
+instance ToSchema ForgotPasswordRequest where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpReq_")
+
+data ForgotPasswordResponse = ForgotPasswordResponse { _fpRes_status :: Text }
+  deriving (Generic )
+$(deriveJSON (unPrefix "_fpRes_") ''ForgotPasswordResponse)
+instance ToSchema ForgotPasswordResponse where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpRes_")
+
+data ForgotPasswordGet = ForgotPasswordGet {_fpGet_password :: Password}
+  deriving (Generic )
+$(deriveJSON (unPrefix "_fpGet_") ''ForgotPasswordGet)
+instance ToSchema ForgotPasswordGet where
+  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpGet_") 
\ No newline at end of file

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
   }
@@ -53,19 +79,27 @@ instance HasNodeStoryVar Env where
 instance HasNodeStorySaver Env where
   hasNodeStorySaver = hasNodeStory . nse_saver
 
+instance HasNodeStoryImmediateSaver Env where
+  hasNodeStoryImmediateSaver = hasNodeStory . nse_saver_immediate
+
+instance HasNodeArchiveStoryImmediateSaver Env where
+  hasNodeArchiveStoryImmediateSaver = hasNodeStory . nse_archive_saver_immediate
+
 instance HasSettings Env where
   settings = env_settings
 
 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
   }
@@ -104,5 +138,11 @@ instance HasNodeStoryVar DevEnv where
 instance HasNodeStorySaver DevEnv where
   hasNodeStorySaver = hasNodeStory . nse_saver
 
+instance HasNodeStoryImmediateSaver DevEnv where
+  hasNodeStoryImmediateSaver = hasNodeStory . nse_saver_immediate
+
+instance HasNodeArchiveStoryImmediateSaver DevEnv where
+  hasNodeArchiveStoryImmediateSaver = hasNodeStory . nse_archive_saver_immediate
+
 instance HasMail DevEnv where
   mailSettings = dev_env_mail

src/Gargantext/API/Admin/Orchestrator/Types.hs

@@ -6,6 +6,7 @@ module Gargantext.API.Admin.Orchestrator.Types
   where
 
 import Control.Lens hiding (elements)
+import Control.Monad.Reader (MonadReader)
 import Data.Aeson
 import Data.Morpheus.Types
   ( GQLType
@@ -23,7 +24,9 @@ import Test.QuickCheck.Arbitrary
 
 import qualified Gargantext.API.GraphQL.Utils as GQLU
 import Gargantext.Core.Types (TODO(..))
+import Gargantext.Database.Prelude (HasConfig(..))
 import Gargantext.Prelude
+import Gargantext.Prelude.Config (gc_pubmed_api_key)
 
 ------------------------------------------------------------------------
 instance Arbitrary a => Arbitrary (JobStatus 'Safe a) where
@@ -35,25 +38,41 @@ instance Arbitrary a => Arbitrary (JobOutput a) where
 -- | Main Types
 -- TODO IsidoreAuth
 data ExternalAPIs = All
-                  | PubMed
+                  | PubMed { mAPIKey :: Maybe Text }
+                  | Arxiv
                   | HAL
                   | IsTex
                   | Isidore
-  deriving (Show, Eq, Enum, Bounded, Generic)
+  deriving (Show, Eq, Generic)
 
 
 -- | Main Instances
 instance FromJSON ExternalAPIs
 instance ToJSON ExternalAPIs
 
-externalAPIs :: [ExternalAPIs]
-externalAPIs = [minBound..maxBound]
+externalAPIs :: ( MonadReader env m
+                , HasConfig env) => m [ExternalAPIs]
+externalAPIs = do
+  pubmed_api_key <- view $ hasConfig . gc_pubmed_api_key
+
+  pure [ All
+       , PubMed { mAPIKey = Just pubmed_api_key }
+       , Arxiv
+       , HAL
+       , IsTex
+       , Isidore ]
 
 instance Arbitrary ExternalAPIs
   where
-    arbitrary = elements externalAPIs
-
-instance ToSchema ExternalAPIs
+    arbitrary = elements [ All
+                         , PubMed { mAPIKey = Nothing }
+                         , Arxiv
+                         , HAL
+                         , IsTex
+                         , Isidore ]
+
+instance ToSchema ExternalAPIs where
+  declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
 
 instance ToSchema URL where
   declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)

src/Gargantext/API/Admin/Settings.hs

-{-| 
+{-|
 Module      : Gargantext.API.Admin.Settings
 Description : Settings of the API (Server and Client)
 Copyright   : (c) CNRS, 2017-Present
@@ -21,13 +21,13 @@ module Gargantext.API.Admin.Settings
 -- import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
 import Codec.Serialise (Serialise(), serialise)
 import Control.Lens
-import Control.Monad.Logger
+import Control.Monad.Logger (LogLevel(..))
 import Control.Monad.Reader
 import Data.Maybe (fromMaybe)
 import Data.Pool (Pool, createPool)
 import Database.PostgreSQL.Simple (Connection, connect, close, ConnectInfo)
 import Gargantext.Core.NodeStory
-import Gargantext.Prelude.Config (GargConfig(..), {-gc_repofilepath,-} readConfig)
+import Gargantext.Prelude.Config ({-GargConfig(..),-} {-gc_repofilepath,-} readConfig)
 import Network.HTTP.Client.TLS (newTlsManager)
 import Servant.Auth.Server (defaultJWTSettings, CookieSettings(..), XsrfCookieSettings(..), defaultCookieSettings, defaultXsrfCookieSettings, readKey, writeKey)
 import Servant.Client (parseBaseUrl)
@@ -43,10 +43,14 @@ import qualified Data.ByteString.Lazy as L
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Admin.Types
 -- import Gargantext.API.Ngrams.Types (NgramsRepo, HasRepo(..), RepoEnv(..), r_version, initRepo, renv_var, renv_lock)
-import Gargantext.Database.Prelude (databaseParameters)
+import Gargantext.Database.Prelude (databaseParameters, hasConfig)
 import Gargantext.Prelude
--- import Gargantext.Prelude.Config (gc_repofilepath)
+import Gargantext.Prelude.Config (gc_js_job_timeout, gc_js_id_timeout)
 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
+import qualified Gargantext.Utils.Jobs.Settings as Jobs
 
 devSettings :: FilePath -> IO Settings
 devSettings jwkFile = do
@@ -177,11 +181,22 @@ 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 (_gc_repofilepath config_env)
+  nodeStory_env <- readNodeStoryEnv pool
   scrapers_env  <- newJobEnv defaultSettings manager_env
+
+  secret        <- Jobs.genSecret
+  let jobs_settings = (Jobs.defaultJobSettings 1 secret)
+                        & Jobs.l_jsJobTimeout .~ (fromIntegral $ config_env ^. hasConfig ^. gc_js_job_timeout)
+                        & Jobs.l_jsIDTimeout  .~ (fromIntegral $ config_env ^. hasConfig ^. gc_js_id_timeout)
+  jobs_env      <- Jobs.newJobEnv jobs_settings prios' manager_env
   logger        <- newStderrLoggerSet defaultBufSize
   config_mail   <- Mail.readConfig file
 
@@ -192,6 +207,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

src/Gargantext/API/Admin/Types.hs

@@ -5,7 +5,7 @@
 module Gargantext.API.Admin.Types where
 
 import Control.Lens
-import Control.Monad.Logger
+import Control.Monad.Logger (LogLevel)
 import Data.ByteString (ByteString)
 import GHC.Enum
 import GHC.Generics (Generic)

src/Gargantext/API/Dev.hs

 {-|
 Module      : Gargantext.API.Dev
-Description : 
+Description :
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
@@ -17,12 +17,12 @@ import Control.Monad (fail)
 import Control.Monad.Reader (runReaderT)
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Admin.Settings
-import Gargantext.API.Ngrams (saveNodeStory)
+import Gargantext.API.Ngrams (saveNodeStoryImmediate)
 import Gargantext.API.Prelude
 import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (GargConfig(..), readConfig)
+import Gargantext.Prelude.Config (readConfig)
 import qualified Gargantext.Prelude.Mail as Mail
 import Servant
 import System.IO (FilePath)
@@ -38,8 +38,9 @@ withDevEnv iniPath k = do
     newDevEnv = do
       cfg     <- readConfig         iniPath
       dbParam <- databaseParameters iniPath
-      nodeStory_env <- readNodeStoryEnv (_gc_repofilepath cfg)
+      --nodeStory_env <- readNodeStoryEnv (_gc_repofilepath cfg)
       pool    <- newPool            dbParam
+      nodeStory_env <- readNodeStoryEnv pool
       setts   <- devSettings devJwkFile
       mail    <- Mail.readConfig iniPath
       pure $ DevEnv
@@ -61,11 +62,11 @@ runCmdReplServantErr = runCmdRepl
 -- the command.
 -- This function is constrained to the DevEnv rather than
 -- using HasConnectionPool and HasRepoVar.
-runCmdDev :: (Show err) => DevEnv -> Cmd'' DevEnv err a -> IO a
+runCmdDev :: Show err => DevEnv -> Cmd'' DevEnv err a -> IO a
 runCmdDev env f =
   (either (fail . show) pure =<< runCmd env f)
     `finally`
-  runReaderT saveNodeStory env
+  runReaderT saveNodeStoryImmediate env
 
 runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
 runCmdDevNoErr = runCmdDev

src/Gargantext/API/Flow.hs

@@ -29,4 +29,3 @@ data OutputFlow
 
 flow :: Flow -> OutputFlow
 flow = undefined
-

src/Gargantext/API/GraphQL.hs

+{-# OPTIONS_GHC -fprint-potential-instances #-}
+
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}  -- permit duplications for field names in multiple constructors
 {-# LANGUAGE KindSignatures #-}  -- for use of Endpoint (name :: Symbol)
@@ -9,8 +11,7 @@ module Gargantext.API.GraphQL where
 import Data.ByteString.Lazy.Char8
   ( ByteString
   )
-import Data.List.NonEmpty (NonEmpty ((:|)))
-import Data.Map (Map)
+import Data.Map.Strict (Map)
 import Data.Morpheus
   ( App
   , deriveApp )
@@ -29,48 +30,61 @@ import Data.Morpheus.Types
   , RootResolver(..)
   , Undefined(..)
   )
+import Data.Proxy
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
 import Gargantext.API.Prelude (HasJobEnv')
+import qualified Gargantext.API.GraphQL.Annuaire as GQLA
 import qualified Gargantext.API.GraphQL.AsyncTask as GQLAT
+import qualified Gargantext.API.GraphQL.Context as GQLCTX
+import qualified Gargantext.API.GraphQL.IMT as GQLIMT
 import qualified Gargantext.API.GraphQL.Node as GQLNode
 import qualified Gargantext.API.GraphQL.User as GQLUser
 import qualified Gargantext.API.GraphQL.UserInfo as GQLUserInfo
+import qualified Gargantext.API.GraphQL.TreeFirstLevel as GQLTree
+import qualified Gargantext.API.GraphQL.Team as GQLTeam
 import Gargantext.API.Prelude (GargM, GargError)
+import Gargantext.API.Types
 import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 import Gargantext.Prelude
 import GHC.Generics (Generic)
-import Network.HTTP.Media ((//), (/:))
-import qualified Prelude as Prelude
 import Servant
   ( (:<|>) (..)
   , (:>)
-  , Accept (..)
   , Get
   , JSON
-  , MimeRender (..)
   , Post
   , ReqBody
   ,  ServerT
   )
 import qualified Servant.Auth as SA
 import qualified Servant.Auth.Server as SAS
+import Gargantext.API.Admin.Types (HasSettings)
+
 
 -- | Represents possible GraphQL queries.
 data Query m
   = Query
-    { job_logs    :: GQLAT.JobLogArgs -> m (Map Int JobLog)
-    , nodes       :: GQLNode.NodeArgs -> m [GQLNode.Node]
-    , node_parent :: GQLNode.NodeParentArgs -> m [GQLNode.Node]
-    , user_infos  :: GQLUserInfo.UserInfoArgs -> m [GQLUserInfo.UserInfo]
-    , users       :: GQLUser.UserArgs -> m [GQLUser.User m]
+    { annuaire_contacts   :: GQLA.AnnuaireContactArgs -> m [GQLA.AnnuaireContact]
+    , contexts            :: GQLCTX.NodeContextArgs -> m [GQLCTX.NodeContextGQL]
+    , contexts_for_ngrams :: GQLCTX.ContextsForNgramsArgs -> m [GQLCTX.ContextGQL]
+    , imt_schools         :: GQLIMT.SchoolsArgs -> m [GQLIMT.School]
+    , job_logs            :: GQLAT.JobLogArgs -> m (Map Int JobLog)
+    , nodes               :: GQLNode.NodeArgs -> m [GQLNode.Node]
+    , node_parent         :: GQLNode.NodeParentArgs -> m [GQLNode.Node]
+    , user_infos          :: GQLUserInfo.UserInfoArgs -> m [GQLUserInfo.UserInfo]
+    , users               :: GQLUser.UserArgs -> m [GQLUser.User m]
+    , tree                :: GQLTree.TreeArgs -> m (GQLTree.TreeFirstLevel m)
+    , team                :: GQLTeam.TeamArgs -> m GQLTeam.Team
     } deriving (Generic, GQLType)
 
 data Mutation m
   = Mutation
-    { update_user_info :: GQLUserInfo.UserInfoMArgs -> m Int }
-    deriving (Generic, GQLType)
+    { update_user_info       :: GQLUserInfo.UserInfoMArgs -> m Int
+    , delete_team_membership :: GQLTeam.TeamDeleteMArgs -> m [Int]
+    , update_node_context_category :: GQLCTX.NodeContextCategoryMArgs -> m [Int]
+    } deriving (Generic, GQLType)
 
 -- | Possible GraphQL Events, i.e. here we describe how we will
 -- manipulate the data.
@@ -90,21 +104,29 @@ data Contet m
 -- | The main GraphQL resolver: how queries, mutations and
 -- subscriptions are handled.
 rootResolver
-  :: (HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env)
+  :: (HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env, HasSettings env)
   => RootResolver (GargM env GargError) e Query Mutation Undefined
 rootResolver =
   RootResolver
-    { queryResolver = Query { job_logs    = GQLAT.resolveJobLogs
-                            , nodes       = GQLNode.resolveNodes
-                            , node_parent = GQLNode.resolveNodeParent
-                            , user_infos  = GQLUserInfo.resolveUserInfos
-                            , users       = GQLUser.resolveUsers }
-    , mutationResolver = Mutation { update_user_info = GQLUserInfo.updateUserInfo }
+    { queryResolver = Query { annuaire_contacts   = GQLA.resolveAnnuaireContacts
+                            , contexts            = GQLCTX.resolveNodeContext
+                            , contexts_for_ngrams = GQLCTX.resolveContextsForNgrams
+                            , imt_schools         = GQLIMT.resolveSchools
+                            , job_logs            = GQLAT.resolveJobLogs
+                            , nodes               = GQLNode.resolveNodes
+                            , node_parent         = GQLNode.resolveNodeParent
+                            , user_infos          = GQLUserInfo.resolveUserInfos
+                            , users               = GQLUser.resolveUsers
+                            , tree                = GQLTree.resolveTree
+                            , team                = GQLTeam.resolveTeam }
+    , mutationResolver = Mutation { update_user_info       = GQLUserInfo.updateUserInfo
+                                  , delete_team_membership = GQLTeam.deleteTeamMembership
+                                  , update_node_context_category = GQLCTX.updateNodeContextCategory }
     , subscriptionResolver = Undefined }
 
 -- | Main GraphQL "app".
 app
-  :: (Typeable env, HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env)
+  :: (Typeable env, HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env, HasSettings env)
   => App (EVENT (GargM env GargError)) (GargM env GargError)
 app = deriveApp rootResolver
 
@@ -113,13 +135,6 @@ app = deriveApp rootResolver
 -- Now for some boilerplate to integrate the above GraphQL app with
 -- servant.
 
--- | HTML type is needed for the GraphQL Playground.
-data HTML deriving (Typeable)
-instance Accept HTML where
-  contentTypes _ = "text" // "html" /: ("charset", "utf-8") :| ["text" // "html"]
-instance MimeRender HTML ByteString where
-  mimeRender _ = Prelude.id
-
 -- | Servant route for the app we defined above.
 type GQAPI = ReqBody '[JSON] GQLRequest :> Post '[JSON] GQLResponse
 -- type Schema = "schema" :> Get '[PlainText] Text
@@ -130,6 +145,9 @@ type Playground = Get '[HTML] ByteString
 type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
             :> "gql" :> (GQAPI :<|> Playground)
 
+gqapi :: Proxy API
+gqapi = Proxy
+
 -- serveEndpoint ::
 --   ( SubApp ServerApp e
 --   , PubApp e
@@ -138,15 +156,14 @@ type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
 --   App e IO ->
 --   Server (API name)
 -- serveEndpoint publish app' = (liftIO . httpPubApp publish app') :<|> withSchema app' :<|> pure httpPlayground
--- 
+--
 -- withSchema :: (Applicative f) => App e m -> f Text
 -- withSchema = pure . LT.toStrict . decodeUtf8 . render
 
 -- | Implementation of our API.
 --api :: Server API
 api
-  :: (Typeable env, HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env)
+  :: (Typeable env, HasConnectionPool env, HasConfig env, HasMail env, HasJobEnv' env, HasSettings env)
   => ServerT API (GargM env GargError)
 api (SAS.Authenticated _auser) = httpPubApp [] app :<|> pure httpPlayground
---api _                          = panic "401 in graphql" --SAS.throwAll (_ServerError # err401)
-api _ = httpPubApp [] app :<|> pure httpPlayground
+api _                          = panic "401 in graphql" -- SAS.throwAll (_ServerError # err401)

src/Gargantext/API/GraphQL/Annuaire.hs

+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Gargantext.API.GraphQL.Annuaire where
+
+import Control.Lens
+import Data.Morpheus.Types
+  ( GQLType
+  , Resolver
+  , QUERY
+  , lift
+  )
+import Data.Proxy
+import Data.Text (Text)
+import Gargantext.API.Prelude (GargM, GargError)
+import Gargantext.Core.Mail.Types (HasMail)
+import Gargantext.Database.Admin.Types.Hyperdata.Contact
+  ( HyperdataContact
+  , ContactWho
+  , cw_firstName
+  , cw_lastName
+  , hc_who, ContactWhere, hc_where, cw_organization, cw_labTeamDepts, cw_role, cw_office, cw_country, cw_city, cw_touch, ct_mail, ct_phone, ct_url, hc_title, hc_source)
+import Gargantext.Database.Admin.Types.Node (NodeId(..))
+import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
+import Gargantext.Database.Query.Table.Context (getContextWith)
+import Gargantext.Database.Schema.Node (node_hyperdata)
+import Gargantext.Prelude
+import GHC.Generics (Generic)
+
+data AnnuaireContact = AnnuaireContact
+  { ac_title        :: !(Maybe Text)
+  , ac_source       :: !(Maybe Text)
+  , ac_id           :: !Int
+  , ac_firstName    :: !(Maybe Text)
+  , ac_lastName     :: !(Maybe Text)
+  , ac_labTeamDepts :: ![Text]
+  , ac_organization :: ![Text]
+  , ac_role         :: !(Maybe Text)
+  , ac_office       :: !(Maybe Text)
+  , ac_country      :: !(Maybe Text)
+  , ac_city         :: !(Maybe Text)
+  , ac_touchMail    :: !(Maybe Text)
+  , ac_touchPhone   :: !(Maybe Text)
+  , ac_touchUrl     :: !(Maybe Text)
+  }
+  deriving (Generic, GQLType, Show)
+
+-- | Arguments to the "user info" query.
+data AnnuaireContactArgs
+  = AnnuaireContactArgs
+    { contact_id :: Int
+    } deriving (Generic, GQLType)
+
+type GqlM e env = Resolver QUERY e (GargM env GargError)
+
+-- | Function to resolve user from a query.
+resolveAnnuaireContacts
+  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => AnnuaireContactArgs -> GqlM e env [AnnuaireContact]
+resolveAnnuaireContacts AnnuaireContactArgs { contact_id } = dbAnnuaireContacts contact_id
+
+-- | Inner function to fetch the user from DB.
+dbAnnuaireContacts
+  :: (HasConnectionPool env, HasConfig env, HasMail env)
+  => Int -> GqlM e env [AnnuaireContact]
+dbAnnuaireContacts contact_id = do
+  -- lift $ printDebug "[dbUsers]" user_id
+--  user <- getUsersWithId user_id
+--  hyperdata <- getUserHyperdata user_id
+--  lift (map toUser <$> zip user hyperdata)
+  c <- lift $ getContextWith (NodeId contact_id) (Proxy :: Proxy HyperdataContact)
+  pure [toAnnuaireContact (contact_id, c ^. node_hyperdata)]
+
+toAnnuaireContact :: (Int, HyperdataContact) -> AnnuaireContact
+toAnnuaireContact (c_id, c_hyperdata) =
+  AnnuaireContact { ac_title = c_hyperdata ^. ac_titleL
+                  , ac_source = c_hyperdata ^. ac_sourceL
+                  , ac_id = c_id
+                  , ac_firstName = c_hyperdata ^. ac_firstNameL
+                  , ac_lastName = c_hyperdata ^. ac_lastNameL
+                  , ac_organization = c_hyperdata ^. ac_organizationL
+                  , ac_labTeamDepts = c_hyperdata ^. ac_labTeamDeptsL
+                  , ac_role = c_hyperdata ^. ac_roleL
+                  , ac_office = c_hyperdata ^. ac_officeL
+                  , ac_country = c_hyperdata ^. ac_countryL
+                  , ac_city = c_hyperdata ^. ac_cityL
+                  , ac_touchMail = c_hyperdata ^. ac_touchMailL
+                  , ac_touchPhone = c_hyperdata ^. ac_touchPhoneL
+                  , ac_touchUrl = c_hyperdata ^. ac_touchUrlL }
+
+ac_titleL :: Traversal' HyperdataContact (Maybe Text)
+ac_titleL = hc_title
+ac_sourceL :: Traversal' HyperdataContact (Maybe Text)
+ac_sourceL = hc_source
+contactWhoL :: Traversal' HyperdataContact ContactWho
+contactWhoL = hc_who . _Just
+ac_firstNameL :: Traversal' HyperdataContact (Maybe Text)
+ac_firstNameL = contactWhoL . cw_firstName
+ac_lastNameL :: Traversal' HyperdataContact (Maybe Text)
+ac_lastNameL = contactWhoL . cw_lastName
+contactWhereL :: Traversal' HyperdataContact ContactWhere
+contactWhereL = hc_where . ix 0
+ac_organizationL :: Traversal' HyperdataContact [Text]
+ac_organizationL = contactWhereL . cw_organization
+ac_labTeamDeptsL :: Traversal' HyperdataContact [Text]
+ac_labTeamDeptsL = contactWhereL . cw_labTeamDepts
+ac_roleL :: Traversal' HyperdataContact (Maybe Text)
+ac_roleL = contactWhereL . cw_role
+ac_officeL :: Traversal' HyperdataContact (Maybe Text)
+ac_officeL = contactWhereL . cw_office
+ac_countryL :: Traversal' HyperdataContact (Maybe Text)
+ac_countryL = contactWhereL . cw_country
+ac_cityL :: Traversal' HyperdataContact (Maybe Text)
+ac_cityL = contactWhereL . cw_city
+ac_touchMailL :: Traversal' HyperdataContact (Maybe Text)
+ac_touchMailL = contactWhereL . cw_touch . _Just . ct_mail
+ac_touchPhoneL :: Traversal' HyperdataContact (Maybe Text)
+ac_touchPhoneL = contactWhereL . cw_touch . _Just . ct_phone
+ac_touchUrlL :: Traversal' HyperdataContact (Maybe Text)
+ac_touchUrlL = contactWhereL . cw_touch . _Just . ct_url

src/Gargantext/API/GraphQL/AsyncTask.hs

-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 
@@ -7,26 +6,20 @@ module Gargantext.API.GraphQL.AsyncTask where
 import Control.Concurrent.Async (poll)
 import Control.Concurrent.MVar (readMVar)
 import Control.Lens
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Control.Monad.Base (liftBase)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
 import Control.Monad.Reader (ask, liftIO)
 import Data.Either (Either(..))
 import qualified Data.IntMap.Strict as IntMap
-import Data.Maybe (Maybe(..), catMaybes)
+import Data.Maybe (catMaybes)
 import Data.Morpheus.Types
   ( GQLType
   , Resolver
-  , ResolverM
   , QUERY
   , lift
   )
-import Data.Text (Text)
-import qualified Data.Text as T
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
 import Gargantext.API.Prelude (GargM, GargError, HasJobEnv')
-import Gargantext.Core.Mail.Types (HasMail)
-import Gargantext.Database.Admin.Types.Node (NodeId(..))
 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 import Gargantext.Prelude
 import GHC.Generics (Generic)
@@ -48,15 +41,15 @@ resolveJobLogs JobLogArgs { job_log_id } = dbJobLogs job_log_id
 dbJobLogs
   :: (HasConnectionPool env, HasConfig env, HasJobEnv' env)
   => Int -> GqlM e env (Map Int JobLog)
-dbJobLogs job_log_id = do
+dbJobLogs _job_log_id = do
   --getJobLogs job_log_id
   lift $ do
     env <- ask
     --val <- liftBase $ readMVar $ env ^. job_env . jenv_jobs . env_state_mvar
     var <- liftIO $ readMVar (env ^. job_env . jenv_jobs . env_state_mvar)
     let envItems = var ^. env_map
-    printDebug "[dbJobLogs] env ^. job_env ^. jenv_jobs" $ length $ IntMap.keys envItems
-    printDebug "[dbJobLogs] job_log_id" job_log_id
+    -- printDebug "[dbJobLogs] env ^. job_env ^. jenv_jobs" $ length $ IntMap.keys envItems
+    -- printDebug "[dbJobLogs] job_log_id" job_log_id
     --pure $ IntMap.elems val
     liftIO $ do
       let jobsList = IntMap.toList $ IntMap.map (\e -> e ^. env_item . job_async) envItems

src/Gargantext/API/GraphQL/IMT.hs

+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Gargantext.API.GraphQL.IMT
+  ( School(..)
+  , SchoolsArgs(..)
+  , resolveSchools
+  )
+  where
+
+import Data.Morpheus.Types
+  ( GQLType
+  , Resolver
+  , QUERY
+  )
+import Gargantext.API.Prelude (GargM, GargError)
+import Gargantext.Core.Ext.IMT (School(..), schools)
+import Gargantext.Prelude
+import GHC.Generics (Generic)
+
+data SchoolsArgs
+  = SchoolsArgs
+    { } deriving (Generic, GQLType)
+
+type GqlM e env = Resolver QUERY e (GargM env GargError)
+
+resolveSchools
+  :: SchoolsArgs -> GqlM e env [School]
+resolveSchools SchoolsArgs { } = pure $ schools

src/Gargantext/API/GraphQL/Node.hs

-
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 
@@ -22,7 +21,7 @@ import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 import qualified Gargantext.Database.Schema.Node as N
 import Gargantext.Prelude
 import GHC.Generics (Generic)
-import qualified Prelude as Prelude
+import qualified Prelude
 import Text.Read (readEither)
 
 data Node = Node

src/Gargantext/API/GraphQL/Team.hs

+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+module Gargantext.API.GraphQL.Team where
+
+import Gargantext.Prelude
+import GHC.Generics (Generic)
+import Data.Morpheus.Types (GQLType, Resolver, QUERY, ResolverM, lift)
+import Data.Text ( Text )
+import Gargantext.API.Admin.Types (HasSettings)
+import Gargantext.API.GraphQL.Utils (authUser, AuthStatus (Invalid, Valid))
+import Gargantext.API.Prelude (GargM, GargError)
+import Gargantext.Core.Mail.Types (HasMail)
+import Gargantext.Core.Types (NodeId(..), unNodeId)
+import Gargantext.Database (HasConfig)
+import Gargantext.Database.Action.Share (membersOf, deleteMemberShip)
+import Gargantext.Database.Prelude (HasConnectionPool)
+import Gargantext.Database.Query.Table.Node (getNode)
+import Gargantext.Database.Query.Table.User (getUsersWithNodeHyperdata)
+import Gargantext.Database.Schema.Node (NodePoly(Node, _node_id), _node_user_id)
+
+import qualified Data.Text as T
+import Gargantext.Database.Schema.User (UserLight(..))
+
+data TeamArgs = TeamArgs
+  { team_node_id :: Int } deriving (Generic, GQLType)
+
+data Team = Team
+ { team_owner_username :: Text
+ , team_members         :: [TeamMember]
+ } deriving (Generic, GQLType)
+
+data TeamMember = TeamMember
+ { username         :: Text
+ , shared_folder_id :: Int
+ } deriving (Generic, GQLType)
+
+data TeamDeleteMArgs = TeamDeleteMArgs
+  { token :: Text
+  , shared_folder_id :: Int
+  , team_node_id     :: Int
+  } deriving (Generic, GQLType)
+
+type GqlM e env = Resolver QUERY e (GargM env GargError)
+type GqlM' e env a = ResolverM e (GargM env GargError) a
+
+
+resolveTeam :: (HasConnectionPool env, HasConfig env, HasMail env) => TeamArgs -> GqlM e env Team
+resolveTeam TeamArgs { team_node_id } = dbTeam team_node_id
+
+dbTeam :: (HasConnectionPool env, HasConfig env, HasMail env) => Int -> GqlM e env Team
+dbTeam nodeId = do
+  let nId = NodeId nodeId
+  res <- lift $ membersOf nId
+  teamNode <- lift $ getNode nId
+  userNodes <- lift $ getUsersWithNodeHyperdata $ uId teamNode
+  let username = getUsername userNodes
+  pure $ Team { team_owner_username = username
+              , team_members = map toTeamMember res
+              }
+  where
+    toTeamMember :: (Text, NodeId) -> TeamMember
+    toTeamMember (username, fId)= TeamMember {
+      username,
+      shared_folder_id = unNodeId fId
+    }
+    uId Node { _node_user_id } = _node_user_id
+    getUsername [] = panic "[resolveTeam] Team creator doesn't exist"
+    getUsername ((UserLight {userLight_username}, _):_) = userLight_username
+
+-- TODO: list as argument
+deleteTeamMembership :: (HasConnectionPool env, HasConfig env, HasMail env, HasSettings env) => TeamDeleteMArgs -> GqlM' e env [Int]
+deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } = do
+  teamNode <- lift $ getNode $ NodeId team_node_id
+  userNodes <- lift (getUsersWithNodeHyperdata $ uId teamNode)
+  case userNodes of
+    [] -> panic $ "[deleteTeamMembership] User with id " <> T.pack (show $ uId teamNode) <> " doesn't exist."
+    (( _, node_u):_) -> do
+      testAuthUser <- lift $ authUser (nId node_u) token
+      case testAuthUser of
+        Invalid -> panic "[deleteTeamMembership] failed to validate user"
+        Valid -> do
+          lift $ deleteMemberShip [(NodeId shared_folder_id, NodeId team_node_id)]
+  where
+    uId Node { _node_user_id } = _node_user_id
+    nId Node { _node_id } = _node_id

src/Gargantext/API/GraphQL/User.hs

@@ -42,7 +42,7 @@ resolveUsers UserArgs { user_id } = dbUsers user_id
 -- | Inner function to fetch the user from DB.
 dbUsers
   :: (HasConnectionPool env, HasConfig env, HasMail env)
-  => Int -> GqlM e env ([User (GqlM e env)])
+  => Int -> GqlM e env [User (GqlM e env)]
 dbUsers user_id = lift (map toUser <$> getUsersWithId user_id)
 
 toUser

src/Gargantext/API/Metrics.hs

@@ -94,10 +94,10 @@ updateScatter :: FlowCmdM env err m =>
   -> Maybe Limit
   -> m ()
 updateScatter cId maybeListId tabType maybeLimit = do
-  printDebug "[updateScatter] cId" cId
-  printDebug "[updateScatter] maybeListId" maybeListId
-  printDebug "[updateScatter] tabType" tabType
-  printDebug "[updateScatter] maybeLimit" maybeLimit
+  -- printDebug "[updateScatter] cId" cId
+  -- printDebug "[updateScatter] maybeListId" maybeListId
+  -- printDebug "[updateScatter] tabType" tabType
+  -- printDebug "[updateScatter] maybeLimit" maybeLimit
   _ <- updateScatter' cId maybeListId tabType maybeLimit
   pure ()