keter 1.3.10.1 → 1.4.0
raw patch · 13 files changed
+116/−114 lines, 13 filesdep −system-fileiodep ~system-filepathdep ~wai-app-static
Dependencies removed: system-fileio
Dependency ranges changed: system-filepath, wai-app-static
Files
- ChangeLog.md +4/−0
- Codec/Archive/TempTarball.hs +27/−27
- Data/Yaml/FilePath.hs +8/−6
- Keter/App.hs +18/−18
- Keter/AppManager.hs +1/−2
- Keter/Main.hs +22/−20
- Keter/Plugin/Postgres.hs +9/−8
- Keter/Proxy.hs +3/−4
- Keter/Types/Common.hs +9/−11
- Keter/Types/V04.hs +3/−4
- Keter/Types/V10.hs +6/−7
- keter.cabal +4/−5
- main/keter.hs +2/−2
ChangeLog.md view
@@ -1,3 +1,7 @@+## 1.4.0++* Drop system-filepath+ ## 1.3.10 * Configurable time bound [#92](https://github.com/snoyberg/keter/pull/92)
Codec/Archive/TempTarball.hs view
@@ -20,11 +20,11 @@ import Data.ByteString.Unsafe (unsafeUseAsCStringLen) import qualified Data.IORef as I import Data.Monoid ((<>))-import Data.Text (Text, pack)+import Data.Text (Text, pack, unpack) import Data.Word (Word)-import qualified Filesystem as F-import Filesystem.Path.CurrentOS ((</>))-import qualified Filesystem.Path.CurrentOS as F+import System.FilePath ((</>))+import qualified System.FilePath as F+import qualified System.Directory as D import Foreign.Ptr (castPtr) import System.Posix.Files (setFdOwnerAndGroup, setOwnerAndGroup)@@ -33,45 +33,45 @@ import System.Posix.Types (GroupID, UserID) data TempFolder = TempFolder- { tfRoot :: F.FilePath+ { tfRoot :: FilePath , tfCounter :: I.IORef Word } -setup :: F.FilePath -> IO TempFolder+setup :: FilePath -> IO TempFolder setup fp = do- e <- F.isDirectory fp- when e $ F.removeTree fp- F.createTree fp+ e <- D.doesDirectoryExist fp+ when e $ D.removeDirectoryRecursive fp+ D.createDirectoryIfMissing True fp c <- I.newIORef minBound return $ TempFolder fp c getFolder :: Maybe (UserID, GroupID) -> TempFolder -> Text -- ^ prefix for folder name- -> IO F.FilePath+ -> IO FilePath getFolder muid TempFolder {..} appname = do !i <- I.atomicModifyIORef tfCounter $ \i -> (succ i, i)- let fp = tfRoot </> F.fromText (appname <> "-" <> pack (show i))- F.createTree fp+ let fp = tfRoot </> unpack (appname <> "-" <> pack (show i))+ D.createDirectoryIfMissing True fp case muid of Nothing -> return ()- Just (uid, gid) -> setOwnerAndGroup (F.encodeString fp) uid gid+ Just (uid, gid) -> setOwnerAndGroup fp uid gid return fp unpackTempTar :: Maybe (UserID, GroupID) -> TempFolder- -> F.FilePath -- ^ bundle+ -> FilePath -- ^ bundle -> Text -- ^ prefix for folder name- -> (F.FilePath -> IO a)+ -> (FilePath -> IO a) -> IO a unpackTempTar muid tf bundle appname withDir = do- lbs <- L.readFile $ F.encodeString bundle- bracketOnError (getFolder muid tf appname) F.removeTree $ \dir -> do+ lbs <- L.readFile bundle+ bracketOnError (getFolder muid tf appname) D.removeDirectoryRecursive $ \dir -> do unpackTar muid dir $ Tar.read $ decompress lbs withDir dir unpackTar :: Maybe (UserID, GroupID)- -> F.FilePath+ -> FilePath -> Tar.Entries Tar.FormatError -> IO () unpackTar muid dir =@@ -82,18 +82,18 @@ loop (Tar.Next e es) = go e >> loop es go e = do- let fp = dir </> F.decodeString (Tar.entryPath e)+ let fp = dir </> Tar.entryPath e case Tar.entryContent e of Tar.NormalFile lbs _ -> do case muid of- Nothing -> F.createTree $ F.directory fp- Just (uid, gid) -> createTreeUID uid gid $ F.directory fp+ Nothing -> D.createDirectoryIfMissing True $ F.takeDirectory fp+ Just (uid, gid) -> createTreeUID uid gid $ F.takeDirectory fp let write fd bs = unsafeUseAsCStringLen bs $ \(ptr, len) -> do _ <- fdWriteBuf fd (castPtr ptr) (fromIntegral len) return () bracket (do- fd <- createFile (F.encodeString fp) $ Tar.entryPermissions e+ fd <- createFile fp $ Tar.entryPermissions e setFdOption fd CloseOnExec True case muid of Nothing -> return ()@@ -105,13 +105,13 @@ -- | Create a directory tree, setting the uid and gid of all newly created -- folders.-createTreeUID :: UserID -> GroupID -> F.FilePath -> IO ()+createTreeUID :: UserID -> GroupID -> FilePath -> IO () createTreeUID uid gid = go where go fp = do- exists <- F.isDirectory fp+ exists <- D.doesDirectoryExist fp unless exists $ do- go $ F.parent fp- F.createDirectory False fp- setOwnerAndGroup (F.encodeString fp) uid gid+ go $ F.takeDirectory fp+ D.createDirectoryIfMissing False fp+ setOwnerAndGroup fp uid gid
Data/Yaml/FilePath.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-} -- | Utilities for dealing with YAML config files which contain relative file -- paths. module Data.Yaml.FilePath@@ -11,13 +13,13 @@ ) where import Control.Applicative ((<$>))-import Filesystem.Path.CurrentOS (FilePath, encodeString, directory, fromText, (</>)) import Data.Yaml (decodeFileEither, ParseException (AesonException), parseJSON)-import Prelude (($!), ($), Either (..), return, IO, (.), (>>=), Maybe (..), maybe, mapM, Ord, fail)+import Prelude (($!), ($), Either (..), return, IO, (.), (>>=), Maybe (..), maybe, mapM, Ord, fail, FilePath) import Data.Aeson.Types ((.:), (.:?), Object, Parser, Value, parseEither)-import Data.Text (Text)+import Data.Text (Text, unpack) import qualified Data.Set as Set import qualified Data.Vector as V+import System.FilePath (takeDirectory, (</>)) -- | The directory from which we're reading the config file. newtype BaseDir = BaseDir FilePath@@ -27,7 +29,7 @@ => FilePath -> IO (Either ParseException a) decodeFileRelative fp = do- evalue <- decodeFileEither $ encodeString fp+ evalue <- decodeFileEither fp return $! case evalue of Left e -> Left e Right value ->@@ -35,7 +37,7 @@ Left s -> Left $! AesonException s Right x -> Right $! x where- basedir = BaseDir $ directory fp+ basedir = BaseDir $ takeDirectory fp -- | A replacement for the @.:@ operator which will both parse a file path and -- apply the relative file logic.@@ -52,7 +54,7 @@ parseYamlFile :: BaseDir -> Value -> Parser a instance ParseYamlFile FilePath where- parseYamlFile (BaseDir dir) o = ((dir </>) . fromText) <$> parseJSON o+ parseYamlFile (BaseDir dir) o = ((dir </>) . unpack) <$> parseJSON o instance (ParseYamlFile a, Ord a) => ParseYamlFile (Set.Set a) where parseYamlFile base o = parseJSON o >>= ((Set.fromList <$>) . mapM (parseYamlFile base)) instance ParseYamlFile a => ParseYamlFile (V.Vector a) where
Keter/App.hs view
@@ -30,15 +30,15 @@ import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import qualified Data.Set as Set-import Data.Text (pack)+import Data.Text (pack, unpack) import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Vector as V import Data.Yaml import Data.Yaml.FilePath-import Filesystem (canonicalizePath, isFile,- removeTree)-import qualified Filesystem.Path.CurrentOS as F+import System.FilePath ((</>))+import System.Directory (canonicalizePath, doesFileExist,+ removeDirectoryRecursive) import Keter.HostManager hiding (start) import Keter.PortPool (PortPool, getPort, releasePort) import Keter.Types@@ -81,10 +81,10 @@ -- Get the FilePath for the keter yaml configuration. Tests for -- keter.yml and defaults to keter.yaml. configFP <- do- let yml = dir F.</> "config" F.</> "keter.yml"- exists <- isFile yml+ let yml = dir </> "config" </> "keter.yml"+ exists <- doesFileExist yml return $ if exists then yml- else dir F.</> "config" F.</> "keter.yaml"+ else dir </> "config" </> "keter.yaml" mconfig <- decodeFileRelative configFP config <-@@ -117,7 +117,7 @@ withConfig _asc _aid (AIData bconfig) f = f Nothing bconfig Nothing withConfig asc aid (AIBundle fp modtime) f = bracketOnError (unpackBundle asc fp aid)- (\(newdir, _) -> removeTree newdir)+ (\(newdir, _) -> removeDirectoryRecursive newdir) $ \(newdir, bconfig) -> f (Just newdir) bconfig (Just modtime) withReservations :: AppStartConfig@@ -181,16 +181,16 @@ mrlog <- readTVarIO var case mrlog of Nothing -> bracketOnError- (LogFile.openRotatingLog (F.encodeString dir) LogFile.defaultMaxTotal)+ (LogFile.openRotatingLog dir LogFile.defaultMaxTotal) LogFile.close (f var) Just rlog -> f var rlog where- dir = kconfigDir ascKeterConfig F.</> "log" F.</> name+ dir = kconfigDir ascKeterConfig </> "log" </> name name = case aid of AIBuiltin -> "__builtin__"- AINamed x -> F.fromText $ "app-" <> x+ AINamed x -> unpack $ "app-" <> x withSanityChecks :: AppStartConfig -> BundleConfig -> IO a -> IO a withSanityChecks AppStartConfig {..} BundleConfig {..} f = do@@ -203,10 +203,10 @@ go _ = return () isExec fp = do- exists <- isFile fp+ exists <- doesFileExist fp if exists then do- canExec <- fileAccess (F.encodeString fp) True False True+ canExec <- fileAccess fp True False True if canExec then return () else throwIO $ FileNotExecutable fp@@ -291,8 +291,8 @@ (ascLog . OtherMessage . decodeUtf8With lenientDecode) ascProcessTracker (encodeUtf8 . fst <$> ascSetuid)- (encodeUtf8 $ either id id $ F.toText exec)- (maybe "/tmp" (encodeUtf8 . either id id . F.toText) mdir)+ (encodeUtf8 $ pack exec)+ (maybe "/tmp" (encodeUtf8 . pack) mdir) (map encodeUtf8 $ V.toList waconfigArgs) (map (encodeUtf8 *** encodeUtf8) env) (LogFile.addChunk rlog)@@ -378,8 +378,8 @@ (ascLog . OtherMessage . decodeUtf8With lenientDecode) ascProcessTracker (encodeUtf8 . fst <$> ascSetuid)- (encodeUtf8 $ either id id $ F.toText exec)- (maybe "/tmp" (encodeUtf8 . either id id . F.toText) mdir)+ (encodeUtf8 $ pack exec)+ (maybe "/tmp" (encodeUtf8 . pack) mdir) (map encodeUtf8 $ V.toList bgconfigArgs) (map (encodeUtf8 *** encodeUtf8) env) (LogFile.addChunk rlog)@@ -580,7 +580,7 @@ Nothing -> return () Just dir -> do ascLog $ RemovingOldFolder dir- res <- try $ removeTree dir+ res <- try $ removeDirectoryRecursive dir case res of Left e -> $logEx ascLog e Right () -> return ()
Keter/AppManager.hs view
@@ -25,7 +25,6 @@ import Data.Maybe (mapMaybe) import Data.Maybe (catMaybes) import qualified Data.Set as Set-import qualified Filesystem.Path.CurrentOS as F import Keter.App (App, AppStartConfig) import qualified Keter.App as App import Keter.Types@@ -247,7 +246,7 @@ getInputForBundle :: FilePath -> IO (AppId, Action) getInputForBundle bundle = do- time <- modificationTime <$> getFileStatus (F.encodeString bundle)+ time <- modificationTime <$> getFileStatus bundle return (AINamed $ getAppname bundle, Reload $ AIBundle bundle time) terminateApp :: AppManager -> Appname -> IO ()
Keter/Main.hs view
@@ -13,6 +13,7 @@ import qualified Data.CaseInsensitive as CI import qualified Data.Conduit.LogFile as LogFile import Data.Monoid (mempty)+import Data.String (fromString) import qualified Data.Vector as V import Keter.App (AppStartConfig (..)) import qualified Keter.AppManager as AppMan@@ -36,10 +37,8 @@ import qualified Data.Text.Read import Data.Time (getCurrentTime) import Data.Yaml.FilePath-import Filesystem (createTree)-import qualified Filesystem as F-import Filesystem.Path.CurrentOS (hasExtension, (</>))-import qualified Filesystem.Path.CurrentOS as F+import System.Directory (createDirectoryIfMissing, doesFileExist, createDirectoryIfMissing, getDirectoryContents, doesDirectoryExist)+import System.FilePath (takeExtension, (</>)) import qualified Network.HTTP.Conduit as HTTP (conduitManagerSettings, newManager) import Prelude hiding (FilePath, log)@@ -47,6 +46,7 @@ import System.Posix.User (getUserEntryForID, getUserEntryForName, userGroupID, userID, userName)+import Filesystem.Path.CurrentOS (encodeString) -- needed for fsnotify keter :: FilePath -- ^ root directory or config file -> [FilePath -> IO Plugin]@@ -61,7 +61,7 @@ -> (KeterConfig -> IO a) -> IO a withConfig input f = do- exists <- F.isFile input+ exists <- doesFileExist input config <- if exists then do@@ -77,7 +77,7 @@ -> IO a withLogger fp f = withConfig fp $ \config -> do mainlog <- LogFile.openRotatingLog- (F.encodeString $ (kconfigDir config) </> "log" </> "keter")+ (kconfigDir config </> "log" </> "keter") LogFile.defaultMaxTotal f config $ \ml -> do@@ -127,7 +127,7 @@ launchInitial :: KeterConfig -> AppMan.AppManager -> IO () launchInitial kc@KeterConfig {..} appMan = do- createTree incoming+ createDirectoryIfMissing True incoming bundles0 <- filter isKeter <$> listDirectoryTree incoming mapM_ (AppMan.addApp appMan) bundles0 @@ -142,24 +142,25 @@ getIncoming kc = kconfigDir kc </> "incoming" isKeter :: FilePath -> Bool-isKeter fp = hasExtension fp "keter"+isKeter fp = takeExtension fp == ".keter" startWatching :: KeterConfig -> AppMan.AppManager -> (LogMessage -> IO ()) -> IO () startWatching kc@KeterConfig {..} appMan log = do -- File system watching wm <- FSN.startManager- _ <- FSN.watchTree wm incoming (const True) $ \e -> do- e' <-+ _ <- FSN.watchTree wm (fromString incoming) (const True) $ \e -> do+ e' <- do+ let toString = encodeString case e of FSN.Removed fp _ -> do- log $ WatchedFile "removed" fp- return $ Left fp+ log $ WatchedFile "removed" $ toString fp+ return $ Left $ toString fp FSN.Added fp _ -> do- log $ WatchedFile "added" fp- return $ Right fp+ log $ WatchedFile "added" $ toString fp+ return $ Right $ toString fp FSN.Modified fp _ -> do- log $ WatchedFile "modified" fp- return $ Right fp+ log $ WatchedFile "modified" $ toString fp+ return $ Right $ toString fp case e' of Left fp -> when (isKeter fp) $ AppMan.terminateApp appMan $ getAppname fp Right fp -> when (isKeter fp) $ AppMan.addApp appMan $ incoming </> fp@@ -168,7 +169,7 @@ void $ flip (installHandler sigHUP) Nothing $ Catch $ do bundles <- fmap (filter isKeter) $ listDirectoryTree incoming newMap <- fmap Map.fromList $ forM bundles $ \bundle -> do- time <- modificationTime <$> getFileStatus (F.encodeString bundle)+ time <- modificationTime <$> getFileStatus bundle return (getAppname bundle, (bundle, time)) AppMan.reloadAppList appMan newMap where@@ -176,9 +177,10 @@ listDirectoryTree :: FilePath -> IO [FilePath] listDirectoryTree fp = do- dir <- F.listDirectory fp- concat <$> mapM (\fp1 -> do- isDir <- F.isDirectory fp1+ dir <- getDirectoryContents fp+ concat <$> mapM (\fpRel -> do+ let fp1 = fp </> fpRel+ isDir <- doesDirectoryExist fp1 if isDir then listDirectoryTree fp1
Keter/Plugin/Postgres.hs view
@@ -16,19 +16,20 @@ import Control.Monad (forever, mzero, replicateM, void) import Control.Monad.Trans.Class (lift) import qualified Control.Monad.Trans.State as S+import qualified Data.Char as C import Data.Default import qualified Data.HashMap.Strict as HMap import qualified Data.Map as Map import Data.Monoid ((<>))-import qualified Data.Char as C import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (fromText, toLazyText) import Data.Yaml-import Filesystem (createTree, isFile, rename)-import Filesystem.Path.CurrentOS (directory, encodeString, (<.>)) import Keter.Types import Prelude hiding (FilePath)+import System.Directory (createDirectoryIfMissing,+ doesFileExist, renameFile)+import System.FilePath (takeDirectory, (<.>)) import System.Process (readProcess) import qualified System.Random as R @@ -86,10 +87,10 @@ -- automatically be saved to this file. load :: Settings -> FilePath -> IO Plugin load Settings{..} fp = do- createTree $ directory fp- e <- isFile fp+ createDirectoryIfMissing True $ takeDirectory fp+ e <- doesFileExist fp edb <- if e- then decodeFileEither $ encodeString fp+ then decodeFileEither fp else return $ Right Map.empty case edb of Left ex -> throwIO ex@@ -131,8 +132,8 @@ Right () -> do let db' = Map.insert appname dbi db ey <- lift $ try $ do- encodeFile (encodeString tmpfp) db'- rename tmpfp fp+ encodeFile tmpfp db'+ renameFile tmpfp fp case ey of Left e -> return $ Left e Right () -> do
Keter/Proxy.hs view
@@ -17,7 +17,6 @@ import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Vector as V-import qualified Filesystem.Path.CurrentOS as F import Keter.Types import Keter.Types.Middleware import Network.HTTP.Conduit (Manager)@@ -55,9 +54,9 @@ LPInsecure host port -> (Warp.runSettings (warp host port), False) LPSecure host port cert chainCerts key -> (WarpTLS.runTLS (WarpTLS.tlsSettingsChain- (F.encodeString cert)- (map F.encodeString $ V.toList chainCerts)- (F.encodeString key))+ cert+ (V.toList chainCerts)+ key) (warp host port), True) withClient :: Bool -- ^ is secure?
Keter/Types/Common.hs view
@@ -22,11 +22,9 @@ import Data.Text (Text, pack, unpack) import Data.Typeable (Typeable) import qualified Data.Yaml-import Filesystem.Path.CurrentOS (FilePath, basename, encodeString,- toText) import qualified Language.Haskell.TH.Syntax as TH-import Prelude hiding (FilePath) import System.Exit (ExitCode)+import System.FilePath (takeBaseName) -- | Name of the application. Should just be the basename of the application -- file.@@ -55,7 +53,7 @@ type HostBS = CI ByteString getAppname :: FilePath -> Text-getAppname = either id id . toText . basename+getAppname = pack . takeBaseName data LogMessage = ProcessCreated FilePath@@ -81,16 +79,16 @@ | WatchedFile Text FilePath instance Show LogMessage where- show (ProcessCreated f) = "Created process: " ++ encodeString f+ show (ProcessCreated f) = "Created process: " ++ f show (InvalidBundle f e) = concat [ "Unable to parse bundle file '"- , encodeString f+ , f , "': " , show e ] show (ProcessDidNotStart fp) = concat [ "Could not start process within timeout period: "- , encodeString fp+ , fp ] show (ExceptionThrown t e) = concat [ unpack t@@ -100,16 +98,16 @@ show (RemovingPort p) = "Port in use, removing from port pool: " ++ show p show (UnpackingBundle b) = concat [ "Unpacking bundle '"- , encodeString b+ , b , "'" ] show (TerminatingApp t) = "Shutting down app: " ++ unpack t show (FinishedReloading t) = "App finished reloading: " ++ unpack t show (TerminatingOldProcess (AINamed t)) = "Sending old process TERM signal: " ++ unpack t show (TerminatingOldProcess AIBuiltin) = "Sending old process TERM signal: builtin"- show (RemovingOldFolder fp) = "Removing unneeded folder: " ++ encodeString fp+ show (RemovingOldFolder fp) = "Removing unneeded folder: " ++ fp show (ReceivedInotifyEvent t) = "Received unknown INotify event: " ++ unpack t- show (ProcessWaiting f) = "Process restarting too quickly, waiting before trying again: " ++ encodeString f+ show (ProcessWaiting f) = "Process restarting too quickly, waiting before trying again: " ++ f show (OtherMessage t) = unpack t show (ErrorStartingBundle name e) = concat [ "Error occured when launching bundle "@@ -135,7 +133,7 @@ [ "Watched file " , unpack action , ": "- , encodeString fp+ , fp ] data KeterException = CannotParsePostgres FilePath
Keter/Types/V04.hs view
@@ -10,8 +10,7 @@ import qualified Data.Set as Set import Data.String (fromString) import Data.Yaml.FilePath-import qualified Filesystem.Path as F-import Filesystem.Path.CurrentOS (encodeString)+import qualified System.FilePath as F import Keter.Types.Common import Network.HTTP.ReverseProxy.Rewrite import qualified Network.Wai.Handler.Warp as Warp@@ -124,8 +123,8 @@ $ Warp.setPort port Warp.defaultSettings) WarpTLS.defaultTlsSettings- { WarpTLS.certFile = encodeString cert- , WarpTLS.keyFile = encodeString key+ { WarpTLS.certFile = cert+ , WarpTLS.keyFile = key } -- | Controls execution of the nginx thread. Follows the settings type pattern.
Keter/Types/V10.hs view
@@ -24,14 +24,13 @@ import qualified Data.Vector as V import Data.Word (Word) import Data.Yaml.FilePath-import qualified Filesystem.Path.CurrentOS as F+import qualified System.FilePath as F import Keter.Types.Common import Keter.Types.Middleware import qualified Keter.Types.V04 as V04 import Network.HTTP.ReverseProxy.Rewrite (ReverseProxyConfig) import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.WarpTLS as WarpTLS-import Prelude hiding (FilePath) import System.Posix.Types (EpochTime) data BundleConfig = BundleConfig@@ -124,9 +123,9 @@ getSSL (Just (V04.TLSConfig s ts)) = V.singleton $ LPSecure (Warp.getHost s) (Warp.getPort s)- (F.decodeString $ WarpTLS.certFile ts)+ (WarpTLS.certFile ts) V.empty- (F.decodeString $ WarpTLS.keyFile ts)+ (WarpTLS.keyFile ts) instance Default KeterConfig where def = KeterConfig@@ -253,7 +252,7 @@ instance ToJSON StaticFilesConfig where toJSON StaticFilesConfig {..} = object- [ "root" .= F.encodeString sfconfigRoot+ [ "root" .= sfconfigRoot , "hosts" .= Set.map CI.original sfconfigHosts , "directory-listing" .= sfconfigListings , "middleware" .= sfconfigMiddleware@@ -383,7 +382,7 @@ instance ToJSON (WebAppConfig ()) where toJSON WebAppConfig {..} = object- [ "exec" .= F.encodeString waconfigExec+ [ "exec" .= waconfigExec , "args" .= waconfigArgs , "env" .= waconfigEnvironment , "hosts" .= map CI.original (waconfigApprootHost : Set.toList waconfigHosts)@@ -420,7 +419,7 @@ instance ToJSON BackgroundConfig where toJSON BackgroundConfig {..} = object $ catMaybes- [ Just $ "exec" .= F.encodeString bgconfigExec+ [ Just $ "exec" .= bgconfigExec , Just $ "args" .= bgconfigArgs , Just $ "env" .= bgconfigEnvironment , case bgconfigRestartCount of
keter.cabal view
@@ -1,5 +1,5 @@ Name: keter-Version: 1.3.10.1+Version: 1.4.0 Synopsis: Web application deployment manager, focusing on Haskell web frameworks Description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/keter>. Homepage: http://www.yesodweb.com/@@ -35,13 +35,11 @@ , yaml >= 0.8.4 && < 0.9 , unix-compat >= 0.3 && < 0.5 , fsnotify >= 0.0.11- , system-filepath >= 0.4 && < 0.5- , system-fileio >= 0.3 && < 0.4 , conduit >= 1.1 , conduit-extra >= 1.1 , http-reverse-proxy >= 0.4 && < 0.5 , unix >= 2.5- , wai-app-static >= 3.0 && < 3.1+ , wai-app-static >= 3.1 && < 3.2 , wai >= 3.0 && < 3.1 , wai-extra >= 3.0.3 && < 3.1 , http-types@@ -60,6 +58,7 @@ , stm >= 2.4 , async , lifted-base+ , system-filepath if impl(ghc < 7.6) build-depends: ghc-prim@@ -87,7 +86,7 @@ Executable keter Main-is: keter.hs hs-source-dirs: main- Build-depends: base, keter, system-filepath, data-default+ Build-depends: base, keter, data-default, filepath ghc-options: -threaded -Wall other-modules: Paths_keter
main/keter.hs view
@@ -7,7 +7,7 @@ import Data.Version (showVersion) import qualified Keter.Plugin.Postgres as Postgres import Data.Default (def)-import Filesystem.Path.CurrentOS ((</>), decodeString)+import System.FilePath ((</>)) main :: IO () main = do@@ -16,7 +16,7 @@ ["--version"] -> putStrLn $ "keter version: " ++ showVersion version ["--help"] -> printUsage [dir] -> keter- (decodeString dir)+ dir [\configDir -> Postgres.load def $ configDir </> "etc" </> "postgres.yaml"] _ -> printUsage