initial commit

src/System/Serverman/Actions/Env.hs

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

src/System/Serverman/Actions/Install.hs

@@ -0,0 +1,38 @@
+module System.Serverman.Actions.Install (installService) where
+  import System.Serverman.Action
+  import System.Serverman.Utils
+  import System.Serverman.Services
+  import System.Serverman.Actions.Env
+
+
+  import System.IO.Error
+  import System.Process
+  import Control.Concurrent.Async
+  import Control.Monad.Free
+
+  class Installable a where
+    dependencies :: a -> [String]
+    package :: a -> String
+
+  instance Installable Service where
+    dependencies _ = []
+
+    package NGINX = "nginx"
+    package Apache = "apache2"
+
+  installService :: Service -> OS -> IO ()
+  installService service os = do
+    let command = case os of
+          Arch -> "pacman -S "
+          Debian -> "apt-get install "
+          _ -> "echo 'Unknown operating system'"
+
+    process <- async $ do
+      result <- tryIOError $ callCommand (command ++ package service)
+
+      case result of
+        Left err ->
+          putStrLn $ commandError command
+        Right _ ->
+          putStrLn $ "installed " ++ show service ++ "."
+    wait process

src/System/Serverman/Actions/Nginx.hs

@@ -0,0 +1,68 @@
+module System.Serverman.Actions.Nginx (nginx) where
+  import System.Serverman.Action
+  import System.Serverman.Actions.WebServer
+  import System.Serverman.Utils
+
+  import System.Directory
+  import System.IO
+  import System.IO.Error
+  import System.FilePath
+  import System.Process
+  import Control.Concurrent.Async
+  import Control.Monad
+  import Control.Monad.Free
+
+  nginx :: ServerParams -> IO ()
+  nginx params = 
+    do
+      -- Turn SSL off at first, because we have not yet received a certificate
+      let content = show (params { ssl = False })
+          parent = output params </> "configs"
+          path = parent </> domain params
+          targetDir = directory params
+
+      createDirectoryIfMissing True targetDir
+      createDirectoryIfMissing True parent
+
+      when (ssl params) $ do
+        let sslPath = output params </> "ssl.conf"
+        writeFileIfMissing sslPath nginxSSL
+        putStrLn $ "wrote ssl configuration to " ++ sslPath
+
+      writeFile path content
+
+      putStrLn $ "wrote your configuration file to " ++ path
+
+      restart <- async $ do
+        let command = "systemctl restart nginx"
+        result <- tryIOError $ callCommand command
+        case result of
+          Left err -> do
+            putStrLn $ commandError command
+          Right _ ->
+            putStrLn $ "restarted " ++ show (service params)
+
+      wait restart
+      
+      when (ssl params) $ do
+        case serverType params of
+          Static -> do
+            let command = "certbot certonly --webroot --webroot-path " ++ directory params ++ " -d " ++ domain params
+            letsencrypt <- async $ do
+              result <- tryIOError $ callCommand command
+              case result of
+                Left err -> do
+                  putStrLn $ commandError command
+                Right _ -> do
+                  putStrLn $ "created a certificate for " ++ domain params
+                  writeFile path (show params)
+                  
+            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 $ "my suggestion is running this command:"
+            putStrLn $ "sudo certbot certonly --webroot --webroot-path <YOUR_APPLICATION_DIRECTORY> -d " ++ domain params
+
+        putStrLn $ "for more information, see: https://certbot.eff.org/"
+      return ()

src/System/Serverman/Actions/WebServer.hs

@@ -0,0 +1,44 @@
+module System.Serverman.Actions.WebServer (ServerParams(..), ServerType(..)) where
+  import System.Serverman.Utils
+  import System.Serverman.Services
+
+  import Control.Monad.Free
+
+  data ServerType = Static | PortForwarding deriving (Show, Eq)
+  data ServerParams = ServerParams { directory  :: String
+                                   , domain     :: String
+                                   , port       :: String
+                                   , forward    :: String
+                                   , output     :: String
+                                   , ssl        :: Bool
+                                   , serverType :: ServerType
+                                   , service    :: Service
+                                   } deriving (Eq)
+  instance Show ServerParams where
+    show conf 
+      | service 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")
+                             , ("include", "ssl.conf")]
+                | otherwise = []
+
+              base = [ ("server_name", domain conf)
+                     , ("listen", port conf)
+                     , ("index", "index.html index.html index.php")
+                     ] ++ https
+          in 
+            case serverType conf of
+              Static -> 
+                nginxBlock "server" $ keyvalue (base ++ [("root", directory conf)])
+
+              PortForwarding -> 
+                let proxyBlock = nginxBlock "location /" $
+                                    keyvalue ([ ("proxy_pass", "http://127.0.0.1:" ++ forward conf)
+                                              , ("proxy_set_header", "X-Forwarded-Host $host")
+                                              , ("proxy_set_header", "X-Forwarded-Server $host")
+                                              , ("proxy_set_header", "X-Forwarded-For $proxy_add_x_forwarded_for")
+                                              ])
+                in nginxBlock "server" $ keyvalue base ++ proxyBlock
+
+      | otherwise = "Unknown service provider"