Reject ranges that start beyond last item

src/Dbapi.hs

@@ -99,11 +99,11 @@ respondWithRangedResult rr =
   responseLBS status [
     jsonContentType,
     ("Content-Range",
-      if rrTotal rr == 0
+      if total == 0 || from > total
-      then "*/0"
+      then "*/" <> BS.pack (show total)
-      else (BS.pack $ show from)  <> "-"
+      else BS.pack (show from)  <> "-"
-         <> (BS.pack $ show to)    <> "/"
+         <> BS.pack (show to)    <> "/"
-         <> (BS.pack $ show total)
+         <> BS.pack (show total)
     )
   ] (rrBody rr)
 
@@ -111,9 +111,11 @@ respondWithRangedResult rr =
     from   = rrFrom rr
     to     = rrTo   rr
     total  = rrTotal rr
-    status = if total == 0 then status204
+    status
-             else if (1 + to - from) < total then status206
+      | from > total            = status416
-             else status200
+      | total == 0               = status204
+      | (1 + to - from) < total = status206
+      | otherwise               = status200
 
 requestedVersion :: RequestHeaders -> Maybe Int
 requestedVersion hdrs =

src/PgQuery.hs

@@ -29,7 +29,7 @@ data RangedResult = RangedResult {
 , rrTo    :: Int
 , rrTotal :: Int
 , rrBody  :: BL.ByteString
-}
+} deriving (Show)
 
 type QuotedSql = (String, [SqlValue])
 
@@ -44,7 +44,7 @@ getRows schema table qq range conn = do
   r <- quickQuery conn query []
 
   return $ case r of
-           [[_, _, SqlNull]] -> RangedResult 0 0 0 ""
+           [[total, _, SqlNull]] -> RangedResult offset 0 (fromSql total) ""
            [[total, limited_total, json]] ->
             RangedResult offset (offset + fromSql limited_total - 1)
                          (fromSql total) (fromSql json)

src/RangeQuery.hs

@@ -49,4 +49,4 @@ offset :: NonnegRange -> Int
 offset range =
   case rangeLower range
     of BoundaryBelow from -> from
-       _ -> 0 -- should never happen
+       _ -> error "range without lower bound" -- should never happen

test/Feature/RangeSpec.hs

@@ -39,11 +39,29 @@ spec = around appWithFixture $
             `shouldRespondWith` ResponseMatcher {
               matchBody    = Nothing
             , matchStatus  = 204
-            , matchHeaders = []
+            , matchHeaders = [("Content-Range", "*/0")]
             }
 
-      context "of invalid range" $
+      context "of invalid range" $ do
         it "fails with 416 for offside range" $
           request methodGet  "/items"
                   (rangeHdrs $ ByteRangeFromTo 1 0) ""
             `shouldRespondWith` 416
+
+        it "refuses a range with nonzero start when there are no items" $
+          request methodGet "/menagerie"
+                  (rangeHdrs $ ByteRangeFromTo 1 2) ""
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Nothing
+            , matchStatus  = 416
+            , matchHeaders = [("Content-Range", "*/0")]
+            }
+
+        it "refuses a range requesting start past last item" $
+          request methodGet "/items"
+                  (rangeHdrs $ ByteRangeFromTo 100 199) ""
+            `shouldRespondWith` ResponseMatcher {
+              matchBody    = Nothing
+            , matchStatus  = 416
+            , matchHeaders = [("Content-Range", "*/15")]
+            }