[FIX] init script to create new users

bin/gargantext-import/Main.hs

@@ -29,7 +29,6 @@ import Gargantext.API.Prelude (GargError)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpusFile, flowAnnuaire, TermType(..))
-import Gargantext.Database.Query.Table.User (insertUsersDemo)
 import Gargantext.Database.Admin.Types.Hyperdata (toHyperdataDocument)
 import Gargantext.Database.Admin.Types.Node (CorpusId)
 import Gargantext.Database.Prelude (Cmd)
@@ -42,9 +41,6 @@ main = do
 
   --{-
 
-  let createUsers :: Cmd GargError Int64
-      createUsers = insertUsersDemo
-  
   let
     --tt = (Unsupervised EN 6 0 Nothing)
     tt = (Multi EN)
@@ -70,10 +66,6 @@ main = do
   --}
 
   withDevEnv iniPath $ \env -> do
-    _ <- if fun == "users"
-          then runCmdDev env createUsers
-          else pure 0 --(cs "false")
-
     _ <- if fun == "corpus"
           then runCmdDev env corpus
           else pure 0 --(cs "false")

bin/gargantext-init/Main.hs

@@ -20,10 +20,10 @@ import Data.Either (Either(..))
 import Gargantext.API.Dev (withDevEnv, runCmdDev)
 import Gargantext.API.Prelude (GargError)
 import Gargantext.API.Node () -- instances only
-import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Core.Types.Individu (User(..), arbitraryNewUsers, NewUser(..), arbitraryUsername, GargPassword(..))
 import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMk_RootWithCorpus)
 import Gargantext.Database.Query.Table.Node (getOrMkList)
-import Gargantext.Database.Query.Table.User (insertUsersDemo)
+import Gargantext.Database.Query.Table.User (insertNewUsers, )
 import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
@@ -31,6 +31,7 @@ import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
 import Gargantext.Database.Prelude (Cmd, )
 import Gargantext.Prelude
 import System.Environment (getArgs)
+import Prelude (getLine)
 
 -- TODO put this in gargantext.ini
 secret :: Text
@@ -40,12 +41,21 @@ main :: IO ()
 main = do
   [iniPath] <- getArgs
 
+  putStrLn "Enter master user (gargantua) _password_ :"
+  password  <- getLine
+
+  putStrLn "Enter master user (gargantua) _email_ :"
+  email     <- getLine
+
+
   let createUsers :: Cmd GargError Int64
-      createUsers = insertUsersDemo
+      createUsers = insertNewUsers (NewUser "gargantua" (cs email) (GargPassword $ cs password)
+                                   : arbitraryNewUsers
+                                   )
 
   let
     mkRoots :: Cmd GargError [(UserId, RootId)]
-    mkRoots = mapM getOrMkRoot $ map UserName ["gargantua", "user1", "user2", "user3"]
+    mkRoots = mapM getOrMkRoot $ map UserName ("gargantua" : arbitraryUsername)
     -- TODO create all users roots
 
   let

src/Gargantext/Core/Types/Individu.hs

@@ -52,7 +52,7 @@ data NewUser a = NewUser { _nu_username :: Username
   deriving (Show)
 
 arbitraryUsername :: [Username]
-arbitraryUsername = ["gargantua"] <> users
+arbitraryUsername = {- ["gargantua"] <> -} users
   where
     users = zipWith (\a b -> a <> (pack . show) b) 
                     (repeat "user") ([1..20]::[Int])
@@ -68,12 +68,13 @@ toUserHash (NewUser u m (GargPassword p)) = do
   h <- Auth.createPasswordHash p
   pure $ NewUser u m h
 
+-- TODO remove
 arbitraryUsersHash :: MonadIO m
                   => m [NewUser HashPassword]
-arbitraryUsersHash = mapM toUserHash arbitraryUsers
+arbitraryUsersHash = mapM toUserHash arbitraryNewUsers
 
-arbitraryUsers :: [NewUser GargPassword]
-arbitraryUsers = map (\u -> NewUser u (u <> "@gargantext.org") (GargPassword $ reverse u))
+arbitraryNewUsers :: [NewUser GargPassword]
+arbitraryNewUsers = map (\u -> NewUser u (u <> "@gargantext.org") (GargPassword $ reverse u))
                      arbitraryUsername
 
 

src/Gargantext/Database/Query/Table/User.hs

@@ -24,7 +24,7 @@ module Gargantext.Database.Query.Table.User
   , updateUserDB
   , queryUserTable
   , getUser
-  , insertUsersDemo
+  , insertNewUsers
   , selectUsersLightWith
   , userWithUsername
   , userWithId
@@ -141,9 +141,9 @@ getUser u = userLightWithUsername u <$> usersLight
 
 
 ----------------------------------------------------------------------
-insertUsersDemo :: Cmd err Int64
-insertUsersDemo = do
-  users <- liftBase arbitraryUsersHash
+insertNewUsers :: [NewUser GargPassword] -> Cmd err Int64
+insertNewUsers newUsers = do
+  users <- liftBase $ mapM toUserHash newUsers
   insertUsers $ map toUserWrite users
 
 ----------------------------------------------------------------------