feat(mongodb): mongodb dummy data and initialization

feat(utils, execute): executeRoot for running as sudo, by default runs
as current user

serverman.cabal

@@ -23,8 +23,10 @@ library
                      , System.Serverman.Actions.Nginx
                      , System.Serverman.Actions.Database
                      , System.Serverman.Actions.MySQL
+                     , System.Serverman.Actions.MongoDB
                      , System.Serverman.Actions.Install
                      , System.Serverman.Actions.Env
+                     , System.Serverman.Actions.Start
                      , System.Serverman.Services
   build-depends:       base >= 4.7 && < 5
                      , free >= 4.12.4 && < 5
@@ -35,6 +37,10 @@ library
                      , directory
                      , filepath
                      , async
+                     , mysql >= 0.1.4 && < 1
+                     , mongoDB >= 2.1.1.1 && < 3
+                     , text
+                     , bytestring
   default-language:    Haskell2010
 
 executable serverman

src/System/Serverman.hs

@@ -11,14 +11,16 @@ module System.Serverman ( run
   import System.Serverman.Utils
   import System.Serverman.Services
 
-  import System.Serverman.Actions.Install
   import System.Serverman.Actions.Env
+  import System.Serverman.Actions.Install
+  import System.Serverman.Actions.Start
 
   import System.Serverman.Actions.WebServer
   import System.Serverman.Actions.Nginx
 
   import System.Serverman.Actions.Database
   import System.Serverman.Actions.MySQL
+  import System.Serverman.Actions.MongoDB
 
   import Control.Monad.Free
 
@@ -28,8 +30,10 @@ module System.Serverman ( run
     | serverService params == NGINX = nginx params >> run next
     | otherwise = run next
   run (Free (DetectOS next)) = getOS >>= run . next
+  run (Free (Start os service next)) = startService os service >> run next
   run (Free (Install os service next)) = installService os service >> run next
   run (Free (NewDatabase params next))
     | databaseService params == MySQL = mysql params >> run next
+    | databaseService params == MongoDB = mongodb params >> run next
     | otherwise = run next
 

src/System/Serverman/Action.hs

@@ -4,10 +4,13 @@ module System.Serverman.Action ( ActionF(..)
                                , Action
                                , newServer
                                , newDatabase
+                               , newFileSharing
+                               , start
                                , install
                                , detectOS) where
 
   import System.Serverman.Actions.WebServer
+  import System.Serverman.Actions.FileSharing
   import System.Serverman.Actions.Database
   import System.Serverman.Actions.Env
   import System.Serverman.Utils
@@ -25,13 +28,17 @@ module System.Serverman.Action ( ActionF(..)
 
   data ActionF x = NewWebServer ServerParams x
                  | NewDatabase DatabaseParams x
+                 | NewFileSharing FileSharingParams x
                  | DetectOS (OS -> x)
                  | Install Service OS x
+                 | Start Service OS x
 
   instance Functor ActionF where
     fmap f (NewWebServer params x) = NewWebServer params (f x)
     fmap f (NewDatabase params x) = NewDatabase params (f x)
+    fmap f (NewSharedFolder params x) = NewSharedFolder params (f x)
     fmap f (Install service os x) = Install service os (f x)
+    fmap f (Start service os x) = Start service os (f x)
     fmap f (DetectOS x) = DetectOS (f . x)
 
   type Action = Free ActionF
@@ -42,8 +49,14 @@ module System.Serverman.Action ( ActionF(..)
   newDatabase :: DatabaseParams -> Action ()
   newDatabase params = liftF $ NewDatabase params ()
 
+  newFileSharing :: FileSharingParams -> Action ()
+  newFileSharing params = liftF $ NewFileSharing params ()
+
   install :: Service -> OS -> Action ()
   install service os = liftF $ Install service os ()
 
+  start :: Service -> OS -> Action ()
+  start service os = liftF $ Start service os ()
+
   detectOS :: Action OS
   detectOS = liftF $ DetectOS id

src/System/Serverman/Actions/Database.hs

@@ -1,4 +1,4 @@
-module System.Serverman.Actions.Database (DatabaseParams(..)) where
+module System.Serverman.Actions.Database (DatabaseParams(..), dummy) where
   import System.Serverman.Utils
   import System.Serverman.Services
 
@@ -6,4 +6,49 @@ module System.Serverman.Actions.Database (DatabaseParams(..)) where
 
   data DatabaseParams = DatabaseParams { database        :: String
                                        , databaseService :: Service
+                                       , dummyData       :: Bool
+                                       , databaseUser    :: String
+                                       , databasePass    :: String
+                                       , databaseHost    :: String
                                        } deriving (Eq)
+
+  dummy = ("serverman_users", ["first_name", "last_name", "email", "children", "birth_date", "gender"], [
+                              ["MacKenzie","Wilcox","vel.sapien.imperdiet@bibendumsedest.com","4","1997-10-30T06:29:02-08:00","Male"],
+                              ["Martha","Elliott","Phasellus@luctusetultrices.com","3","2000-03-04T00:53:32-08:00","Male"],
+                              ["Declan","Nash","ut.quam@ultriciessemmagna.net","1","1975-08-02T00:27:02-07:00","Female"],
+                              ["Kasimir","Fisher","sit.amet.consectetuer@sapien.net","2","2015-06-09T21:45:41-07:00","Male"],
+                              ["Uma","Kelley","vulputate@maurisa.ca","2","1990-05-27T06:28:00-07:00","Female"],
+                              ["Hayley","Owen","eu.eros@velnisl.org","4","2013-07-02T06:13:04-07:00","Male"],
+                              ["Pamela","Hebert","vestibulum.lorem@molestietellus.net","1","1998-01-21T05:32:18-08:00","Female"],
+                              ["Sydnee","Irwin","ultrices@consectetueradipiscing.edu","4","1984-01-15T22:55:10-08:00","Female"],
+                              ["Brandon","Sharp","non@nunc.co.uk","3","2000-06-21T10:05:13-07:00","Female"],
+                              ["Gray","Guerrero","ipsum@magnaUttincidunt.net","1","1975-12-02T06:59:56-08:00","Female"],
+                              ["Nomlanga","Mercado","dolor.Quisque.tincidunt@Donec.edu","1","2015-07-04T01:21:44-07:00","Male"],
+                              ["Luke","Frazier","Aenean.sed.pede@Etiamvestibulum.co.uk","1","2007-01-22T22:03:24-08:00","Male"],
+                              ["Cynthia","Farmer","vel@eratEtiam.co.uk","3","1975-06-20T06:40:51-07:00","Female"],
+                              ["Timothy","Hopper","magna.Praesent.interdum@Phasellusvitaemauris.org","1","1991-03-18T15:36:03-08:00","Male"],
+                              ["Graiden","Walton","est.mauris@aultricies.edu","1","1997-12-06T10:35:10-08:00","Female"],
+                              ["Abigail","Webster","elementum.dui@Duissitamet.com","4","1978-05-03T13:39:42-07:00","Female"],
+                              ["Samuel","Dyer","parturient.montes@Etiamligula.org","3","2002-08-30T21:34:17-07:00","Female"],
+                              ["May","Blackburn","montes.nascetur.ridiculus@Aliquameratvolutpat.org","1","2004-11-01T13:10:43-08:00","Female"],
+                              ["Regina","Hicks","Sed.nulla.ante@atpretium.edu","2","2005-08-28T02:52:49-07:00","Female"],
+                              ["Roth","Bright","lacus@feugiattellus.edu","4","2010-07-26T14:27:31-07:00","Male"],
+                              ["Sylvester","Chapman","Sed.eu@sitametdiam.edu","4","1975-01-23T19:36:26-08:00","Male"],
+                              ["Martin","Sharp","Nullam@Vivamusnibh.net","2","2016-10-18T23:48:20-07:00","Male"],
+                              ["Mary","Schroeder","sem.egestas.blandit@nullaatsem.com","1","1993-03-16T17:41:10-08:00","Female"],
+                              ["Blythe","Alston","amet.faucibus.ut@ornareFuscemollis.org","1","1980-09-22T04:58:53-07:00","Female"],
+                              ["Nathan","Ramsey","in.molestie@Mauris.ca","4","2006-05-07T08:30:57-07:00","Female"],
+                              ["Zelenia","Meadows","nunc@Aenean.com","3","1983-04-03T01:42:18-08:00","Female"],
+                              ["Karyn","Booker","tempor@sagittissemperNam.ca","3","2006-10-13T02:29:44-07:00","Male"],
+                              ["Hiram","Booth","semper@risusDonecegestas.ca","4","2001-10-30T19:53:13-08:00","Male"],
+                              ["Robert","Mcclure","semper@nonduinec.org","1","2012-11-14T17:32:09-08:00","Female"],
+                              ["Celeste","Callahan","convallis@NulladignissimMaecenas.edu","1","1984-08-22T22:56:35-07:00","Female"],
+                              ["Magee","Olsen","ligula.consectetuer.rhoncus@fermentumvel.com","2","1978-04-09T15:12:05-08:00","Female"],
+                              ["Dana","Mccullough","ut.sem.Nulla@eleifendnec.net","4","2000-08-23T07:54:53-07:00","Male"],
+                              ["Yen","Blanchard","et@Morbi.org","3","1997-05-09T03:30:56-07:00","Male"],
+                              ["Cora","Valdez","lorem.vitae.odio@vulputateullamcorpermagna.net","2","1998-10-24T16:06:46-07:00","Male"],
+                              ["Amela","Blackburn","vulputate.dui@ultrices.co.uk","3","2006-03-08T07:42:27-08:00","Male"],
+                              ["Dean","Blanchard","ac.tellus@nonummyipsumnon.co.uk","2","2014-12-21T14:38:37-08:00","Female"],
+                              ["Alika","Shields","est.mauris@mollis.co.uk","3","1976-11-08T22:32:16-08:00","Female"],
+                              ["Byron","Dudley","mattis@nequeNullam.org","1","1992-07-04T12:32:20-07:00","Female"],
+                              ["Noelle","Young","et.malesuada.fames@aliquetmolestietellus.net","2","2009-04-05T03:05:01-07:00","Female"]])

src/System/Serverman/Actions/Install.hs

@@ -1,4 +1,4 @@
-module System.Serverman.Actions.Install (installService) where
+module System.Serverman.Actions.Install (installService, package, dependencies) where
   import System.Serverman.Action
   import System.Serverman.Utils
   import System.Serverman.Services
@@ -19,12 +19,17 @@ module System.Serverman.Actions.Install (installService) where
     dependencies NGINX = [LetsEncrypt]
     dependencies _ = []
 
-    package NGINX _ = "nginx"
-    package MySQL _ = "mysql"
-
     package LetsEncrypt Arch = "certbot"
     package LetsEncrypt _ = "letsencrypt"
 
+    package NGINX _ = "nginx"
+
+    package MySQL _ = "mysql"
+
+    package MongoDB _ = "mongodb"
+
+    package VsFTPd _ = "vsftpd"
+
   installService :: Service -> OS -> IO ()
   installService service os = do
     forM_ (dependencies service) (`installService` os) 
@@ -37,7 +42,7 @@ module System.Serverman.Actions.Install (installService) where
         pkg = package service os
 
     process <- async $ do
-      result <- execute (fst base) (snd base ++ [pkg]) "" True
+      result <- executeRoot (fst base) (snd base ++ [pkg]) "" True
 
       case result of
         Left err -> return ()

src/System/Serverman/Actions/MongoDB.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module System.Serverman.Actions.MongoDB (mongodb) where
+  import System.Serverman.Actions.Database
+  import System.Serverman.Utils hiding (execute)
+  import Database.MongoDB
+  import qualified Data.ByteString.Char8 as BS
+  import Data.List hiding (delete)
+  import qualified Data.Text as T
+  import Control.Monad
+  import System.IO.Error
+
+  mongodb :: DatabaseParams -> IO ()
+  mongodb (DatabaseParams { database, dummyData, databaseHost }) = do
+    result <- tryIOError $ connect (readHostPort databaseHost)
+
+    case result of
+      Right pipe -> do
+        e <- access pipe master (T.pack database) run
+
+        close pipe
+      Left err -> do
+        putStrLn $ show err
+        putStrLn $ "[Error] could not connect to MongoDB server " ++ databaseHost
+  
+    where
+      run = do
+        when dummyData $ do
+          clearCollection
+          insertToCollection
+          return ()
+
+      clearCollection = delete (select [] (T.pack collectionName))
+        where (collectionName, _, _) = dummy
+
+      insertToCollection = insertMany (T.pack collectionName) records
+        where
+          (collectionName, definitions, rows) = dummy
+          records = map (\row -> zipWith (\def value -> def =: row) (map T.pack definitions) row) rows
+        
+
+  createDummyTables = createTable dummy
+    where
+      createTable (tableName, columns, rows) = "CREATE TABLE IF NOT EXISTS " ++ tableName ++ "(" ++ intercalate "," (map columnDef columns) ++ ")";
+      columnDef "children" = "children INT"
+      columnDef "birth_date" = "birth_date DATETIME"
+      columnDef "gender" = "gender ENUM('Male', 'Female')"
+      columnDef name = name ++ " VARCHAR(255)"
+
+  insertToDummyTables = insertTable dummy
+    where
+      insertTable (tableName, _, rows) = "INSERT INTO " ++ tableName ++ " VALUES " ++ intercalate "," (map insertRow rows)
+      insertRow row = "('" ++ intercalate "','" row ++ "')"
+    

src/System/Serverman/Actions/MySQL.hs

@@ -1,8 +1,45 @@
 {-# LANGUAGE NamedFieldPuns #-}
+
 module System.Serverman.Actions.MySQL (mysql) where
   import System.Serverman.Actions.Database
-  import System.Serverman.Utils
+  import System.Serverman.Utils hiding (execute)
+  import Database.MySQL.Base
+  import qualified Data.ByteString.Char8 as BS
+  import Data.List
+  import Control.Monad
 
   mysql :: DatabaseParams -> IO ()
-  mysql (DatabaseParams { database, databaseService }) = do
+  mysql (DatabaseParams { database, dummyData, databaseUser, databasePass, databaseHost }) = do
+    conn <- connect $ defaultConnectInfo { connectUser = databaseUser, connectPassword = databasePass, connectHost = databaseHost }
+
+    query conn $ BS.pack ("CREATE DATABASE IF NOT EXISTS " ++ database)
+    
+
+    when dummyData $ do
+      let (tableName, _, _) = dummy
+
+      query conn $ BS.pack createDummyTables
+      query conn $ BS.pack clearTable
+      query conn $ BS.pack insertToDummyTables
+
+      putStrLn $ "Created dummy table '" ++ tableName ++ "' and filled it with data."
+      return ()
+
     return ()
+
+  clearTable = "DELETE FROM " ++ tableName
+    where (tableName, _, _) = dummy
+
+  createDummyTables = createTable dummy
+    where
+      createTable (tableName, columns, rows) = "CREATE TABLE IF NOT EXISTS " ++ tableName ++ "(" ++ intercalate "," (map columnDef columns) ++ ")";
+      columnDef "children" = "children INT"
+      columnDef "birth_date" = "birth_date DATETIME"
+      columnDef "gender" = "gender ENUM('Male', 'Female')"
+      columnDef name = name ++ " VARCHAR(255)"
+
+  insertToDummyTables = insertTable dummy
+    where
+      insertTable (tableName, _, rows) = "INSERT INTO " ++ tableName ++ " VALUES " ++ intercalate "," (map insertRow rows)
+      insertRow row = "('" ++ intercalate "','" row ++ "')"
+    

src/System/Serverman/Actions/Nginx.hs

@@ -46,7 +46,7 @@ module System.Serverman.Actions.Nginx (nginx) where
         dhExists <- doesFileExist dhparamPath
 
         when (not dhExists) $ do
-          dhparam <- async $ execute "openssl" ["dhparam", "-out", dhparamPath, "2048"] "" True
+          dhparam <- async $ executeRoot "openssl" ["dhparam", "-out", dhparamPath, "2048"] "" True
           wait dhparam
           return ()
 
@@ -65,14 +65,14 @@ module System.Serverman.Actions.Nginx (nginx) where
       return ()
     where
       restart = async $ do
-        result <- execute "systemctl" ["restart", "nginx"] "" True
+        result <- executeRoot "systemctl" ["restart", "nginx"] "" True
         case result of
           Left err -> return ()
           Right _ ->
             putStrLn $ "restarted " ++ show serverService
 
       createCert path cmd = do
-        result <- execute cmd ["certonly", "--webroot", "--webroot-path", directory, "-d", domain, "--email", email, "--agree-tos", "-n"] "" False
+        result <- executeRoot cmd ["certonly", "--webroot", "--webroot-path", directory, "-d", domain, "--email", email, "--agree-tos", "-n"] "" False
         case result of
           Left _ -> if cmd == "letsencrypt" then createCert path "certbot" else return ()
           Right stdout -> do

src/System/Serverman/Actions/Start.hs

@@ -0,0 +1,12 @@
+module System.Serverman.Actions.Start (startService) where
+  import System.Serverman.Utils
+  import System.Serverman.Actions.Env
+  import System.Serverman.Actions.Install
+  import System.Serverman.Services
+
+  startService :: Service -> OS -> IO ()
+  startService service os
+    | os == Mac = putStrLn $ "Couldn't start " ++ package service os ++ " automatically. If you encounter any problems, make sure it is running."
+    | otherwise = executeRoot "systemctl" ["start", package service os] "" True
+                >> execute "sleep" ["5s"] "" True
+                >> return ()

src/System/Serverman/Services.hs

@@ -3,6 +3,8 @@ module System.Serverman.Services ( Service(..)
 
   data Service = NGINX
                | MySQL
+               | MongoDB
+               | VsFTPd
                | LetsEncrypt
                  deriving (Eq, Show)
 
@@ -11,10 +13,14 @@ module System.Serverman.Services ( Service(..)
 
   instance Configurable Service where
     configDirectory NGINX = "/etc/nginx/"
-    configDirectory mysql = "/etc/mysql/"
+    configDirectory MySQL = "/etc/mysql/"
+    configDirectory MongoDB = "/etc/mongodb"
+    configDirectory VsFTPd = "/etc/vsftpd"
 
   instance Read Service where
     readsPrec _ service
           | service == "nginx" = [(NGINX, [])]
           | service == "mysql" = [(MySQL, [])]
+          | service == "mongodb" = [(MongoDB, [])]
+          | service == "vsftpd" = [(VsFTPd, [])]
           | service == "letsencrypt" = [(LetsEncrypt, [])]

src/System/Serverman/Utils.hs

@@ -4,7 +4,8 @@ module System.Serverman.Utils ( keyvalue
                               , writeFileIfMissing
                               , commandError
                               , appendAfter
-                              , execute) where
+                              , execute
+                              , executeRoot) where
 
   import System.IO
   import Control.Monad
@@ -14,6 +15,7 @@ module System.Serverman.Utils ( keyvalue
   import Control.Concurrent.Async
   import Data.List
   import Control.Exception
+  import System.Exit
 
   keyvalue :: [(String, String)] -> String
   keyvalue ((a, b):xs) = a ++ " " ++ b ++ ";\n" ++ keyvalue xs
@@ -50,9 +52,22 @@ module System.Serverman.Utils ( keyvalue
       result <- tryIOError $ readProcessWithExitCode cmd args stdin
 
       case result of
-         Right (_, stdout, _) -> return $ Right stdout
+         Right (ExitSuccess, stdout, _) -> return $ Right stdout
+
+         Right (ExitFailure code, stdout, stderr) -> do
+           when logErrors $ do
+             putStrLn $ "exit code: " ++ show code
+             putStrLn stdout
+             putStrLn stderr
+             putStrLn $ commandError command
+           return $ Left stdout
          Left err -> do
-           when logErrors $ putStrLn (commandError command)
+           when logErrors $ do
+             putStrLn $ show err
+             putStrLn $ commandError command
            return $ Left (show err)
 
     wait process
+
+  executeRoot :: String -> [String] -> String -> Bool -> IO (Either String String)
+  executeRoot cmd args stdin logErrors = execute "sudo" (cmd:args) stdin logErrors

src/System/Term.hs

@@ -21,6 +21,12 @@ module System.Term ( initialize ) where
                            &= summary "serverman v0.1.0, (C) Mahdi Dibaiee 2017"
                            &= helpArg [name "h"]
 
+    user <- getEnv "USER"
+
+    when (user == "ROOT") $ do
+      putStrLn $ "It's recommended that you don't run serverman as root."
+      putStrLn $ "Serverman will automatically use sudo whenever needed."
+
     let fixArgs
                   | null args = ["--help"]
                   | otherwise = args
@@ -53,7 +59,12 @@ module System.Term ( initialize ) where
                                 , email     :: String
                                 }
               | DatabaseParams { databaseName :: String
-                               , dService     :: String }
+                               , dService     :: String
+                               , dummyData    :: Bool
+                               , dUser        :: String
+                               , dPass        :: String
+                               , dHost        :: String
+                               }
 
               | InstallParams { iService :: String }
 
@@ -70,6 +81,10 @@ module System.Term ( initialize ) where
 
   database = DatabaseParams { databaseName = "test" &= help "database name, defaults to test" &= explicit &= name "name"
                             , dService     = "mysql" &= help "service to setup: mysql, defaults to mysql" &= explicit &= name "service"
+                            , dummyData    = False &= help "generate dummy data in the database" &= explicit &= name "dummy-data"
+                            , dUser        = "root" &= help "database's username, defaults to root" &= explicit &= name "user"
+                            , dPass        = "" &= help "database's password, defaults to blank string" &= explicit &= name "password"
+                            , dHost        = "127.0.0.1" &= help "database's host, defaults to localhost" &= explicit &= name "host"
                             } &= explicit &= name "database"
 
 
@@ -101,16 +116,29 @@ module System.Term ( initialize ) where
                                 , S.serverService = serviceName
                                 , S.email         = email
                                 }
-    S.run $ S.detectOS >>= (S.install serviceName) >> S.newServer params
+    S.run $ S.detectOS >>= (S.install serviceName)
+         >> S.detectOS >>= (S.start serviceName)
+         >> S.newServer params
 
   manualInstall (InstallParams { iService }) = do
-    S.run $ S.detectOS >>= (S.install (read iService))
+    let serviceName = read iService :: Service
 
-  databaseSetup (DatabaseParams { databaseName, dService }) = do
+    S.run $ S.detectOS >>= (S.install serviceName)
+         >> S.detectOS >>= (S.start serviceName)
+    
+
+  databaseSetup (DatabaseParams { databaseName, dService, dummyData, dUser, dPass, dHost }) = do
     let serviceName = read dService
 
     let params = S.DatabaseParams { S.database = databaseName
-                                  , S.databaseService = serviceName }
+                                  , S.databaseService = serviceName
+                                  , S.dummyData = dummyData
+                                  , S.databaseUser = dUser
+                                  , S.databasePass = dPass
+                                  , S.databaseHost = dHost
+                                  }
 
-    S.run $ S.detectOS >>= (S.install serviceName) >> S.newDatabase params
+    S.run $ S.detectOS >>= (S.install serviceName)
+         >> S.detectOS >>= (S.start serviceName)
+         >> S.newDatabase params