jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #89 from begriffs/release

Browse Source 
cleanup connections on close.
This commit is contained in:
Joe Nelson
2014-10-28 15:26:27 -07:00
parent f84ca1d615 2b829f9152
commit aaf8a7fbfa
1 changed files with 17 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Main.hs
+17 -11
View File
@@ -9,13 +9,14 @@ import Data.String.Conversions (cs)
import Control.Monad (unless) import Control.Monad (unless)
import Control.Applicative import Control.Applicative
import Control.Exception(bracket)
import Options.Applicative hiding (columns) import Options.Applicative hiding (columns)
import Network.Wai.Middleware.Gzip (gzip, def) import Network.Wai.Middleware.Gzip (gzip, def)
import Network.Wai.Middleware.Cors (cors) import Network.Wai.Middleware.Cors (cors)
import Network.Wai.Middleware.Static (staticPolicy, only) import Network.Wai.Middleware.Static (staticPolicy, only)
import Database.HDBC (disconnect) import Database.HDBC (disconnect)
import Database.HDBC.PostgreSQL(connectPostgreSQL') import Database.HDBC.PostgreSQL(connectPostgreSQL')
import Data.Pool(createPool) import Data.Pool(createPool, destroyAllResources)
argParser :: Parser AppConfig argParser :: Parser AppConfig
argParser = AppConfig argParser = AppConfig
@@ -33,17 +34,22 @@ argParser = AppConfig
main :: IO () main :: IO ()
main = do main = do
conf <- execParser (info (helper <*> argParser) describe) conf <- execParser (info (helper <*> argParser) describe)
pool <- createPool (connectPostgreSQL' (configDbUri conf)) disconnect 1 600 (configPool conf) bracket
let port = configPort conf (createPool (connectPostgreSQL' (configDbUri conf))
disconnect 1 600 (configPool conf))
destroyAllResources
(\pool -> do
let port = configPort conf
unless (configSecure conf) $ unless (configSecure conf) $
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)
run port $ (if configSecure conf then redirectInsecure else id) run port $ (if configSecure conf then redirectInsecure else id)
. gzip def . cors corsPolicy . clientErrors . gzip def . cors corsPolicy . clientErrors
. staticPolicy (only [("favicon.ico", "static/favicon.ico")]) . staticPolicy (only [("favicon.ico", "static/favicon.ico")])
. withDBConnection pool . inTransaction . withDBConnection pool . inTransaction
. authenticated (cs $ configAnonRole conf) . withSavepoint $ app . authenticated (cs $ configAnonRole conf) . withSavepoint $ app
)
where where
describe = progDesc "create a REST API to an existing Postgres database" describe = progDesc "create a REST API to an existing Postgres database"