Test for --max-rows behavior

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" $

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"),

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" $

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

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

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" $

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

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 "/" [] ""

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