From 2dd22abdf8221a33206f4f7ddd9ca75532600a31 Mon Sep 17 00:00:00 2001 From: Josh Berman Date: Wed, 10 Jun 2015 17:22:46 +0300 Subject: [PATCH 1/5] Added DBServerInfo type and instances. Accounted for `plugins: postgres` stanza containing array or bool. --- Keter/Plugin/Postgres.hs | 65 +++++++++++++++++++++++++++++----------- 1 file changed, 48 insertions(+), 17 deletions(-) diff --git a/Keter/Plugin/Postgres.hs b/Keter/Plugin/Postgres.hs index 8781f42..93c13b9 100644 --- a/Keter/Plugin/Postgres.hs +++ b/Keter/Plugin/Postgres.hs @@ -8,7 +8,7 @@ module Keter.Plugin.Postgres , load ) where -import Control.Applicative ((<$>), (<*>)) +import Control.Applicative ((<$>), (<*>), pure) import Control.Concurrent (forkIO) import Control.Concurrent.Chan import Control.Concurrent.MVar @@ -20,10 +20,12 @@ import qualified Data.Char as C import Data.Default import qualified Data.HashMap.Strict as HMap import qualified Data.Map as Map +import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (fromText, toLazyText) +import qualified Data.Vector as V import Data.Yaml import Keter.Types import Prelude hiding (FilePath) @@ -54,23 +56,32 @@ instance Default Settings where -- | Information on an individual PostgreSQL database. data DBInfo = DBInfo - { dbiName :: Text - , dbiUser :: Text - , dbiPass :: Text + { dbiName :: Text + , dbiUser :: Text + , dbiPass :: Text + , dbiServer :: DBServerInfo } deriving Show -randomDBI :: R.StdGen -> (DBInfo, R.StdGen) -randomDBI = - S.runState (DBInfo <$> rt <*> rt <*> rt) +data DBServerInfo = DBServerInfo + { dbServer :: Text + , dbPort :: Int + } + deriving Show + +randomDBI :: DBServerInfo -> R.StdGen -> (DBInfo, R.StdGen) +randomDBI dbsi r = + S.runState (DBInfo <$> rt <*> rt <*> rt <*> (pure dbsi)) r where rt = T.pack <$> replicateM 10 (S.state $ R.randomR ('a', 'z')) instance ToJSON DBInfo where - toJSON (DBInfo n u p) = object - [ "name" .= n - , "user" .= u - , "pass" .= p + toJSON (DBInfo n u p (DBServerInfo server port)) = object + [ "name" .= n + , "user" .= u + , "pass" .= p + , "server" .= server + , "port" .= port ] instance FromJSON DBInfo where @@ -78,9 +89,21 @@ instance FromJSON DBInfo where <$> o .: "name" <*> o .: "user" <*> o .: "pass" + <*> (DBServerInfo + <$> o .:? "server" .!= "localhost" + <*> o .:? "port" .!= 5432) parseJSON _ = mzero -data Command = GetConfig Appname (Either SomeException DBInfo -> IO ()) +instance FromJSON DBServerInfo where + parseJSON (Object o) = DBServerInfo + <$> o .: "server" + <*> o .: "port" + parseJSON _ = mzero + +instance Default DBServerInfo where + def = DBServerInfo "localhost" 5432 + +data Command = GetConfig Appname DBServerInfo (Either SomeException DBInfo -> IO ()) -- | Load a set of existing connections from a config file. If the file does -- not exist, it will be created. Any newly created databases will @@ -104,9 +127,16 @@ load Settings{..} fp = do return Plugin { pluginGetEnv = \appname o -> case HMap.lookup "postgres" o of + Just (Array x) -> do + let Object o' = V.head x + dbServer = fromMaybe def . parseMaybe parseJSON $ V.head x + x <- newEmptyMVar + writeChan chan $ GetConfig appname dbServer $ putMVar x + edbi <- takeMVar x + edbiToEnv edbi Just (Bool True) -> do x <- newEmptyMVar - writeChan chan $ GetConfig appname $ putMVar x + writeChan chan $ GetConfig appname def $ putMVar x edbi <- takeMVar x edbiToEnv edbi _ -> return [] @@ -115,13 +145,13 @@ load Settings{..} fp = do tmpfp = fp <.> "tmp" loop chan = do - GetConfig appname f <- lift $ readChan chan + GetConfig appname dbServer f <- lift $ readChan chan (db, g) <- S.get dbi <- case Map.lookup appname db of Just dbi -> return $ Right dbi Nothing -> do - let (dbi', g') = randomDBI g + let (dbi', g') = randomDBI dbServer g let dbi = dbi' { dbiName = sanitize appname <> dbiName dbi' , dbiUser = sanitize appname <> dbiUser dbi' @@ -152,9 +182,10 @@ edbiToEnv :: Either SomeException DBInfo -> IO [(Text, Text)] edbiToEnv (Left e) = throwIO e edbiToEnv (Right dbi) = return - [ ("PGHOST", "localhost") - , ("PGPORT", "5432") + [ ("PGHOST", dbServer $ dbiServer dbi) + , ("PGPORT", T.pack . show . dbPort $ dbiServer dbi) , ("PGUSER", dbiUser dbi) , ("PGPASS", dbiPass dbi) , ("PGDATABASE", dbiName dbi) ] + From 95503ad1f4869c8ae446dae79e82cb669eaeb12f Mon Sep 17 00:00:00 2001 From: Josh Berman Date: Sun, 14 Jun 2015 10:58:15 +0300 Subject: [PATCH 2/5] support remote-server sytax in keter.yaml file, update README --- Keter/Plugin/Postgres.hs | 32 +++++++++++++++++--------------- README.md | 16 +++++++++++++++- 2 files changed, 32 insertions(+), 16 deletions(-) mode change 100644 => 100755 README.md diff --git a/Keter/Plugin/Postgres.hs b/Keter/Plugin/Postgres.hs index 93c13b9..2505ca6 100644 --- a/Keter/Plugin/Postgres.hs +++ b/Keter/Plugin/Postgres.hs @@ -50,7 +50,11 @@ instance Default Settings where "';\nCREATE DATABASE " <> fromText dbiName <> " OWNER " <> fromText dbiUser <> ";" - _ <- readProcess "sudo" ["-u", "postgres", "psql"] $ TL.unpack sql + cmd = [ "-u", "postgres", "psql" + , "-h", (T.unpack $ dbServer dbiServer) + , "-p", (show $ dbPort dbiServer) + , "-U", "postgres"] + _ <- readProcess "sudo" cmd $ TL.unpack sql return () } @@ -70,8 +74,8 @@ data DBServerInfo = DBServerInfo deriving Show randomDBI :: DBServerInfo -> R.StdGen -> (DBInfo, R.StdGen) -randomDBI dbsi r = - S.runState (DBInfo <$> rt <*> rt <*> rt <*> (pure dbsi)) r +randomDBI dbsi = + S.runState (DBInfo <$> rt <*> rt <*> rt <*> (pure dbsi)) where rt = T.pack <$> replicateM 10 (S.state $ R.randomR ('a', 'z')) @@ -127,21 +131,19 @@ load Settings{..} fp = do return Plugin { pluginGetEnv = \appname o -> case HMap.lookup "postgres" o of - Just (Array x) -> do - let Object o' = V.head x - dbServer = fromMaybe def . parseMaybe parseJSON $ V.head x - x <- newEmptyMVar - writeChan chan $ GetConfig appname dbServer $ putMVar x - edbi <- takeMVar x - edbiToEnv edbi + Just (Array v) -> do + let dbServer = fromMaybe def . parseMaybe parseJSON $ V.head v + doenv chan appname dbServer Just (Bool True) -> do - x <- newEmptyMVar - writeChan chan $ GetConfig appname def $ putMVar x - edbi <- takeMVar x - edbiToEnv edbi + doenv chan appname def _ -> return [] } - + where doenv chan appname dbs = do + x <- newEmptyMVar + writeChan chan $ GetConfig appname dbs $ putMVar x + edbi <- takeMVar x + edbiToEnv edbi + tmpfp = fp <.> "tmp" loop chan = do diff --git a/README.md b/README.md old mode 100644 new mode 100755 index 7204168..9710b22 --- a/README.md +++ b/README.md @@ -179,8 +179,22 @@ plugins: postgres: true ``` +* Keter can be configured to connect to a remote postgres server using the following syntax: +```yaml +plugins: + postgres: + - server: remoteServerNameOrIP + port: 1234 +``` + +Different webapps can be configured to use different servers using the above syntax. +Keter will connect to the remote servers using the `postgres` account. This setup +assumes the remote server's `pg_hba.conf` file has been configured to allow connections +from the keter-server IP using the `trust` method. + (Note: The `plugins` configuration option was added in v1.0 of the -keter configuration syntax. If you are using v0.4 then use `postgres: true`.) +keter configuration syntax. If you are using v0.4 then use `postgres: true`. +The remote-postgres server syntax was added in v1.4.2.) * Modify your application to get its database connection settings from the following environment variables: * `PGHOST` From 69b77a70e573ad476d83719449de95569511d234 Mon Sep 17 00:00:00 2001 From: Josh Berman Date: Sun, 14 Jun 2015 11:50:35 +0300 Subject: [PATCH 3/5] different commands for remote and local DB server, version bump, readme --- Keter/Plugin/Postgres.hs | 13 +++++++++---- README.md | 4 ++++ keter.cabal | 2 +- 3 files changed, 14 insertions(+), 5 deletions(-) diff --git a/Keter/Plugin/Postgres.hs b/Keter/Plugin/Postgres.hs index 2505ca6..396741f 100644 --- a/Keter/Plugin/Postgres.hs +++ b/Keter/Plugin/Postgres.hs @@ -50,10 +50,15 @@ instance Default Settings where "';\nCREATE DATABASE " <> fromText dbiName <> " OWNER " <> fromText dbiUser <> ";" - cmd = [ "-u", "postgres", "psql" - , "-h", (T.unpack $ dbServer dbiServer) - , "-p", (show $ dbPort dbiServer) - , "-U", "postgres"] + cmd + | ( dbServer dbiServer == "localhost" + || dbServer dbiServer == "127.0.0.1") = + [ "-u", "postgres", "psql" ] + | otherwise = + [ "psql" + , "-h", (T.unpack $ dbServer dbiServer) + , "-p", (show $ dbPort dbiServer) + , "-U", "postgres"] _ <- readProcess "sudo" cmd $ TL.unpack sql return () } diff --git a/README.md b/README.md index 9710b22..c1c44ea 100755 --- a/README.md +++ b/README.md @@ -188,6 +188,10 @@ plugins: ``` Different webapps can be configured to use different servers using the above syntax. +It should be noted that keter will prioritize it's own postgres.yaml record for an app. +So if moving an existing app from a local postgres server to a remote one (or +switching remote servers), the postgres.yaml file will need to be updated manually. + Keter will connect to the remote servers using the `postgres` account. This setup assumes the remote server's `pg_hba.conf` file has been configured to allow connections from the keter-server IP using the `trust` method. diff --git a/keter.cabal b/keter.cabal index f09780b..d3d1516 100644 --- a/keter.cabal +++ b/keter.cabal @@ -1,5 +1,5 @@ Name: keter -Version: 1.4.1 +Version: 1.4.2 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/ From 2c157660d46b20fc887b9cf1b7776036c1f0699f Mon Sep 17 00:00:00 2001 From: Josh Berman Date: Tue, 16 Jun 2015 18:38:38 +0300 Subject: [PATCH 4/5] no sudo command for remote DB host --- Keter/Plugin/Postgres.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Keter/Plugin/Postgres.hs b/Keter/Plugin/Postgres.hs index 396741f..e243f57 100644 --- a/Keter/Plugin/Postgres.hs +++ b/Keter/Plugin/Postgres.hs @@ -50,16 +50,16 @@ instance Default Settings where "';\nCREATE DATABASE " <> fromText dbiName <> " OWNER " <> fromText dbiUser <> ";" - cmd + (cmd, args) | ( dbServer dbiServer == "localhost" || dbServer dbiServer == "127.0.0.1") = - [ "-u", "postgres", "psql" ] + ("sudo", ["-u", "postgres", "psql"]) | otherwise = - [ "psql" - , "-h", (T.unpack $ dbServer dbiServer) + ("psql", + [ "-h", (T.unpack $ dbServer dbiServer) , "-p", (show $ dbPort dbiServer) - , "-U", "postgres"] - _ <- readProcess "sudo" cmd $ TL.unpack sql + , "-U", "postgres"]) + _ <- readProcess cmd args $ TL.unpack sql return () } From ce1e0ba574794c422e8e4206ab8235684d239b33 Mon Sep 17 00:00:00 2001 From: Josh Berman Date: Wed, 17 Jun 2015 03:22:25 +0300 Subject: [PATCH 5/5] add new syntax to example keter.yaml --- incoming/foo1_0/config/keter.yaml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/incoming/foo1_0/config/keter.yaml b/incoming/foo1_0/config/keter.yaml index 14fe3a5..96a7b15 100644 --- a/incoming/foo1_0/config/keter.yaml +++ b/incoming/foo1_0/config/keter.yaml @@ -67,3 +67,7 @@ stanzas: plugins: #postgres: true +# Syntax for remote-DB server: +# postgres: +# - server: remoteServerNameOrIP +# port: 1234