Add support for Prefer tx=rollback

2020-11-22 18:21:06 -05:00
parent 698fac8ff2
commit dbf99c6ac1
9 changed files with 290 additions and 16 deletions
@@ -15,6 +15,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - #1559, No downtime when reloading the schema cache with SIGUSR1 - @steve-chavez
 - #504, Add `log-level` config option. The admitted levels are: crit, error, warn and info - @steve-chavez
 - #1607, Enable embedding through multiple views recursively - @wolfgangwalther
+ - #1598, Allow rollback of the transaction with Prefer tx=rollback - @wolfgangwalther

 ### Fixed
 
@@ -154,8 +154,10 @@ test-suite spec
                      Feature.DeleteSpec
                      Feature.EmbedDisambiguationSpec
                      Feature.ExtraSearchPathSpec
+                      Feature.HtmlRawOutputSpec
                      Feature.InsertSpec
                      Feature.JsonOperatorSpec
+                      Feature.MultipleSchemaSpec
                      Feature.NoJwtSpec
                      Feature.NonexistentSchemaSpec
                      Feature.OpenApiSpec
@@ -164,6 +166,8 @@ test-suite spec
                      Feature.QueryLimitedSpec
                      Feature.QuerySpec
                      Feature.RangeSpec
+                      Feature.RawOutputTypesSpec
+                      Feature.RollbackSpec
                      Feature.RootSpec
                      Feature.RpcPreRequestGucsSpec
                      Feature.RpcSpec
@@ -171,9 +175,6 @@ test-suite spec
                      Feature.UnicodeSpec
                      Feature.UpdateSpec
                      Feature.UpsertSpec
-                      Feature.RawOutputTypesSpec
-                      Feature.HtmlRawOutputSpec
-                      Feature.MultipleSchemaSpec
                      SpecHelper
                      TestTypes
  hs-source-dirs:     test
@@ -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)
@@ -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.
@@ -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 =
@@ -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]
@@ -0,0 +1,218 @@
+module Feature.RollbackSpec where
+
+import Network.Wai (Application)
+
+import Network.HTTP.Types
+import Test.Hspec
+import Test.Hspec.Wai
+import Test.Hspec.Wai.JSON
+
+import Protolude  hiding (get)
+import SpecHelper
+
+-- two helpers functions to make sure that each test can setup and cleanup properly
+
+-- creates Item to work with for PATCH and DELETE
+postItem =
+  request methodPost "/items"
+      [("Prefer", "resolution=ignore-duplicates")]
+      [json|{"id":0}|]
+    `shouldRespondWith`
+      ""
+      { matchStatus  = 201 }
+
+-- removes Items left over from POST, PUT, and PATCH
+deleteItems =
+  delete "/items?id=lte.0"
+    `shouldRespondWith`
+      ""
+      { matchStatus  = 204 }
+
+preferDefault  = [("Prefer", "return=representation")]
+preferCommit   = [("Prefer", "return=representation"), ("Prefer", "tx=commit")]
+preferRollback = [("Prefer", "return=representation"), ("Prefer", "tx=rollback")]
+
+withoutPreferenceApplied      = []
+withPreferenceCommitApplied   = [ "Preference-Applied" <:> "tx=commit" ]
+withPreferenceRollbackApplied = [ "Preference-Applied" <:> "tx=rollback" ]
+
+shouldRespondToReads reqHeaders respHeaders = do
+  it "responds to GET" $ do
+    request methodGet "/items?id=eq.1"
+        reqHeaders
+        ""
+      `shouldRespondWith`
+        [json|[{"id":1}]|]
+        { matchHeaders = respHeaders }
+
+  it "responds to HEAD" $ do
+    request methodHead "/items?id=eq.1"
+        reqHeaders
+        ""
+      `shouldRespondWith`
+        ""
+        { matchHeaders = respHeaders }
+
+  it "responds to GET on RPC" $ do
+    request methodGet "/rpc/search?id=1"
+        reqHeaders
+        ""
+      `shouldRespondWith`
+        [json|[{"id":1}]|]
+        { matchHeaders = respHeaders }
+
+  it "responds to POST on RPC" $ do
+    request methodPost "/rpc/search"
+        reqHeaders
+        [json|{"id":1}|]
+      `shouldRespondWith`
+        [json|[{"id":1}]|]
+        { matchHeaders = respHeaders }
+
+shouldPersistMutations reqHeaders respHeaders = do
+  it "does persist post" $ do
+    request methodPost "/items"
+        reqHeaders
+        [json|{"id":0}|]
+      `shouldRespondWith`
+        [json|[{"id":0}]|]
+        { matchStatus  = 201
+        , matchHeaders = respHeaders }
+    get "items?id=eq.0"
+      `shouldRespondWith`
+        [json|[{"id":0}]|]
+    deleteItems
+
+  it "does persist put" $ do
+    request methodPut "/items?id=eq.0"
+        reqHeaders
+        [json|{"id":0}|]
+      `shouldRespondWith`
+        [json|[{"id":0}]|]
+        { matchHeaders = respHeaders }
+    get "items?id=eq.0"
+      `shouldRespondWith`
+        [json|[{"id":0}]|]
+    deleteItems
+
+  it "does persist patch" $ do
+    postItem
+    request methodPatch "/items?id=eq.0"
+        reqHeaders
+        [json|{"id":-1}|]
+      `shouldRespondWith`
+        [json|[{"id":-1}]|]
+        { matchHeaders = respHeaders }
+    get "items?id=eq.0"
+      `shouldRespondWith`
+        [json|[]|]
+    get "items?id=eq.-1"
+      `shouldRespondWith`
+        [json|[{"id":-1}]|]
+    deleteItems
+
+  it "does persist delete" $ do
+    postItem
+    request methodDelete "/items?id=eq.0"
+        reqHeaders
+        ""
+      `shouldRespondWith`
+        [json|[{"id":0}]|]
+        { matchHeaders = respHeaders }
+    get "items?id=eq.0"
+      `shouldRespondWith`
+        [json|[]|]
+
+shouldNotPersistMutations reqHeaders respHeaders = do
+  it "does not persist post" $ do
+    request methodPost "/items"
+        reqHeaders
+        [json|{"id":0}|]
+      `shouldRespondWith`
+        [json|[{"id":0}]|]
+        { matchStatus  = 201
+        , matchHeaders = respHeaders }
+    get "items?id=eq.0"
+      `shouldRespondWith`
+        [json|[]|]
+
+  it "does not persist put" $ do
+    request methodPut "/items?id=eq.0"
+        reqHeaders
+        [json|{"id":0}|]
+      `shouldRespondWith`
+        [json|[{"id":0}]|]
+        { matchHeaders = respHeaders }
+    get "items?id=eq.0"
+      `shouldRespondWith`
+        [json|[]|]
+
+  it "does not persist patch" $ do
+    request methodPatch "/items?id=eq.1"
+        reqHeaders
+        [json|{"id":0}|]
+      `shouldRespondWith`
+        [json|[{"id":0}]|]
+        { matchHeaders = respHeaders }
+    get "items?id=eq.0"
+      `shouldRespondWith`
+        [json|[]|]
+    get "items?id=eq.1"
+      `shouldRespondWith`
+        [json|[{"id":1}]|]
+
+  it "does not persist delete" $ do
+    request methodDelete "/items?id=eq.1"
+        reqHeaders
+        ""
+      `shouldRespondWith`
+        [json|[{"id":1}]|]
+        { matchHeaders = respHeaders }
+    get "items?id=eq.1"
+      `shouldRespondWith`
+        [json|[{"id":1}]|]
+
+allowed :: SpecWith ((), Application)
+allowed = describe "tx-allow-override = true" $ do
+  describe "without Prefer tx" $ do
+    -- TODO: Change this to default to rollback for whole test-suite
+    preferDefault `shouldRespondToReads` withoutPreferenceApplied
+    preferDefault `shouldPersistMutations` withoutPreferenceApplied
+
+  describe "Prefer tx=commit" $ do
+    preferCommit `shouldRespondToReads` withPreferenceCommitApplied
+    preferCommit `shouldPersistMutations` withPreferenceCommitApplied
+
+  describe "Prefer tx=rollback" $ do
+    preferRollback `shouldRespondToReads` withPreferenceRollbackApplied
+    preferRollback `shouldNotPersistMutations` withPreferenceRollbackApplied
+
+disallowed :: SpecWith ((), Application)
+disallowed = describe "tx-rollback-all = false, tx-allow-override = false" $ do
+  describe "without Prefer tx" $ do
+    preferDefault `shouldRespondToReads` withoutPreferenceApplied
+    preferDefault `shouldPersistMutations` withoutPreferenceApplied
+
+  describe "Prefer tx=commit" $ do
+    preferCommit `shouldRespondToReads` withoutPreferenceApplied
+    preferCommit `shouldPersistMutations` withoutPreferenceApplied
+
+  describe "Prefer tx=rollback" $ do
+    preferRollback `shouldRespondToReads` withoutPreferenceApplied
+    preferRollback `shouldPersistMutations` withoutPreferenceApplied
+
+
+forced :: SpecWith ((), Application)
+forced = describe "tx-rollback-all = true, tx-allow-override = false" $ do
+  describe "without Prefer tx" $ do
+    preferDefault `shouldRespondToReads` withoutPreferenceApplied
+    preferDefault `shouldNotPersistMutations` withoutPreferenceApplied
+
+  describe "Prefer tx=commit" $ do
+    preferCommit `shouldRespondToReads` withoutPreferenceApplied
+    preferCommit `shouldNotPersistMutations` withoutPreferenceApplied
+
+  describe "Prefer tx=rollback" $ do
+    preferRollback `shouldRespondToReads` withoutPreferenceApplied
+    preferRollback `shouldNotPersistMutations` withoutPreferenceApplied
+
@@ -43,6 +43,7 @@ import qualified Feature.QueryLimitedSpec
 import qualified Feature.QuerySpec
 import qualified Feature.RangeSpec
 import qualified Feature.RawOutputTypesSpec
+import qualified Feature.RollbackSpec
 import qualified Feature.RootSpec
 import qualified Feature.RpcPreRequestGucsSpec
 import qualified Feature.RpcSpec
@@ -87,6 +88,8 @@ main = do
      rootSpecApp          = app testCfgRootSpec
      htmlRawOutputApp     = app testCfgHtmlRawOutput
      responseHeadersApp   = app testCfgResponseHeaders
+      disallowRollbackApp  = app testCfgDisallowRollback
+      forceRollbackApp     = app testCfgForceRollback

      extraSearchPathApp   = appDbs testCfgExtraSearchPath
      unicodeApp           = appDbs testUnicodeCfg
@@ -109,6 +112,7 @@ main = do
        , ("Feature.OptionsSpec"             , Feature.OptionsSpec.spec)
        , ("Feature.QuerySpec"               , Feature.QuerySpec.spec actualPgVersion)
        , ("Feature.EmbedDisambiguationSpec" , Feature.EmbedDisambiguationSpec.spec)
+        , ("Feature.RollbackAllowedSpec"     , Feature.RollbackSpec.allowed)
        , ("Feature.RpcSpec"                 , Feature.RpcSpec.spec actualPgVersion)
        , ("Feature.AndOrParamsSpec"         , Feature.AndOrParamsSpec.spec actualPgVersion)
        , ("Feature.UpsertSpec"              , Feature.UpsertSpec.spec)
@@ -175,6 +179,13 @@ main = do
    before extraSearchPathApp $
      describe "Feature.ExtraSearchPathSpec" Feature.ExtraSearchPathSpec.spec

+    -- this test runs with tx-rollback-all = false and tx-allow-override = false
+    before disallowRollbackApp $
+      describe "Feature.RollbackDisallowedSpec" Feature.RollbackSpec.disallowed
+
+    -- this test runs with tx-rollback-all = true and tx-allow-override = false
+    before forceRollbackApp $
+      describe "Feature.RollbackForcedSpec" Feature.RollbackSpec.forced

    when (actualPgVersion >= pgVersion96) $ do
      -- this test runs with a root spec function override
@@ -90,11 +90,19 @@ _baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in
  , configRawMediaTypes     = []
  , configJWKS              = parseSecret <$> secret
  , configLogLevel          = LogCrit
+  , configTxRollbackAll     = False
+  , configTxAllowOverride   = True
  }

 testCfg :: Text -> AppConfig
 testCfg testDbConn = _baseCfg { configDbUri = testDbConn }

+testCfgDisallowRollback :: Text -> AppConfig
+testCfgDisallowRollback testDbConn = (testCfg testDbConn) { configTxRollbackAll = False, configTxAllowOverride = False }
+
+testCfgForceRollback :: Text -> AppConfig
+testCfgForceRollback testDbConn = (testCfg testDbConn) { configTxRollbackAll = True, configTxAllowOverride = False }
+
 testCfgNoJWT :: Text -> AppConfig
 testCfgNoJWT testDbConn = (testCfg testDbConn) { configJwtSecret = Nothing, configJWKS = Nothing }