diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.4.0 + +* Drop system-filepath + ## 1.3.10 * Configurable time bound [#92](https://github.com/snoyberg/keter/pull/92) diff --git a/Codec/Archive/TempTarball.hs b/Codec/Archive/TempTarball.hs --- a/Codec/Archive/TempTarball.hs +++ b/Codec/Archive/TempTarball.hs @@ -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 diff --git a/Data/Yaml/FilePath.hs b/Data/Yaml/FilePath.hs --- a/Data/Yaml/FilePath.hs +++ b/Data/Yaml/FilePath.hs @@ -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 diff --git a/Keter/App.hs b/Keter/App.hs --- a/Keter/App.hs +++ b/Keter/App.hs @@ -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 () diff --git a/Keter/AppManager.hs b/Keter/AppManager.hs --- a/Keter/AppManager.hs +++ b/Keter/AppManager.hs @@ -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 () diff --git a/Keter/Main.hs b/Keter/Main.hs --- a/Keter/Main.hs +++ b/Keter/Main.hs @@ -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 diff --git a/Keter/Plugin/Postgres.hs b/Keter/Plugin/Postgres.hs --- a/Keter/Plugin/Postgres.hs +++ b/Keter/Plugin/Postgres.hs @@ -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 diff --git a/Keter/Proxy.hs b/Keter/Proxy.hs --- a/Keter/Proxy.hs +++ b/Keter/Proxy.hs @@ -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? diff --git a/Keter/Types/Common.hs b/Keter/Types/Common.hs --- a/Keter/Types/Common.hs +++ b/Keter/Types/Common.hs @@ -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 diff --git a/Keter/Types/V04.hs b/Keter/Types/V04.hs --- a/Keter/Types/V04.hs +++ b/Keter/Types/V04.hs @@ -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. diff --git a/Keter/Types/V10.hs b/Keter/Types/V10.hs --- a/Keter/Types/V10.hs +++ b/Keter/Types/V10.hs @@ -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 diff --git a/keter.cabal b/keter.cabal --- a/keter.cabal +++ b/keter.cabal @@ -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: . 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 diff --git a/main/keter.hs b/main/keter.hs --- a/main/keter.hs +++ b/main/keter.hs @@ -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