diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs index 136ae4549..0454d65c5 100644 --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -12,7 +12,7 @@ import SpecHelper spec :: Spec spec = beforeAll (clearTable "postgrest.auth") . afterAll_ (clearTable "postgrest.auth") - $ around withApp + $ around (withApp cfgDefault) $ describe "authorization" $ do it "hides tables that anonymous does not own" $ diff --git a/test/Feature/CorsSpec.hs b/test/Feature/CorsSpec.hs index 35ff69982..1e0da8695 100644 --- a/test/Feature/CorsSpec.hs +++ b/test/Feature/CorsSpec.hs @@ -12,7 +12,7 @@ import Network.HTTP.Types -- }}} spec :: Spec -spec = around withApp $ describe "CORS" $ do +spec = around (withApp cfgDefault) $ describe "CORS" $ do let preflightHeaders = [ ("Accept", "*/*"), ("Origin", "http://example.com"), diff --git a/test/Feature/DeleteSpec.hs b/test/Feature/DeleteSpec.hs index adf946e50..7e368925d 100644 --- a/test/Feature/DeleteSpec.hs +++ b/test/Feature/DeleteSpec.hs @@ -8,7 +8,7 @@ import Network.HTTP.Types spec :: Spec spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable "items") - . around withApp $ + . around (withApp cfgDefault) $ describe "Deleting" $ do context "existing record" $ do it "succeeds with 204 and deletion count" $ diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs index 3639c72d1..83d79870a 100644 --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -17,7 +17,7 @@ import Control.Monad (replicateM_) import TestTypes(IncPK(..), CompoundPK(..)) spec :: Spec -spec = afterAll_ resetDb $ around withApp $ do +spec = afterAll_ resetDb $ around (withApp cfgDefault) $ do describe "Posting new record" $ do after_ (clearTable "menagerie") . context "disparate csv types" $ do it "accepts disparate json types" $ do diff --git a/test/Feature/QueryLimitedSpec.hs b/test/Feature/QueryLimitedSpec.hs new file mode 100644 index 000000000..31ec64d49 --- /dev/null +++ b/test/Feature/QueryLimitedSpec.hs @@ -0,0 +1,32 @@ +module Feature.QueryLimitedSpec where + +import Test.Hspec hiding (pendingWith) +import Test.Hspec.Wai +import Test.Hspec.Wai.JSON +import Network.HTTP.Types +import Network.Wai.Test (SResponse(simpleHeaders, simpleStatus)) + +import SpecHelper + +spec :: Spec +spec = + beforeAll (clearTable "items" >> createItems 15) + . afterAll_ (clearTable "items") + . around (withApp $ cfgLimitRows 3) $ do + + describe "Requesting many items with server limits enabled" $ do + it "restricts results" $ + get "/items" + `shouldRespondWith` ResponseMatcher { + matchBody = Just [json| [{"id":1},{"id":2},{"id":3}] |] + , matchStatus = 206 + , matchHeaders = ["Content-Range" <:> "0-2/15"] + } + + it "respects additional client limiting" $ do + r <- request methodGet "/items" + (rangeHdrs $ ByteRangeFromTo 0 1) "" + liftIO $ do + simpleHeaders r `shouldSatisfy` + matchHeader "Content-Range" "0-1/15" + simpleStatus r `shouldBe` partialContent206 diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 99ec84403..9f9441c8e 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -22,7 +22,7 @@ spec = createLikableStrings >> createJsonData) . afterAll_ (clearTable "items" >> clearTable "complex_items" >> clearTable "no_pk" >> clearTable "simple_pk") - . around withApp $ do + . around (withApp cfgDefault) $ do describe "Querying a table with a column called count" $ it "should not confuse count column with pg_catalog.count aggregate" $ diff --git a/test/Feature/RangeSpec.hs b/test/Feature/RangeSpec.hs index 35c22a27b..30cd57fd5 100644 --- a/test/Feature/RangeSpec.hs +++ b/test/Feature/RangeSpec.hs @@ -10,7 +10,7 @@ import SpecHelper spec :: Spec spec = beforeAll (clearTable "items" >> createItems 15) . afterAll_ (clearTable "items") - . around withApp $ + . around (withApp cfgDefault) $ describe "GET /items" $ do context "without range headers" $ do diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index 339a36044..d32048577 100644 --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -9,7 +9,7 @@ import SpecHelper import Network.HTTP.Types spec :: Spec -spec = around withApp $ do +spec = around (withApp cfgDefault) $ do describe "GET /" $ do it "lists views in schema" $ request methodGet "/" [] "" diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 2cae197d5..ccb1eefa3 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -41,8 +41,13 @@ isLeft :: Either a b -> Bool isLeft (Left _ ) = True isLeft _ = False -cfg :: AppConfig -cfg = AppConfig dbString 3000 "postgrest_anonymous" "test" (secret "safe") 10 Nothing +cfgDefault :: AppConfig +cfgDefault = AppConfig dbString 3000 "postgrest_anonymous" "test" (secret "safe") 10 Nothing + +cfgLimitRows :: Int -> AppConfig +cfgLimitRows limit = + AppConfig dbString 3000 "postgrest_anonymous" "test" + (secret "safe") 10 (Just limit) testPoolOpts :: PoolSettings testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30 @@ -50,20 +55,20 @@ testPoolOpts = fromMaybe (error "bad settings") $ H.poolSettings 1 30 pgSettings :: P.Settings pgSettings = P.StringSettings $ cs dbString -withApp :: ActionWith Application -> IO () -withApp perform = do +withApp :: AppConfig -> ActionWith Application -> IO () +withApp config perform = do pool :: H.Pool P.Postgres <- H.acquirePool pgSettings testPoolOpts let txSettings = Just (H.ReadCommitted, Just True) - dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema cfg) + dbOrError <- H.session pool $ H.tx txSettings $ getDbStructure (cs $ configSchema config) db <- either (fail . show) return dbOrError perform $ middle $ \req resp -> do time <- getPOSIXTime body <- strictRequestBody req result <- liftIO $ H.session pool $ H.tx txSettings - $ runWithClaims cfg time (app db cfg body) req + $ runWithClaims config time (app db config body) req either (resp . pgErrResponse) resp result where middle = defaultMiddle