Permalink
Browse files

add support for byte ranges

  • Loading branch information...
1 parent bcecd89 commit f425d671bc318277b6b536a5c466030f3fd59e8d @aristidb aristidb committed May 23, 2012
Showing with 60 additions and 15 deletions.
  1. +50 −14 Network/HTTP/Types.hs
  2. +1 −1 http-types.cabal
  3. +9 −0 runtests.hs
View
@@ -106,10 +106,12 @@ module Network.HTTP.Types
, gatewayTimeout504
, status505
, httpVersionNotSupported505
--- * Headers
+ -- * Headers
+ -- ** Types
, Header
, RequestHeaders
, ResponseHeaders
+ -- ** Common headers
, headerAccept
, headerAuthorization
, headerCacheControl
@@ -118,6 +120,13 @@ module Network.HTTP.Types
, headerContentType
, headerContentMD5
, headerDate
+ -- ** Byte ranges
+, ByteRange(..)
+, renderByteRangeBuilder
+, renderByteRange
+, ByteRanges
+, renderByteRangesBuilder
+, renderByteRanges
-- * Query string
, QueryItem
, Query
@@ -191,21 +200,22 @@ module Network.HTTP.Types
)
where
-import Control.Arrow (second, (|||), (***))
+import Control.Arrow (second, (|||), (***))
import Data.Array
-import Data.Bits (shiftL, (.|.))
+import Data.Bits (shiftL, (.|.))
import Data.Char
import Data.Maybe
-import Data.Monoid (mempty, mappend, mconcat)
-import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
-import Data.Text.Encoding.Error (lenientDecode)
-import Data.Word (Word8)
-import Data.List (intersperse)
-import qualified Blaze.ByteString.Builder as Blaze
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Char8 as B8
-import qualified Data.CaseInsensitive as CI
+import Data.Monoid (mempty, mappend, mconcat)
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
+import Data.Text.Encoding.Error (lenientDecode)
+import Data.Word (Word8)
+import Data.List (intersperse)
+import qualified Blaze.ByteString.Builder as Blaze
+import qualified Blaze.ByteString.Builder.Char8 as Blaze
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.CaseInsensitive as CI
type Ascii = B.ByteString
@@ -852,11 +862,37 @@ headerContentType = (,) "Content-Type"
headerContentMD5 = (,) "Content-MD5"
headerDate = (,) "Date"
+-- | RFC 2616 Byte range (individual).
+--
+-- Negative indices are not allowed!
+data ByteRange
+ = ByteRangeFrom !Integer
+ | ByteRangeFromTo !Integer !Integer
+ | ByteRangeSuffix !Integer
+
+renderByteRangeBuilder :: ByteRange -> Blaze.Builder
+renderByteRangeBuilder (ByteRangeFrom from) = Blaze.fromShow from `mappend` Blaze.fromChar '-'
+renderByteRangeBuilder (ByteRangeFromTo from to) = Blaze.fromShow from `mappend` Blaze.fromChar '-' `mappend` Blaze.fromShow to
+renderByteRangeBuilder (ByteRangeSuffix suffix) = Blaze.fromChar '-' `mappend` Blaze.fromShow suffix
+
+renderByteRange :: ByteRange -> Ascii
+renderByteRange = Blaze.toByteString . renderByteRangeBuilder
+
+-- | RFC 2616 Byte ranges (set).
+type ByteRanges = [ByteRange]
+
+renderByteRangesBuilder :: ByteRanges -> Blaze.Builder
+renderByteRangesBuilder xs = Blaze.copyByteString "bytes=" `mappend`
+ mconcat (intersperse (Blaze.fromChar ',') (map renderByteRangeBuilder xs))
+
+renderByteRanges :: ByteRanges -> Ascii
+renderByteRanges = Blaze.toByteString . renderByteRangesBuilder
+
-- | Query item
type QueryItem = (B.ByteString, Maybe B.ByteString)
-- | Query.
---
+--
-- General form: a=b&c=d, but if the value is Nothing, it becomes
-- a&c=d.
type Query = [QueryItem]
View
@@ -7,7 +7,7 @@ Name: http-types
-- The package version. See the Haskell package versioning policy
-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
-- standards guiding when and how versions should be incremented.
-Version: 0.6.10
+Version: 0.6.11
-- A short (one-line) description of the package.
Synopsis: Generic HTTP types for Haskell (for both client and server code).
View
@@ -33,6 +33,15 @@ main = hspecX
[ it "is identity to encode and then decode"
$ property propEncodeDecodePathSegments
]
+ , describe "encode ByteRanges"
+ [ it "first 500 bytes" $ renderByteRanges [ByteRangeFromTo 0 499] @?= "bytes=0-499"
+ , it "second 500 bytes" $ renderByteRanges [ByteRangeFromTo 500 999] @?= "bytes=500-999"
+ , it "final 500 bytes" $ renderByteRanges [ByteRangeSuffix 500] @?= "bytes=-500"
+ , it "final 500 bytes (of 1000, absolute)" $ renderByteRanges [ByteRangeFrom 9500] @?= "bytes=9500-"
+ , it "first and last bytes only" $ renderByteRanges [ByteRangeFromTo 0 0, ByteRangeSuffix 1] @?= "bytes=0-0,-1"
+ , it "non-canonical second 500 bytes (1)" $ renderByteRanges [ByteRangeFromTo 500 600, ByteRangeFromTo 601 999] @?= "bytes=500-600,601-999"
+ , it "non-canonical second 500 bytes (2)" $ renderByteRanges [ByteRangeFromTo 500 700, ByteRangeFromTo 601 999] @?= "bytes=500-700,601-999"
+ ]
]
propEncodeDecodePath :: ([Text], Query) -> Bool

0 comments on commit f425d67

Please sign in to comment.