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

withSavepoint middleware

Browse Source
This commit is contained in:
Adam C. Baker
2014-10-13 13:04:25 -07:00
parent a984fe3bf9
commit 2028500da7
2 changed files with 43 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Middleware.hs
+7 -1
View File
@@ -11,13 +11,19 @@ import Network.HTTP.Types.Header (hContentType)
import Network.HTTP.Types.Status (status400)
import Database.HDBC.Types (SqlError(..))
import Network.Wai (Application, responseLBS)
import Control.Exception (finally, catchJust)
import Control.Exception (finally, throw, catchJust, catch, SomeException)
inTransaction :: (Connection -> Application) -> (Connection -> Application)
inTransaction app conn req respond =
finally (runRaw conn "begin" >> app conn req respond) (runRaw conn "commit")
withSavepoint :: (Connection -> Application) -> Connection -> Application
withSavepoint app conn req respond = do
runRaw conn "savepoint req_sp"
catch (app conn req respond) (\e -> let _ = (e::SomeException) in
runRaw conn "rollback to savepoint req_sp" >> throw e)
instance ToJSON SqlError where
toJSON t = object [
"error" .= object [