Add support for Prefer tx=rollback

src/PostgREST/ApiRequest.hs

@@ -114,6 +114,7 @@ data ApiRequest = ApiRequest {
   , iPreferParameters     :: Maybe PreferParameters           -- ^ How to pass parameters to a stored procedure
   , iPreferCount          :: Maybe PreferCount                -- ^ Whether the client wants a result count
   , iPreferResolution     :: Maybe PreferResolution           -- ^ Whether the client wants to UPSERT or ignore records on PK conflict
+  , iPreferTransaction    :: Maybe PreferTransaction          -- ^ Whether the clients wants to commit or rollback the transaction
   , iFilters              :: [(Text, Text)]                   -- ^ Filters on the result ("id", "eq.10")
   , iLogic                :: [(Text, Text)]                   -- ^ &and and &or parameters used for complex boolean logic
   , iSelect               :: Maybe Text                       -- ^ &select parameter used to shape the response
@@ -146,16 +147,19 @@ userApiRequest confSchemas rootSpec dbStructure req reqBody
       , iAccepts = maybe [CTAny] (map decodeContentType . parseHttpAccept) $ lookupHeader "accept"
       , iPayload = relevantPayload
       , iPreferRepresentation = representation
-      , iPreferParameters = if | hasPrefer (show SingleObject)     -> Just SingleObject
-                               | hasPrefer (show MultipleObjects)  -> Just MultipleObjects
-                               | otherwise                         -> Nothing
-      , iPreferCount      = if | hasPrefer (show ExactCount)     -> Just ExactCount
-                               | hasPrefer (show PlannedCount)   -> Just PlannedCount
-                               | hasPrefer (show EstimatedCount) -> Just EstimatedCount
-                               | otherwise                         -> Nothing
-      , iPreferResolution = if | hasPrefer (show MergeDuplicates)  -> Just MergeDuplicates
-                               | hasPrefer (show IgnoreDuplicates) -> Just IgnoreDuplicates
-                               | otherwise                         -> Nothing
+      , iPreferParameters  = if | hasPrefer (show SingleObject)     -> Just SingleObject
+                                | hasPrefer (show MultipleObjects)  -> Just MultipleObjects
+                                | otherwise                         -> Nothing
+      , iPreferCount       = if | hasPrefer (show ExactCount)       -> Just ExactCount
+                                | hasPrefer (show PlannedCount)     -> Just PlannedCount
+                                | hasPrefer (show EstimatedCount)   -> Just EstimatedCount
+                                | otherwise                         -> Nothing
+      , iPreferResolution  = if | hasPrefer (show MergeDuplicates)  -> Just MergeDuplicates
+                                | hasPrefer (show IgnoreDuplicates) -> Just IgnoreDuplicates
+                                | otherwise                         -> Nothing
+      , iPreferTransaction = if | hasPrefer (show Commit)           -> Just Commit
+                                | hasPrefer (show Rollback)         -> Just Rollback
+                                | otherwise                         -> Nothing
       , iFilters = filters
       , iLogic = [(toS k, toS $ fromJust v) | (k,v) <- qParams, isJust v, endingIn ["and", "or"] k ]
       , iSelect = toS <$> join (lookup "select" qParams)

src/PostgREST/App.hs

@@ -86,7 +86,15 @@ postgrest logLev refConf refDbStructure pool getTime connWorker =
                 Right claims -> do
                   let
                     authed = containsRole claims
-                    handleReq = runPgLocals conf claims (app dbStructure conf) apiRequest
+                    shouldCommit   = configTxAllowOverride conf && iPreferTransaction apiRequest == Just Commit
+                    shouldRollback = configTxAllowOverride conf && iPreferTransaction apiRequest == Just Rollback
+                    preferenceApplied
+                      | shouldCommit    = addHeadersIfNotIncluded [(hPreferenceApplied, BS.pack (show Commit))]
+                      | shouldRollback  = addHeadersIfNotIncluded [(hPreferenceApplied, BS.pack (show Rollback))]
+                      | otherwise       = identity
+                    handleReq = do
+                      when (shouldRollback || (configTxRollbackAll conf && not shouldCommit)) HT.condemn
+                      mapResponseHeaders preferenceApplied <$> runPgLocals conf claims (app dbStructure conf) apiRequest
                   dbResp <- P.use pool $ HT.transaction HT.ReadCommitted (txMode apiRequest) handleReq
                   return $ either (errorResponseFor . PgError authed) identity dbResp
         -- Launch the connWorker when the connection is down. The postgrest function can respond successfully(with a stale schema cache) before the connWorker is done.

src/PostgREST/Config.hs

@@ -97,6 +97,9 @@ data AppConfig = AppConfig {
   , configJWKS              :: Maybe JWKSet
 
   , configLogLevel          :: LogLevel
+
+  , configTxRollbackAll     :: Bool
+  , configTxAllowOverride   :: Bool
   }
 
 configPoolTimeout' :: (Fractional a) => AppConfig -> a
@@ -196,6 +199,15 @@ readPathShowHelp = customExecParser parserPrefs opts
           |
           |## logging level, the admitted values are: crit, error, warn and info.
           |# log-level = "error"
+          |
+          |## rollback all transactions by default, use for test environments
+          |## disabled by default
+          |# tx-rollback-all = false
+          |
+          |## allow overriding the tx-rollback-all setting for a request by
+          |## setting the Prefer: tx=[commit|rollback] header
+          |## disabled by default
+          |# tx-allow-override = false
           |]
 
 -- | Parse the config file
@@ -225,9 +237,9 @@ readAppConfig cfgPath = do
         <*> (fmap unpack <$> optString "server-unix-socket")
         <*> parseSocketFileMode "server-unix-socket-mode"
         <*> (fromMaybe "pgrst" <$> optString "db-channel")
-        <*> ((Just True ==) <$> optBool "db-channel-enabled")
+        <*> (fromMaybe False <$> optBool "db-channel-enabled")
         <*> (fmap encodeUtf8 <$> optString "jwt-secret")
-        <*> ((Just True ==) <$> optBool "secret-is-base64")
+        <*> (fromMaybe False <$> optBool "secret-is-base64")
         <*> parseJwtAudience "jwt-aud"
         <*> (fromMaybe 10 <$> optInt "db-pool")
         <*> (fromMaybe 10 <$> optInt "db-pool-timeout")
@@ -240,6 +252,8 @@ readAppConfig cfgPath = do
         <*> (maybe [] (fmap encodeUtf8 . splitOnCommas) <$> optValue "raw-media-types")
         <*> pure Nothing
         <*> parseLogLevel "log-level"
+        <*> (fromMaybe False <$> optBool "tx-rollback-all")
+        <*> (fromMaybe False <$> optBool "tx-allow-override")
 
     parseSocketFileMode :: C.Key -> C.Parser C.Config (Either Text FileMode)
     parseSocketFileMode k =

src/PostgREST/Types.hs

@@ -109,6 +109,15 @@ instance Show PreferCount where
   show PlannedCount   = "count=planned"
   show EstimatedCount = "count=estimated"
 
+data PreferTransaction
+  = Commit   -- Commit transaction - the default.
+  | Rollback -- Rollback transaction after sending the response - does not persist changes, e.g. for running tests.
+  deriving Eq
+
+instance Show PreferTransaction where
+  show Commit   = "tx=commit"
+  show Rollback = "tx=rollback"
+
 data DbStructure = DbStructure {
   dbTables      :: [Table]
 , dbColumns     :: [Column]