Overhaul without breaking existing functionality

CHANGELOG.md

@@ -1,10 +1,15 @@
 # Changelog for `http-types`
 
-## 0.12.5 [XXXX-XX-XX]
+## 0.13 [XXXX-XX-XX]
 
-* Export everything from `Network.HTTP.Types`
+* Export everything from `Network.HTTP.Types`, so that is technically
+  the only module you'd have to import.
 * Added a bunch of regression, unit and property tests for stability.
 * Updated the `README.md`
+* Added new `HttpVersion`: `http30`
+* Added new parse and render functions for `HttpVersion`
+* Added pattern synonyms for `HttpVersion`s
+* Added new `Status`: `status451` / `unavailableForLegalReasons451`
 
 ## 0.12.4 [2023-11-29]
 

Network/HTTP/Types.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PatternSynonyms #-}
 module Network.HTTP.Types (
     -- * Methods
 
@@ -28,9 +29,17 @@ module Network.HTTP.Types (
 
     HttpVersion (..),
     http09,
+    pattern Http09,
     http10,
+    pattern Http10,
     http11,
+    pattern Http11,
     http20,
+    pattern Http20,
+    http30,
+    pattern Http30,
+    parseHttpVersion,
+    renderHttpVersion,
 
     -- * Status
 
@@ -122,6 +131,8 @@ module Network.HTTP.Types (
     tooManyRequests429,
     status431,
     requestHeaderFieldsTooLarge431,
+    status451,
+    unavailableForLegalReasons451,
     status500,
     internalServerError500,
     status501,

Network/HTTP/Types/Header.hs

@@ -89,17 +89,19 @@
 )
 where
 
+import Control.Monad (guard)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Builder as B
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.CaseInsensitive as CI
 import Data.Data (Data)
 import Data.List (intersperse)
 #if __GLASGOW_HASKELL__ < 710
 import Data.Monoid
 #endif
 import Data.Typeable (Typeable)
+import Data.Word8 (_comma, _hyphen)
 import GHC.Generics (Generic)
 
 -- | A full HTTP header field with the name and value separated.
@@ -480,9 +482,9 @@
 --
 -- @since 0.6.11
 renderByteRangeBuilder :: ByteRange -> B.Builder
-renderByteRangeBuilder (ByteRangeFrom from) = B.integerDec from `mappend` B.char7 '-'
-renderByteRangeBuilder (ByteRangeFromTo from to) = B.integerDec from `mappend` B.char7 '-' `mappend` B.integerDec to
-renderByteRangeBuilder (ByteRangeSuffix suffix) = B.char7 '-' `mappend` B.integerDec suffix
+renderByteRangeBuilder (ByteRangeFrom from) = B.integerDec from `mappend` B.word8 _hyphen
+renderByteRangeBuilder (ByteRangeFromTo from to) = B.integerDec from `mappend` B.word8 _hyphen `mappend` B.integerDec to
+renderByteRangeBuilder (ByteRangeSuffix suffix) = B.word8 _hyphen `mappend` B.integerDec suffix
 
 -- | Renders a byte range into a 'B.ByteString'.
 --
@@ -504,7 +506,7 @@
 renderByteRangesBuilder :: ByteRanges -> B.Builder
 renderByteRangesBuilder xs =
     B.byteString "bytes="
-        `mappend` mconcat (intersperse (B.char7 ',') $ map renderByteRangeBuilder xs)
+        `mappend` mconcat (intersperse (B.word8 _comma) $ map renderByteRangeBuilder xs)
 
 -- | Renders a list of byte ranges into a 'B.ByteString'.
 --
@@ -537,7 +539,7 @@
 -- @since 0.9.1
 parseByteRanges :: B.ByteString -> Maybe ByteRanges
 parseByteRanges bs1 = do
-    bs2 <- stripPrefixB "bytes=" bs1
+    bs2 <- B.stripPrefix "bytes=" bs1
     (r, bs3) <- range bs2
     ranges (r :) bs3
   where
@@ -546,19 +548,15 @@
         if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-")
             then Just (ByteRangeSuffix (negate i), bs3)
             else do
-                bs4 <- stripPrefixB "-" bs3
+                (w8, bs4) <- B.uncons bs3
+                guard $ w8 == _hyphen
                 case B8.readInteger bs4 of
                     Just (j, bs5) | j >= i -> Just (ByteRangeFromTo i j, bs5)
                     _ -> Just (ByteRangeFrom i, bs4)
     ranges front bs3
         | B.null bs3 = Just (front [])
         | otherwise = do
-            bs4 <- stripPrefixB "," bs3
+            (w8, bs4) <- B.uncons bs3
+            guard $ w8 == _comma
             (r, bs5) <- range bs4
             ranges (front . (r :)) bs5
-
-    -- FIXME: Use 'stripPrefix' from the 'bytestring' package.
-    -- Might have to update the dependency constraints though.
-    stripPrefixB x y
-        | x `B.isPrefixOf` y = Just (B.drop (B.length x) y)
-        | otherwise = Nothing

Network/HTTP/Types/Method.hs

@@ -33,7 +33,7 @@ module Network.HTTP.Types.Method (
 where
 
 import Control.Arrow ((|||))
-import Data.Array (Array, Ix, assocs, listArray, (!))
+import Data.Array (Array, Ix, listArray, (!))
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as B8
 import Data.Data (Data)
@@ -53,39 +53,39 @@ import GHC.Generics (Generic)
 -- | HTTP method (flat 'ByteString' type).
 type Method = B.ByteString
 
--- | HTTP GET Method
+-- | GET Method
 methodGet :: Method
 methodGet = renderStdMethod GET
 
--- | HTTP POST Method
+-- | POST Method
 methodPost :: Method
 methodPost = renderStdMethod POST
 
--- | HTTP HEAD Method
+-- | HEAD Method
 methodHead :: Method
 methodHead = renderStdMethod HEAD
 
--- | HTTP PUT Method
+-- | PUT Method
 methodPut :: Method
 methodPut = renderStdMethod PUT
 
--- | HTTP DELETE Method
+-- | DELETE Method
 methodDelete :: Method
 methodDelete = renderStdMethod DELETE
 
--- | HTTP TRACE Method
+-- | TRACE Method
 methodTrace :: Method
 methodTrace = renderStdMethod TRACE
 
--- | HTTP CONNECT Method
+-- | CONNECT Method
 methodConnect :: Method
 methodConnect = renderStdMethod CONNECT
 
--- | HTTP OPTIONS Method
+-- | OPTIONS Method
 methodOptions :: Method
 methodOptions = renderStdMethod OPTIONS
 
--- | HTTP PATCH Method
+-- | PATCH Method
 --
 -- @since 0.8.0
 methodPatch :: Method
@@ -96,6 +96,9 @@ methodPatch = renderStdMethod PATCH
 --
 -- @since 0.2.0
 data StdMethod
+    -- These are ordered by suspected frequency. More popular methods should go first.
+    -- The reason is that 'methodList' is used with 'lookup'.
+    -- 'lookup' is probably faster for these few cases than setting up an elaborate data structure.
     = GET
     | POST
     | HEAD
@@ -121,17 +124,11 @@ data StdMethod
           Data
         )
 
--- These are ordered by suspected frequency. More popular methods should go first.
--- The reason is that methodList is used with lookup.
--- lookup is probably faster for these few cases than setting up an elaborate data structure.
-
--- FIXME: listArray (minBound, maxBound) $ fmap fst methodList
 methodArray :: Array StdMethod Method
-methodArray = listArray (minBound, maxBound) $ map (B8.pack . show) [minBound :: StdMethod .. maxBound]
+methodArray = listArray (minBound, maxBound) $ fst <$> methodList
 
--- FIXME: map (\m -> (B8.pack $ show m, m)) [minBound .. maxBound]
 methodList :: [(Method, StdMethod)]
-methodList = map (\(a, b) -> (b, a)) (assocs methodArray)
+methodList = map (\m -> (B8.pack $ show m, m)) [minBound :: StdMethod .. maxBound]
 
 -- | Convert a method 'ByteString' to a 'StdMethod' if possible.
 --

Network/HTTP/Types/QueryLike.hs

@@ -9,8 +9,8 @@ module Network.HTTP.Types.QueryLike (
 where
 
 import Control.Arrow ((***))
-import Data.ByteString as B (ByteString, concat)
-import Data.ByteString.Lazy as L (ByteString, toChunks)
+import Data.ByteString as B (ByteString)
+import Data.ByteString.Lazy as L (ByteString, toStrict)
 import Data.Maybe (catMaybes)
 import Data.Text as T (Text, pack)
 import Data.Text.Encoding as T (encodeUtf8)
@@ -48,12 +48,12 @@ instance (QueryKeyLike k, QueryValueLike v) => QueryLike [Maybe (k, v)] where
     toQuery = toQuery . catMaybes
 
 instance QueryKeyLike B.ByteString where toQueryKey = id
-instance QueryKeyLike L.ByteString where toQueryKey = B.concat . L.toChunks
+instance QueryKeyLike L.ByteString where toQueryKey = L.toStrict
 instance QueryKeyLike T.Text where toQueryKey = T.encodeUtf8
 instance QueryKeyLike [Char] where toQueryKey = T.encodeUtf8 . T.pack
 
 instance QueryValueLike B.ByteString where toQueryValue = Just
-instance QueryValueLike L.ByteString where toQueryValue = Just . B.concat . L.toChunks
+instance QueryValueLike L.ByteString where toQueryValue = Just . L.toStrict
 instance QueryValueLike T.Text where toQueryValue = Just . T.encodeUtf8
 instance QueryValueLike [Char] where toQueryValue = Just . T.encodeUtf8 . T.pack
 instance QueryValueLike a => QueryValueLike (Maybe a) where

Network/HTTP/Types/Status.hs

@@ -8,12 +8,7 @@
 module Network.HTTP.Types.Status (
     -- * HTTP Status
 
-    -- If we ever want to deprecate the 'Status' data constructor:
-    -- #if __GLASGOW_HASKELL__ >= 908
-    --   {-# DEPRECATED "Use 'mkStatus' when constructing a 'Status'" #-} Status(Status)
-    -- #else
     Status (Status),
-    -- #endif
     statusCode,
     statusMessage,
     mkStatus,
@@ -101,6 +96,8 @@ module Network.HTTP.Types.Status (
     tooManyRequests429,
     status431,
     requestHeaderFieldsTooLarge431,
+    status451,
+    unavailableForLegalReasons451,
     status500,
     internalServerError500,
     status501,
@@ -126,6 +123,7 @@ module Network.HTTP.Types.Status (
 
 import Data.ByteString as B (ByteString, empty)
 import Data.Data (Data)
+import Data.Function (on)
 import Data.Typeable (Typeable)
 import GHC.Generics (Generic)
 
@@ -161,18 +159,24 @@ data Status = Status
 -- name of the constructor, so that it doesn't clash with the new pattern synonym
 -- that's replacing it.
 --
--- > data Status = MkStatus ...
--- > pattern Status code msg = MkStatus code msg
+-- > {-# LANGUAGE PatternSynonyms #-}
+-- > data Status = MkStatus
+-- > { statusCode :: Int -- ^ 404
+-- > , statusMessage :: B.ByteString -- ^ "Not Found"
+-- > , statusRaw :: B.ByteString -- ^ "404 Not Found"
+-- > }
+-- > pattern Status code msg <- MkStatus code msg _
+-- >   where Status code msg = MkStatus code msg (fromString (show code <> " ") <> msg)
 
 -- | A 'Status' is equal to another 'Status' if the status codes are equal.
 instance Eq Status where
-    Status { statusCode = a } == Status { statusCode = b } = a == b
+    (==) = (==) `on` statusCode
 
 -- | 'Status'es are ordered according to their status codes only.
 instance Ord Status where
-    compare Status { statusCode = a } Status { statusCode = b } = a `compare` b
+    compare = compare `on` statusCode
 
--- | Be advised, that when using the \"enumFrom*\" family of methods or
+-- | Be advised, that when using the @enumFrom*@ family of methods or
 -- ranges in lists, it will generate all possible status codes.
 --
 -- E.g. @[status100 .. status200]@ generates 'Status'es of @100, 101, 102 .. 198, 199, 200@
@@ -223,6 +227,7 @@ instance Enum Status where
     toEnum 428 = status428
     toEnum 429 = status429
     toEnum 431 = status431
+    toEnum 451 = status451
     toEnum 500 = status500
     toEnum 501 = status501
     toEnum 502 = status502
@@ -702,6 +707,20 @@ status431 = mkStatus 431 "Request Header Fields Too Large"
 requestHeaderFieldsTooLarge431 :: Status
 requestHeaderFieldsTooLarge431 = status431
 
+-- | Unavailable For Legal Reasons 451
+-- (<https://tools.ietf.org/html/rfc7725 RFC 7725>)
+--
+-- @since 0.13
+status451 :: Status
+status451 = mkStatus 451 "Unavailable For Legal Reasons"
+
+-- | Unavailable For Legal Reasons 451
+-- (<https://tools.ietf.org/html/rfc7725 RFC 7725>)
+--
+-- @since 0.13
+unavailableForLegalReasons451 :: Status
+unavailableForLegalReasons451 = status451
+
 -- | Internal Server Error 500
 status500 :: Status
 status500 = mkStatus 500 "Internal Server Error"
@@ -790,36 +809,40 @@ networkAuthenticationRequired511 = status511
 --
 -- @since 0.8.0
 statusIsInformational :: Status -> Bool
-statusIsInformational (Status {statusCode=code}) = code >= 100 && code < 200
+statusIsInformational = statusIs 1
 
 -- | Successful class
 --
 -- Checks if the status is in the 2XX range.
 --
 -- @since 0.8.0
 statusIsSuccessful :: Status -> Bool
-statusIsSuccessful (Status {statusCode=code}) = code >= 200 && code < 300
+statusIsSuccessful = statusIs 2
 
 -- | Redirection class
 --
 -- Checks if the status is in the 3XX range.
 --
 -- @since 0.8.0
 statusIsRedirection :: Status -> Bool
-statusIsRedirection (Status {statusCode=code}) = code >= 300 && code < 400
+statusIsRedirection = statusIs 3
 
 -- | Client Error class
 --
 -- Checks if the status is in the 4XX range.
 --
 -- @since 0.8.0
 statusIsClientError :: Status -> Bool
-statusIsClientError (Status {statusCode=code}) = code >= 400 && code < 500
+statusIsClientError = statusIs 4
 
 -- | Server Error class
 --
 -- Checks if the status is in the 5XX range.
 --
 -- @since 0.8.0
 statusIsServerError :: Status -> Bool
-statusIsServerError (Status {statusCode=code}) = code >= 500 && code < 600
+statusIsServerError = statusIs 5
+
+statusIs :: Int -> Status -> Bool
+statusIs i = (== i) . (`div` 100) . statusCode
+{-# INLINE statusIs #-}