fix(install): don't show output of install to user

feat(mysql): add mysql as a service, only installation works right now,
there's no configuration
feat(execute): internal function to execute commands

serverman.cabal

@@ -19,8 +19,10 @@ library
                      , System.Serverman
                      , System.Serverman.Utils
                      , System.Serverman.Action
-                     , System.Serverman.Actions.Nginx
                      , System.Serverman.Actions.WebServer
+                     , System.Serverman.Actions.Nginx
+                     , System.Serverman.Actions.Database
+                     , System.Serverman.Actions.MySQL
                      , System.Serverman.Actions.Install
                      , System.Serverman.Actions.Env
                      , System.Serverman.Services

src/System/Serverman.hs

@@ -3,27 +3,33 @@ module System.Serverman ( run
                         , module System.Serverman.Utils
                         , module System.Serverman.Services
                         , module System.Serverman.Actions.WebServer
+                        , module System.Serverman.Actions.Database
                         , module System.Serverman.Actions.Env
                         , module System.Serverman.Actions.Install) where
 
   import System.Serverman.Action
   import System.Serverman.Utils
   import System.Serverman.Services
-  import System.Serverman.Actions.WebServer
+
   import System.Serverman.Actions.Install
   import System.Serverman.Actions.Env
 
-  import System.Serverman.Actions.Nginx
   import System.Serverman.Actions.WebServer
+  import System.Serverman.Actions.Nginx
+
+  import System.Serverman.Actions.Database
+  import System.Serverman.Actions.MySQL
 
   import Control.Monad.Free
 
   run :: Action r -> IO r
   run (Pure r) = return r
   run (Free (NewWebServer params next))
-    | service params == NGINX = nginx params >> run next
+    | serverService params == NGINX = nginx params >> run next
-    -- | service == Apache = apache n >> run next
     | otherwise = run next
   run (Free (DetectOS next)) = getOS >>= 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
+    | otherwise = run next
 

src/System/Serverman/Action.hs

@@ -3,10 +3,12 @@
 module System.Serverman.Action ( ActionF(..)
                                , Action
                                , newServer
+                               , newDatabase
                                , install
                                , detectOS) where
 
   import System.Serverman.Actions.WebServer
+  import System.Serverman.Actions.Database
   import System.Serverman.Actions.Env
   import System.Serverman.Utils
   import System.Serverman.Services
@@ -22,11 +24,13 @@ module System.Serverman.Action ( ActionF(..)
   import Data.Char
 
   data ActionF x = NewWebServer ServerParams x
+                 | NewDatabase DatabaseParams x
                  | DetectOS (OS -> x)
                  | Install 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 (Install service os x) = Install service os (f x)
     fmap f (DetectOS x) = DetectOS (f . x)
 
@@ -35,6 +39,9 @@ module System.Serverman.Action ( ActionF(..)
   newServer :: ServerParams -> Action ()
   newServer params = liftF $ NewWebServer params ()
 
+  newDatabase :: DatabaseParams -> Action ()
+  newDatabase params = liftF $ NewDatabase params ()
+
   install :: Service -> OS -> Action ()
   install service os = liftF $ Install service os ()
 

src/System/Serverman/Actions/Database.hs

@@ -0,0 +1,9 @@
+module System.Serverman.Actions.Database (DatabaseParams(..)) where
+  import System.Serverman.Utils
+  import System.Serverman.Services
+
+  import Control.Monad.Free
+
+  data DatabaseParams = DatabaseParams { database        :: String
+                                       , databaseService :: Service
+                                       } deriving (Eq)

src/System/Serverman/Actions/Env.hs

@@ -1,4 +1,5 @@
 module System.Serverman.Actions.Env (OS(..), getOS) where
+  import System.Serverman.Utils
   import System.Process
   import Data.List
   import System.IO.Error
@@ -7,11 +8,11 @@ module System.Serverman.Actions.Env (OS(..), getOS) where
   data OS = Debian | Arch | Mac | Unknown deriving (Show, Eq)
   
   getOS = do
-    arch_release <- tryIOError $ readProcessWithExitCode "/usr/bin/cat" ["/etc/os-release"] ""
+    arch_release <- execute "/usr/bin/cat" ["/etc/os-release"] "" False
-    deb_release <- tryIOError $ readProcessWithExitCode "/usr/bin/cat" ["/etc/lsb-release"] ""
+    deb_release <- execute "/usr/bin/cat" ["/etc/lsb-release"] "" False
-    mac_release <- tryIOError $ readProcessWithExitCode "/usr/bin/sw_vers" ["-productName"] ""
+    mac_release <- execute "/usr/bin/sw_vers" ["-productName"] "" False
 
-    let (_, release, _) = head $ rights [arch_release, deb_release, mac_release] 
+    let release = head $ rights [arch_release, deb_release, mac_release] 
         distro
             | or $ map (`isInfixOf` release) ["ubuntu", "debian", "raspbian"] = Debian
             | "arch" `isInfixOf` release = Arch

src/System/Serverman/Actions/Install.hs

@@ -12,28 +12,30 @@ module System.Serverman.Actions.Install (installService) where
 
   class Installable a where
     dependencies :: a -> [String]
-    package :: a -> String
+    package :: a -> OS -> String
 
   instance Installable Service where
     dependencies _ = []
 
-    package NGINX = "nginx"
+    package NGINX _ = "nginx"
-    package Apache = "apache2"
+    package MySQL _ = "mysql"
 
   installService :: Service -> OS -> IO ()
   installService service os = do
-    let command = case os of
+    let base = case os of
-          Arch -> "pacman -S "
+          Arch -> ("pacman", ["-S", "--noconfirm", "--quiet"])
-          Debian -> "apt-get install "
+          Debian -> ("apt-get", ["install", "-y"])
-          Mac -> "brew install "
+          Mac -> ("brew", ["install", "-y"])
-          _ -> "echo 'Unknown operating system'"
+          _ -> ("echo", ["Unknown operating system"])
+        pkg = package service os
+
 
     process <- async $ do
-      result <- tryIOError $ callCommand (command ++ package service)
+      result <- execute (fst base) (snd base ++ [pkg]) "" True
 
       case result of
-        Left err ->
+        Left err -> return ()
-          putStrLn $ commandError command
+        Right stdout -> do
-        Right _ ->
+          putStrLn stdout
           putStrLn $ "installed " ++ show service ++ "."
     wait process

src/System/Serverman/Actions/MySQL.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE NamedFieldPuns #-}
+module System.Serverman.Actions.MySQL (mysql) where
+  import System.Serverman.Actions.Database
+  import System.Serverman.Utils
+
+  mysql :: DatabaseParams -> IO ()
+  mysql (DatabaseParams { database, databaseService }) = do
+    return ()

src/System/Serverman/Actions/Nginx.hs

@@ -1,7 +1,9 @@
+{-# LANGUAGE NamedFieldPuns #-}
 module System.Serverman.Actions.Nginx (nginx) where
   import System.Serverman.Action
   import System.Serverman.Actions.WebServer
   import System.Serverman.Utils
+  import System.Serverman.Services
 
   import System.Directory
   import System.IO
@@ -13,19 +15,19 @@ module System.Serverman.Actions.Nginx (nginx) where
   import Control.Monad.Free
 
   nginx :: ServerParams -> IO ()
-  nginx params = 
+  nginx params@(ServerParams { ssl, serverService, domain, directory, serverType }) = 
     do
       -- Turn SSL off at first, because we have not yet received a certificate
       let content = show (params { ssl = False })
-          parent = output params </> "configs"
+          parent = configDirectory serverService </> "configs"
-          path = parent </> domain params
+          path = parent </> domain
-          targetDir = directory params
+          targetDir = directory
 
       createDirectoryIfMissing True targetDir
       createDirectoryIfMissing True parent
 
-      when (ssl params) $ do
+      when ssl $ do
-        let sslPath = output params </> "ssl.conf"
+        let sslPath = configDirectory serverService </> "ssl.conf"
         writeFileIfMissing sslPath nginxSSL
         putStrLn $ "wrote ssl configuration to " ++ sslPath
 
@@ -35,36 +37,32 @@ module System.Serverman.Actions.Nginx (nginx) where
       
       wait =<< restart
 
-      when (ssl params) $ do
+      when ssl $ do
-        case serverType params of
+        case serverType of
           Static -> do
-            let command = "certbot certonly --webroot --webroot-path " ++ directory params ++ " -d " ++ domain params
             letsencrypt <- async $ do
-              result <- tryIOError $ callCommand command
+              result <- execute "certbot" ["certonly", "--webroot", "--webroot-path", directory, "-d", domain] "" True
               case result of
-                Left err -> do
+                Left _ -> return ()
-                  putStrLn $ commandError command
                 Right _ -> do
-                  putStrLn $ "created a certificate for " ++ domain params
+                  putStrLn $ "created a certificate for " ++ domain
                   writeFile path (show params)
                   wait =<< restart
                   
             wait letsencrypt
           _ -> do
             putStrLn $ "you should use letsencrypt to create a certificate for your domain"
-            putStrLn $ "and put it in /etc/letsencrypt/live/" ++ domain params ++ "/fullchain.pem"
+            putStrLn $ "and put it in /etc/letsencrypt/live/" ++ domain ++ "/fullchain.pem"
             putStrLn $ "my suggestion is running this command:"
-            putStrLn $ "sudo certbot certonly --webroot --webroot-path <YOUR_APPLICATION_DIRECTORY> -d " ++ domain params
+            putStrLn $ "sudo certbot certonly --webroot --webroot-path <YOUR_APPLICATION_DIRECTORY> -d " ++ domain 
 
         putStrLn $ "for more information, see: https://certbot.eff.org/"
       return ()
     where
       restart = async $ do
-        let command = "systemctl restart nginx"
+        result <- execute "systemctl" ["restart", "nginx"] "" True
-        result <- tryIOError $ callCommand command
         case result of
-          Left err -> do
+          Left err -> return ()
-            putStrLn $ commandError command
           Right _ ->
-            putStrLn $ "restarted " ++ show (service params)
+            putStrLn $ "restarted " ++ show serverService
 

src/System/Serverman/Actions/WebServer.hs

@@ -5,18 +5,17 @@ module System.Serverman.Actions.WebServer (ServerParams(..), ServerType(..)) whe
   import Control.Monad.Free
 
   data ServerType = Static | PortForwarding deriving (Show, Eq)
-  data ServerParams = ServerParams { directory  :: String
+  data ServerParams = ServerParams { directory     :: String
-                                   , domain     :: String
+                                   , domain        :: String
-                                   , port       :: String
+                                   , port          :: String
-                                   , forward    :: String
+                                   , forward       :: String
-                                   , output     :: String
+                                   , ssl           :: Bool
-                                   , ssl        :: Bool
+                                   , serverType    :: ServerType
-                                   , serverType :: ServerType
+                                   , serverService :: Service
-                                   , service    :: Service
                                    } deriving (Eq)
   instance Show ServerParams where
     show conf 
-      | service conf == NGINX = 
+      | serverService conf == NGINX = 
           let https
                 | ssl conf = [ ("ssl_certificate", "/etc/letsencrypt/live/" ++ domain conf ++ "/fullchain.pem")
                              , ("ssl_certificate_key", "/etc/letsencrypt/live/" ++ domain conf ++ "/privkey.pem")

src/System/Serverman/Services.hs

@@ -1,9 +1,18 @@
 module System.Serverman.Services ( Service(..)
-                                 , ) where
+                                 , configDirectory) where
 
-  data Service = NGINX | Apache deriving (Eq, Show)
+  data Service = NGINX
+               | MySQL
+                 deriving (Eq, Show)
+
+  class Configurable a where
+    configDirectory :: a -> FilePath
+
+  instance Configurable Service where
+    configDirectory NGINX = "/etc/nginx/"
+    configDirectory mysql = "/etc/mysql/"
 
   instance Read Service where
     readsPrec _ service
-          | service == "nginx" || service == "n" = [(NGINX, [])]
+          | service == "nginx" = [(NGINX, [])]
-          | service == "apache" || service == "a" = [(Apache, [])]
+          | service == "mysql" = [(MySQL, [])]

src/System/Serverman/Utils.hs

@@ -2,11 +2,17 @@ module System.Serverman.Utils ( keyvalue
                               , nginxBlock
                               , nginxSSL
                               , writeFileIfMissing
-                              , commandError) where
+                              , commandError
+                              , execute) where
 
   import System.IO
   import Control.Monad
   import System.Directory
+  import System.Process
+  import System.IO.Error
+  import Control.Concurrent.Async
+  import Data.List
+  import Control.Exception
 
   keyvalue :: [(String, String)] -> String
   keyvalue ((a, b):xs) = a ++ " " ++ b ++ ";\n" ++ keyvalue xs
@@ -28,6 +34,21 @@ module System.Serverman.Utils ( keyvalue
   commandError :: String -> String
   commandError command = "[Error] an error occured while running: " ++ command ++ "\nplease try running the command manually."
 
+  execute :: String -> [String] -> String -> Bool -> IO (Either String String)
+  execute cmd args stdin logErrors = do
+    let command = cmd ++ " " ++ intercalate " " args
+
+    process <- async $ do
+      result <- tryIOError $ readProcessWithExitCode cmd args stdin
+
+      case result of
+         Right (_, stdout, _) -> return $ Right stdout
+         Left err -> do
+           when logErrors $ putStrLn (commandError command)
+           return $ Left (show err)
+
+    wait process
+
   nginxSSL = "ssl_protocols TLSv1 TLSv1.1 TLSv1.2;\n\
 \ssl_prefer_server_ciphers on;\n\
 \ssl_dhparam /etc/ssl/certs/dhparam.pem;\n\

src/System/Term.hs

@@ -12,18 +12,31 @@ module System.Term ( initialize ) where
   import Data.Maybe
 
   initialize = do
-    let mode = cmdArgsMode $ modes [webserver, install] &= program "serverman" &= summary "serverman v0.1.0, (C) Mahdi Dibaiee 2017"
+    args <- getArgs
+    let mode = cmdArgsMode $ modes [install, webserver, database] 
+                           &= program "serverman"
+                           &= summary "serverman v0.1.0, (C) Mahdi Dibaiee 2017"
+                           &= helpArg [name "h"]
 
-    (CmdArgs args help version _ _) <- E.processArgs mode
+    let fixArgs
+                  | null args = ["--help"]
+                  | otherwise = args
 
-    if isJust help then
+    let result = E.process mode fixArgs
-      putStrLn $ fromJust help
+
-    else if isJust version then
+    case result of 
-      putStrLn $ fromJust version
+      Right (CmdArgs args help version _ _) -> 
-    else
+        if isJust help then
-      case args of
+          putStrLn $ fromJust help
-        p@(WebServerParams _ _ _ _ _ _ _) -> webServer p
+        else if isJust version then
-        p@(InstallParams _) -> manualInstall p
+          putStrLn $ fromJust version
+        else
+          case args of
+            p@(WebServerParams {}) -> webserverSetup p
+            p@(InstallParams {})   -> manualInstall p
+            p@(DatabaseParams {})  -> databaseSetup p
+      Left err ->
+        print err
 
     return ()
 
@@ -31,29 +44,34 @@ module System.Term ( initialize ) where
   data Params = WebServerParams { directory :: String
                                 , domain    :: String
                                 , port      :: String
-                                , ssl       :: Bool
                                 , forward   :: String
-                                , wService   :: String
+                                , wService  :: String
-                                , output    :: String
+                                , ssl       :: Bool
                                 }
+              | DatabaseParams { databaseName :: String
+                               , dService     :: String }
 
               | InstallParams { iService :: String }
 
               deriving (Show, Data, Typeable)
 
   webserver = WebServerParams { directory = "/var/www/html/" &= typDir &= help "directory to serve static files from, defaults to /var/www/html/" 
-                              , domain = "test.dev" &= typ "DOMAIN" &= help "domain/server name, defaults to test.dev" 
+                              , domain    = "test.dev" &= typ "DOMAIN" &= help "domain/server name, defaults to test.dev"
-                              , port = def &= typ "PORT" &= help "port number to listen to, defaults to 80 for http and 443 for https" 
+                              , port      = def &= typ "PORT" &= help "port number to listen to, defaults to 80 for http and 443 for https"
-                              , forward = def &= typ "PORT" &= help "the port to forward to (in case of a port-forwarding server)" 
+                              , forward   = def &= typ "PORT" &= help "the port to forward to (in case of a port-forwarding server)"
-                              , ssl = False &= help "create a letsencrypt certificate for this domain, defaults to false" 
+                              , ssl       = False &= help "create a letsencrypt certificate for this domain, defaults to false"
-                              , wService = "nginx" &= help "service to build config for: (n)ginx, (a)pache, defaults to nginx" &= explicit &= name "service"
+                              , wService  = "nginx" &= help "service to build config for: nginx, defaults to nginx" &= explicit &= name "service"
-                              , output = def &= help "output directory for the selected service, defaults to /etc/nginx for nginx and /etc/apache2 for apache"
                               } &= explicit &= name "webserver"
 
+  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"
+                            } &= explicit &= name "database"
+
+
   install = InstallParams { iService = def &= argPos 0
                           } &= explicit &= name "install"
 
-  webServer (WebServerParams { directory, domain, port, ssl, forward, wService, output }) = do
+  webserverSetup (WebServerParams { directory, domain, port, ssl, forward, wService }) = do
     let serverType 
           | (not . null) forward = S.PortForwarding
           | otherwise = S.Static
@@ -65,22 +83,22 @@ module System.Term ( initialize ) where
           | ssl = "403"
           | otherwise = "80"
 
-    let outDir
+    let params = S.ServerParams { S.directory     = directory
-          | (not . null) output = output
+                                , S.domain        = domain
-          | serviceName == S.NGINX = "/etc/nginx/"
+                                , S.port          = portNumber
-          | serviceName == S.Apache = "/etc/apache2/"
+                                , S.ssl           = ssl
-
+                                , S.forward       = forward
-    let params = S.ServerParams { S.directory  = directory
+                                , S.serverType    = serverType
-                                , S.domain     = domain
+                                , S.serverService = serviceName
-                                , S.port       = portNumber
-                                , S.ssl        = ssl
-                                , S.forward    = forward
-                                , S.serverType = serverType
-                                , S.service    = serviceName
-                                , S.output     = outDir
                                 }
     S.run $ S.newServer params
 
   manualInstall (InstallParams { iService }) = do
     S.run $ S.detectOS >>= (S.install (read iService))
 
+  databaseSetup (DatabaseParams { databaseName, dService }) = do
+    let params = S.DatabaseParams { S.database = databaseName
+                                  , S.databaseService = read dService }
+
+    S.run $ S.newDatabase params
+