Add support for Prefer tx=rollback

test/Feature/RollbackSpec.hs

@@ -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
+

test/Main.hs

@@ -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

test/SpecHelper.hs

@@ -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 }