Commit b0568522 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Make CLI compile again

parent d4116e48
Pipeline #7575 failed with stages
in 44 minutes and 14 seconds
...@@ -29,12 +29,13 @@ import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus) ...@@ -29,12 +29,13 @@ import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers) import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus) import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
import Gargantext.Database.Admin.Types.Node import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (DBCmd, DBCmdWithEnv) import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node (getOrMkList) import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Database.Query.Table.User (insertNewUsers, ) import Gargantext.Database.Query.Table.User (insertNewUsers, )
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserMaster)) import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserMaster))
import Gargantext.Prelude import Gargantext.Prelude
import Options.Applicative import Options.Applicative
import Gargantext.Core.Types.Individu (toUserHash)
initCLI :: InitArgs -> IO () initCLI :: InitArgs -> IO ()
...@@ -45,34 +46,36 @@ initCLI (InitArgs settingsPath) = do ...@@ -45,34 +46,36 @@ initCLI (InitArgs settingsPath) = do
putStrLn ("Enter master user (gargantua) _email_ :" :: Text) putStrLn ("Enter master user (gargantua) _email_ :" :: Text)
email <- getLine email <- getLine
hashedUsers <- NE.fromList <$> mapM toUserHash (NewUser "gargantua" (cs email) (GargPassword $ cs password) : arbitraryNewUsers)
cfg <- readConfig settingsPath cfg <- readConfig settingsPath
let secret = _s_secret_key $ _gc_secrets cfg let secret = _s_secret_key $ _gc_secrets cfg
let createUsers :: forall env. DBCmdWithEnv env BackendInternalError Int64 let createUsers :: DBUpdate BackendInternalError Int64
createUsers = insertNewUsers (NewUser "gargantua" (cs email) (GargPassword $ cs password) createUsers = insertNewUsers hashedUsers
NE.:| arbitraryNewUsers
)
let let
mkRoots :: forall env. DBCmdWithEnv env BackendInternalError [(UserId, RootId)] mkRoots :: DBUpdate BackendInternalError [(UserId, RootId)]
mkRoots = mapM getOrMkRoot $ map UserName ("gargantua" : arbitraryUsername) mkRoots = mapM (getOrMkRoot cfg) $ map UserName ("gargantua" : arbitraryUsername)
-- TODO create all users roots -- TODO create all users roots
let let
initMaster :: forall env. DBCmdWithEnv env BackendInternalError (UserId, RootId, CorpusId, ListId) initMaster :: DBUpdate BackendInternalError (UserId, RootId, CorpusId, ListId)
initMaster = do initMaster = do
(masterUserId, masterRootId, masterCorpusId) (masterUserId, masterRootId, masterCorpusId)
<- getOrMkRootWithCorpus MkCorpusUserMaster <- getOrMkRootWithCorpus cfg MkCorpusUserMaster
(Nothing :: Maybe HyperdataCorpus) (Nothing :: Maybe HyperdataCorpus)
masterListId <- getOrMkList masterCorpusId masterUserId masterListId <- getOrMkList masterCorpusId masterUserId
_triggers <- initLastTriggers masterListId _triggers <- initLastTriggers masterListId
pure (masterUserId, masterRootId, masterCorpusId, masterListId) pure (masterUserId, masterRootId, masterCorpusId, masterListId)
withDevEnv settingsPath $ \env -> do withDevEnv settingsPath $ \env -> do
_ <- runCmdDev env (initFirstTriggers secret :: DBCmd BackendInternalError [Int64]) x <- runCmdDev env $ runDBTx $ do
_ <- runCmdDev env createUsers _ <- initFirstTriggers secret
x <- runCmdDev env initMaster _ <- createUsers
_ <- runCmdDev env mkRoots x' <- initMaster
_ <- mkRoots
pure x'
putStrLn (show x :: Text) putStrLn (show x :: Text)
initCmd :: HasCallStack => Mod CommandFields CLI initCmd :: HasCallStack => Mod CommandFields CLI
......
...@@ -707,6 +707,7 @@ executable gargantext ...@@ -707,6 +707,7 @@ executable gargantext
, gargantext , gargantext
, gargantext-prelude , gargantext-prelude
, haskell-bee , haskell-bee
, lens >= 5.2.2 && < 5.3
, MonadRandom ^>= 0.6 , MonadRandom ^>= 0.6
, optparse-applicative , optparse-applicative
, postgresql-simple >= 0.6.4 && <= 0.7.0.0 , postgresql-simple >= 0.6.4 && <= 0.7.0.0
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment