From a984fe3bf9d789570fbd4fd21c23d93f4c521645 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Fri, 10 Oct 2014 17:32:17 -0700 Subject: [PATCH] flip args to inTransaction --- src/Main.hs | 4 ++-- src/Middleware.hs | 11 +++++------ 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index f268f28c5..f7ce83637 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -41,8 +41,8 @@ main = do Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String) conn <- connectPostgreSQL' dburi - runTLS tls settings $ gzip def $ cors corsPolicy $ - inTransaction conn (app (cs $ configAnonRole conf)) + runTLS tls settings . gzip def . cors corsPolicy $ + inTransaction (app (cs $ configAnonRole conf)) conn where describe = progDesc "create a REST API to an existing Postgres database" diff --git a/src/Middleware.hs b/src/Middleware.hs index 89a7d0e16..14cfd8bdf 100644 --- a/src/Middleware.hs +++ b/src/Middleware.hs @@ -10,14 +10,13 @@ import Database.HDBC.PostgreSQL (Connection) import Network.HTTP.Types.Header (hContentType) import Network.HTTP.Types.Status (status400) import Database.HDBC.Types (SqlError(..)) -import Network.Wai (Application, Request, Response, ResponseReceived, responseLBS) +import Network.Wai (Application, responseLBS) import Control.Exception (finally, catchJust) -type ResHandler = Response -> IO ResponseReceived -inTransaction :: Connection -> (Connection -> Application) -> Request -> ResHandler -> IO ResponseReceived -inTransaction conn app req respond = - finally (putStrLn "begin txn" >> runRaw conn "begin" >> app conn req respond) (putStrLn "commit txn" >> runRaw conn "commit") +inTransaction :: (Connection -> Application) -> (Connection -> Application) +inTransaction app conn req respond = + finally (runRaw conn "begin" >> app conn req respond) (runRaw conn "commit") instance ToJSON SqlError where toJSON t = object [ @@ -28,7 +27,7 @@ instance ToJSON SqlError where ] ] -reportPgErrors :: Application -> Request -> ResHandler -> IO ResponseReceived +reportPgErrors :: Application -> Application reportPgErrors app req respond = catchJust isPgException (app req respond) ( respond . responseLBS status400 [(hContentType, "application/json")]