Parse args more sensibly, and use correct port for postgres connection

This commit is contained in:
Joe Nelson
2014-12-07 18:42:18 -08:00
parent 1fd757c2ad
commit b302843e10
2 changed files with 18 additions and 19 deletions
+16 -11
View File
@@ -10,7 +10,12 @@ import Options.Applicative hiding (columns)
import Network.Wai.Middleware.Cors (CorsResourcePolicy(..)) import Network.Wai.Middleware.Cors (CorsResourcePolicy(..))
data AppConfig = AppConfig { data AppConfig = AppConfig {
configDbUri :: String configDbName :: String
, configDbPort :: Int
, configDbUser :: String
, configDbPass :: String
, configDbHost :: String
, configPort :: Int , configPort :: Int
, configAnonRole :: String , configAnonRole :: String
, configSecure :: Bool , configSecure :: Bool
@@ -19,16 +24,16 @@ data AppConfig = AppConfig {
argParser :: Parser AppConfig argParser :: Parser AppConfig
argParser = AppConfig argParser = AppConfig
<$> strOption (long "db" <> short 'd' <> metavar "URI" <$> strOption (long "db-name" <> short 'd' <> help "name of database")
<> help "database uri to expose, e.g. postgres://user:pass@host:port/database") <*> option (long "db-port" <> short 'P' <> value 5432 <> help "postgres server port")
<*> option (long "port" <> short 'p' <> metavar "NUMBER" <> value 3000 <*> strOption (long "db-user" <> short 'U' <> help "postgres authenticator role")
<> help "port number on which to run HTTP server") <*> strOption (long "db-pass" <> value "" <> help "password for authenticator role")
<*> strOption (long "anonymous" <> short 'a' <> metavar "ROLE" <*> strOption (long "db-host" <> short 'h' <> value "localhost" <> help "postgres server hostname")
<> help "postgres role to use for non-authenticated requests")
<*> switch (long "secure" <> short 's' <*> option (long "port" <> short 'p' <> value 3000 <> help "port number on which to run HTTP server")
<> help "Redirect all requests to HTTPS") <*> strOption (long "anonymous" <> short 'a' <> help "postgres role to use for non-authenticated requests")
<*> option (long "db-pool" <> metavar "NUMBER" <> value 10 <*> switch (long "secure" <> short 's' <> help "Redirect all requests to HTTPS")
<> help "Max connections in database pool") <*> option (long "db-pool" <> value 10 <> help "Max connections in database pool")
defaultCorsPolicy :: CorsResourcePolicy defaultCorsPolicy :: CorsResourcePolicy
defaultCorsPolicy = CorsResourcePolicy Nothing defaultCorsPolicy = CorsResourcePolicy Nothing
+2 -8
View File
@@ -9,12 +9,10 @@ import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Exception import Control.Exception
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Data.List.Split (splitOn)
import Network.Wai.Middleware.Cors (cors) import Network.Wai.Middleware.Cors (cors)
import Network.Wai.Handler.Warp hiding (Connection) import Network.Wai.Handler.Warp hiding (Connection)
import Network.Wai.Middleware.Gzip (gzip, def) import Network.Wai.Middleware.Gzip (gzip, def)
import Network.Wai.Middleware.Static (staticPolicy, only) import Network.Wai.Middleware.Static (staticPolicy, only)
import Network.URI (URI(..), URIAuth(..), parseURI)
import Data.List (intercalate) import Data.List (intercalate)
import Data.Version (versionBranch) import Data.Version (versionBranch)
import qualified Hasql as H import qualified Hasql as H
@@ -32,12 +30,8 @@ main = do
putStrLn "WARNING, running in insecure mode, auth will be in plaintext" putStrLn "WARNING, running in insecure mode, auth will be in plaintext"
Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String) Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String)
let Just uri = parseURI $ configDbUri conf let pgSettings = H.Postgres (cs $ configDbHost conf) (fromIntegral $ configDbPort conf)
Just auth = uriAuthority uri (cs $ configDbUser conf) (cs $ configDbPass conf) (cs $ configDbName conf)
userpass = uriUserInfo auth
[user, pass] = splitOn ":" $ init userpass
pgSettings = H.Postgres (cs $ uriRegName auth) (fromIntegral $ configPort conf)
(cs user) (cs pass) (cs . tail $ uriPath uri)
sessSettings <- maybe (fail "Improper session settings") return $ sessSettings <- maybe (fail "Improper session settings") return $
H.sessionSettings (fromIntegral $ configPool conf) 30 H.sessionSettings (fromIntegral $ configPool conf) 30