flip args to inTransaction
This commit is contained in:
+2
-2
@@ -41,8 +41,8 @@ main = do
|
|||||||
|
|
||||||
Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String)
|
Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String)
|
||||||
conn <- connectPostgreSQL' dburi
|
conn <- connectPostgreSQL' dburi
|
||||||
runTLS tls settings $ gzip def $ cors corsPolicy $
|
runTLS tls settings . gzip def . cors corsPolicy $
|
||||||
inTransaction conn (app (cs $ configAnonRole conf))
|
inTransaction (app (cs $ configAnonRole conf)) conn
|
||||||
|
|
||||||
where
|
where
|
||||||
describe = progDesc "create a REST API to an existing Postgres database"
|
describe = progDesc "create a REST API to an existing Postgres database"
|
||||||
|
|||||||
+5
-6
@@ -10,14 +10,13 @@ import Database.HDBC.PostgreSQL (Connection)
|
|||||||
import Network.HTTP.Types.Header (hContentType)
|
import Network.HTTP.Types.Header (hContentType)
|
||||||
import Network.HTTP.Types.Status (status400)
|
import Network.HTTP.Types.Status (status400)
|
||||||
import Database.HDBC.Types (SqlError(..))
|
import Database.HDBC.Types (SqlError(..))
|
||||||
import Network.Wai (Application, Request, Response, ResponseReceived, responseLBS)
|
import Network.Wai (Application, responseLBS)
|
||||||
import Control.Exception (finally, catchJust)
|
import Control.Exception (finally, catchJust)
|
||||||
|
|
||||||
type ResHandler = Response -> IO ResponseReceived
|
|
||||||
|
|
||||||
inTransaction :: Connection -> (Connection -> Application) -> Request -> ResHandler -> IO ResponseReceived
|
inTransaction :: (Connection -> Application) -> (Connection -> Application)
|
||||||
inTransaction conn app req respond =
|
inTransaction app conn req respond =
|
||||||
finally (putStrLn "begin txn" >> runRaw conn "begin" >> app conn req respond) (putStrLn "commit txn" >> runRaw conn "commit")
|
finally (runRaw conn "begin" >> app conn req respond) (runRaw conn "commit")
|
||||||
|
|
||||||
instance ToJSON SqlError where
|
instance ToJSON SqlError where
|
||||||
toJSON t = object [
|
toJSON t = object [
|
||||||
@@ -28,7 +27,7 @@ instance ToJSON SqlError where
|
|||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|
||||||
reportPgErrors :: Application -> Request -> ResHandler -> IO ResponseReceived
|
reportPgErrors :: Application -> Application
|
||||||
reportPgErrors app req respond =
|
reportPgErrors app req respond =
|
||||||
catchJust isPgException (app req respond) (
|
catchJust isPgException (app req respond) (
|
||||||
respond . responseLBS status400 [(hContentType, "application/json")]
|
respond . responseLBS status400 [(hContentType, "application/json")]
|
||||||
|
|||||||
Reference in New Issue
Block a user