]> Git — Sourcephile - gargantext.git/blob - bin/gargantext-init/Main.hs
Merge remote-tracking branch 'origin/adinapoli/drop-servant-static-th' into dev
[gargantext.git] / bin / gargantext-init / Main.hs
1 {-|
2 Module : Main.hs
3 Description : Gargantext Import Corpus
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 Import a corpus binary.
11
12 -}
13
14 {-# LANGUAGE Strict #-}
15
16 module Main where
17
18 import Data.Either (Either(..))
19 import Gargantext.API.Dev (withDevEnv, runCmdDev)
20 import Gargantext.API.Node () -- instances only
21 import Gargantext.API.Prelude (GargError)
22 import Gargantext.Core.Types.Individu (User(..), arbitraryNewUsers, NewUser(..), arbitraryUsername, GargPassword(..))
23 import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMk_RootWithCorpus)
24 import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
25 import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
26 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
27 import Gargantext.Database.Admin.Types.Node
28 import Gargantext.Database.Prelude (Cmd, )
29 import Gargantext.Database.Query.Table.Node (getOrMkList)
30 import Gargantext.Database.Query.Table.User (insertNewUsers, )
31 import Gargantext.Prelude
32 import Gargantext.Prelude.Config (GargConfig(..), readConfig)
33 import Prelude (getLine)
34 import System.Environment (getArgs)
35
36
37 main :: IO ()
38 main = do
39 params@[iniPath] <- getArgs
40
41 _ <- if length params /= 1
42 then panic "USAGE: ./gargantext-init gargantext.ini"
43 else pure ()
44
45 putStrLn "Enter master user (gargantua) _password_ :"
46 password <- getLine
47
48 putStrLn "Enter master user (gargantua) _email_ :"
49 email <- getLine
50
51 cfg <- readConfig iniPath
52 let secret = _gc_secretkey cfg
53
54 let createUsers :: Cmd GargError Int64
55 createUsers = insertNewUsers (NewUser "gargantua" (cs email) (GargPassword $ cs password)
56 : arbitraryNewUsers
57 )
58
59 let
60 mkRoots :: Cmd GargError [(UserId, RootId)]
61 mkRoots = mapM getOrMkRoot $ map UserName ("gargantua" : arbitraryUsername)
62 -- TODO create all users roots
63
64 let
65 initMaster :: Cmd GargError (UserId, RootId, CorpusId, ListId)
66 initMaster = do
67 (masterUserId, masterRootId, masterCorpusId)
68 <- getOrMk_RootWithCorpus (UserName userMaster)
69 (Left corpusMasterName)
70 (Nothing :: Maybe HyperdataCorpus)
71 masterListId <- getOrMkList masterCorpusId masterUserId
72 _triggers <- initLastTriggers masterListId
73 pure (masterUserId, masterRootId, masterCorpusId, masterListId)
74
75 withDevEnv iniPath $ \env -> do
76 _ <- runCmdDev env (initFirstTriggers secret :: Cmd GargError [Int64])
77 _ <- runCmdDev env createUsers
78 x <- runCmdDev env initMaster
79 _ <- runCmdDev env mkRoots
80 putStrLn $ show x
81 pure ()