Be stricter about partial content response

test/Feature/InsertSpec.hs

@@ -12,26 +12,13 @@ import SpecHelper
 
 import qualified Data.Aeson as JSON
 import Data.Maybe (fromJust)
-import qualified Data.HashMap.Strict as Hash
-import qualified Data.ByteString.Char8 as BS
-import Data.CaseInsensitive
-
-import Text.Regex.TDFA ((=~))
 import Network.HTTP.Types.Header
-import Network.HTTP.Types.Status
+import Network.HTTP.Types
 
 import TestTypes(IncPK, incStr, incNullableStr)
 
 -- }}}
 
-getHeader :: CI BS.ByteString -> [Header] -> Maybe BS.ByteString
-getHeader name headers =
-  Hash.lookup name $ Hash.fromList headers
-
-matchHeader :: CI BS.ByteString -> String -> [Header] -> Bool
-matchHeader name valRegex headers =
-  maybe False (=~ valRegex) $ getHeader name headers
-
 spec :: Spec
 spec = around appWithFixture $
   describe "Posting new record" $ do

test/Feature/RangeSpec.hs

@@ -4,19 +4,37 @@ module Feature.RangeSpec where
 import Test.Hspec
 import Test.Hspec.Wai
 import Network.HTTP.Types
+import Network.Wai.Test (SResponse(simpleHeaders,simpleStatus))
 
 import SpecHelper
 
 spec :: Spec
 spec = around appWithFixture $
   describe "GET /items" $ do
+
     context "without range headers" $
       context "with response under server size limit" $
         it "returns whole range with status 200" $
           get "/items" `shouldRespondWith` 200
-    context "with range headers" $
+
-      context "of acceptable range" $
+    context "with range headers" $ do
-        it "succeeds with partial content" $
+
+      context "of acceptable range" $ do
+        it "succeeds with partial content" $ do
+          r <- request methodGet  "/items"
+                       (rangeHdrs $ ByteRangeFromTo 0 1) ""
+          liftIO $ do
+            simpleHeaders r `shouldSatisfy`
+              matchHeader "Content-Range" "0-1/[0-9]+"
+            simpleStatus r `shouldBe` partialContent206
+
+        it "understands open-ended ranges" $
+          request methodGet "/items"
+                  (rangeHdrs $ ByteRangeFrom 0) ""
+            `shouldRespondWith` 200
+
+      context "of invalid range" $
+        it "fails with 416 for offside range" $
           request methodGet  "/items"
-                  (rangeHdrs $ ByteRangeFromTo 0 1) ""
+                  (rangeHdrs $ ByteRangeFromTo 1 0) ""
-            `shouldRespondWith` 206
+            `shouldRespondWith` 416

test/SpecHelper.hs

@@ -11,6 +11,8 @@ import Control.Exception.Base (bracket)
 
 import Network.HTTP.Types.Header
 import Data.CaseInsensitive (CI(..))
+import Text.Regex.TDFA ((=~))
+import qualified Data.HashMap.Strict as Hash
 import qualified Data.ByteString.Char8 as BS
 
 import Dbapi (app, AppConfig(..))
@@ -46,3 +48,11 @@ rangeHdrs r = [rangeUnit, (hRange, renderByteRange r)]
 
 rangeUnit :: Header
 rangeUnit = ("Range-Unit" :: CI BS.ByteString, "items")
+
+getHeader :: CI BS.ByteString -> [Header] -> Maybe BS.ByteString
+getHeader name headers =
+  Hash.lookup name $ Hash.fromList headers
+
+matchHeader :: CI BS.ByteString -> String -> [Header] -> Bool
+matchHeader name valRegex headers =
+  maybe False (=~ valRegex) $ getHeader name headers