feat: repository

serverman.cabal

@@ -20,20 +20,14 @@ library
                      , System.Serverman.Utils
                      , System.Serverman.Action
                      
-                     , System.Serverman.Actions.WebServer
-                     , System.Serverman.Actions.Nginx
-
-                     , System.Serverman.Actions.Database
-                     , System.Serverman.Actions.MySQL
-                     , System.Serverman.Actions.MongoDB
-
-                     , System.Serverman.Actions.FileSharing
-                     , System.Serverman.Actions.VsFTPd
-
                      , System.Serverman.Actions.Install
                      , System.Serverman.Actions.Env
-                     , System.Serverman.Actions.Start
+                     , System.Serverman.Actions.Manage
                      , System.Serverman.Actions.Remote
+                     , System.Serverman.Actions.Repository
+                     , System.Serverman.Actions.Call
+
+                     , System.Serverman.Types
                      , System.Serverman.Services
   build-depends:       base >= 4.7 && < 5
                      , free >= 4.12.4 && < 5
@@ -52,6 +46,10 @@ library
                      , Unixutils
                      , mtl
                      , monad-control
+                     , aeson
+                     , containers
+                     , hint
+                     , stack
   default-language:    Haskell2010
 
 executable serverman

src/System/Serverman.hs

@@ -2,30 +2,20 @@ module System.Serverman ( run
                         , module System.Serverman.Action
                         , module System.Serverman.Utils
                         , module System.Serverman.Services
-                        , module System.Serverman.Actions.WebServer
-                        , module System.Serverman.Actions.Database
-                        , module System.Serverman.Actions.FileSharing
                         , 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.Types
 
   import System.Serverman.Actions.Env
   import System.Serverman.Actions.Install
-  import System.Serverman.Actions.Start
+  import System.Serverman.Actions.Manage
+  import System.Serverman.Actions.Repository
   import System.Serverman.Actions.Remote
-
+  import System.Serverman.Actions.Call
-  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 System.Serverman.Actions.FileSharing
-  import System.Serverman.Actions.VsFTPd
 
   import Control.Monad.Free
 
@@ -33,20 +23,12 @@ module System.Serverman ( run
   run (Pure r) = return r
   run (Free (DetectOS next)) = getOS >>= run . next
   run (Free (Start os service next)) = startService os service >> run next
+  run (Free (Stop os service next)) = stopService os service >> run next
   run (Free (Install os service next)) = installService os service >> run next
 
-  run (Free (NewWebServer params next))
+  run (Free (Call service params next)) = callService service params >> run next
-    | serverService params == NGINX = nginx params >> run next
-    | otherwise = run next
-
-  run (Free (NewDatabase params next))
-    | databaseService params == MySQL = mysql params >> run next
-    | databaseService params == MongoDB = mongodb params >> run next
-    | otherwise = run next
-
-  run (Free (NewFileSharing params next))
-    | fService params == VsFTPd = vsftpd params >> run next
-    | otherwise = run next
 
   run (Free (Remote addrs action next)) = mapM_ (\addr -> runRemotely addr (run action)) addrs >> run next
 
+  run (Free (FetchRepository next)) = fetchRepo >> run next
+

src/System/Serverman/Action.hs

@@ -2,20 +2,20 @@
 
 module System.Serverman.Action ( ActionF(..)
                                , Action
-                               , newServer
+                               , call
-                               , newDatabase
+                               , fetchRepository
-                               , newFileSharing
                                , start
+                               , stop
                                , install
                                , remote
                                , 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.Actions.Repository
   import System.Serverman.Actions.Remote
+
   import System.Serverman.Utils
+  import System.Serverman.Types
   import System.Serverman.Services
 
   import System.Directory
@@ -28,33 +28,27 @@ module System.Serverman.Action ( ActionF(..)
   import System.IO.Error
   import Data.Char
 
-  data ActionF x = NewWebServer ServerParams x
+  data ActionF x = Call Service Params x
-                 | NewDatabase DatabaseParams x
-                 | NewFileSharing FileSharingParams x
                  | DetectOS (OS -> x)
                  | Install Service OS x
                  | Remote [Address] (Action ()) x
+                 | FetchRepository x
                  | Start Service OS x
+                 | Stop Service OS x
 
   instance Functor ActionF where
-    fmap f (NewWebServer params x) = NewWebServer params (f x)
+    fmap f (Call service params x) = Call service params (f x)
-    fmap f (NewDatabase params x) = NewDatabase params (f x)
-    fmap f (NewFileSharing params x) = NewFileSharing 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 (Stop service os x) = Stop service os (f x)
     fmap f (DetectOS x) = DetectOS (f . x)
     fmap f (Remote addr action x) = Remote addr action (f x)
+    fmap f (FetchRepository x) = FetchRepository (f x)
 
   type Action = Free ActionF
 
-  newServer :: ServerParams -> Action ()
+  call :: Service -> Params -> Action ()
-  newServer params = liftF $ NewWebServer params ()
+  call service params = liftF $ Call service params ()
-
-  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 ()
@@ -62,8 +56,14 @@ module System.Serverman.Action ( ActionF(..)
   start :: Service -> OS -> Action ()
   start service os = liftF $ Start service os ()
 
+  stop :: Service -> OS -> Action ()
+  stop service os = liftF $ Stop service os ()
+
   detectOS :: Action OS
   detectOS = liftF $ DetectOS id
 
   remote :: [Address] -> Action () -> Action ()
   remote addrs action = liftF $ Remote addrs action ()
+
+  fetchRepository :: Action ()
+  fetchRepository = liftF $ FetchRepository ()

src/System/Serverman/Actions/Call.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module System.Serverman.Actions.Call (callService) where
+  import System.Serverman.Types
+  import System.Serverman.Utils
+  import qualified System.Serverman.Actions.Repository
+
+  import System.Directory
+  import System.FilePath
+  import Language.Haskell.Interpreter hiding (get, name)
+  import Control.Monad.State
+  import System.Posix.Env
+  import Data.List
+  import Stack.Package
+
+  callService :: Service -> Params -> App ()
+  callService s@(Service { name, version }) params = do
+    state@(AppState { repositoryURL }) <- get
+
+    dir <- liftIO $ getAppUserDataDirectory "serverman"
+    let path = dir </> "repository" </> "services" </> name
+        source = dir </> "source" </> "src"
+        entry = path </> "src" </> "Main.hs"
+        object = path </> "Main.o"
+
+    packages <- liftIO $ readFile $ path </> "packages"
+
+    {-result <- exec "stack" (["ghc", entry, "--package", intercalate "," . lines $ packages, "--"] ++ includeArgs) "" (Just source) True-}
+    {-let packagePaths = splitAtElem packagePath ':'-}
+    let include = [source, path]
+        includeArgs = map ("-i"++) include
+
+    (Right stackEnv) <- exec "stack" ["exec", "env"] "" (Just path) True
+
+    backupEnv <- liftIO $ getEnvironment
+    liftIO $ setEnvironment $ parseKeyValue stackEnv '='
+
+    liftIO $ print include
+
+    func <- liftIO $ runInterpreter (interpreter include entry)
+
+    case func of
+      Right fn -> fn
+      Left err -> liftIO $ do
+        putStrLn $ "error reading `call` from module " ++ entry
+        print err
+
+    liftIO $ setEnvironment backupEnv
+
+    return ()
+      {-result <- build entry object ["-i" ++ source]-}
+      {-print result-}
+
+      {-result :: (Maybe ) <- liftIO $ eval content ["System.Serverman.Types", "System.Serverman.Utils", "Control.Monad.State"]-}
+      {-liftIO $ print result-}
+
+  interpreter :: [FilePath] -> FilePath -> Interpreter (App ())
+  interpreter path entry = do
+    set [searchPath := path]
+    loadModules [entry]
+    setTopLevelModules ["Main"]
+    interpret "call" (as :: App ())
+

src/System/Serverman/Actions/Env.hs

@@ -1,13 +1,13 @@
 module System.Serverman.Actions.Env (OS(..), getOS) where
   import System.Serverman.Utils
+  import System.Serverman.Types
+
   import System.Process
   import Data.List
   import System.IO.Error
   import Data.Either
   import Data.Char
   
-  data OS = Debian | Arch | Mac | Unknown deriving (Show, Eq)
-  
   getOS = do
     arch_release <- execute "cat" ["/etc/os-release"] "" False
     deb_release <- execute "cat" ["/etc/lsb-release"] "" False

src/System/Serverman/Actions/FileSharing.hs

@@ -17,7 +17,7 @@ module System.Serverman.Actions.FileSharing (FileSharingParams(..)) where
 
   instance Show FileSharingParams where
     show (FileSharingParams { fDirectory, fUser, fPass, fPort, fWritable, fAnonymous, fAnonymousWrite, fService })
-      | fService == VsFTPd = 
+      | name fService == "vsftpd" = 
           let boolToEnglish True  = "YES"
               boolToEnglish False = "NO"
           in 

src/System/Serverman/Actions/Install.hs

@@ -1,11 +1,12 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
-module System.Serverman.Actions.Install (installService, package, dependencies) where
+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.Serverman.Types
 
   import System.IO.Error
   import System.Process
@@ -14,45 +15,24 @@ module System.Serverman.Actions.Install (installService, package, dependencies)
   import Control.Monad.State
   import Control.Monad.Trans.Control
 
-  class Installable a where
-    dependencies :: a -> [a]
-    package :: a -> OS -> String
-
-  instance Installable Service where
-    dependencies NGINX = [LetsEncrypt]
-    dependencies _ = []
-
-    package LetsEncrypt Arch = "certbot"
-    package LetsEncrypt _ = "letsencrypt"
-
-    package NGINX _ = "nginx"
-
-    package MySQL _ = "mysql"
-
-    package MongoDB _ = "mongodb"
-
-    package VsFTPd _ = "vsftpd"
-
-    package SSHFs _ = "sshfs"
-
   installService :: Service -> OS -> App ()
-  installService service os = do
+  installService s@(Service { dependencies, packages }) os = do
-    forM_ (dependencies service) (`installService` os) 
+    forM_ dependencies (`installService` os) 
 
     let base = case os of
           Arch -> ("pacman", ["-S", "--noconfirm", "--quiet"])
           Debian -> ("apt-get", ["install", "-y"])
           Mac -> ("brew", ["install", "-y"])
           _ -> ("echo", ["Unknown operating system"])
-        pkg = package service os
+        pkg = packageByOS s os
 
     process <- liftedAsync $ do
-      result <- executeRoot (fst base) (snd base ++ [pkg]) "" True
+      result <- executeRoot (fst base) (snd base ++ pkg) "" True
 
       case result of
         Left err -> return ()
         Right _ -> do
-          liftIO $ putStrLn $ "installed " ++ show service ++ "."
+          liftIO $ putStrLn $ "installed " ++ show s ++ "."
       
     liftIO $ wait process
     return ()

src/System/Serverman/Actions/Manage.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module System.Serverman.Actions.Manage (startService, stopService) where
+  import System.Serverman.Utils
+  import System.Serverman.Actions.Env
+  import System.Serverman.Actions.Install
+  import System.Serverman.Services
+
+  import Control.Monad.State
+
+  startService :: Service -> OS -> App ()
+  startService (Service { service }) os
+    | os == Mac = liftIO $ putStrLn $ "Couldn't start " ++ service ++ " automatically. If you encounter any problems, make sure it is running."
+    | otherwise = executeRoot "systemctl" ["start", service] "" True
+                >> execute "sleep" ["5s"] "" True
+                >> return ()
+
+  stopService :: Service -> OS -> App ()
+  stopService (Service { service }) os
+    | os == Mac = liftIO $ putStrLn $ "Couldn't stop " ++ service ++ " automatically."
+    | otherwise = executeRoot "systemctl" ["stop", service] "" True
+                >> return ()

src/System/Serverman/Actions/Nginx.hs

@@ -21,8 +21,8 @@ module System.Serverman.Actions.Nginx (nginx) where
     do
       -- Turn SSL off at first, because we have not yet received a certificate
       let content = show (params { ssl = False, port = "80" })
-          mainConfig = configDirectory serverService </> "nginx.conf"
+          mainConfig = config serverService </> "nginx.conf"
-          parent = configDirectory serverService </> "serverman-configs"
+          parent = config serverService </> "serverman-configs"
           path = parent </> domain
           targetDir = wDirectory
 
@@ -33,7 +33,7 @@ module System.Serverman.Actions.Nginx (nginx) where
         writeIncludeStatementIfMissing mainConfig parent
 
         when ssl $ do
-          let sslPath = configDirectory serverService </> "ssl.conf"
+          let sslPath = config serverService </> "ssl.conf"
           writeFileIfMissing sslPath nginxSSL
           putStrLn $ "wrote ssl configuration to " ++ sslPath
 

src/System/Serverman/Actions/Remote.hs

@@ -14,8 +14,6 @@ module System.Serverman.Actions.Remote ( runRemotely
   import Data.IORef
   import Control.Monad.State
 
-  import Debug.Trace
-
   runRemotely :: Address -> App r -> App ()
   runRemotely addr@(Address host port user) action = do
     let servermanAddr = Address host port "serverman"

src/System/Serverman/Actions/Repository.hs

@@ -0,0 +1,86 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module System.Serverman.Actions.Repository (fetchRepo) where
+  import System.Serverman.Utils
+  import System.Directory
+  import System.Serverman.Services
+  import System.Serverman.Actions.Env
+  import System.Serverman.Types
+
+  import System.FilePath
+  import Data.Maybe
+  import Data.Either
+  import Data.Aeson
+  import Data.Aeson.Types
+  import GHC.Generics
+  import qualified Data.Map as M
+  import Control.Monad.State
+  import qualified Data.ByteString.Lazy.Char8 as BS
+  import qualified Data.Text as T
+
+  sourceURL = "https://github.com/mdibaiee/serverman"
+
+  fetchRepo :: App Repository
+  fetchRepo = do
+    state@(AppState { repositoryURL }) <- get
+    dir <- liftIO $ getAppUserDataDirectory "serverman"
+    let path = dir </> "repository"
+    let source = dir </> "source"
+
+    execIfMissing path $ do
+      liftIO $ putStrLn $ "cloning " ++ repositoryURL ++ " in " ++ path
+      execute "git" ["clone", repositoryURL, path] "" True
+      return ()
+
+    execIfMissing source $ do
+      liftIO $ putStrLn $ "cloning " ++ sourceURL ++ " in " ++ source
+      execute "git" ["clone", sourceURL, source] "" True
+      return ()
+
+    {-exec "git" ["pull", "origin", "master"] "" (Just path) True-}
+    {-exec "git" ["pull", "origin", "master"] "" (Just source) True-}
+
+    content <- liftIO $ readFile (path </> "repository.json")
+
+    let json = decode (BS.pack content) :: Maybe [Object]
+
+    case json of
+      Just d -> do
+        let repo :: Maybe [Either String Service] = mapM toService d
+
+        case repo of
+          Just list -> do
+            let r = rights list
+            state <- get
+            put $ state { repository = r }
+            return $ rights list
+
+          Nothing -> do
+            liftIO $ putStrLn $ "error parsing repository data, please try re-fetching the repository."
+            return []
+      Nothing -> do
+        liftIO $ putStrLn $ "error parsing repository data, please try re-fetching the repository."
+        return []
+
+    where
+      toService obj = do
+        return $
+          flip parseEither obj $ \object -> do
+            name <- object .: "name"
+            version <- object .: "version"
+            config <- object .: "config"
+            service <- object .: "service"
+            category <- object .: "category"
+            packages <- object .: "packages"
+
+            pkglist :: [(OS, [String])] <- map (\(os, name) -> (read os, name)) <$> M.toList <$> parseJSON packages
+
+            return Service { name = name
+                           , version = version
+                           , config = config
+                           , service = service
+                           , category = category
+                           , packages = pkglist
+                           }

src/System/Serverman/Actions/Start.hs

@@ -1,4 +1,6 @@
-module System.Serverman.Actions.Start (startService) where
+{-# LANGUAGE NamedFieldPuns #-}
+
+module System.Serverman.Actions.Manage (startService, stopService) where
   import System.Serverman.Utils
   import System.Serverman.Actions.Env
   import System.Serverman.Actions.Install
@@ -7,8 +9,14 @@ module System.Serverman.Actions.Start (startService) where
   import Control.Monad.State
 
   startService :: Service -> OS -> App ()
-  startService service os
+  startService (Service { service }) os
-    | os == Mac = liftIO $ putStrLn $ "Couldn't start " ++ package service os ++ " automatically. If you encounter any problems, make sure it is running."
+    | os == Mac = liftIO $ putStrLn $ "Couldn't start " ++ service ++ " automatically. If you encounter any problems, make sure it is running."
-    | otherwise = executeRoot "systemctl" ["start", package service os] "" True
+    | otherwise = executeRoot "systemctl" ["start", service] "" True
                 >> execute "sleep" ["5s"] "" True
                 >> return ()
+
+  stopService :: Service -> OS -> App ()
+  stopService (Service { service }) os
+    | os == Mac = liftIO $ putStrLn $ "Couldn't stop " ++ service ++ " automatically."
+    | otherwise = executeRoot "systemctl" ["stop", service] "" True
+                >> return ()

src/System/Serverman/Actions/VsFTPd.hs

@@ -21,7 +21,7 @@ module System.Serverman.Actions.VsFTPd (vsftpd) where
   vsftpd params@(FileSharingParams { fDirectory, fPort, fUser, fPass, fAnonymous, fAnonymousWrite, fWritable, fService, fRecreateUser }) =
     do
       let content = show params
-          original = configDirectory fService
+          original = config fService
           userList = takeDirectory original </> "vsftpd-serverman-user-list"
 
       when fRecreateUser $ executeRoot "userdel" [fUser] "" True >> return ()

src/System/Serverman/Actions/WebServer.hs

@@ -18,7 +18,7 @@ module System.Serverman.Actions.WebServer (ServerParams(..), ServerType(..)) whe
                                    } deriving (Eq)
   instance Show ServerParams where
     show (ServerParams { wDirectory, domain, port, forward, email, ssl, serverType, serverService }) 
-      | serverService == NGINX = 
+      | name serverService == "nginx" = 
           let redirect
                 | ssl = block "server" $
                               semicolon $

src/System/Serverman/App.hs

@@ -0,0 +1,18 @@
+module System.Serverman.App ( AppState (..)
+                            , App
+                            , runApp) where
+
+  import qualified System.Serverman.Services (Repository)
+
+  data AppState rep = AppState { remoteMode :: Maybe (Address, String)
+                                , repository :: Repository
+                                } deriving (Show)
+
+  instance Default AppState where
+    def = AppState { remoteMode = Nothing
+                   , repository = [] }
+  type App = StateT AppState IO
+
+  runApp :: App a -> IO (a, AppState)
+  runApp k = runStateT k def
+

src/System/Serverman/Services.hs

@@ -1,28 +1,27 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE DeriveGeneric #-}
+
 module System.Serverman.Services ( Service(..)
-                                 , configDirectory) where
+                                 , Repository
+                                 , packageByOS
+                                 , info) where
+  import System.Serverman.Utils
+  import System.Serverman.Actions.Env
+  import System.Serverman.Types
 
-  data Service = NGINX
+  import Data.Aeson
-               | MySQL
+  import Data.Maybe
-               | MongoDB
+  import GHC.Generics
-               | VsFTPd
-               | LetsEncrypt
-               | SSHFs
-                 deriving (Eq, Show)
 
-  class Configurable a where
+  packageByOS :: Service -> OS -> [String]
-    configDirectory :: a -> FilePath
+  packageByOS (Service { packages }) os = fromMaybe (fromJust $ lookup Unknown packages) (lookup os packages)
 
-  instance Configurable Service where
+  info :: Service -> String
-    configDirectory NGINX = "/etc/nginx/"
+  info s@(Service { config, packages, service, version, dependencies }) = 
-    configDirectory MySQL = "/etc/mysql/"
+    show s ++ (
-    configDirectory MongoDB = "/etc/mongodb"
+      indent $
-    configDirectory VsFTPd = "/etc/vsftpd.conf"
+        keyvalue [ ("config", config)
-
+                 , ("pacakges", commas $ map (commas . snd) packages)
-  instance Read Service where
+                 , ("service", service)
-    readsPrec _ service
+                 , ("dependencies", commas $ map name dependencies)] ": "
-          | service == "nginx" = [(NGINX, [])]
+    )
-          | service == "mysql" = [(MySQL, [])]
-          | service == "mongodb" = [(MongoDB, [])]
-          | service == "vsftpd" = [(VsFTPd, [])]
-          | service == "letsencrypt" = [(LetsEncrypt, [])]
-          | service == "sshfs" = [(SSHFs, [])]

src/System/Serverman/Types.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module System.Serverman.Types ( Service (..)
+                              , Repository
+                              , AppState (..)
+                              , OS (..)
+                              , App
+                              , Address (..)
+                              , Params
+                              , runApp) where
+  import Data.Default.Class
+  import GHC.Generics
+  import Control.Monad.State
+
+  type Host = String
+  type Port = String
+  type User = String
+  data Address = Address Host Port User 
+
+  type Params = [(String, String)]
+
+  instance Read Address where
+    readsPrec _ addr
+      | '@' `elem` addr =
+            let (user, rest) = (takeWhile (/= '@') addr, tail $ dropWhile (/= '@') addr)
+                (host, port) = readHostPort rest
+            in [(Address host port user, [])]
+      | otherwise = 
+            let (host, port) = readHostPort addr
+            in [(Address host port "", [])]
+
+      where
+        readHostPort str = (takeWhile (/= ':') str, tail $ dropWhile (/= ':') str)
+
+  instance Show Address where
+    show (Address host port user)
+      | (not . null) user = user ++ "@" ++ show (Address host port "")
+      | (not . null) port = show (Address host "" "") ++ ":" ++ port
+      | otherwise = host
+
+
+  data OS = Debian | Arch | Mac | Unknown deriving (Eq)
+
+  instance Read OS where
+    readsPrec _ os
+      | os == "debian" = [(Debian, [])]
+      | os == "arch" = [(Arch, [])]
+      | os == "mac" = [(Mac, [])]
+      | os == "_" = [(Unknown, [])]
+
+  instance Show OS where
+    show os
+      | os == Debian = "debian"
+      | os == Arch = "arch"
+      | os == Mac = "mac"
+      | os == Unknown = "_"
+
+  data Service = Service { name         :: String
+                         , config       :: String
+                         , packages     :: [(OS, [String])]
+                         , service      :: String
+                         , version      :: String
+                         , dependencies :: [Service]
+                         , category     :: String
+                         } deriving (Eq, Generic)
+
+  instance Read Service where
+    readsPrec _ service = [(Service { name = service }, [])]
+
+  instance Show Service where
+    show (Service { name, version }) =
+      name ++ "@" ++ version
+
+  type Repository = [Service]
+
+  data AppState = AppState { remoteMode :: Maybe (Address, String)
+                           , repository :: Repository
+                           , repositoryURL :: String
+                           } deriving (Show)
+
+  instance Default AppState where
+    def = AppState { remoteMode = Nothing
+                   , repository = def
+                   , repositoryURL = "https://github.com/mdibaiee/serverman-repository"
+                   }
+  type App = StateT AppState IO
+
+  runApp :: App a -> IO (a, AppState)
+  runApp k = runStateT k def
+

src/System/Serverman/Utils.hs

@@ -6,9 +6,11 @@ module System.Serverman.Utils ( App (..)
                               , runApp
                               , keyvalue
                               , parseKeyValue
+                              , splitAtElem
                               , semicolon
                               , block
                               , indent
+                              , commas
                               , quote
                               , removeTrailingNewline
                               , execIfMissing
@@ -44,16 +46,7 @@ module System.Serverman.Utils ( App (..)
   import Control.Monad.Trans.Control
   import Data.Default.Class
 
-  import Debug.Trace
+  import System.Serverman.Types
-
-  data AppState = AppState { remoteMode :: Maybe (Address, String) } deriving (Show)
-
-  instance Default AppState where
-    def = AppState { remoteMode = Nothing }
-  type App = StateT AppState IO
-
-  runApp :: App a -> IO (a, AppState)
-  runApp k = runStateT k def
 
   keyvalue :: [(String, String)] -> String -> String
   keyvalue ((a, b):xs) delimit = a ++ delimit ++ b ++ "\n" ++ keyvalue xs delimit
@@ -67,15 +60,29 @@ module System.Serverman.Utils ( App (..)
             (key, value) = splitAt delimitIndex line
         in (key, tail value)
 
+  splitAtElem :: String -> Char -> [String]
+  splitAtElem "" _ = []
+  splitAtElem str char =
+    case charIndex of
+      Just index -> 
+        let (left, x:right) = splitAt index str
+        in left : splitAtElem right char
+      Nothing -> [str]
+    where
+      charIndex = char `elemIndex` str
+
   semicolon :: String -> String
   semicolon text = unlines $ map (++ ";") (lines text)
 
   block :: String -> String -> String
   block blockName content = blockName ++ " {\n" ++ indent content ++ "}"
 
+  commas :: [String] -> String
+  commas text = intercalate ", " text
+
   execIfMissing :: (Applicative f, Monad f, MonadIO f) => FilePath -> f () -> f ()
   execIfMissing path action = do
-    exists <- liftIO $ doesFileExist path
+    exists <- liftIO $ doesPathExist path
     
     when (not exists) action
 
@@ -148,30 +155,6 @@ module System.Serverman.Utils ( App (..)
         where
           specialCharacters = ["$"]
 
-  type Host = String
-  type Port = String
-  type User = String
-  data Address = Address Host Port User 
-
-  instance Read Address where
-    readsPrec _ addr
-      | '@' `elem` addr =
-            let (user, rest) = (takeWhile (/= '@') addr, tail $ dropWhile (/= '@') addr)
-                (host, port) = readHostPort rest
-            in [(Address host port user, [])]
-      | otherwise = 
-            let (host, port) = readHostPort addr
-            in [(Address host port "", [])]
-
-      where
-        readHostPort str = (takeWhile (/= ':') str, tail $ dropWhile (/= ':') str)
-
-  instance Show Address where
-    show (Address host port user)
-      | (not . null) user = user ++ "@" ++ show (Address host port "")
-      | (not . null) port = show (Address host "" "") ++ ":" ++ port
-      | otherwise = host
-
   execRemote :: Address -> Maybe String -> Maybe String -> String -> String -> [String] -> String -> Maybe String -> Bool -> App (Either String String)
   execRemote addr@(Address host port user) maybeKey maybeUser password cmd args stdin cwd logErrors = do
     let userArgument = if isJust maybeUser then ["echo", password, "|", "sudo -S", "-u", fromJust maybeUser] else []

src/System/Term.hs

@@ -1,12 +1,10 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module System.Term ( initialize ) where
-  import System.Serverman.Services
   import qualified System.Serverman as S
 
-  import System.Console.CmdArgs
-  import qualified System.Console.CmdArgs.Explicit as E
   import System.Environment
   import System.Directory
   import System.Exit
@@ -14,199 +12,229 @@ module System.Term ( initialize ) where
   import Data.Maybe
   import Control.Monad
   import Control.Monad.State
+  import Data.Default.Class
+  import System.FilePath
+  import Data.List
+
+  import System.Serverman.Utils
 
   initialize = do
     args <- getArgs
-    let mode = cmdArgsMode $ modes [install, webserver, database, filesharing] 
-                           &= program "serverman"
-                           &= summary "serverman v0.1.0, (C) Mahdi Dibaiee 2017"
-                           &= helpArg [name "h"]
 
-    user <- getEnv "USER"
+    dir <- liftIO $ getAppUserDataDirectory "serverman"
+    let path = dir </> "repository"
 
-    {-when (user == "ROOT") $ do-}
+    liftIO $ print args
-      {-putStrLn $ "It's recommended that you don't run serverman as root."-}
+    let params = parseParams args
-      {-putStrLn $ "Serverman will automatically use sudo whenever needed."-}
+    liftIO $ print params
 
-    let fixArgs
+    -- Fetch repository first
-                  | null args = ["--help"]
+    S.runApp $ do
-                  | otherwise = args
+      S.run (S.fetchRepository)
 
-    let result = E.process mode fixArgs
+      state@(S.AppState { S.repository }) <- get
 
-    case result of 
+      case params of
-      Right (CmdArgs args help version _ _) -> 
+        (Params { listServices = True }) -> liftIO $ do
-        if isJust help then
+          mapM_ print repository
-          putStrLn $ fromJust help
+        (Params { install = Just service }) -> do
-        else if isJust version then
+          os <- S.run S.detectOS
-          putStrLn $ fromJust version
+          S.run (S.install (findService repository service) os)
-        else
+
-          case args of
+      {-S.run (S.call (head repository) [])-}
-            p@(WebServerParams {})   -> webserverSetup p
-            p@(InstallParams {})     -> manualInstall p
-            p@(DatabaseParams {})    -> databaseSetup p
-            p@(FileSharingParams {}) -> fileSharingSetup p
-      Left err ->
-        print err
 
     return ()
 
-  -- WEB SERVER 
+    where
-  data Params = WebServerParams { directory :: String
+      findService repository n = fromJust $ find (\a -> S.name a == n) repository
-                                , domain    :: String
-                                , port      :: String
-                                , forward   :: String
-                                , wService  :: String
-                                , ssl       :: Bool
-                                , email     :: String
-                                , wRemote   :: String
-                                }
-              | DatabaseParams { databaseName :: String
-                               , dService     :: String
-                               , dummyData    :: Bool
-                               , dUser        :: String
-                               , dPass        :: String
-                               , dHost        :: String
-                               , dRemote      :: String
-                               }
-
-              | FileSharingParams { fDirectory      :: String
-                                  , fUser           :: String
-                                  , fPass           :: String
-                                  , fPort           :: String
-                                  , fWritable       :: Bool
-                                  , fAnonymous      :: Bool
-                                  , fAnonymousWrite :: Bool
-                                  , fRecreateUser   :: Bool
-                                  , fService        :: String
-                                  , fRemote         :: String
-                                  }
-
-              | InstallParams { iService :: String, remote :: 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"
-                              , 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)"
-                              , ssl       = False &= help "create a letsencrypt certificate for this domain, defaults to false"
-                              , email     = def &= help "email required for registering your certificate"
-                              , wService  = "nginx" &= help "service to build config for: nginx, defaults to nginx" &= explicit &= name "service"
-                              , wRemote = def &= help "path to the file containing list of remote addresses in the format: user@host:port"
-                              } &= 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"
-                            , 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"
-                            , dRemote = def &= help "path to the file containing list of remote addresses in the format: user@host:port"
-                            } &= explicit &= name "database"
-
-  filesharing = FileSharingParams { fDirectory      = "/srv/ftp/" &= typDir &= help "directory to share, defaults to /srv/ftp/" &= explicit &= name "directory"
-                                  , fUser           = "serverman" &= typDir &= help "username, defaults to serverman" &= explicit &= name "user"
-                                  , fPass           = "" &= help "password, defaults to serverman (please change this to avoid security risks)" &= explicit &= name "password"
-                                  , fAnonymous      = False &= help "allow anonymous connections, defaults to False" &= explicit &= name "anonymous"
-                                  , fAnonymousWrite = False &= help "allow anonymous write operations, defaults to False" &= explicit &= name "anonymous-write"
-                                  , fWritable       = True &= help "allow write operations, defaults to True" &= explicit &= name "writable"
-                                  , fPort           = "21" &= help "service port, defaults to 21" &= explicit &= name "port"
-                                  , fService        = "vsftpd" &= help "service to use for file sharing, defaults to vsftpd" &= explicit &= name "service"
-                                  , fRecreateUser   = False &= help "recreate the user" &= explicit &= name "recreate-user"
-                                  , fRemote = def &= help "path to the file containing list of remote addresses in the format: user@host:port"
-                                  } &= explicit &= name "filesharing"
 
 
-  install = InstallParams { iService = def &= argPos 0
+  data Manage = Start | Stop deriving (Eq, Show)
-                          , remote = def &= help "path to the file containing list of remote addresses in the format: user@host:port"
+  data Params = Params { listServices :: Bool
-                          } &= explicit &= name "install"
+                       , install      :: Maybe String
+                       , manage       :: Maybe (Manage, String)
+                       , update       :: Bool
+                       , remote       :: Maybe FilePath
+                       , help         :: Bool
+                       } deriving (Show)
 
-  webserverSetup (WebServerParams { directory, domain, port, ssl, forward, wService, email, wRemote }) = do
+  instance Default Params where
-    remoteSetup wRemote $ do
+    def = Params { listServices = False
-      when (ssl && null email) $ die "Email is required for generating a certificate"
+                  , install      = Nothing
+                  , manage       = Nothing
+                  , remote       = Nothing
+                  , update       = False
+                  , help         = False
+                  }
 
-      let serverType 
+  parseParams :: [String] -> Params
-            | (not . null) forward = S.PortForwarding
+  parseParams ("repository":"list":xs) = (parseParams xs) { listServices = True }
-            | otherwise = S.Static
+  parseParams ("repository":"update":xs) = (parseParams xs) { update = True }
+  parseParams ("service":"start":s:xs) = (parseParams xs) { manage = Just (Start, s) }
+  parseParams ("service":"stop":s:xs) = (parseParams xs) { manage = Just (Stop, s) }
+  parseParams ("install":s:xs) = (parseParams xs) { install = Just s }
+  parseParams ("--remote":s:xs) = (parseParams xs) { remote = Just s }
+  parseParams ("--help":xs) = (parseParams xs) { help = True }
+  parseParams ("-h":xs) = (parseParams xs) { help = True }
+  parseParams [] = def
+  parseParams _ = Params { help = True }
 
-      let serviceName = read wService :: Service
+   {-WEB SERVER -}
+  {-data Params = WebServerParams { directory :: String-}
+                                {-, domain    :: String-}
+                                {-, port      :: String-}
+                                {-, forward   :: String-}
+                                {-, wService  :: String-}
+                                {-, ssl       :: Bool-}
+                                {-, email     :: String-}
+                                {-, wRemote   :: String-}
+                                {-}-}
+              {-| DatabaseParams { databaseName :: String-}
+                               {-, dService     :: String-}
+                               {-, dummyData    :: Bool-}
+                               {-, dUser        :: String-}
+                               {-, dPass        :: String-}
+                               {-, dHost        :: String-}
+                               {-, dRemote      :: String-}
+                               {-}-}
 
-      let portNumber
+              {-| FileSharingParams { fDirectory      :: String-}
-            | (not . null) port = port
+                                  {-, fUser           :: String-}
-            | ssl = "443"
+                                  {-, fPass           :: String-}
-            | otherwise = "80"
+                                  {-, fPort           :: String-}
+                                  {-, fWritable       :: Bool-}
+                                  {-, fAnonymous      :: Bool-}
+                                  {-, fAnonymousWrite :: Bool-}
+                                  {-, fRecreateUser   :: Bool-}
+                                  {-, fService        :: String-}
+                                  {-, fRemote         :: String-}
+                                  {-}-}
 
-      absoluteDirectory <- makeAbsolute directory
+              {-| InstallParams { iService :: String, remote :: String }-}
 
-      let params = S.ServerParams { S.wDirectory    = absoluteDirectory
+              {-deriving (Show, Data, Typeable)-}
-                                  , S.domain        = domain
-                                  , S.port          = portNumber
-                                  , S.ssl           = ssl
-                                  , S.forward       = forward
-                                  , S.serverType    = serverType
-                                  , S.serverService = serviceName
-                                  , S.email         = email
-                                  }
-      return $ S.detectOS >>= (S.install serviceName)
-            >> S.detectOS >>= (S.start serviceName)
-            >> S.newServer params
 
-  manualInstall (InstallParams { iService, remote }) =
+  {-webserver = WebServerParams { directory = "/var/www/html/" &= typDir &= help "directory to serve static files from, defaults to /var/www/html/" -}
-    remoteSetup remote $ do
+                              {-, domain    = "test.dev" &= typ "DOMAIN" &= help "domain/server name, defaults to test.dev"-}
-      let serviceName = read iService :: Service
+                              {-, 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)"-}
+                              {-, ssl       = False &= help "create a letsencrypt certificate for this domain, defaults to false"-}
+                              {-, email     = def &= help "email required for registering your certificate"-}
+                              {-, wService  = "nginx" &= help "service to build config for: nginx, defaults to nginx" &= explicit &= name "service"-}
+                              {-, wRemote = def &= help "path to the file containing list of remote addresses in the format: user@host:port"-}
+                              {-} &= explicit &= name "webserver"-}
 
-      return $ S.detectOS >>= (S.install serviceName)
+  {-database = DatabaseParams { databaseName = "test" &= help "database name, defaults to test" &= explicit &= name "name"-}
-             >> S.detectOS >>= (S.start serviceName)
+                            {-, 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"-}
+                            {-, dRemote = def &= help "path to the file containing list of remote addresses in the format: user@host:port"-}
+                            {-} &= explicit &= name "database"-}
+
+  {-filesharing = FileSharingParams { fDirectory      = "/srv/ftp/" &= typDir &= help "directory to share, defaults to /srv/ftp/" &= explicit &= name "directory"-}
+                                  {-, fUser           = "serverman" &= typDir &= help "username, defaults to serverman" &= explicit &= name "user"-}
+                                  {-, fPass           = "" &= help "password, defaults to serverman (please change this to avoid security risks)" &= explicit &= name "password"-}
+                                  {-, fAnonymous      = False &= help "allow anonymous connections, defaults to False" &= explicit &= name "anonymous"-}
+                                  {-, fAnonymousWrite = False &= help "allow anonymous write operations, defaults to False" &= explicit &= name "anonymous-write"-}
+                                  {-, fWritable       = True &= help "allow write operations, defaults to True" &= explicit &= name "writable"-}
+                                  {-, fPort           = "21" &= help "service port, defaults to 21" &= explicit &= name "port"-}
+                                  {-, fService        = "vsftpd" &= help "service to use for file sharing, defaults to vsftpd" &= explicit &= name "service"-}
+                                  {-, fRecreateUser   = False &= help "recreate the user" &= explicit &= name "recreate-user"-}
+                                  {-, fRemote = def &= help "path to the file containing list of remote addresses in the format: user@host:port"-}
+                                  {-} &= explicit &= name "filesharing"-}
 
 
-  databaseSetup (DatabaseParams { databaseName, dService, dummyData, dUser, dPass, dHost, dRemote }) = do
+  {-install = InstallParams { iService = def &= argPos 0-}
-    remoteSetup dRemote $ do
+                          {-, remote = def &= help "path to the file containing list of remote addresses in the format: user@host:port"-}
-      let serviceName = read dService
+                          {-} &= explicit &= name "install"-}
 
-      let params = S.DatabaseParams { S.database        = databaseName
+  {-webserverSetup (WebServerParams { directory, domain, port, ssl, forward, wService, email, wRemote }) = do-}
-                                    , S.databaseService = serviceName
+    {-remoteSetup wRemote $ do-}
-                                    , S.dummyData       = dummyData
+      {-when (ssl && null email) $ die "Email is required for generating a certificate"-}
-                                    , S.databaseUser    = dUser
-                                    , S.databasePass    = dPass
-                                    , S.databaseHost    = dHost
-                                    }
 
-      return $ S.detectOS >>= (S.install serviceName)
+      {-let serverType -}
-            >> S.detectOS >>= (S.start serviceName)
+            {-| (not . null) forward = S.PortForwarding-}
-            >> S.newDatabase params
+            {-| otherwise = S.Static-}
 
-  fileSharingSetup (FileSharingParams { fDirectory, fUser, fPass, fPort, fAnonymous, fAnonymousWrite, fWritable, fService, fRecreateUser, fRemote }) = do
+      {-let serviceName = read wService-}
-    remoteSetup fRemote $ do
-      let serviceName = read fService
 
-      let params = S.FileSharingParams { S.fDirectory      = fDirectory
+      {-let portNumber-}
-                                      , S.fUser           = fUser
+            {-| (not . null) port = port-}
-                                      , S.fPass           = fPass
+            {-| ssl = "443"-}
-                                      , S.fPort           = fPort
+            {-| otherwise = "80"-}
-                                      , S.fAnonymous      = fAnonymous
-                                      , S.fAnonymousWrite = fAnonymousWrite
-                                      , S.fWritable       = fWritable
-                                      , S.fService        = serviceName
-                                      , S.fRecreateUser   = fRecreateUser
-                                      }
 
-      return $ S.detectOS >>= (S.install serviceName)
+      {-absoluteDirectory <- makeAbsolute directory-}
-            >> S.detectOS >>= (S.start serviceName)
-            >> S.newFileSharing params
 
-  remoteSetup file generateAction
+      {-let params = S.ServerParams { S.wDirectory    = absoluteDirectory-}
-    | null file = do
+                                  {-, S.domain        = domain-}
-      action <- generateAction
+                                  {-, S.port          = portNumber-}
-      S.runApp $
+                                  {-, S.ssl           = ssl-}
-        S.run action
+                                  {-, S.forward       = forward-}
+                                  {-, S.serverType    = serverType-}
+                                  {-, S.serverService = serviceName-}
+                                  {-, S.email         = email-}
+                                  {-}-}
+      {-return $ S.detectOS >>= (S.install serviceName)-}
+            {->> S.detectOS >>= (S.start serviceName)-}
+            {->> S.newServer params-}
 
-      return ()
+  {-manualInstall (InstallParams { iService, remote }) =-}
+    {-remoteSetup remote $ do-}
+      {-let serviceName = read iService-}
 
-    | otherwise = do
+      {-return $ S.detectOS >>= (S.install serviceName)-}
-      list <- liftIO $ map read . lines <$> readFile file
+             {->> S.detectOS >>= (S.start serviceName)-}
-      action <- generateAction
-      S.runApp $ S.run $ S.remote list action
     
-      return ()
+
+  {-databaseSetup (DatabaseParams { databaseName, dService, dummyData, dUser, dPass, dHost, dRemote }) = do-}
+    {-remoteSetup dRemote $ do-}
+      {-let serviceName = read dService-}
+
+      {-let params = S.DatabaseParams { S.database        = databaseName-}
+                                    {-, S.databaseService = serviceName-}
+                                    {-, S.dummyData       = dummyData-}
+                                    {-, S.databaseUser    = dUser-}
+                                    {-, S.databasePass    = dPass-}
+                                    {-, S.databaseHost    = dHost-}
+                                    {-}-}
+
+      {-return $ S.detectOS >>= (S.install serviceName)-}
+            {->> S.detectOS >>= (S.start serviceName)-}
+            {->> S.newDatabase params-}
+
+  {-fileSharingSetup (FileSharingParams { fDirectory, fUser, fPass, fPort, fAnonymous, fAnonymousWrite, fWritable, fService, fRecreateUser, fRemote }) = do-}
+    {-remoteSetup fRemote $ do-}
+      {-let serviceName = read fService-}
+
+      {-let params = S.FileSharingParams { S.fDirectory      = fDirectory-}
+                                      {-, S.fUser           = fUser-}
+                                      {-, S.fPass           = fPass-}
+                                      {-, S.fPort           = fPort-}
+                                      {-, S.fAnonymous      = fAnonymous-}
+                                      {-, S.fAnonymousWrite = fAnonymousWrite-}
+                                      {-, S.fWritable       = fWritable-}
+                                      {-, S.fService        = serviceName-}
+                                      {-, S.fRecreateUser   = fRecreateUser-}
+                                      {-}-}
+
+      {-return $ S.detectOS >>= (S.install serviceName)-}
+            {->> S.detectOS >>= (S.start serviceName)-}
+            {->> S.newFileSharing params-}
+
+  {-remoteSetup file generateAction-}
+    {-| null file = do-}
+      {-action <- generateAction-}
+      {-S.runApp $-}
+        {-S.run action-}
+
+      {-return ()-}
+
+    {-| otherwise = do-}
+      {-list <- liftIO $ map read . lines <$> readFile file-}
+      {-action <- generateAction-}
+      {-S.runApp $ S.run $ S.remote list action-}
+
+      {-return ()-}
  

stack.yaml

@@ -1,66 +1,10 @@
-# This file was automatically generated by 'stack init'
+flags: {}
-#
+extra-package-dbs: []
-# Some commonly used options have been documented as comments in this file.
-# For advanced use and comprehensive documentation of the format, please see:
-# http://docs.haskellstack.org/en/stable/yaml_configuration/
-
-# Resolver to choose a 'specific' stackage snapshot or a compiler version.
-# A snapshot resolver dictates the compiler version and the set of packages
-# to be used for project dependencies. For example:
-#
-# resolver: lts-3.5
-# resolver: nightly-2015-09-21
-# resolver: ghc-7.10.2
-# resolver: ghcjs-0.1.0_ghc-7.10.2
-# resolver:
-#  name: custom-snapshot
-#  location: "./custom-snapshot.yaml"
-resolver: lts-8.0
-
-# User packages to be built.
-# Various formats can be used as shown in the example below.
-#
-# packages:
-# - some-directory
-# - https://example.com/foo/bar/baz-0.0.2.tar.gz
-# - location:
-#    git: https://github.com/commercialhaskell/stack.git
-#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-#   extra-dep: true
-#  subdirs:
-#  - auto-update
-#  - wai
-#
-# A package marked 'extra-dep: true' will only be built if demanded by a
-# non-dependency (i.e. a user package), and its test suites and benchmarks
-# will not be run. This is useful for tweaking upstream packages.
 packages:
 - '.'
-# Dependency packages to be pulled from upstream that are not in the resolver
+extra-deps:
-# (e.g., acme-missiles-0.3)
+- stack-1.3.2
-extra-deps: []
+- store-0.3.1
-
+- store-core-0.3
-# Override default flag values for local packages and extra-deps
+- th-utilities-0.2.0.1
-flags: {}
+resolver: lts-8.0
-
-# Extra package databases containing global packages
-extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-#
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: ">=1.1"
-#
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-#
-# Extra directories used by stack for building
-# extra-include-dirs: [/path/to/dir]
-# extra-lib-dirs: [/path/to/dir]
-#
-# Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor