initial commit

src/System/Serverman/Action.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module System.Serverman.Action ( ActionF(..)
+                               , Action
+                               , newServer
+                               , install
+                               , detectOS) where
+
+  import System.Serverman.Actions.WebServer
+  import System.Serverman.Actions.Env
+  import System.Serverman.Utils
+  import System.Serverman.Services
+
+  import System.Directory
+  import System.FilePath
+  import System.IO
+  import System.Process
+  import Control.Concurrent.Async
+  import Control.Monad
+  import Control.Monad.Free
+  import System.IO.Error
+  import Data.Char
+
+  data ActionF x = NewWebServer ServerParams x
+                 | DetectOS (OS -> x)
+                 | Install Service OS x
+
+  instance Functor ActionF where
+    fmap f (NewWebServer params x) = NewWebServer params (f x)
+    fmap f (Install service os x) = Install service os (f x)
+    fmap f (DetectOS x) = DetectOS (f . x)
+
+  type Action = Free ActionF
+
+  newServer :: ServerParams -> Action ()
+  newServer params = liftF $ NewWebServer params ()
+
+  install :: Service -> OS -> Action ()
+  install service os = liftF $ Install service os ()
+
+  detectOS :: Action OS
+  detectOS = liftF $ DetectOS id

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"

src/System/Serverman/Services.hs

@@ -0,0 +1,9 @@
+module System.Serverman.Services ( Service(..)
+                                 , ) where
+
+  data Service = NGINX | Apache deriving (Eq, Show)
+
+  instance Read Service where
+    readsPrec _ service
+          | service == "nginx" || service == "n" = [(NGINX, [])]
+          | service == "apache" || service == "a" = [(Apache, [])]

src/System/Serverman/Utils.hs

@@ -0,0 +1,39 @@
+module System.Serverman.Utils ( keyvalue
+                              , nginxBlock
+                              , nginxSSL
+                              , writeFileIfMissing
+                              , commandError) where
+
+  import System.IO
+  import Control.Monad
+  import System.Directory
+
+  keyvalue :: [(String, String)] -> String
+  keyvalue ((a, b):xs) = a ++ " " ++ b ++ ";\n" ++ keyvalue xs
+  keyvalue [] = ""
+
+  nginxBlock :: String -> String -> String
+  nginxBlock blockName content = blockName ++ " {\n" ++ indent content ++ "}"
+
+  writeFileIfMissing :: FilePath -> String -> IO ()
+  writeFileIfMissing path content = do
+    exists <- doesFileExist path
+    
+    when (not exists) $ do
+      writeFile path content
+
+  indent :: String -> String
+  indent s = unlines $ map ("\t" ++) (lines s)
+
+  commandError :: String -> String
+  commandError command = "[Error] an error occured while running: " ++ command ++ "\nplease try running the command manually."
+
+  nginxSSL = "ssl_protocols TLSv1 TLSv1.1 TLSv1.2;\n\
+\ssl_prefer_server_ciphers on;\n\
+\ssl_dhparam /etc/ssl/certs/dhparam.pem;\n\
+\ssl_ciphers 'ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-AES256-GCM-SHA384:DHE-RSA-AES128-GCM-SHA256:DHE-DSS-AES128-GCM-SHA256:kEDH+AESGCM:ECDHE-RSA-AES128-SHA256:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA:ECDHE-ECDSA-AES128-SHA:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA:ECDHE-ECDSA-AES256-SHA:DHE-RSA-AES128-SHA256:DHE-RSA-AES128-SHA:DHE-DSS-AES128-SHA256:DHE-RSA-AES256-SHA256:DHE-DSS-AES256-SHA:DHE-RSA-AES256-SHA:AES128-GCM-SHA256:AES256-GCM-SHA384:AES128-SHA256:AES256-SHA256:AES128-SHA:AES256-SHA:AES:CAMELLIA:DES-CBC3-SHA:!aNULL:!eNULL:!EXPORT:!DES:!RC4:!MD5:!PSK:!aECDH:!EDH-DSS-DES-CBC3-SHA:!EDH-RSA-DES-CBC3-SHA:!KRB5-DES-CBC3-SHA';\n\
+\ssl_session_timeout 1d;\n\
+\ssl_session_cache shared:SSL:50m;\n\
+\ssl_stapling on;\n\
+\ssl_stapling_verify on;\n\
+\add_header Strict-Transport-Security max-age=15768000;"