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

Fix executables

parent 4b6991a3
Pipeline #6281 failed with stages
in 10 minutes and 52 seconds
......@@ -24,12 +24,14 @@ import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, DBCmd)
import Gargantext.Database.Prelude (DBCmd)
import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Database.Query.Table.User (insertNewUsers, )
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserMaster))
import Gargantext.Prelude
import Gargantext.Prelude.Config (GargConfig(..), readConfig)
import Gargantext.API.Admin.Types
import Gargantext.Database.Prelude (DBCmd')
main :: IO ()
......@@ -49,18 +51,18 @@ main = do
cfg <- readConfig iniPath
let secret = _gc_secretkey cfg
let createUsers :: Cmd BackendInternalError Int64
let createUsers :: forall env. HasSettings env => DBCmd' env BackendInternalError Int64
createUsers = insertNewUsers (NewUser "gargantua" (cs email) (GargPassword $ cs password)
NE.:| arbitraryNewUsers
)
let
mkRoots :: Cmd BackendInternalError [(UserId, RootId)]
mkRoots :: forall env. HasSettings env => DBCmd' env BackendInternalError [(UserId, RootId)]
mkRoots = mapM getOrMkRoot $ map UserName ("gargantua" : arbitraryUsername)
-- TODO create all users roots
let
initMaster :: Cmd BackendInternalError (UserId, RootId, CorpusId, ListId)
initMaster :: forall env. HasSettings env => DBCmd' env BackendInternalError (UserId, RootId, CorpusId, ListId)
initMaster = do
(masterUserId, masterRootId, masterCorpusId)
<- getOrMkRootWithCorpus MkCorpusUserMaster
......
......@@ -17,6 +17,7 @@ module Main where
import Gargantext.API.Dev (withDevEnv, runCmdDev)
import Gargantext.API.Node () -- instances only
import Gargantext.API.Errors.Types
import Gargantext.API.Admin.Types
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Admin.Types.Node
......@@ -37,7 +38,7 @@ main = do
_cfg <- readConfig iniPath
let invite :: (CmdRandom env BackendInternalError m, HasNLPServer env) => m Int
let invite :: (HasSettings env, CmdRandom env BackendInternalError m, HasNLPServer env) => m Int
invite = Share.api (UserName $ cs user) (UnsafeMkNodeId $ (read node_id :: Int)) (Share.ShareTeamParams $ cs email)
withDevEnv iniPath $ \env -> do
......
......@@ -15,6 +15,7 @@ import Database.PostgreSQL.Simple.Options qualified as Client
import Database.PostgreSQL.Simple.Options qualified as Opts
import Database.Postgres.Temp qualified as Tmp
import Gargantext.API.Admin.EnvTypes (Mode(Mock))
import Gargantext.API.Admin.Settings
import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
import Gargantext.Prelude
import Gargantext.Prelude.Config
......@@ -73,12 +74,15 @@ setup = do
bootstrapDB db pool gargConfig
ugen <- emptyCounter
test_nodeStory <- fromDBNodeStoryEnv pool
stgs <- devSettings devJwkFile
withLoggerHoisted Mock $ \logger -> do
pure $ TestEnv { test_db = DBHandle pool db
, test_config = gargConfig
, test_nodeStory
, test_usernameGen = ugen
, test_logger = logger }
, test_logger = logger
, test_settings = stgs
}
withTestDB :: (TestEnv -> IO ()) -> IO ()
withTestDB = bracket setup teardown
......
......@@ -28,6 +28,7 @@ import Database.Postgres.Temp qualified as Tmp
import Gargantext hiding (to)
import Gargantext.API.Admin.EnvTypes
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Types
import Gargantext.API.Errors.Types
import Gargantext.API.Prelude
import Gargantext.Core.Mail.Types (HasMail(..))
......@@ -61,6 +62,7 @@ data TestEnv = TestEnv {
, test_nodeStory :: !NodeStoryEnv
, test_usernameGen :: !Counter
, test_logger :: !(Logger (GargM TestEnv BackendInternalError))
, test_settings :: !Settings
}
newtype TestMonad a = TestMonad { runTestMonad :: ReaderT TestEnv IO a }
......@@ -104,6 +106,9 @@ instance HasConnectionPool TestEnv where
instance HasConfig TestEnv where
hasConfig = to test_config
instance HasSettings TestEnv where
settings = to test_settings
instance HasMail TestEnv where
mailSettings = to $ const (MailConfig { _mc_mail_host = "localhost"
, _mc_mail_port = 25
......
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