http-types 0.6.11 → 0.12.5

raw patch · 21 files changed

Files

• CHANGELOG.md +57/−0
• Network/HTTP/Types.hs +287/−1127
• Network/HTTP/Types/Header.hs +565/−0
• Network/HTTP/Types/Method.hs +152/−0
• Network/HTTP/Types/QueryLike.hs +60/−0
• Network/HTTP/Types/Status.hs +842/−0
• Network/HTTP/Types/URI.hs +566/−0
• Network/HTTP/Types/Version.hs +60/−0
• README +0/−1
• README.md +21/−0
• http-types.cabal +64/−59
• runtests.hs +0/−85
• test/.golden/urlEncode-path/golden +1/−0
• test/.golden/urlEncode-query/golden +1/−0
• test/Network/HTTP/Types/HeaderSpec.hs +127/−0
• test/Network/HTTP/Types/MethodSpec.hs +50/−0
• test/Network/HTTP/Types/StatusSpec.hs +145/−0
• test/Network/HTTP/Types/URISpec.hs +258/−0
• test/Network/HTTP/Types/VersionSpec.hs +29/−0
• test/Spec.hs +1/−0
• test/doctests.hs +10/−0

@@ -0,0 +1,57 @@+# Changelog for `http-types`++## 0.12.5 [2026-05-31]++* Add status `451 Unavailable For Legal Reasons`+* Add `http30` as a shortcut for `HttpVersion 3 0`+* Export everything from `Network.HTTP.Types`+* Added a bunch of regression, unit and property tests for stability.+* Updated the `README.md`+* Lowest GHC version supported is now `7.10.3`.+  Adjusted dependency constraints to reflect this.+* Removed explicit `Typeable` class derivations since that happens automatically+  since GHC `7.10`++## 0.12.4 [2023-11-29]++* Add `Data` and `Generic` instances to `ByteRange`, `StdMethod`, `Status`+  and `HttpVersion`.+* Rework of all the documentation, with the addition of `@since` notations.++## 0.12.3 [2019-02-24]++* Remove now-invalid doctest options from `doctests.hs`.++## 0.12.2 [2018-09-26]++* Add new `parseQueryReplacePlus` function, which allows specifying whether to replace `'+'` with `' '`.+* Add header name constants for "Prefer" and "Preference-Applied" (RFC 7240).++## 0.12.1 [2018-01-31]++* Add new functions for constructing a query URI where not all parts are escaped.++## 0.12 [2018-01-28]++* URI encoding is now back to upper-case hexadecimal, as that is the preferred canonicalization, and the previous change caused issues with URI signing in at least `amazonka`.++## 0.11 [2017-11-29]++* Remove dependency on `blaze-builder`. (Note that as a side effect of this, URI encoding is now using lower-case rather than upper-case hexadecimal.)+* Add `Bounded` instance to `Status`.+* Re-export more status codes and `http20` from `Network.HTTP.Types`.++## 0.10 [2017-10-22]++* New status codes, new headers.+* Fixed typo in `imATeapot`, added missing `toEnum`.+* Oh, and `http20`.++## 0.9.1 [2016-06-04]++* New function: `parseByteRanges`.+* Support for HTTP status 422 "Unprocessable Entity" (RFC 4918).++## 0.9 [2015-10-09]++* No changelog was maintained up to version `0.9`.

@@ -1,1127 +1,287 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.HTTP.Types-(-  -- * General-  Ascii-  -- * Methods-, Method-, methodGet-, methodPost-, methodHead-, methodPut-, methodDelete-, methodTrace-, methodConnect-, methodOptions-, StdMethod(..)-, parseMethod-, renderMethod-, renderStdMethod-  -- * Versions-, HttpVersion(..)-, http09-, http10-, http11-  -- * Status-, Status(..)-, status100-, continue100-, status101-, switchingProtocols101-, status200-, ok200-, status201-, created201-, status202-, accepted202-, status203-, nonAuthoritative203-, status204-, noContent204-, status205-, resetContent205-, status206-, partialContent206-, status300-, multipleChoices300-, status301-, movedPermanently301-, status302-, found302-, status303-, seeOther303-, status304-, notModified304-, status305-, useProxy305-, status307-, temporaryRedirect307-, status400-, badRequest400-, status401-, unauthorized401-, status402-, paymentRequired402-, status403-, forbidden403-, status404-, notFound404-, status405-, methodNotAllowed405-, status406-, notAcceptable406-, status407-, proxyAuthenticationRequired407-, status408-, requestTimeout408-, status409-, conflict409-, status410-, gone410-, status411-, lengthRequired411-, status412-, preconditionFailed412-, status413-, requestEntityTooLarge413-, status414-, requestURITooLong414-, status415-, unsupportedMediaType415-, status416-, requestedRangeNotSatisfiable416-, status417-, expectationFailed417-, status418-, imATeaPot418-, status500-, internalServerError500-, status501-, notImplemented501-, status502-, badGateway502-, status503-, serviceUnavailable503-, status504-, gatewayTimeout504-, status505-, httpVersionNotSupported505-  -- * Headers-  -- ** Types-, Header-, RequestHeaders-, ResponseHeaders-  -- ** Common headers-, headerAccept-, headerAuthorization-, headerCacheControl-, headerConnection-, headerContentLength-, headerContentType-, headerContentMD5-, headerDate-  -- ** Byte ranges-, ByteRange(..)-, renderByteRangeBuilder-, renderByteRange-, ByteRanges-, renderByteRangesBuilder-, renderByteRanges-  -- * Query string-, QueryItem-, Query-, SimpleQueryItem-, SimpleQuery-, simpleQueryToQuery-, renderQuery-, renderQueryBuilder-, renderSimpleQuery-, parseQuery-, parseSimpleQuery-  -- ** Text query string (UTF8 encoded)-, QueryText-, queryTextToQuery-, queryToQueryText-, renderQueryText-, parseQueryText-  -- * Path segments-, encodePathSegments-, decodePathSegments-, encodePathSegmentsRelative-  -- * Path (segments + query string)-, encodePath-, decodePath-  -- * URL encoding / decoding-, urlEncodeBuilder-, urlEncode-, urlDecode-  -- * Deprecated functions-, statusNotAllowed-, statusContinue-, statusSwitchingProtocols-, statusOK-, statusCreated-, statusAccepted-, statusNonAuthoritative-, statusNoContent-, statusResetContent-, statusPartialContent-, statusMultipleChoices-, statusMovedPermanently-, statusFound-, statusSeeOther-, statusNotModified-, statusUseProxy-, statusTemporaryRedirect-, statusBadRequest-, statusUnauthorized-, statusPaymentRequired-, statusForbidden-, statusNotFound-, statusNotAcceptable-, statusProxyAuthenticationRequired-, statusRequestTimeout-, statusConflict-, statusGone-, statusLengthRequired-, statusPreconditionFailed-, statusRequestEntityTooLarge-, statusRequestURITooLong-, statusUnsupportedMediaType-, statusRequestedRangeNotSatisfiable-, statusExpectationFailed-, statusImATeapot-, statusServerError-, statusNotImplemented-, statusBadGateway-, statusServiceUnavailable-, statusGatewayTimeout-, statusHTTPVersionNotSupported-)-where--import           Control.Arrow                  (second, (|||), (***))-import           Data.Array-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 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---- | HTTP method (flat string type).-type Method = Ascii---- | HTTP Method constants.-methodGet, methodPost, methodHead, methodPut, methodDelete, methodTrace, methodConnect, methodOptions :: Method-methodGet     = renderStdMethod GET-methodPost    = renderStdMethod POST-methodHead    = renderStdMethod HEAD-methodPut     = renderStdMethod PUT-methodDelete  = renderStdMethod DELETE-methodTrace   = renderStdMethod TRACE-methodConnect = renderStdMethod CONNECT-methodOptions = renderStdMethod OPTIONS---- | HTTP standard method (as defined by RFC 2616).-data StdMethod-    = GET-    | POST-    | HEAD  -    | PUT-    | DELETE-    | TRACE-    | CONNECT-    | OPTIONS-    deriving (Read, Show, Eq, Ord, Enum, Bounded, Ix)--- 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.--methodArray :: Array StdMethod Method-methodArray = listArray (minBound, maxBound) $ map (B8.pack . show) [minBound :: StdMethod .. maxBound]--methodList :: [(Method, StdMethod)]-methodList = map (\(a, b) -> (b, a)) (assocs methodArray)---- | Convert a method 'ByteString' to a 'StdMethod' if possible.-parseMethod :: Method -> Either Ascii StdMethod-parseMethod bs = maybe (Left bs) Right $ lookup bs methodList---- | Convert an algebraic method to a 'ByteString'.-renderMethod :: Either Ascii StdMethod -> Method-renderMethod = id ||| renderStdMethod---- | Convert a 'StdMethod' to a 'ByteString'.-renderStdMethod :: StdMethod -> Method-renderStdMethod m = methodArray ! m---- | HTTP Version.--- --- Note that the Show instance is intended merely for debugging.-data HttpVersion -    = HttpVersion {-        httpMajor :: !Int -      , httpMinor :: !Int-      }-    deriving (Eq, Ord)--instance Show HttpVersion where-    show (HttpVersion major minor) = "HTTP/" ++ show major ++ "." ++ show minor---- | HTTP 0.9-http09 :: HttpVersion-http09 = HttpVersion 0 9---- | HTTP 1.0-http10 :: HttpVersion-http10 = HttpVersion 1 0---- | HTTP 1.1-http11 :: HttpVersion-http11 = HttpVersion 1 1---- | HTTP Status.--- --- Only the 'statusCode' is used for comparisons.--- --- Note that the Show instance is only for debugging.-data Status-    = Status {-        statusCode :: Int-      , statusMessage :: Ascii-      }-    deriving (Show)--instance Eq Status where-    Status { statusCode = a } == Status { statusCode = b } = a == b--instance Ord Status where-    compare Status { statusCode = a } Status { statusCode = b } = a `compare` b---- | Continue 100-status100 :: Status-status100 = Status 100 "Continue"---- | Continue 100-continue100 :: Status-continue100 = status100---- | Continue 100 (DEPRECATED)-statusContinue :: Status-statusContinue = status100-{-# DEPRECATED statusContinue "Deprecated" #-}---- | Switching Protocols 101-status101 :: Status-status101 = Status 101 "Switching Protocols"---- | Switching Protocols 101-switchingProtocols101 :: Status-switchingProtocols101 = status101---- | Switching Protocols 101 (DEPRECATED)-statusSwitchingProtocols :: Status-statusSwitchingProtocols = status101-{-# DEPRECATED statusSwitchingProtocols "Deprecated" #-}---- | OK 200-status200 :: Status-status200 = Status 200 "OK"---- | OK 200-ok200 :: Status-ok200 = status200---- | OK 200 (DEPRECATED)-statusOK :: Status-statusOK = status200-{-# DEPRECATED statusOK "Deprecated" #-}---- | Created 201-status201 :: Status-status201 = Status 201 "Created"---- | Created 201-created201 :: Status-created201 = status201---- | Created 201 (DEPRECATED)-statusCreated :: Status-statusCreated = status201-{-# DEPRECATED statusCreated "Deprecated" #-}---- | Accepted 202-status202 :: Status-status202 = Status 202 "Accepted"---- | Accepted 202-accepted202 :: Status-accepted202 = status202---- | Accepted 202 (DEPRECATED)-statusAccepted :: Status-statusAccepted = status202-{-# DEPRECATED statusAccepted "Deprecated" #-}---- | Non-Authoritative Information 203-status203 :: Status-status203 = Status 203 "Non-Authoritative Information"---- | Non-Authoritative Information 203-nonAuthoritative203 :: Status-nonAuthoritative203 = status203---- | Non-Authoritative Information 203 (DEPRECATED)-statusNonAuthoritative :: Status-statusNonAuthoritative = status203-{-# DEPRECATED statusNonAuthoritative "Deprecated" #-}---- | No Content 204-status204 :: Status-status204 = Status 204 "No Content"---- | No Content 204-noContent204 :: Status-noContent204 = status204---- | No Content 204 (DEPRECATED)-statusNoContent :: Status-statusNoContent = status204-{-# DEPRECATED statusNoContent "Deprecated" #-}---- | Reset Content 205-status205 :: Status-status205 = Status 205 "Reset Content"---- | Reset Content 205-resetContent205 :: Status-resetContent205 = status205---- | Reset Content 205 (DEPRECATED)-statusResetContent :: Status-statusResetContent = status205-{-# DEPRECATED statusResetContent "Deprecated" #-}---- | Partial Content 206-status206 :: Status-status206 = Status 206 "Partial Content"---- | Partial Content 206-partialContent206 :: Status-partialContent206 = status206---- | Partial Content 206 (DEPRECATED)-statusPartialContent :: Status-statusPartialContent = status206-{-# DEPRECATED statusPartialContent "Deprecated" #-}---- | Multiple Choices 300-status300 :: Status-status300 = Status 300 "Multiple Choices"---- | Multiple Choices 300-multipleChoices300 :: Status-multipleChoices300 = status300---- | Multiple Choices 300 (DEPRECATED)-statusMultipleChoices :: Status-statusMultipleChoices = status300-{-# DEPRECATED statusMultipleChoices "Deprecated" #-}---- | Moved Permanently 301-status301 :: Status-status301 = Status 301 "Moved Permanently"---- | Moved Permanently 301-movedPermanently301 :: Status-movedPermanently301 = status301---- | Moved Permanently 301 (DEPRECATED)-statusMovedPermanently :: Status-statusMovedPermanently = status301-{-# DEPRECATED statusMovedPermanently "Deprecated" #-}---- | Found 302-status302 :: Status-status302 = Status 302 "Found"---- | Found 302-found302 :: Status-found302 = status302---- | Found 302 (DEPRECATED)-statusFound :: Status-statusFound = status302-{-# DEPRECATED statusFound "Deprecated" #-}---- | See Other 303-status303 :: Status-status303 = Status 303 "See Other"---- | See Other 303-seeOther303 :: Status-seeOther303 = status303---- | See Other 303 (DEPRECATED)-statusSeeOther :: Status-statusSeeOther = status303-{-# DEPRECATED statusSeeOther "Deprecated" #-}---- | Not Modified 304-status304 :: Status-status304 = Status 304 "Not Modified"---- | Not Modified 304-notModified304 :: Status-notModified304 = status304---- | Not Modified 304 (DEPRECATED)-statusNotModified :: Status-statusNotModified = status304-{-# DEPRECATED statusNotModified "Deprecated" #-}---- | Use Proxy 305-status305 :: Status-status305 = Status 305 "Use Proxy"---- | Use Proxy 305-useProxy305 :: Status-useProxy305 = status305---- | Use Proxy 305 (DEPRECATED)-statusUseProxy :: Status-statusUseProxy = status305-{-# DEPRECATED statusUseProxy "Deprecated" #-}---- | Temporary Redirect 307-status307 :: Status-status307 = Status 307 "Temporary Redirect"---- | Temporary Redirect 307-temporaryRedirect307 :: Status-temporaryRedirect307 = status307---- | Temporary Redirect 307 (DEPRECATED)-statusTemporaryRedirect :: Status-statusTemporaryRedirect = status307-{-# DEPRECATED statusTemporaryRedirect "Deprecated" #-}---- | Bad Request 400-status400 :: Status-status400 = Status 400 "Bad Request"---- | Bad Request 400-badRequest400 :: Status-badRequest400 = status400---- | Bad Request 400 (DEPRECATED)-statusBadRequest :: Status-statusBadRequest = status400-{-# DEPRECATED statusBadRequest "Deprecated" #-}---- | Unauthorized 401-status401 :: Status-status401 = Status 401 "Unauthorized"---- | Unauthorized 401-unauthorized401 :: Status-unauthorized401 = status401---- | Unauthorized 401 (DEPRECATED)-statusUnauthorized :: Status-statusUnauthorized = status401-{-# DEPRECATED statusUnauthorized "Deprecated" #-}---- | Payment Required 402-status402 :: Status-status402 = Status 402 "Payment Required"---- | Payment Required 402-paymentRequired402 :: Status-paymentRequired402 = status402---- | Payment Required 402 (DEPRECATED)-statusPaymentRequired :: Status-statusPaymentRequired = status402-{-# DEPRECATED statusPaymentRequired "Deprecated" #-}---- | Forbidden 403-status403 :: Status-status403 = Status 403 "Forbidden"---- | Forbidden 403-forbidden403 :: Status-forbidden403 = status403---- | Forbidden 403 (DEPRECATED)-statusForbidden :: Status-statusForbidden = status403-{-# DEPRECATED statusForbidden "Deprecated" #-}---- | Not Found 404-status404 :: Status-status404 = Status 404 "Not Found"---- | Not Found 404-notFound404 :: Status-notFound404 = status404---- | Not Found 404 (DEPRECATED)-statusNotFound :: Status-statusNotFound = status404-{-# DEPRECATED statusNotFound "Deprecated" #-}---- | Method Not Allowed 405-status405 :: Status-status405 = Status 405 "Method Not Allowed"---- | Method Not Allowed 405-methodNotAllowed405 :: Status-methodNotAllowed405 = status405---- | Method Not Allowed 405 (DEPRECATED!)-statusNotAllowed :: Status-statusNotAllowed = status405-{-# DEPRECATED statusNotAllowed "Use status405 or methodNotAllowed405 instead" #-}---- | Not Acceptable 406-status406 :: Status-status406 = Status 406 "Not Acceptable"---- | Not Acceptable 406-notAcceptable406 :: Status-notAcceptable406 = status406---- | Not Acceptable 406 (DEPRECATED)-statusNotAcceptable :: Status-statusNotAcceptable = status406-{-# DEPRECATED statusNotAcceptable "Deprecated" #-}---- | Proxy Authentication Required 407-status407 :: Status-status407 = Status 407 "Proxy Authentication Required"---- | Proxy Authentication Required 407-proxyAuthenticationRequired407 :: Status-proxyAuthenticationRequired407 = status407---- | Proxy Authentication Required 407-statusProxyAuthenticationRequired :: Status-statusProxyAuthenticationRequired = status407-{-# DEPRECATED statusProxyAuthenticationRequired "Deprecated" #-}---- | Request Timeout 408-status408 :: Status-status408 = Status 408 "Request Timeout"---- | Request Timeout 408-requestTimeout408 :: Status-requestTimeout408 = status408---- | Request Timeout 408 (DEPRECATED)-statusRequestTimeout :: Status-statusRequestTimeout = status408-{-# DEPRECATED statusRequestTimeout "Deprecated" #-}---- | Conflict 409-status409 :: Status-status409 = Status 409 "Conflict"---- | Conflict 409-conflict409 :: Status-conflict409 = status409---- | Conflict 409 (DEPRECATED)-statusConflict :: Status-statusConflict = status409-{-# DEPRECATED statusConflict "Deprecated" #-}---- | Gone 410-status410 :: Status-status410 = Status 410 "Gone"---- | Gone 410-gone410 :: Status-gone410 = status410---- | Gone 410 (DEPRECATED)-statusGone :: Status-statusGone = status410-{-# DEPRECATED #-}---- | Length Required 411-status411 :: Status-status411 = Status 411 "Length Required"---- | Length Required 411-lengthRequired411 :: Status-lengthRequired411 = status411---- | Length Required 411 (DEPRECATED)-statusLengthRequired :: Status-statusLengthRequired = status411-{-# DEPRECATED statusLengthRequired "Deprecated" #-}---- | Precondition Failed 412-status412 :: Status-status412 = Status 412 "Precondition Failed"---- | Precondition Failed 412-preconditionFailed412 :: Status-preconditionFailed412 = status412---- | Precondition Failed 412 (DEPRECATED)-statusPreconditionFailed :: Status-statusPreconditionFailed = status412-{-# DEPRECATED statusPreconditionFailed "Deprecated" #-}---- | Request Entity Too Large 413-status413 :: Status-status413 = Status 413 "Request Entity Too Large"---- | Request Entity Too Large 413-requestEntityTooLarge413 :: Status-requestEntityTooLarge413 = status413---- | Request Entity Too Large 413 (DEPRECATED)-statusRequestEntityTooLarge :: Status-statusRequestEntityTooLarge = status413-{-# DEPRECATED statusRequestEntityTooLarge "Deprecated" #-}---- | Request-URI Too Long 414-status414 :: Status-status414 = Status 414 "Request-URI Too Long"---- | Request-URI Too Long 414-requestURITooLong414 :: Status-requestURITooLong414 = status414---- | Request-URI Too Long 414 (DEPRECATED)-statusRequestURITooLong :: Status-statusRequestURITooLong = status414-{-# DEPRECATED statusRequestURITooLong "Deprecated" #-}---- | Unsupported Media Type 415-status415 :: Status-status415 = Status 415 "Unsupported Media Type"---- | Unsupported Media Type 415-unsupportedMediaType415 :: Status-unsupportedMediaType415 = status415---- | Unsupported Media Type 415 (DEPRECATED)-statusUnsupportedMediaType :: Status-statusUnsupportedMediaType = status415-{-# DEPRECATED statusUnsupportedMediaType "Deprecated" #-}---- | Requested Range Not Satisfiable 416-status416 :: Status-status416 = Status 416 "Requested Range Not Satisfiable"---- | Requested Range Not Satisfiable 416-requestedRangeNotSatisfiable416 :: Status-requestedRangeNotSatisfiable416 = status416---- | Requested Range Not Satisfiable 416 (DEPRECATED)-statusRequestedRangeNotSatisfiable :: Status-statusRequestedRangeNotSatisfiable = status416-{-# DEPRECATED statusRequestedRangeNotSatisfiable "Deprecated" #-}---- | Expectation Failed 417-status417 :: Status-status417 = Status 417 "Expectation Failed"---- | Expectation Failed 417-expectationFailed417 :: Status-expectationFailed417 = status417---- | Expectation Failed 417 (DEPRECATED)-statusExpectationFailed :: Status-statusExpectationFailed = status417-{-# DEPRECATED statusExpectationFailed "Deprecated" #-}---- | I'm a teapot 418-status418 :: Status-status418 = Status 418 "I'm a teapot"---- | I'm a teapot 418-imATeaPot418 :: Status-imATeaPot418 = status418---- | I'm a teapot 418 (DEPRECATED)-statusImATeapot :: Status-statusImATeapot = status418-{-# DEPRECATED statusImATeapot "Deprecated" #-}---- | Internal Server Error 500-status500 :: Status-status500 = Status 500 "Internal Server Error"---- | Internal Server Error 500-internalServerError500 :: Status-internalServerError500 = status500---- | Internal Server Error 500 (DEPRECATED)-statusServerError :: Status-statusServerError = status500-{-# DEPRECATED statusServerError "Deprecated" #-}---- | Not Implemented 501-status501 :: Status-status501 = Status 501 "Not Implemented"---- | Not Implemented 501-notImplemented501 :: Status-notImplemented501 = status501---- | Not Implemented 501 (DEPRECATED)-statusNotImplemented :: Status-statusNotImplemented = status501-{-# DEPRECATED statusNotImplemented "Deprecated" #-}---- | Bad Gateway 502-status502 :: Status-status502 = Status 502 "Bad Gateway"---- | Bad Gateway 502-badGateway502 :: Status-badGateway502 = status502---- | Bad Gateway 502 (DEPRECATED)-statusBadGateway :: Status-statusBadGateway = status502-{-# DEPRECATED statusBadGateway "Deprecated" #-}---- | Service Unavailable 503-status503 :: Status-status503 = Status 503 "Service Unavailable"---- | Service Unavailable 503-serviceUnavailable503 :: Status-serviceUnavailable503 = status503---- | Service Unavailable 503 (DEPRECATED)-statusServiceUnavailable :: Status-statusServiceUnavailable = status503-{-# DEPRECATED statusServiceUnavailable "Deprecated" #-}---- | Gateway Timeout 504-status504 :: Status-status504 = Status 504 "Gateway Timeout"---- | Gateway Timeout 504-gatewayTimeout504 :: Status-gatewayTimeout504 = status504---- | Gateway Timeout 504 (DEPRECATED)-statusGatewayTimeout :: Status-statusGatewayTimeout = status504-{-# DEPRECATED statusGatewayTimeout "Deprecated" #-}---- | HTTP Version Not Supported 505-status505 :: Status-status505 = Status 505 "HTTP Version Not Supported"---- | HTTP Version Not Supported 505-httpVersionNotSupported505 :: Status-httpVersionNotSupported505 = status505---- | HTTP Version Not Supported 505 (DEPRECATED)-statusHTTPVersionNotSupported :: Status-statusHTTPVersionNotSupported = status505-{-# DEPRECATED statusHTTPVersionNotSupported "Deprecated" #-}---- | Header-type Header = (CI.CI Ascii, Ascii)---- | Request Headers-type RequestHeaders = [Header]---- | Response Headers-type ResponseHeaders = [Header]---- | HTTP Headers-headerAccept, headerAuthorization, headerCacheControl, headerConnection, headerContentLength, headerContentType, headerContentMD5, headerDate :: Ascii -> Header-headerAccept        = (,) "Accept"-headerAuthorization = (,) "Authorization"-headerCacheControl  = (,) "Cache-Control"-headerConnection    = (,) "Connection"-headerContentLength = (,) "Content-Length"-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]--type QueryText = [(Text, Maybe Text)]--queryTextToQuery :: QueryText -> Query-queryTextToQuery = map $ encodeUtf8 *** fmap encodeUtf8--renderQueryText :: Bool -- ^ prepend a question mark?-                -> QueryText-                -> Blaze.Builder-renderQueryText b = renderQueryBuilder b . queryTextToQuery--queryToQueryText :: Query -> QueryText-queryToQueryText =-    map $ go *** fmap go-  where-    go = decodeUtf8With lenientDecode--parseQueryText :: B.ByteString -> QueryText-parseQueryText = queryToQueryText . parseQuery---- | Simplified Query item type without support for parameter-less items.-type SimpleQueryItem = (B.ByteString, B.ByteString)---- | Simplified Query type without support for parameter-less items.-type SimpleQuery = [SimpleQueryItem]---- | Convert 'SimpleQuery' to 'Query'.-simpleQueryToQuery :: SimpleQuery -> Query-simpleQueryToQuery = map (\(a, b) -> (a, Just b))--renderQueryBuilder :: Bool -- ^ prepend a question mark?-                   -> Query-                   -> Blaze.Builder-renderQueryBuilder _ [] = mempty--- FIXME replace mconcat + map with foldr-renderQueryBuilder qmark' (p:ps) = mconcat-    $ go (if qmark' then qmark else mempty) p-    : map (go amp) ps-  where-    qmark = Blaze.copyByteString "?"-    amp = Blaze.copyByteString "&"-    equal = Blaze.copyByteString "="-    go sep (k, mv) = mconcat [-                      sep-                     , urlEncodeBuilder True k-                     , case mv of-                         Nothing -> mempty-                         Just v -> equal `mappend` urlEncodeBuilder True v-                     ]---- | Convert 'Query' to 'ByteString'.-renderQuery :: Bool -- ^ prepend question mark?-            -> Query -> Ascii-renderQuery qm = Blaze.toByteString . renderQueryBuilder qm---- | Convert 'SimpleQuery' to 'ByteString'.-renderSimpleQuery :: Bool -- ^ prepend question mark?-                  -> SimpleQuery -> Ascii-renderSimpleQuery useQuestionMark = renderQuery useQuestionMark . simpleQueryToQuery---- | Split out the query string into a list of keys and values. A few--- importants points:------ * The result returned is still bytestrings, since we perform no character--- decoding here. Most likely, you will want to use UTF-8 decoding, but this is--- left to the user of the library.------ * Percent decoding errors are ignored. In particular, "%Q" will be output as--- "%Q".-parseQuery :: B.ByteString -> Query-parseQuery = parseQueryString' . dropQuestion-  where-    dropQuestion q =-        case B.uncons q of-            Just (63, q') -> q'-            _ -> q-    parseQueryString' q | B.null q = []-    parseQueryString' q =-        let (x, xs) = breakDiscard queryStringSeparators q-         in parsePair x : parseQueryString' xs-      where-        parsePair x =-            let (k, v) = B.breakByte 61 x -- equal sign-                v'' =-                    case B.uncons v of-                        Just (_, v') -> Just $ urlDecode True v'-                        _ -> Nothing-             in (urlDecode True k, v'')--queryStringSeparators :: B.ByteString-queryStringSeparators = B.pack [38,59] -- ampersand, semicolon---- | Break the second bytestring at the first occurence of any bytes from--- the first bytestring, discarding that byte.-breakDiscard :: B.ByteString -> B.ByteString -> (B.ByteString, B.ByteString)-breakDiscard seps s =-    let (x, y) = B.break (`B.elem` seps) s-     in (x, B.drop 1 y)---- | Parse 'SimpleQuery' from a 'ByteString'.-parseSimpleQuery :: B.ByteString -> SimpleQuery-parseSimpleQuery = map (second $ fromMaybe B.empty) . parseQuery--ord8 :: Char -> Word8-ord8 = fromIntegral . ord--unreservedQS, unreservedPI :: [Word8]-unreservedQS = map ord8 "-_.~"-unreservedPI = map ord8 "-_.~:@&=+$,"---- | Percent-encoding for URLs.-urlEncodeBuilder' :: [Word8] -> B.ByteString -> Blaze.Builder-urlEncodeBuilder' extraUnreserved = mconcat . map encodeChar . B.unpack-    where-      encodeChar ch | unreserved ch = Blaze.fromWord8 ch-                    | otherwise     = h2 ch-      -      unreserved ch | ch >= 65 && ch <= 90  = True -- A-Z-                    | ch >= 97 && ch <= 122 = True -- a-z-                    | ch >= 48 && ch <= 57  = True -- 0-9-      unreserved c = c `elem` extraUnreserved-      -      h2 v = let (a, b) = v `divMod` 16 in Blaze.fromWord8s [37, h a, h b] -- percent (%)-      h i | i < 10    = 48 + i -- zero (0)-          | otherwise = 65 + i - 10 -- 65: A--urlEncodeBuilder-    :: Bool -- ^ Whether input is in query string. True: Query string, False: Path element-    -> B.ByteString-    -> Blaze.Builder-urlEncodeBuilder True  = urlEncodeBuilder' unreservedQS-urlEncodeBuilder False = urlEncodeBuilder' unreservedPI--urlEncode :: Bool -> B.ByteString -> Ascii-urlEncode q = Blaze.toByteString . urlEncodeBuilder q---- | Percent-decoding.-urlDecode :: Bool -- ^ Whether to decode '+' to ' '-          -> B.ByteString -> B.ByteString-urlDecode replacePlus z = fst $ B.unfoldrN (B.length z) go z-  where-    go bs =-        case B.uncons bs of-            Nothing -> Nothing-            Just (43, ws) | replacePlus -> Just (32, ws) -- plus to space-            Just (37, ws) -> Just $ fromMaybe (37, ws) $ do -- percent-                (x, xs) <- B.uncons ws-                x' <- hexVal x-                (y, ys) <- B.uncons xs-                y' <- hexVal y-                Just $ (combine x' y', ys)-            Just (w, ws) -> Just (w, ws)-    hexVal w-        | 48 <= w && w <= 57  = Just $ w - 48 -- 0 - 9-        | 65 <= w && w <= 70  = Just $ w - 55 -- A - F-        | 97 <= w && w <= 102 = Just $ w - 87 -- a - f-        | otherwise = Nothing-    combine :: Word8 -> Word8 -> Word8-    combine a b = shiftL a 4 .|. b---- | Encodes a list of path segments into a valid URL fragment.------ This function takes the following three steps:------ * UTF-8 encodes the characters.------ * Performs percent encoding on all unreserved characters, as well as \:\@\=\+\$,------ * Prepends each segment with a slash.------ For example:------ > encodePathSegments [\"foo\", \"bar\", \"baz\"]------ \"\/foo\/bar\/baz\"------ > encodePathSegments [\"foo bar\", \"baz\/bin\"]------ \"\/foo\%20bar\/baz\%2Fbin\"------ > encodePathSegments [\"שלום\"]------ \"\/%D7%A9%D7%9C%D7%95%D7%9D\"------ Huge thanks to Jeremy Shaw who created the original implementation of this--- function in web-routes and did such thorough research to determine all--- correct escaping procedures.-encodePathSegments :: [Text] -> Blaze.Builder-encodePathSegments [] = mempty-encodePathSegments (x:xs) =-    Blaze.copyByteString "/"-    `mappend` encodePathSegment x-    `mappend` encodePathSegments xs---- | Like encodePathSegments, but without the initial slash.-encodePathSegmentsRelative :: [Text] -> Blaze.Builder-encodePathSegmentsRelative xs = mconcat $ intersperse (Blaze.copyByteString "/") (map encodePathSegment xs)--encodePathSegment :: Text -> Blaze.Builder-encodePathSegment = urlEncodeBuilder False . encodeUtf8--decodePathSegments :: B.ByteString -> [Text]-decodePathSegments "" = []-decodePathSegments "/" = []-decodePathSegments a =-    go $ drop1Slash a-  where-    drop1Slash bs =-        case B.uncons bs of-            Just (47, bs') -> bs' -- 47 == /-            _ -> bs-    go bs =-        let (x, y) = B.breakByte 47 bs-         in decodePathSegment x :-            if B.null y-                then []-                else go $ B.drop 1 y--decodePathSegment :: B.ByteString -> Text-decodePathSegment = decodeUtf8With lenientDecode . urlDecode False--encodePath :: [Text] -> Query -> Blaze.Builder-encodePath x [] = encodePathSegments x-encodePath x y = encodePathSegments x `mappend` renderQueryBuilder True y--decodePath :: B.ByteString -> ([Text], Query)-decodePath b =-    let (x, y) = B.breakByte 63 b -- question mark-    in (decodePathSegments x, parseQuery y)+module Network.HTTP.Types (+    -- * Methods++    -- | __For more information__: "Network.HTTP.Types.Method"++    Method,++    -- ** Constants+    methodGet,+    methodPost,+    methodHead,+    methodPut,+    methodDelete,+    methodTrace,+    methodConnect,+    methodOptions,+    methodPatch,+    StdMethod (..),++    -- ** Parsing and redering methods+    parseMethod,+    renderMethod,+    renderStdMethod,++    -- * Versions++    -- | __For more information__: "Network.HTTP.Types.Version"++    HttpVersion (..),+    http09,+    http10,+    http11,+    http20,+    http30,++    -- * Status++    -- | __For more information__: "Network.HTTP.Types.Status"++    Status (..),++    -- ** Constants+    mkStatus,+    status100,+    continue100,+    status101,+    switchingProtocols101,+    status200,+    ok200,+    status201,+    created201,+    status202,+    accepted202,+    status203,+    nonAuthoritative203,+    status204,+    noContent204,+    status205,+    resetContent205,+    status206,+    partialContent206,+    status300,+    multipleChoices300,+    status301,+    movedPermanently301,+    status302,+    found302,+    status303,+    seeOther303,+    status304,+    notModified304,+    status305,+    useProxy305,+    status307,+    temporaryRedirect307,+    status308,+    permanentRedirect308,+    status400,+    badRequest400,+    status401,+    unauthorized401,+    status402,+    paymentRequired402,+    status403,+    forbidden403,+    status404,+    notFound404,+    status405,+    methodNotAllowed405,+    status406,+    notAcceptable406,+    status407,+    proxyAuthenticationRequired407,+    status408,+    requestTimeout408,+    status409,+    conflict409,+    status410,+    gone410,+    status411,+    lengthRequired411,+    status412,+    preconditionFailed412,+    status413,+    requestEntityTooLarge413,+    status414,+    requestURITooLong414,+    status415,+    unsupportedMediaType415,+    status416,+    requestedRangeNotSatisfiable416,+    status417,+    expectationFailed417,+    status418,+    imATeapot418,+    status422,+    unprocessableEntity422,+    status426,+    upgradeRequired426,+    status428,+    preconditionRequired428,+    status429,+    tooManyRequests429,+    status431,+    requestHeaderFieldsTooLarge431,+    status451,+    unavailableForLegalReasons451,+    status500,+    internalServerError500,+    status501,+    notImplemented501,+    status502,+    badGateway502,+    status503,+    serviceUnavailable503,+    status504,+    gatewayTimeout504,+    status505,+    httpVersionNotSupported505,+    status511,+    networkAuthenticationRequired511,+    statusIsInformational,+    statusIsSuccessful,+    statusIsRedirection,+    statusIsClientError,+    statusIsServerError,++    -- * Headers++    -- | __For more information__: "Network.HTTP.Types.Header"++    -- ** Types+    Header,+    HeaderName,+    RequestHeaders,+    ResponseHeaders,++    -- ** Header constants+    hAccept,+    hAcceptCharset,+    hAcceptEncoding,+    hAcceptLanguage,+    hAcceptRanges,+    hAge,+    hAllow,+    hAuthorization,+    hCacheControl,+    hConnection,+    hContentDisposition,+    hContentEncoding,+    hContentLanguage,+    hContentLength,+    hContentLocation,+    hContentMD5,+    hContentRange,+    hContentType,+    hCookie,+    hDate,+    hETag,+    hExpect,+    hExpires,+    hFrom,+    hHost,+    hIfMatch,+    hIfModifiedSince,+    hIfNoneMatch,+    hIfRange,+    hIfUnmodifiedSince,+    hLastModified,+    hLocation,+    hMaxForwards,+    hMIMEVersion,+    hOrigin,+    hPragma,+    hPrefer,+    hPreferenceApplied,+    hProxyAuthenticate,+    hProxyAuthorization,+    hRange,+    hReferer,+    hRetryAfter,+    hServer,+    hSetCookie,+    hTE,+    hTrailer,+    hTransferEncoding,+    hUpgrade,+    hUserAgent,+    hVary,+    hVia,+    hWWWAuthenticate,+    hWarning,++    -- ** Byte ranges+    ByteRange (..),+    renderByteRangeBuilder,+    renderByteRange,+    ByteRanges,+    renderByteRangesBuilder,+    renderByteRanges,+    parseByteRanges,++    -- * URI++    -- | __For more extensive information__: "Network.HTTP.Types.URI"++    -- ** Query strings++    -- *** Query+    Query,+    QueryItem,+    renderQuery,+    renderQueryBuilder,+    parseQuery,+    parseQueryReplacePlus,++    -- *** Text query string (UTF8 encoded)+    QueryText,+    queryTextToQuery,+    queryToQueryText,+    renderQueryText,+    parseQueryText,++    -- *** SimpleQuery+    SimpleQuery,+    SimpleQueryItem,+    simpleQueryToQuery,+    renderSimpleQuery,+    parseSimpleQuery,++    -- *** PartialEscapeQuery+    PartialEscapeQuery,+    PartialEscapeQueryItem,+    EscapeItem (..),+    renderQueryPartialEscape,+    renderQueryBuilderPartialEscape,++    -- ** Generalized query types+    QueryLike (..),+    QueryKeyLike (..),+    QueryValueLike (..),++    -- ** Path++    -- *** Segments + Query String+    extractPath,+    encodePath,+    decodePath,++    -- *** Path Segments+    encodePathSegments,+    encodePathSegmentsRelative,+    decodePathSegments,++    -- ** URL encoding / decoding+    urlEncode,+    urlEncodeBuilder,+    urlDecode,+)+where++import Network.HTTP.Types.Header+import Network.HTTP.Types.Method+import Network.HTTP.Types.QueryLike+import Network.HTTP.Types.Status+import Network.HTTP.Types.URI+import Network.HTTP.Types.Version

@@ -0,0 +1,565 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Type and constants for handling HTTP header fields.+--+-- At the bottom are also some functions to handle certain header field values.+module Network.HTTP.Types.Header (+    -- * HTTP Headers+    Header,+    HeaderName,+    RequestHeaders,+    ResponseHeaders,++    -- ** Common headers++    -- | The following header constants are provided for convenience,+    -- to prevent accidental spelling errors.+    hAccept,+    hAcceptCharset,+    hAcceptEncoding,+    hAcceptLanguage,+    hAcceptRanges,+    hAge,+    hAllow,+    hAuthorization,+    hCacheControl,+    hConnection,+    hContentDisposition,+    hContentEncoding,+    hContentLanguage,+    hContentLength,+    hContentLocation,+    hContentMD5,+    hContentRange,+    hContentType,+    hCookie,+    hDate,+    hETag,+    hExpect,+    hExpires,+    hFrom,+    hHost,+    hIfMatch,+    hIfModifiedSince,+    hIfNoneMatch,+    hIfRange,+    hIfUnmodifiedSince,+    hLastModified,+    hLocation,+    hMaxForwards,+    hMIMEVersion,+    hOrigin,+    hPragma,+    hPrefer,+    hPreferenceApplied,+    hProxyAuthenticate,+    hProxyAuthorization,+    hRange,+    hReferer,+    hRetryAfter,+    hServer,+    hSetCookie,+    hTE,+    hTrailer,+    hTransferEncoding,+    hUpgrade,+    hUserAgent,+    hVary,+    hVia,+    hWWWAuthenticate,+    hWarning,++    -- ** Byte ranges++    -- | Convenience functions and types to handle values from Range headers.+    --+    -- https://www.rfc-editor.org/rfc/rfc9110.html#name-byte-ranges+    ByteRange (..),+    renderByteRangeBuilder,+    renderByteRange,+    ByteRanges,+    renderByteRangesBuilder,+    renderByteRanges,+    parseByteRanges,+)+where++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)+import GHC.Generics (Generic)++-- | A full HTTP header field with the name and value separated.+--+-- E.g. @\"Content-Length: 28\"@ parsed into a 'Header' would turn into @("Content-Length", "28")@+type Header = (HeaderName, B.ByteString)++-- | A case-insensitive name of a header field.+--+-- This is the part of the header field before the colon: @HeaderName: some value@+type HeaderName = CI.CI B.ByteString++-- | A list of 'Header's.+--+-- Same type as 'ResponseHeaders', but useful to differentiate in type signatures.+type RequestHeaders = [Header]++-- | A list of 'Header's.+--+-- Same type as 'RequestHeaders', but useful to differentiate in type signatures.+type ResponseHeaders = [Header]++-- | [Accept](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept)+--+-- @since 0.7.0+hAccept :: HeaderName+hAccept = "Accept"++-- | [Accept-Charset](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept-charset)+--+-- @since 0.9+hAcceptCharset :: HeaderName+hAcceptCharset = "Accept-Charset"++-- | [Accept-Encoding](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept-encoding)+--+-- @since 0.9+hAcceptEncoding :: HeaderName+hAcceptEncoding = "Accept-Encoding"++-- | [Accept-Language](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept-language)+--+-- @since 0.7.0+hAcceptLanguage :: HeaderName+hAcceptLanguage = "Accept-Language"++-- | [Accept-Ranges](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept-ranges)+--+-- @since 0.9+hAcceptRanges :: HeaderName+hAcceptRanges = "Accept-Ranges"++-- | [Age](https://www.rfc-editor.org/rfc/rfc9111.html#name-age)+--+-- @since 0.9+hAge :: HeaderName+hAge = "Age"++-- | [Allow](https://www.rfc-editor.org/rfc/rfc9110.html#name-allow)+--+-- @since 0.9+hAllow :: HeaderName+hAllow = "Allow"++-- | [Authorization](https://www.rfc-editor.org/rfc/rfc9110.html#name-authorization)+--+-- @since 0.7.0+hAuthorization :: HeaderName+hAuthorization = "Authorization"++-- | [Cache-Control](https://www.rfc-editor.org/rfc/rfc9111.html#name-cache-control)+--+-- @since 0.7.0+hCacheControl :: HeaderName+hCacheControl = "Cache-Control"++-- | [Connection](https://www.rfc-editor.org/rfc/rfc9110.html#name-connection)+--+-- @since 0.7.0+hConnection :: HeaderName+hConnection = "Connection"++-- | [Content-Encoding](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-encoding)+--+-- @since 0.7.0+hContentEncoding :: HeaderName+hContentEncoding = "Content-Encoding"++-- | [Content-Language](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-language)+--+-- @since 0.9+hContentLanguage :: HeaderName+hContentLanguage = "Content-Language"++-- | [Content-Length](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-length)+--+-- @since 0.7.0+hContentLength :: HeaderName+hContentLength = "Content-Length"++-- | [Content-Location](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-location)+--+-- @since 0.9+hContentLocation :: HeaderName+hContentLocation = "Content-Location"++-- | [Content-MD5](https://www.rfc-editor.org/rfc/rfc2616.html#section-14.15)+--+-- /This header has been obsoleted in RFC 9110./+--+-- @since 0.7.0+hContentMD5 :: HeaderName+hContentMD5 = "Content-MD5"++-- | [Content-Range](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-range)+--+-- @since 0.9+hContentRange :: HeaderName+hContentRange = "Content-Range"++-- | [Content-Type](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-type)+--+-- @since 0.7.0+hContentType :: HeaderName+hContentType = "Content-Type"++-- | [Date](https://www.rfc-editor.org/rfc/rfc9110.html#name-date)+--+-- @since 0.7.0+hDate :: HeaderName+hDate = "Date"++-- | [ETag](https://www.rfc-editor.org/rfc/rfc9110.html#name-etag)+--+-- @since 0.9+hETag :: HeaderName+hETag = "ETag"++-- | [Expect](https://www.rfc-editor.org/rfc/rfc9110.html#name-expect)+--+-- @since 0.9+hExpect :: HeaderName+hExpect = "Expect"++-- | [Expires](https://www.rfc-editor.org/rfc/rfc9111.html#name-expires)+--+-- @since 0.9+hExpires :: HeaderName+hExpires = "Expires"++-- | [From](https://www.rfc-editor.org/rfc/rfc9110.html#name-from)+--+-- @since 0.9+hFrom :: HeaderName+hFrom = "From"++-- | [Host](https://www.rfc-editor.org/rfc/rfc9110.html#name-host-and-authority)+--+-- @since 0.9+hHost :: HeaderName+hHost = "Host"++-- | [If-Match](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-match)+--+-- @since 0.9+hIfMatch :: HeaderName+hIfMatch = "If-Match"++-- | [If-Modified-Since](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-modified-since)+--+-- @since 0.7.0+hIfModifiedSince :: HeaderName+hIfModifiedSince = "If-Modified-Since"++-- | [If-None-Match](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-none-match)+--+-- @since 0.9+hIfNoneMatch :: HeaderName+hIfNoneMatch = "If-None-Match"++-- | [If-Range](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-range)+--+-- @since 0.7.0+hIfRange :: HeaderName+hIfRange = "If-Range"++-- | [If-Unmodified-Since](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-unmodified-since)+--+-- @since 0.9+hIfUnmodifiedSince :: HeaderName+hIfUnmodifiedSince = "If-Unmodified-Since"++-- | [Last-Modified](https://www.rfc-editor.org/rfc/rfc9110.html#name-last-modified)+--+-- @since 0.7.0+hLastModified :: HeaderName+hLastModified = "Last-Modified"++-- | [Location](https://www.rfc-editor.org/rfc/rfc9110.html#name-location)+--+-- @since 0.7.1+hLocation :: HeaderName+hLocation = "Location"++-- | [Max-Forwards](https://www.rfc-editor.org/rfc/rfc9110.html#name-max-forwards)+--+-- @since 0.9+hMaxForwards :: HeaderName+hMaxForwards = "Max-Forwards"++-- | [Pragma](https://www.rfc-editor.org/rfc/rfc9111.html#name-pragma)+--+-- /This header has been deprecated in RFC 9111 in favor of "Cache-Control"./+--+-- @since 0.9+hPragma :: HeaderName+hPragma = "Pragma"++-- | [Proxy-Authenticate](https://www.rfc-editor.org/rfc/rfc9110.html#name-proxy-authenticate)+--+-- @since 0.9+hProxyAuthenticate :: HeaderName+hProxyAuthenticate = "Proxy-Authenticate"++-- | [Proxy-Authorization](https://www.rfc-editor.org/rfc/rfc9110.html#name-proxy-authorization)+--+-- @since 0.9+hProxyAuthorization :: HeaderName+hProxyAuthorization = "Proxy-Authorization"++-- | [Range](https://www.rfc-editor.org/rfc/rfc9110.html#name-range)+--+-- @since 0.7.0+hRange :: HeaderName+hRange = "Range"++-- | [Referer](https://www.rfc-editor.org/rfc/rfc9110.html#name-referer)+--+-- @since 0.7.0+hReferer :: HeaderName+hReferer = "Referer"++-- | [Retry-After](https://www.rfc-editor.org/rfc/rfc9110.html#name-retry-after)+--+-- @since 0.9+hRetryAfter :: HeaderName+hRetryAfter = "Retry-After"++-- | [Server](https://www.rfc-editor.org/rfc/rfc9110.html#name-server)+--+-- @since 0.7.1+hServer :: HeaderName+hServer = "Server"++-- | [TE](https://www.rfc-editor.org/rfc/rfc9110.html#name-te)+--+-- @since 0.9+hTE :: HeaderName+hTE = "TE"++-- | [Trailer](https://www.rfc-editor.org/rfc/rfc9110.html#name-trailer)+--+-- @since 0.9+hTrailer :: HeaderName+hTrailer = "Trailer"++-- | [Transfer-Encoding](https://www.rfc-editor.org/rfc/rfc9112#name-transfer-encoding)+--+-- @since 0.9+hTransferEncoding :: HeaderName+hTransferEncoding = "Transfer-Encoding"++-- | [Upgrade](https://www.rfc-editor.org/rfc/rfc9110.html#name-upgrade)+--+-- @since 0.9+hUpgrade :: HeaderName+hUpgrade = "Upgrade"++-- | [User-Agent](https://www.rfc-editor.org/rfc/rfc9110.html#name-user-agent)+--+-- @since 0.7.0+hUserAgent :: HeaderName+hUserAgent = "User-Agent"++-- | [Vary](https://www.rfc-editor.org/rfc/rfc9110.html#name-vary)+--+-- @since 0.9+hVary :: HeaderName+hVary = "Vary"++-- | [Via](https://www.rfc-editor.org/rfc/rfc9110.html#name-via)+--+-- @since 0.9+hVia :: HeaderName+hVia = "Via"++-- | [WWW-Authenticate](https://www.rfc-editor.org/rfc/rfc9110.html#name-www-authenticate)+--+-- @since 0.9+hWWWAuthenticate :: HeaderName+hWWWAuthenticate = "WWW-Authenticate"++-- | [Warning](https://www.rfc-editor.org/rfc/rfc9111.html#name-warning)+--+-- /This header has been obsoleted in RFC 9111./+--+-- @since 0.9+hWarning :: HeaderName+hWarning = "Warning"++-- | [Content-Disposition](https://www.rfc-editor.org/rfc/rfc6266.html)+--+-- @since 0.10+hContentDisposition :: HeaderName+hContentDisposition = "Content-Disposition"++-- | [MIME-Version](https://www.rfc-editor.org/rfc/rfc2616.html#section-19.4.1)+--+-- @since 0.10+hMIMEVersion :: HeaderName+hMIMEVersion = "MIME-Version"++-- | [Cookie](https://www.rfc-editor.org/rfc/rfc6265.html#section-4.2)+--+-- @since 0.7.0+hCookie :: HeaderName+hCookie = "Cookie"++-- | [Set-Cookie](https://www.rfc-editor.org/rfc/rfc6265.html#section-4.1)+--+-- @since 0.10+hSetCookie :: HeaderName+hSetCookie = "Set-Cookie"++-- | [Origin](https://www.rfc-editor.org/rfc/rfc6454.html#section-7)+--+-- @since 0.10+hOrigin :: HeaderName+hOrigin = "Origin"++-- | [Prefer](https://www.rfc-editor.org/rfc/rfc7240.html#section-2)+--+-- @since 0.12.2+hPrefer :: HeaderName+hPrefer = "Prefer"++-- | [Preference-Applied](https://www.rfc-editor.org/rfc/rfc7240.html#section-3)+--+-- @since 0.12.2+hPreferenceApplied :: HeaderName+hPreferenceApplied = "Preference-Applied"++-- | An individual byte range. Used in @Range@ request headers.+-- This type and its accompanying functions are /NOT/ compatible with the+-- @Content-Range@ response header.+--+-- Negative indices are not allowed!+--+-- @since 0.6.11+data ByteRange+    = ByteRangeFrom !Integer+    | ByteRangeFromTo !Integer !Integer+    | ByteRangeSuffix !Integer+    deriving+        ( -- | @since 0.8.4+          Show+        , -- | @since 0.8.4+          Eq+        , -- | @since 0.8.4+          Ord+        , -- | @since 0.8.4+          Data+        , -- | @since 0.12.4+          Generic+        )++-- | Turns a byte range into a byte string 'B.Builder'.+--+-- @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++-- | Renders a byte range into a 'B.ByteString'.+--+-- >>> renderByteRange (ByteRangeFrom 2048)+-- "2048-"+--+-- @since 0.6.11+renderByteRange :: ByteRange -> B.ByteString+renderByteRange = BL.toStrict . B.toLazyByteString . renderByteRangeBuilder++-- | A list of byte ranges.+--+-- @since 0.6.11+type ByteRanges = [ByteRange]++-- | Turns a list of byte ranges into a byte string 'B.Builder'.+--+-- @since 0.6.11+renderByteRangesBuilder :: ByteRanges -> B.Builder+renderByteRangesBuilder xs =+    B.byteString "bytes="+        `mappend` mconcat (intersperse (B.char7 ',') $ map renderByteRangeBuilder xs)++-- | Renders a list of byte ranges into a 'B.ByteString'.+--+-- >>> renderByteRanges [ByteRangeFrom 2048, ByteRangeSuffix 20]+-- "bytes=2048-,-20"+--+-- @since 0.6.11+renderByteRanges :: ByteRanges -> B.ByteString+renderByteRanges = BL.toStrict . B.toLazyByteString . renderByteRangesBuilder++-- | Parse the value of a Range header into a 'ByteRanges'.+--+-- >>> parseByteRanges "error"+-- Nothing+-- >>> parseByteRanges "bytes=0-499"+-- Just [ByteRangeFromTo 0 499]+-- >>> parseByteRanges "bytes=500-999"+-- Just [ByteRangeFromTo 500 999]+-- >>> parseByteRanges "bytes=-500"+-- Just [ByteRangeSuffix 500]+-- >>> parseByteRanges "bytes=9500-"+-- Just [ByteRangeFrom 9500]+-- >>> parseByteRanges "bytes=0-0,-1"+-- Just [ByteRangeFromTo 0 0,ByteRangeSuffix 1]+-- >>> parseByteRanges "bytes=500-600,601-999"+-- Just [ByteRangeFromTo 500 600,ByteRangeFromTo 601 999]+-- >>> parseByteRanges "bytes=500-700,601-999"+-- Just [ByteRangeFromTo 500 700,ByteRangeFromTo 601 999]+--+-- @since 0.9.1+parseByteRanges :: B.ByteString -> Maybe ByteRanges+parseByteRanges bs1 = do+    bs2 <- stripPrefixB "bytes=" bs1+    (r, bs3) <- range bs2+    ranges (r :) bs3+  where+    range bs2 = do+        (i, bs3) <- B8.readInteger bs2+        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+                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+            (r, bs5) <- range bs4+            ranges (front . (r :)) bs5++stripPrefixB :: B.ByteString -> B.ByteString -> Maybe B.ByteString+#if !MIN_VERSION_bytestring(0,10,8)+-- 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+#else+stripPrefixB = B.stripPrefix+#endif

@@ -0,0 +1,152 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}++-- | Types and constants for HTTP methods.+--+-- The HTTP standard defines a set of standard methods, when to use them,+-- and how to handle them. The standard set has been provided as a separate+-- data type 'StdMethod', but since you can also use custom methods, the+-- basic type 'Method' is just a synonym for 'B.ByteString'.+module Network.HTTP.Types.Method (+    -- * HTTP methods+    Method,++    -- ** Constants+    methodGet,+    methodPost,+    methodHead,+    methodPut,+    methodDelete,+    methodTrace,+    methodConnect,+    methodOptions,+    methodPatch,++    -- ** Standard Methods++    -- | One data type that holds all standard HTTP methods.+    StdMethod (..),+    parseMethod,+    renderMethod,+    renderStdMethod,+)+where++import Control.Arrow ((|||))+import Data.Array (Array, Ix, assocs, listArray, (!))+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import Data.Data (Data)+import GHC.Generics (Generic)++-- $setup+-- >>> import Data.ByteString.Char8 (ByteString)+-- >>> import Data.Text (pack)+-- >>> import Data.Text.Encoding (encodeUtf8)+-- >>> import Test.QuickCheck+-- >>> :{+-- instance Arbitrary ByteString where+--     arbitrary = encodeUtf8 . pack <$> arbitrary+-- :}++-- | HTTP method (flat 'B.ByteString' type).+type Method = B.ByteString++-- | GET Method+methodGet :: Method+methodGet = renderStdMethod GET++-- | POST Method+methodPost :: Method+methodPost = renderStdMethod POST++-- | HEAD Method+methodHead :: Method+methodHead = renderStdMethod HEAD++-- | PUT Method+methodPut :: Method+methodPut = renderStdMethod PUT++-- | DELETE Method+methodDelete :: Method+methodDelete = renderStdMethod DELETE++-- | TRACE Method+methodTrace :: Method+methodTrace = renderStdMethod TRACE++-- | CONNECT Method+methodConnect :: Method+methodConnect = renderStdMethod CONNECT++-- | OPTIONS Method+methodOptions :: Method+methodOptions = renderStdMethod OPTIONS++-- | PATCH Method+--+-- @since 0.8.0+methodPatch :: Method+methodPatch = renderStdMethod PATCH++-- | HTTP standard method (as defined by RFC 2616, and PATCH which is defined+--   by RFC 5789).+--+-- @since 0.2.0+data StdMethod+    = GET+    | POST+    | HEAD+    | PUT+    | DELETE+    | TRACE+    | CONNECT+    | OPTIONS+    | -- | @since 0.8.0+      PATCH+    deriving+        ( Read+        , Show+        , Eq+        , Ord+        , Enum+        , Bounded+        , Ix+        , -- | @since 0.12.4+          Generic+        , -- | @since 0.12.4+          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]++-- FIXME: map (\m -> (B8.pack $ show m, m)) [minBound .. maxBound]+methodList :: [(Method, StdMethod)]+methodList = map (\(a, b) -> (b, a)) (assocs methodArray)++-- | Convert a method 'B.ByteString' to a 'StdMethod' if possible.+--+-- @since 0.2.0+parseMethod :: Method -> Either B.ByteString StdMethod+parseMethod bs = maybe (Left bs) Right $ lookup bs methodList++-- | Convert an algebraic method to a 'B.ByteString'.+--+-- prop> renderMethod (parseMethod bs) == bs+--+-- @since 0.3.0+renderMethod :: Either B.ByteString StdMethod -> Method+renderMethod = id ||| renderStdMethod++-- | Convert a 'StdMethod' to a 'B.ByteString'.+--+-- @since 0.2.0+renderStdMethod :: StdMethod -> Method+renderStdMethod m = methodArray ! m

@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleInstances #-}++-- | Some type classes to make more general functions when handling query strings.+module Network.HTTP.Types.QueryLike (+    QueryLike (..),+    QueryKeyLike (..),+    QueryValueLike (..),+)+where++import Control.Arrow ((***))+import Data.ByteString as B (ByteString, concat)+import Data.ByteString.Lazy as L (ByteString, toChunks)+import Data.Maybe (catMaybes)+import Data.Text as T (Text, pack)+import Data.Text.Encoding as T (encodeUtf8)++import Network.HTTP.Types.URI (Query)++-- | Types which can, and commonly are, converted to 'Query' are in this class.+--+-- You can use lists of simple key value pairs, with 'B.ByteString' (strict, or lazy:+-- 'L.ByteString'), 'T.Text', or 'String' as the key/value types. You can also have the value+-- type lifted into a Maybe to support keys without values; and finally it is possible to put+-- each pair into a Maybe for key-value pairs that aren't always present.+--+-- @since 0.7.0+class QueryLike a where+    -- | Convert to 'Query'.+    toQuery :: a -> Query++-- | Types which, in a Query-like key-value list, are used in the Key position.+--+-- @since 0.7.0+class QueryKeyLike a where+    toQueryKey :: a -> B.ByteString++-- | Types which, in a Query-like key-value list, are used in the Value position.+--+-- @since 0.7.0+class QueryValueLike a where+    toQueryValue :: a -> Maybe B.ByteString++instance (QueryKeyLike k, QueryValueLike v) => QueryLike [(k, v)] where+    toQuery = map (toQueryKey *** toQueryValue)++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 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 T.Text where toQueryValue = Just . T.encodeUtf8+instance QueryValueLike [Char] where toQueryValue = Just . T.encodeUtf8 . T.pack+instance QueryValueLike a => QueryValueLike (Maybe a) where+    toQueryValue mVal = mVal >>= toQueryValue

@@ -0,0 +1,842 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Types and constants to describe HTTP status codes.+--+-- At the bottom are some functions to check if a given 'Status' is from a certain category. (i.e. @1XX@, @2XX@, etc.)+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,++    -- * Common statuses+    status100,+    continue100,+    status101,+    switchingProtocols101,+    status200,+    ok200,+    status201,+    created201,+    status202,+    accepted202,+    status203,+    nonAuthoritative203,+    status204,+    noContent204,+    status205,+    resetContent205,+    status206,+    partialContent206,+    status300,+    multipleChoices300,+    status301,+    movedPermanently301,+    status302,+    found302,+    status303,+    seeOther303,+    status304,+    notModified304,+    status305,+    useProxy305,+    status307,+    temporaryRedirect307,+    status308,+    permanentRedirect308,+    status400,+    badRequest400,+    status401,+    unauthorized401,+    status402,+    paymentRequired402,+    status403,+    forbidden403,+    status404,+    notFound404,+    status405,+    methodNotAllowed405,+    status406,+    notAcceptable406,+    status407,+    proxyAuthenticationRequired407,+    status408,+    requestTimeout408,+    status409,+    conflict409,+    status410,+    gone410,+    status411,+    lengthRequired411,+    status412,+    preconditionFailed412,+    status413,+    requestEntityTooLarge413,+    status414,+    requestURITooLong414,+    status415,+    unsupportedMediaType415,+    status416,+    requestedRangeNotSatisfiable416,+    status417,+    expectationFailed417,+    status418,+    imATeapot418,+    status422,+    unprocessableEntity422,+    status426,+    upgradeRequired426,+    status428,+    preconditionRequired428,+    status429,+    tooManyRequests429,+    status431,+    requestHeaderFieldsTooLarge431,+    status451,+    unavailableForLegalReasons451,+    status500,+    internalServerError500,+    status501,+    notImplemented501,+    status502,+    badGateway502,+    status503,+    serviceUnavailable503,+    status504,+    gatewayTimeout504,+    status505,+    httpVersionNotSupported505,+    status511,+    networkAuthenticationRequired511,++    -- * Checking status code category+    statusIsInformational,+    statusIsSuccessful,+    statusIsRedirection,+    statusIsClientError,+    statusIsServerError,+) where++import Data.ByteString as B (ByteString, empty)+import Data.Data (Data)+import GHC.Generics (Generic)++-- | HTTP Status.+--+-- Only the 'statusCode' is used for comparisons.+--+-- /Please use 'mkStatus' to create status codes from code and message, or the 'Enum' instance or the/+-- /status code constants (like 'ok200'). There might be additional record members in the future./+--+-- Note that the 'Show' instance is only for debugging.+data Status = Status+    { statusCode :: Int+    -- ^ The 3-digit code of a 'Status'+    --+    -- For example: "200" in a @200 OK@ status+    , statusMessage :: B.ByteString+    -- ^ The textual message of a 'Status'+    --+    -- For example: "Not Found" in a @404 Not Found@ status+    }+    deriving+        ( Show+        , -- | @since 0.12.4+          Data+        , -- | @since 0.12.4+          Generic+        )++-- FIXME: If the data constructor of 'Status' is ever deprecated, we should define+-- a pattern synonym to minimize any breakage. This also involves changing the+-- 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++-- | 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++-- | 'Status'es are ordered according to their status codes only.+instance Ord Status where+    compare Status{statusCode = a} Status{statusCode = b} = a `compare` b++-- | 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@+--+-- The statuses not included in this library will have an empty message.+--+-- @since 0.7.3+instance Enum Status where+    fromEnum = statusCode+    toEnum 100 = status100+    toEnum 101 = status101+    toEnum 200 = status200+    toEnum 201 = status201+    toEnum 202 = status202+    toEnum 203 = status203+    toEnum 204 = status204+    toEnum 205 = status205+    toEnum 206 = status206+    toEnum 300 = status300+    toEnum 301 = status301+    toEnum 302 = status302+    toEnum 303 = status303+    toEnum 304 = status304+    toEnum 305 = status305+    toEnum 307 = status307+    toEnum 308 = status308+    toEnum 400 = status400+    toEnum 401 = status401+    toEnum 402 = status402+    toEnum 403 = status403+    toEnum 404 = status404+    toEnum 405 = status405+    toEnum 406 = status406+    toEnum 407 = status407+    toEnum 408 = status408+    toEnum 409 = status409+    toEnum 410 = status410+    toEnum 411 = status411+    toEnum 412 = status412+    toEnum 413 = status413+    toEnum 414 = status414+    toEnum 415 = status415+    toEnum 416 = status416+    toEnum 417 = status417+    toEnum 418 = status418+    toEnum 422 = status422+    toEnum 426 = status426+    toEnum 428 = status428+    toEnum 429 = status429+    toEnum 431 = status431+    toEnum 451 = status451+    toEnum 500 = status500+    toEnum 501 = status501+    toEnum 502 = status502+    toEnum 503 = status503+    toEnum 504 = status504+    toEnum 505 = status505+    toEnum 511 = status511+    toEnum c = mkStatus c B.empty++-- | @since 0.11+instance Bounded Status where+    minBound = status100+    maxBound = status511++-- | Create a 'Status' from a status code and message.+--+-- @since 0.7.3+mkStatus :: Int -> B.ByteString -> Status+mkStatus = Status++-- | Continue 100+--+-- @since 0.6.6+status100 :: Status+status100 = mkStatus 100 "Continue"++-- | Continue 100+--+-- @since 0.6.6+continue100 :: Status+continue100 = status100++-- | Switching Protocols 101+--+-- @since 0.6.6+status101 :: Status+status101 = mkStatus 101 "Switching Protocols"++-- | Switching Protocols 101+--+-- @since 0.6.6+switchingProtocols101 :: Status+switchingProtocols101 = status101++-- | OK 200+status200 :: Status+status200 = mkStatus 200 "OK"++-- | OK 200+ok200 :: Status+ok200 = status200++-- | Created 201+status201 :: Status+status201 = mkStatus 201 "Created"++-- | Created 201+created201 :: Status+created201 = status201++-- | Accepted 202+--+-- @since 0.6.6+status202 :: Status+status202 = mkStatus 202 "Accepted"++-- | Accepted 202+--+-- @since 0.6.6+accepted202 :: Status+accepted202 = status202++-- | Non-Authoritative Information 203+--+-- @since 0.6.6+status203 :: Status+status203 = mkStatus 203 "Non-Authoritative Information"++-- | Non-Authoritative Information 203+--+-- @since 0.6.6+nonAuthoritative203 :: Status+nonAuthoritative203 = status203++-- | No Content 204+--+-- @since 0.6.6+status204 :: Status+status204 = mkStatus 204 "No Content"++-- | No Content 204+--+-- @since 0.6.6+noContent204 :: Status+noContent204 = status204++-- | Reset Content 205+--+-- @since 0.6.6+status205 :: Status+status205 = mkStatus 205 "Reset Content"++-- | Reset Content 205+--+-- @since 0.6.6+resetContent205 :: Status+resetContent205 = status205++-- | Partial Content 206+--+-- @since 0.5.1+status206 :: Status+status206 = mkStatus 206 "Partial Content"++-- | Partial Content 206+--+-- @since 0.5.1+partialContent206 :: Status+partialContent206 = status206++-- | Multiple Choices 300+status300 :: Status+status300 = mkStatus 300 "Multiple Choices"++-- | Multiple Choices 300+multipleChoices300 :: Status+multipleChoices300 = status300++-- | Moved Permanently 301+status301 :: Status+status301 = mkStatus 301 "Moved Permanently"++-- | Moved Permanently 301+movedPermanently301 :: Status+movedPermanently301 = status301++-- | Found 302+status302 :: Status+status302 = mkStatus 302 "Found"++-- | Found 302+found302 :: Status+found302 = status302++-- | See Other 303+status303 :: Status+status303 = mkStatus 303 "See Other"++-- | See Other 303+seeOther303 :: Status+seeOther303 = status303++-- | Not Modified 304+--+-- @since 0.6.1+status304 :: Status+status304 = mkStatus 304 "Not Modified"++-- | Not Modified 304+--+-- @since 0.6.1+notModified304 :: Status+notModified304 = status304++-- | Use Proxy 305+--+-- @since 0.6.6+status305 :: Status+status305 = mkStatus 305 "Use Proxy"++-- | Use Proxy 305+--+-- @since 0.6.6+useProxy305 :: Status+useProxy305 = status305++-- | Temporary Redirect 307+--+-- @since 0.6.6+status307 :: Status+status307 = mkStatus 307 "Temporary Redirect"++-- | Temporary Redirect 307+--+-- @since 0.6.6+temporaryRedirect307 :: Status+temporaryRedirect307 = status307++-- | Permanent Redirect 308+--+-- @since 0.9+status308 :: Status+status308 = mkStatus 308 "Permanent Redirect"++-- | Permanent Redirect 308+--+-- @since 0.9+permanentRedirect308 :: Status+permanentRedirect308 = status308++-- | Bad Request 400+status400 :: Status+status400 = mkStatus 400 "Bad Request"++-- | Bad Request 400+badRequest400 :: Status+badRequest400 = status400++-- | Unauthorized 401+status401 :: Status+status401 = mkStatus 401 "Unauthorized"++-- | Unauthorized 401+unauthorized401 :: Status+unauthorized401 = status401++-- | Payment Required 402+--+-- @since 0.6.6+status402 :: Status+status402 = mkStatus 402 "Payment Required"++-- | Payment Required 402+--+-- @since 0.6.6+paymentRequired402 :: Status+paymentRequired402 = status402++-- | Forbidden 403+status403 :: Status+status403 = mkStatus 403 "Forbidden"++-- | Forbidden 403+forbidden403 :: Status+forbidden403 = status403++-- | Not Found 404+status404 :: Status+status404 = mkStatus 404 "Not Found"++-- | Not Found 404+notFound404 :: Status+notFound404 = status404++-- | Method Not Allowed 405+status405 :: Status+status405 = mkStatus 405 "Method Not Allowed"++-- | Method Not Allowed 405+methodNotAllowed405 :: Status+methodNotAllowed405 = status405++-- | Not Acceptable 406+--+-- @since 0.6.6+status406 :: Status+status406 = mkStatus 406 "Not Acceptable"++-- | Not Acceptable 406+--+-- @since 0.6.6+notAcceptable406 :: Status+notAcceptable406 = status406++-- | Proxy Authentication Required 407+--+-- @since 0.6.6+status407 :: Status+status407 = mkStatus 407 "Proxy Authentication Required"++-- | Proxy Authentication Required 407+--+-- @since 0.6.6+proxyAuthenticationRequired407 :: Status+proxyAuthenticationRequired407 = status407++-- | Request Timeout 408+--+-- @since 0.6.6+status408 :: Status+status408 = mkStatus 408 "Request Timeout"++-- | Request Timeout 408+--+-- @since 0.6.6+requestTimeout408 :: Status+requestTimeout408 = status408++-- | Conflict 409+--+-- @since 0.6.6+status409 :: Status+status409 = mkStatus 409 "Conflict"++-- | Conflict 409+--+-- @since 0.6.6+conflict409 :: Status+conflict409 = status409++-- | Gone 410+--+-- @since 0.6.6+status410 :: Status+status410 = mkStatus 410 "Gone"++-- | Gone 410+--+-- @since 0.6.6+gone410 :: Status+gone410 = status410++-- | Length Required 411+--+-- @since 0.6.6+status411 :: Status+status411 = mkStatus 411 "Length Required"++-- | Length Required 411+--+-- @since 0.6.6+lengthRequired411 :: Status+lengthRequired411 = status411++-- | Precondition Failed 412+--+-- @since 0.6.1+status412 :: Status+status412 = mkStatus 412 "Precondition Failed"++-- | Precondition Failed 412+--+-- @since 0.6.1+preconditionFailed412 :: Status+preconditionFailed412 = status412++-- | Request Entity Too Large 413+--+-- @since 0.6.6+status413 :: Status+status413 = mkStatus 413 "Request Entity Too Large"++-- | Request Entity Too Large 413+--+-- @since 0.6.6+requestEntityTooLarge413 :: Status+requestEntityTooLarge413 = status413++-- | Request-URI Too Long 414+--+-- @since 0.6.6+status414 :: Status+status414 = mkStatus 414 "Request-URI Too Long"++-- | Request-URI Too Long 414+--+-- @since 0.6.6+requestURITooLong414 :: Status+requestURITooLong414 = status414++-- | Unsupported Media Type 415+--+-- @since 0.6.6+status415 :: Status+status415 = mkStatus 415 "Unsupported Media Type"++-- | Unsupported Media Type 415+--+-- @since 0.6.6+unsupportedMediaType415 :: Status+unsupportedMediaType415 = status415++-- | Requested Range Not Satisfiable 416+--+-- @since 0.6.1+status416 :: Status+status416 = mkStatus 416 "Requested Range Not Satisfiable"++-- | Requested Range Not Satisfiable 416+--+-- @since 0.6.1+requestedRangeNotSatisfiable416 :: Status+requestedRangeNotSatisfiable416 = status416++-- | Expectation Failed 417+--+-- @since 0.6.6+status417 :: Status+status417 = mkStatus 417 "Expectation Failed"++-- | Expectation Failed 417+--+-- @since 0.6.6+expectationFailed417 :: Status+expectationFailed417 = status417++-- FIXME: RFC 7168 updates the message to "I'm a Teapot" (capital T)+-- Should we update this?++-- | I'm a teapot 418+--+-- @since 0.6.6+status418 :: Status+status418 = mkStatus 418 "I'm a teapot"++-- | I'm a teapot 418+--+-- @since 0.6.6+imATeapot418 :: Status+imATeapot418 = status418++-- | Unprocessable Entity 422+-- (<https://tools.ietf.org/html/rfc4918 RFC 4918>)+--+-- @since 0.9.1+status422 :: Status+status422 = mkStatus 422 "Unprocessable Entity"++-- | Unprocessable Entity 422+-- (<https://tools.ietf.org/html/rfc4918 RFC 4918>)+--+-- @since 0.9.1+unprocessableEntity422 :: Status+unprocessableEntity422 = status422++-- | Upgrade Required 426+-- (<https://tools.ietf.org/html/rfc7231#section-6.5.15 RFC 7231>)+--+-- @since 0.10+status426 :: Status+status426 = mkStatus 426 "Upgrade Required"++-- | Upgrade Required 426+-- (<https://tools.ietf.org/html/rfc7231#section-6.5.15 RFC 7231>)+--+-- @since 0.10+upgradeRequired426 :: Status+upgradeRequired426 = status426++-- | Precondition Required 428+-- (<https://tools.ietf.org/html/rfc6585#section-3 RFC 6585>)+--+-- @since 0.8.5+status428 :: Status+status428 = mkStatus 428 "Precondition Required"++-- | Precondition Required 428+-- (<https://tools.ietf.org/html/rfc6585#section-3 RFC 6585>)+--+-- @since 0.8.5+preconditionRequired428 :: Status+preconditionRequired428 = status428++-- | Too Many Requests 429+-- (<https://tools.ietf.org/html/rfc6585#section-4 RFC 6585>)+--+-- @since 0.8.5+status429 :: Status+status429 = mkStatus 429 "Too Many Requests"++-- | Too Many Requests 429+-- (<https://tools.ietf.org/html/rfc6585#section-4 RFC 6585>)+--+-- @since 0.8.5+tooManyRequests429 :: Status+tooManyRequests429 = status429++-- | Request Header Fields Too Large 431+-- (<https://tools.ietf.org/html/rfc6585#section-5 RFC 6585>)+--+-- @since 0.8.5+status431 :: Status+status431 = mkStatus 431 "Request Header Fields Too Large"++-- | Request Header Fields Too Large 431+-- (<https://tools.ietf.org/html/rfc6585#section-5 RFC 6585>)+--+-- @since 0.8.5+requestHeaderFieldsTooLarge431 :: Status+requestHeaderFieldsTooLarge431 = status431++-- | Unavailable For Legal Reasons 451+-- (<https://tools.ietf.org/html/rfc7725 RFC 7725>)+--+-- @since 0.12.5+status451 :: Status+status451 = mkStatus 451 "Unavailable For Legal Reasons"++-- | Unavailable For Legal Reasons 451+-- (<https://tools.ietf.org/html/rfc7725 RFC 7725>)+--+-- @since 0.12.5+unavailableForLegalReasons451 :: Status+unavailableForLegalReasons451 = status451++-- | Internal Server Error 500+status500 :: Status+status500 = mkStatus 500 "Internal Server Error"++-- | Internal Server Error 500+internalServerError500 :: Status+internalServerError500 = status500++-- | Not Implemented 501+--+-- @since 0.6.1+status501 :: Status+status501 = mkStatus 501 "Not Implemented"++-- | Not Implemented 501+--+-- @since 0.6.1+notImplemented501 :: Status+notImplemented501 = status501++-- | Bad Gateway 502+--+-- @since 0.6.6+status502 :: Status+status502 = mkStatus 502 "Bad Gateway"++-- | Bad Gateway 502+--+-- @since 0.6.6+badGateway502 :: Status+badGateway502 = status502++-- | Service Unavailable 503+--+-- @since 0.6.6+status503 :: Status+status503 = mkStatus 503 "Service Unavailable"++-- | Service Unavailable 503+--+-- @since 0.6.6+serviceUnavailable503 :: Status+serviceUnavailable503 = status503++-- | Gateway Timeout 504+--+-- @since 0.6.6+status504 :: Status+status504 = mkStatus 504 "Gateway Timeout"++-- | Gateway Timeout 504+--+-- @since 0.6.6+gatewayTimeout504 :: Status+gatewayTimeout504 = status504++-- | HTTP Version Not Supported 505+--+-- @since 0.6.6+status505 :: Status+status505 = mkStatus 505 "HTTP Version Not Supported"++-- | HTTP Version Not Supported 505+--+-- @since 0.6.6+httpVersionNotSupported505 :: Status+httpVersionNotSupported505 = status505++-- | Network Authentication Required 511+-- (<https://tools.ietf.org/html/rfc6585#section-6 RFC 6585>)+--+-- @since 0.8.5+status511 :: Status+status511 = mkStatus 511 "Network Authentication Required"++-- | Network Authentication Required 511+-- (<https://tools.ietf.org/html/rfc6585#section-6 RFC 6585>)+--+-- @since 0.8.5+networkAuthenticationRequired511 :: Status+networkAuthenticationRequired511 = status511++-- | Informational class+--+-- Checks if the status is in the 1XX range.+--+-- @since 0.8.0+statusIsInformational :: Status -> Bool+statusIsInformational (Status{statusCode = code}) = code >= 100 && code < 200++-- | 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++-- | 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++-- | 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++-- | 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

@@ -0,0 +1,566 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Query strings generally have the following form: @"key1=value1&key2=value2"@+--+-- >>> renderQuery False [("key1", Just "value1"), ("key2", Just "value2")]+-- "key1=value1&key2=value2"+--+-- But if the value of @key1@ is 'Nothing', it becomes: @key1&key2=value2@+--+-- >>> renderQuery False [("key1", Nothing), ("key2", Just "value2")]+-- "key1&key2=value2"+--+-- This module also provides type synonyms and functions to handle queries+-- that do not allow/expect keys without values ('SimpleQuery'), handle+-- queries which have partially escaped characters+module Network.HTTP.Types.URI (+    -- * Query strings++    -- ** Query+    Query,+    QueryItem,+    renderQuery,+    renderQueryBuilder,+    parseQuery,+    parseQueryReplacePlus,++    -- *** Query (Text)+    QueryText,+    queryTextToQuery,+    queryToQueryText,+    renderQueryText,+    parseQueryText,++    -- ** SimpleQuery++    -- | If values are guaranteed, it might be easier working with 'SimpleQuery'.+    --+    -- This way, you don't have to worry about any 'Maybe's, though when parsing+    -- a query string and there's no @\'=\'@ after the key in the query item, the+    -- value will just be an empty 'B.ByteString'.+    SimpleQuery,+    SimpleQueryItem,+    simpleQueryToQuery,+    renderSimpleQuery,+    parseSimpleQuery,++    -- ** PartialEscapeQuery++    -- | For some values in query items, certain characters must not be percent-encoded,+    -- for example @\'+\'@ or @\':\'@ in+    --+    -- @q=a+language:haskell+created:2009-01-01..2009-02-01&sort=stars@+    --+    -- Using specific 'EscapeItem's provides a way to decide which parts of a query string value+    -- will be URL encoded and which won't.+    --+    -- This is mandatory when searching for @\'+\'@ (@%2B@ being a percent-encoded @\'+\'@):+    --+    -- @q=%2B+language:haskell@+    PartialEscapeQuery,+    PartialEscapeQueryItem,+    EscapeItem (..),+    renderQueryPartialEscape,+    renderQueryBuilderPartialEscape,++    -- * Path++    -- ** Segments + Query String+    extractPath,+    encodePath,+    decodePath,++    -- ** Path Segments+    encodePathSegments,+    encodePathSegmentsRelative,+    decodePathSegments,++    -- * URL encoding / decoding+    urlEncode,+    urlEncodeBuilder,+    urlDecode,+)+where++import Control.Arrow (second, (***))+import Data.Bits (shiftL, (.|.))+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Lazy as BL+import Data.Char (ord)+import Data.List (intersperse)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8With, encodeUtf8)+import Data.Text.Encoding.Error (lenientDecode)+import Data.Word (Word8)++-- This section is needed to run doctests for GHC 8.10.7+#if !MIN_VERSION_bytestring(0,11,1)+-- $setup+-- >>> :{+-- instance Show B.Builder where+--   show = show . B.toLazyByteString+-- :}+#endif++-- | An item from the query string, split up into two parts.+--+-- The second part should be 'Nothing' if there was no key-value+-- separator after the query item name.+--+-- @since 0.2.0+type QueryItem = (B.ByteString, Maybe B.ByteString)++-- | A sequence of 'QueryItem's.+type Query = [QueryItem]++-- | Like Query, but with 'Text' instead of 'B.ByteString' (UTF8-encoded).+--+-- @since 0.5.2+type QueryText = [(Text, Maybe Text)]++-- | Convert 'QueryText' to 'Query'.+--+-- @since 0.5.2+queryTextToQuery :: QueryText -> Query+queryTextToQuery = map $ encodeUtf8 *** fmap encodeUtf8++-- | Convert 'QueryText' to a 'B.Builder'.+--+-- If you want a question mark (@?@) added to the front of the result, use 'True'.+--+-- @since 0.5.2+renderQueryText :: Bool -> QueryText -> B.Builder+renderQueryText b = renderQueryBuilder b . queryTextToQuery++-- | Convert 'Query' to 'QueryText' (leniently decoding the UTF-8).+--+-- @since 0.5.2+queryToQueryText :: Query -> QueryText+queryToQueryText =+    map $ go *** fmap go+  where+    go = decodeUtf8With lenientDecode++-- | Parse a 'QueryText' from a 'B.ByteString'. See 'parseQuery' for details.+--+-- @'queryToQueryText' . 'parseQuery'@+--+-- @since 0.5.2+parseQueryText :: B.ByteString -> QueryText+parseQueryText = queryToQueryText . parseQuery++-- | Simplified query item type without support for parameter-less items.+--+-- @since 0.2.0+type SimpleQueryItem = (B.ByteString, B.ByteString)++-- | A sequence of 'SimpleQueryItem's.+type SimpleQuery = [SimpleQueryItem]++-- | Convert 'SimpleQuery' to 'Query'.+--+-- @since 0.5+simpleQueryToQuery :: SimpleQuery -> Query+simpleQueryToQuery = map (second Just)++-- | Renders the given 'Query' into a 'B.Builder'.+--+-- If you want a question mark (@?@) added to the front of the result, use 'True'.+--+-- @since 0.5+renderQueryBuilder :: Bool -> Query -> B.Builder+renderQueryBuilder _ [] = mempty+renderQueryBuilder qmark' (p : ps) =+    -- FIXME: replace mconcat + map with foldr+    mconcat $+        go (if qmark' then qmark else mempty) p+            : map (go amp) ps+  where+    qmark = B.byteString "?"+    amp = B.byteString "&"+    equal = B.byteString "="+    go sep (k, mv) =+        mconcat+            [ sep+            , urlEncodeBuilder True k+            , case mv of+                Nothing -> mempty+                Just v -> equal `mappend` urlEncodeBuilder True v+            ]++-- | Renders the given 'Query' into a 'B.ByteString'.+--+-- If you want a question mark (@?@) added to the front of the result, use 'True'.+--+-- @since 0.2.0+renderQuery :: Bool -> Query -> B.ByteString+renderQuery qm = BL.toStrict . B.toLazyByteString . renderQueryBuilder qm++-- | Render the given 'SimpleQuery' into a 'B.ByteString'.+--+-- If you want a question mark (@?@) added to the front of the result, use 'True'.+--+-- @since 0.2.0+renderSimpleQuery :: Bool -> SimpleQuery -> B.ByteString+renderSimpleQuery useQuestionMark = renderQuery useQuestionMark . simpleQueryToQuery++-- | Split out the query string into a list of keys and values. A few+-- importants points:+--+-- * The result returned is still bytestrings, since we perform no character+-- decoding here. Most likely, you will want to use UTF-8 decoding, but this is+-- left to the user of the library.+--+-- * Percent decoding errors are ignored. In particular, @"%Q"@ will be output as+-- @"%Q"@.+--+-- * It decodes @\'+\'@ characters to @\' \'@+--+-- @since 0.2.0+parseQuery :: B.ByteString -> Query+parseQuery = parseQueryReplacePlus True++-- | Same functionality as 'parseQuery', but with the option to decode @\'+\'@ characters to @\' \'@+-- or to preserve any @\'+\'@ encountered.+--+-- If you want to replace any @\'+\'@ with a space, use 'True'.+--+-- @since 0.12.2+parseQueryReplacePlus :: Bool -> B.ByteString -> Query+parseQueryReplacePlus replacePlus bs = parseQueryString' $ dropQuestion bs+  where+    dropQuestion q =+        case B.uncons q of+            Just (63, q') -> q'+            _ -> q+    parseQueryString' q | B.null q = []+    parseQueryString' q =+        let (x, xs) = breakDiscard queryStringSeparators q+         in parsePair x : parseQueryString' xs+      where+        parsePair x =+            let (k, v) = B.break (== 61) x -- equal sign+                v'' =+                    case B.uncons v of+                        Just (_, v') -> Just $ urlDecode replacePlus v'+                        _ -> Nothing+             in (urlDecode replacePlus k, v'')++queryStringSeparators :: B.ByteString+queryStringSeparators = B.pack [38, 59] -- ampersand, semicolon++-- | Break the second bytestring at the first occurrence of any bytes from+-- the first bytestring, discarding that byte.+breakDiscard :: B.ByteString -> B.ByteString -> (B.ByteString, B.ByteString)+breakDiscard seps s =+    let (x, y) = B.break (`B.elem` seps) s+     in (x, B.drop 1 y)++-- | Parse 'SimpleQuery' from a 'B.ByteString'.+--+-- This uses 'parseQuery' under the hood, and will transform+-- any 'Nothing' values into an empty 'B.ByteString'.+--+-- @since 0.2.0+parseSimpleQuery :: B.ByteString -> SimpleQuery+parseSimpleQuery = map (second $ fromMaybe B.empty) . parseQuery++ord8 :: Char -> Word8+ord8 = fromIntegral . ord++unreservedQS, unreservedPI :: [Word8]+-- FIXME: According to RFC 3986, the following are also allowed in query segments:+-- "!'()*;:@&=+$,/?"+--+-- https://www.rfc-editor.org/rfc/rfc3986#section-3.4+--+-- Incidentally, this is also the list of unreserved characters for fragments.+unreservedQS = map ord8 "-_.~"+-- FIXME: According to RFC 3986, the following are also allowed in path segments:+-- "!'()*;"+--+-- https://www.rfc-editor.org/rfc/rfc3986#section-3.3+unreservedPI = map ord8 "-_.~:@&=+$,"++-- | Percent-encoding for URLs.+--+-- This will substitute every byte with its percent-encoded equivalent unless:+--+-- * The byte is alphanumeric. (i.e. one of @/[A-Za-z0-9]/@)+--+-- * The byte is one of the 'Word8' listed in the first argument.+urlEncodeBuilder' :: [Word8] -> B.ByteString -> B.Builder+urlEncodeBuilder' extraUnreserved =+    mconcat . map encodeChar . B.unpack+  where+    encodeChar ch+        | unreserved ch = B.word8 ch+        | otherwise = h2 ch++    unreserved ch+        | ch >= 65 && ch <= 90 = True -- A-Z+        | ch >= 97 && ch <= 122 = True -- a-z+        | ch >= 48 && ch <= 57 = True -- 0-9+    unreserved c = c `elem` extraUnreserved++    -- must be upper-case+    h2 v = B.word8 37 `mappend` B.word8 (h a) `mappend` B.word8 (h b) -- 37 = %+      where+        (a, b) = v `divMod` 16+    h i+        | i < 10 = 48 + i -- zero (0)+        | otherwise = 65 + i - 10 -- 65: A++-- | Percent-encoding for URLs.+--+-- Like 'urlEncode', but only makes the 'B.Builder'.+--+-- @since 0.5+urlEncodeBuilder :: Bool -> B.ByteString -> B.Builder+urlEncodeBuilder True = urlEncodeBuilder' unreservedQS+urlEncodeBuilder False = urlEncodeBuilder' unreservedPI++-- | Percent-encoding for URLs.+--+-- In short:+--+-- * if you're encoding (parts of) a path element, use 'False'.+--+-- * if you're encoding (parts of) a query string, use 'True'.+--+-- === __In-depth explanation__+--+-- This will substitute every byte with its percent-encoded equivalent unless:+--+-- * The byte is alphanumeric. (i.e. @A-Z@, @a-z@, or @0-9@)+--+-- * The byte is either a dash @\'-\'@, an underscore @\'_\'@, a dot @\'.\'@, or a tilde @\'~\'@+--+-- * If 'False' is used, the following will also /not/ be percent-encoded:+--+--     * colon @\':\'@, at sign @\'\@\'@, ampersand @\'&\'@, equals sign @\'=\'@, plus sign @\'+\'@, dollar sign @\'$\'@ or a comma @\',\'@+--+-- @since 0.2.0+urlEncode :: Bool -> B.ByteString -> B.ByteString+urlEncode q = BL.toStrict . B.toLazyByteString . urlEncodeBuilder q++-- | Percent-decoding.+--+-- If you want to replace any @\'+\'@ with a space, use 'True'.+--+-- @since 0.2.0+urlDecode :: Bool -> B.ByteString -> B.ByteString+urlDecode replacePlus z = fst $ B.unfoldrN (B.length z) go z+  where+    go bs =+        case B.uncons bs of+            Nothing -> Nothing+            -- plus to space+            Just (43, ws) | replacePlus -> Just (32, ws)+            -- percent+            Just (37, ws) -> Just $ fromMaybe (37, ws) $ do+                (x, xs) <- B.uncons ws+                x' <- hexVal x+                (y, ys) <- B.uncons xs+                y' <- hexVal y+                Just (combine x' y', ys)+            Just (w, ws) -> Just (w, ws)+    hexVal w+        | 48 <= w && w <= 57 = Just $ w - 48 -- 0 - 9+        | 65 <= w && w <= 70 = Just $ w - 55 -- A - F+        | 97 <= w && w <= 102 = Just $ w - 87 -- a - f+        | otherwise = Nothing+    combine :: Word8 -> Word8 -> Word8+    combine a b = shiftL a 4 .|. b++-- | Encodes a list of path segments into a valid URL fragment.+--+-- This function takes the following three steps:+--+-- * UTF-8 encodes the characters.+--+-- * Prepends each segment with a slash.+--+-- * Performs percent-encoding on all characters that are __not__:+--+--     * alphanumeric (i.e. @A-Z@ and @a-z@)+--+--     * digits (i.e. @0-9@)+--+--     * a dash @\'-\'@, an underscore @\'_\'@, a dot @\'.\'@, or a tilde @\'~\'@+--+-- For example:+--+-- >>> encodePathSegments ["foo", "bar1", "~baz"]+-- "/foo/bar1/~baz"+--+-- >>> encodePathSegments ["foo bar", "baz/bin"]+-- "/foo%20bar/baz%2Fbin"+--+-- >>> encodePathSegments ["שלום"]+-- "/%D7%A9%D7%9C%D7%95%D7%9D"+--+-- Huge thanks to /Jeremy Shaw/ who created the original implementation of this+-- function in web-routes and did such thorough research to determine all+-- correct escaping procedures.+--+-- @since 0.5+encodePathSegments :: [Text] -> B.Builder+encodePathSegments = foldr (\x -> mappend (B.byteString "/" `mappend` encodePathSegment x)) mempty++-- | Like 'encodePathSegments', but without the initial slash.+--+-- @since 0.6.10+encodePathSegmentsRelative :: [Text] -> B.Builder+encodePathSegmentsRelative xs = mconcat $ intersperse (B.byteString "/") (map encodePathSegment xs)++encodePathSegment :: Text -> B.Builder+encodePathSegment = urlEncodeBuilder False . encodeUtf8++-- | Parse a list of path segments from a valid URL fragment.+--+-- Will also decode any percent-encoded characters.+--+-- @since 0.5+decodePathSegments :: B.ByteString -> [Text]+decodePathSegments "" = []+decodePathSegments "/" = []+decodePathSegments a =+    go $ drop1Slash a+  where+    drop1Slash bs =+        case B.uncons bs of+            Just (47, bs') -> bs' -- 47 == /+            _ -> bs+    go bs =+        let (x, y) = B.break (== 47) bs+         in decodePathSegment x+                : if B.null y+                    then []+                    else go $ B.drop 1 y++decodePathSegment :: B.ByteString -> Text+decodePathSegment = decodeUtf8With lenientDecode . urlDecode False++-- | Extract whole path (path segments + query) from a+-- [RFC 2616 Request-URI](http://tools.ietf.org/html/rfc2616#section-5.1.2).+--+-- Though a more accurate description of this function's behaviour is that+-- it removes the domain/origin if the string starts with an HTTP protocol.+-- (i.e. @http://@ or @https://@)+--+-- This function will not change anything when given any other 'B.ByteString'.+-- (except return a root path @\"\/\"@ if given an empty string)+--+-- >>> extractPath "/path"+-- "/path"+--+-- >>> extractPath "http://example.com:8080/path"+-- "/path"+--+-- >>> extractPath "http://example.com"+-- "/"+--+-- >>> extractPath ""+-- "/"+--+-- >>> extractPath "www.google.com/some/path"+-- "www.google.com/some/path"+--+-- @since 0.8.5+extractPath :: B.ByteString -> B.ByteString+extractPath = ensureNonEmpty . extract+  where+    extract path+        | "http://" `B.isPrefixOf` path = (snd . breakOnSlash . B.drop 7) path+        | "https://" `B.isPrefixOf` path = (snd . breakOnSlash . B.drop 8) path+        | otherwise = path+    breakOnSlash = B.break (== 47)+    ensureNonEmpty "" = "/"+    ensureNonEmpty p = p++-- | Encode a whole path (path segments + query).+--+-- @since 0.5+encodePath :: [Text] -> Query -> B.Builder+encodePath x [] = encodePathSegments x+encodePath x y = encodePathSegments x `mappend` renderQueryBuilder True y++-- | Decode a whole path (path segments + query).+--+-- @since 0.5+decodePath :: B.ByteString -> ([Text], Query)+decodePath b =+    let (x, y) = B.break (== 63) b -- question mark+     in (decodePathSegments x, parseQuery y)++-----------------------------------------------------------------------------------------++-- | Section of a query item value that decides whether to use+-- regular URL encoding (using @'urlEncode True'@) with 'QE',+-- or to not encode /anything/ with 'QN'.+--+-- @since 0.12.1+data EscapeItem+    = -- | will be URL encoded+      QE B.ByteString+    | -- | will NOT /at all/ be URL encoded+      QN B.ByteString+    deriving (Show, Eq, Ord)++-- | Partially escaped query item.+--+-- The key will always be encoded using @'urlEncode True'@,+-- but the value will be encoded depending on which 'EscapeItem's are used.+--+-- @since 0.12.1+type PartialEscapeQueryItem = (B.ByteString, [EscapeItem])++-- | Query with some characters that should not be escaped.+--+-- General form: @a=b&c=d:e+f&g=h@+--+-- @since 0.12.1+type PartialEscapeQuery = [PartialEscapeQueryItem]++-- | Convert 'PartialEscapeQuery' to 'B.ByteString'.+--+-- If you want a question mark (@?@) added to the front of the result, use 'True'.+--+-- >>> renderQueryPartialEscape True [("a", [QN "x:z + ", QE (encodeUtf8 "They said: \"שלום\"")])]+-- "?a=x:z + They%20said%3A%20%22%D7%A9%D7%9C%D7%95%D7%9D%22"+--+-- @since 0.12.1+renderQueryPartialEscape :: Bool -> PartialEscapeQuery -> B.ByteString+renderQueryPartialEscape qm =+    BL.toStrict . B.toLazyByteString . renderQueryBuilderPartialEscape qm++-- | Convert a 'PartialEscapeQuery' to a 'B.Builder'.+--+-- If you want a question mark (@?@) added to the front of the result, use 'True'.+--+-- @since 0.12.1+renderQueryBuilderPartialEscape :: Bool -> PartialEscapeQuery -> B.Builder+renderQueryBuilderPartialEscape _ [] = mempty+-- FIXME: replace mconcat + map with foldr+renderQueryBuilderPartialEscape qmark' (p : ps) =+    mconcat $+        go (if qmark' then qmark else mempty) p+            : map (go amp) ps+  where+    qmark = B.byteString "?"+    amp = B.byteString "&"+    equal = B.byteString "="+    go sep (k, mv) =+        mconcat+            [ sep+            , urlEncodeBuilder True k+            , case mv of+                [] -> mempty+                vs -> equal `mappend` mconcat (map encode vs)+            ]+    encode (QE v) = urlEncodeBuilder True v+    encode (QN v) = B.byteString v

@@ -0,0 +1,60 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}++-- | Types and constants to describe the HTTP version.+module Network.HTTP.Types.Version (+    HttpVersion (..),+    http09,+    http10,+    http11,+    http20,+    http30,+) where++import Data.Data (Data)+import GHC.Generics (Generic)++-- | HTTP Version.+--+-- Note that the 'Show' instance is intended merely for debugging.+data HttpVersion = HttpVersion+    { httpMajor :: !Int+    , httpMinor :: !Int+    }+    deriving+        ( Eq+        , Ord+        , -- | @since 0.12.4+          Data+        , -- | @since 0.12.4+          Generic+        )++-- | >>> show http11+-- "HTTP/1.1"+instance Show HttpVersion where+    show (HttpVersion major minor) = "HTTP/" ++ show major ++ "." ++ show minor++-- | HTTP 0.9+http09 :: HttpVersion+http09 = HttpVersion 0 9++-- | HTTP 1.0+http10 :: HttpVersion+http10 = HttpVersion 1 0++-- | HTTP 1.1+http11 :: HttpVersion+http11 = HttpVersion 1 1++-- | HTTP 2.0+--+-- @since 0.10+http20 :: HttpVersion+http20 = HttpVersion 2 0++-- | HTTP 3.0+--+-- @since 0.12.5+http30 :: HttpVersion+http30 = HttpVersion 3 0

@@ -1,1 +0,0 @@-Generic HTTP types for Haskell (for both client and server code).

@@ -0,0 +1,21 @@+![Build Status](https://github.com/Vlix/http-types/actions/workflows/ci.yml/badge.svg?branch=master)+[![Hackage](https://img.shields.io/hackage/v/http-types.svg)](https://hackage.haskell.org/package/http-types)+[![Stackage LTS](http://stackage.org/package/http-types/badge/lts)](http://stackage.org/lts/package/http-types)+[![Stackage Nightly](http://stackage.org/package/http-types/badge/nightly)](http://stackage.org/nightly/package/http-types)+[![BSD 3-Clause License](https://img.shields.io/badge/License-BSD_3--Clause-blue.svg)](./LICENSE)++# Generic HTTP types for Haskell (for both client and server code).++The goal of this library is to have one location for any library, package or project+to base their general HTTP types on for better interoperability.++### This library provides basic types for the following:++* HTTP versions (e.g. `HTTP/1.1`)+* HTTP methods (e.g. `GET`)+* HTTP headers (e.g. `Content-Type`)+* HTTP statusses (e.g. `404`)++This library also contains some utility functions, e.g. related to URI handling,+that are not necessarily restricted in use to HTTP, but the scope is restricted+to things that are useful inside HTTP, i.e. no FTP URI parsing.

@@ -1,73 +1,78 @@--- http-types.cabal auto-generated by cabal init. For additional--- options, see--- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.--- The name of the package.+Cabal-version:       2.2 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.11---- A short (one-line) description of the package.+Version:             0.12.5 Synopsis:            Generic HTTP types for Haskell (for both client and server code).---- A longer description of the package.-Description:         Generic HTTP types for Haskell (for both client and server code).---- URL for the project homepage or repository.-Homepage:            https://github.com/aristidb/http-types---- The license under which the package is released.-License:             BSD3---- The file containing the license text.+Description:         Types and functions to describe and handle HTTP concepts.+                     Including "methods", "headers", "query strings", "paths" and "HTTP versions".+Homepage:            https://github.com/Vlix/http-types+License:             BSD-3-Clause License-file:        LICENSE---- The package author(s). Author:              Aristid Breitkreuz, Michael Snoyman---- An email address to which users can send suggestions, bug reports,--- and patches.-Maintainer:          aristidb@googlemail.com---- A copyright notice.-Copyright:           (C) 2011 Aristid Breitkreuz-+Maintainer:          felix.paulusma@gmail.com+Copyright:           (C) 2011 Aristid Breitkreuz, (C) 2023 Felix Paulusma Category:            Network, Web- Build-type:          Simple+Tested-with:+    GHC == 7.10.3, GHC == 9.6.7, GHC == 9.8.4, GHC == 9.10.3, GHC == 9.12.4, GHC == 9.14.1+Extra-source-files:+    test/.golden/urlEncode-path/golden+    test/.golden/urlEncode-query/golden+Extra-doc-files:+    README.md+    CHANGELOG.md --- Extra files to be distributed with the package, such as examples or--- a README.-Extra-source-files:  README+Source-repository this+  type: git+  location: https://github.com/Vlix/http-types.git+  tag: v0.12.5 --- Constraint on the version of Cabal needed to build this package.-Cabal-version:       >=1.8+Source-repository head+  type: git+  location: https://github.com/Vlix/http-types.git  Library-  -- Modules exported by the library.   Exposed-modules:     Network.HTTP.Types+                       Network.HTTP.Types.Header+                       Network.HTTP.Types.Method+                       Network.HTTP.Types.QueryLike+                       Network.HTTP.Types.Status+                       Network.HTTP.Types.URI+                       Network.HTTP.Types.Version+  GHC-Options:         -Wall+  Build-depends:       base >= 4.8 && < 5,+                       bytestring >= 0.10.6.0 && < 1,+                       array >= 0.5.1.0 && < 0.6,+                       case-insensitive >= 1.2.0.2 && < 1.3,+                       text >= 1.2.0.2 && < 3+  Default-language:    Haskell2010 -  -- GHC Options.+Test-suite spec+  main-is:             Spec.hs+  hs-source-dirs:      test+  other-modules:       Network.HTTP.Types.HeaderSpec+                       Network.HTTP.Types.MethodSpec+                       Network.HTTP.Types.StatusSpec+                       Network.HTTP.Types.URISpec+                       Network.HTTP.Types.VersionSpec+  type:                exitcode-stdio-1.0   GHC-Options:         -Wall-  -  -- Packages needed in order to build this package.-  Build-depends:       base >= 4 && < 5,-                       bytestring >=0.9.1.5 && <0.10,-                       array >=0.2 && <0.5,-                       case-insensitive >=0.2 && <0.5,-                       blaze-builder >= 0.2.1.4 && < 0.4,-                       text >= 0.11.0.2 && < 0.12-  -  -- Modules not exported by this package.-  -- Other-modules:       -  -  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.-  -- Build-tools:         -  +  default-language:    Haskell2010+  build-tool-depends:  hspec-discover:hspec-discover+  build-depends:       base < 5,+                       bytestring,+                       case-insensitive,+                       filepath,+                       hspec >= 1.3,+                       hspec-golden >= 0.2,+                       http-types,+                       QuickCheck,+                       quickcheck-instances,+                       text -Test-suite runtests-    main-is:           runtests.hs-    type:              exitcode-stdio-1.0-    build-depends:     text, bytestring, base, blaze-builder, array, case-insensitive, QuickCheck, HUnit, hspec >= 1.0+Test-Suite doctests+  main-is:             doctests.hs+  hs-source-dirs:      test+  type:                exitcode-stdio-1.0+  ghc-options:         -threaded -Wall+  default-language:    Haskell2010+  build-depends:       base < 5, doctest >= 0.19.0

@@ -1,85 +0,0 @@-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-import           Data.Text                (Text)-import           Debug.Trace-import           Network.HTTP.Types-import           Test.Hspec-import           Test.Hspec.QuickCheck-import           Test.Hspec.HUnit-import           Test.QuickCheck          (Arbitrary (..))-import           Test.HUnit-import qualified Blaze.ByteString.Builder as Blaze-import qualified Data.ByteString          as S-import qualified Data.ByteString.Char8    as S8-import qualified Data.Text                as T----main :: IO ()-main = hspecX-    [ describe "encode/decode path"-        [ it "is identity to encode and then decode"-            $ property propEncodeDecodePath-        , it "does not escape period and dash" $-            Blaze.toByteString (encodePath ["foo-bar.baz"] []) @?= "/foo-bar.baz"-        ]-    , describe "encode/decode query"-        [ it "is identity to encode and then decode"-            $ property propEncodeDecodeQuery-        , it "add ? in front of Query if and only if necessary"-            $ property propQueryQuestionMark-        ]-    , describe "encode/decode path segments"-        [ 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-propEncodeDecodePath (p', q') =-    let x = Blaze.toByteString $ encodePath a b-        y = decodePath x-        z = y == (a, b)-     in if z then z else traceShow (a, b, x, y) z-  where-    a = if p' == [""] then [] else p'-    b = filter (\(x, _) -> not (S.null x)) q'--propEncodeDecodeQuery :: Query -> Bool-propEncodeDecodeQuery q' =-    q == parseQuery (renderQuery True q)-  where-    q = filter (\(x, _) -> not (S.null x)) q'--propQueryQuestionMark :: (Bool, Query) -> Bool-propQueryQuestionMark (useQuestionMark, query) = actual == expected-    where-      actual = case S8.uncons $ renderQuery useQuestionMark query of-                 Nothing       -> False-                 Just ('?', _) -> True-                 _             -> False-      expected = case (useQuestionMark, null query) of-                   (False, _)    -> False-                   (True, True)  -> False-                   (True, False) -> True-          -propEncodeDecodePathSegments :: [Text] -> Bool-propEncodeDecodePathSegments p' =-    p == decodePathSegments (Blaze.toByteString $ encodePathSegments p)-  where-    p = if p' == [""] then [] else p'--instance Arbitrary Text where-    arbitrary = fmap T.pack arbitrary--instance Arbitrary S.ByteString where-    arbitrary = fmap S.pack arbitrary

@@ -0,0 +1,1 @@+%00%01%02%03%04%05%06%07%08%09%0A%0B%0C%0D%0E%0F%10%11%12%13%14%15%16%17%18%19%1A%1B%1C%1D%1E%1F%20%21%22%23$%25&%27%28%29%2A+,-.%2F0123456789:%3B%3C=%3E%3F@ABCDEFGHIJKLMNOPQRSTUVWXYZ%5B%5C%5D%5E_%60abcdefghijklmnopqrstuvwxyz%7B%7C%7D~%7F%80%81%82%83%84%85%86%87%88%89%8A%8B%8C%8D%8E%8F%90%91%92%93%94%95%96%97%98%99%9A%9B%9C%9D%9E%9F%A0%A1%A2%A3%A4%A5%A6%A7%A8%A9%AA%AB%AC%AD%AE%AF%B0%B1%B2%B3%B4%B5%B6%B7%B8%B9%BA%BB%BC%BD%BE%BF%C0%C1%C2%C3%C4%C5%C6%C7%C8%C9%CA%CB%CC%CD%CE%CF%D0%D1%D2%D3%D4%D5%D6%D7%D8%D9%DA%DB%DC%DD%DE%DF%E0%E1%E2%E3%E4%E5%E6%E7%E8%E9%EA%EB%EC%ED%EE%EF%F0%F1%F2%F3%F4%F5%F6%F7%F8%F9%FA%FB%FC%FD%FE%FF

@@ -0,0 +1,1 @@+%00%01%02%03%04%05%06%07%08%09%0A%0B%0C%0D%0E%0F%10%11%12%13%14%15%16%17%18%19%1A%1B%1C%1D%1E%1F%20%21%22%23%24%25%26%27%28%29%2A%2B%2C-.%2F0123456789%3A%3B%3C%3D%3E%3F%40ABCDEFGHIJKLMNOPQRSTUVWXYZ%5B%5C%5D%5E_%60abcdefghijklmnopqrstuvwxyz%7B%7C%7D~%7F%80%81%82%83%84%85%86%87%88%89%8A%8B%8C%8D%8E%8F%90%91%92%93%94%95%96%97%98%99%9A%9B%9C%9D%9E%9F%A0%A1%A2%A3%A4%A5%A6%A7%A8%A9%AA%AB%AC%AD%AE%AF%B0%B1%B2%B3%B4%B5%B6%B7%B8%B9%BA%BB%BC%BD%BE%BF%C0%C1%C2%C3%C4%C5%C6%C7%C8%C9%CA%CB%CC%CD%CE%CF%D0%D1%D2%D3%D4%D5%D6%D7%D8%D9%DA%DB%DC%DD%DE%DF%E0%E1%E2%E3%E4%E5%E6%E7%E8%E9%EA%EB%EC%ED%EE%EF%F0%F1%F2%F3%F4%F5%F6%F7%F8%F9%FA%FB%FC%FD%FE%FF

@@ -0,0 +1,127 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Network.HTTP.Types.HeaderSpec (main, spec) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import Data.CaseInsensitive (original)+import Data.Word (Word8)+import Test.Hspec+import Test.QuickCheck (Arbitrary (..), Gen, NonEmptyList (..), oneof, property)+import Test.QuickCheck.Instances ()++import Network.HTTP.Types++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+    describe "Regression tests" $ do+        mapM_ headerCheck allHeaders++    describe "byte ranges" $ do+        it "is identity to render and parse ByteRanges" $+            property $ \(NonEmpty brs) ->+                Just brs == parseByteRanges (renderByteRanges brs)+        it "is satisfiable with from-to of zero" $+            parseByteRanges "bytes=0-0" `shouldBe` Just [ByteRangeFromTo 0 0]+        it "is not satisfiable with suffix of zero" $+            parseByteRanges "bytes=-0" `shouldBe` Nothing+        it "is not satisfiable with 'from' lower than 'to'" $+            property $ \w81 w82 ->+                let w8toInt = fromIntegral :: Word8 -> Integer+                    -- if both are 0 it's @not (start < end)@ so we add 1+                    start = w8toInt w81 + end + 1+                    end = w8toInt w82+                    range = show start <> "-" <> show end+                 in parseByteRanges ("bytes=" <> B8.pack range) `shouldBe` Nothing++type HeaderTuple = (HeaderName, HeaderName)++allHeaders :: [HeaderTuple]+allHeaders =+    [ (hAccept, "Accept")+    , (hAcceptCharset, "Accept-Charset")+    , (hAcceptEncoding, "Accept-Encoding")+    , (hAcceptLanguage, "Accept-Language")+    , (hAcceptRanges, "Accept-Ranges")+    , (hAge, "Age")+    , (hAllow, "Allow")+    , (hAuthorization, "Authorization")+    , (hCacheControl, "Cache-Control")+    , (hConnection, "Connection")+    , (hContentDisposition, "Content-Disposition")+    , (hContentEncoding, "Content-Encoding")+    , (hContentLanguage, "Content-Language")+    , (hContentLength, "Content-Length")+    , (hContentLocation, "Content-Location")+    , (hContentMD5, "Content-MD5")+    , (hContentRange, "Content-Range")+    , (hContentType, "Content-Type")+    , (hCookie, "Cookie")+    , (hDate, "Date")+    , (hETag, "ETag")+    , (hExpect, "Expect")+    , (hExpires, "Expires")+    , (hFrom, "From")+    , (hHost, "Host")+    , (hIfMatch, "If-Match")+    , (hIfModifiedSince, "If-Modified-Since")+    , (hIfNoneMatch, "If-None-Match")+    , (hIfRange, "If-Range")+    , (hIfUnmodifiedSince, "If-Unmodified-Since")+    , (hLastModified, "Last-Modified")+    , (hLocation, "Location")+    , (hMaxForwards, "Max-Forwards")+    , (hMIMEVersion, "MIME-Version")+    , (hOrigin, "Origin")+    , (hPragma, "Pragma")+    , (hPrefer, "Prefer")+    , (hPreferenceApplied, "Preference-Applied")+    , (hProxyAuthenticate, "Proxy-Authenticate")+    , (hProxyAuthorization, "Proxy-Authorization")+    , (hRange, "Range")+    , (hReferer, "Referer")+    , (hRetryAfter, "Retry-After")+    , (hServer, "Server")+    , (hSetCookie, "Set-Cookie")+    , (hTE, "TE")+    , (hTrailer, "Trailer")+    , (hTransferEncoding, "Transfer-Encoding")+    , (hUpgrade, "Upgrade")+    , (hUserAgent, "User-Agent")+    , (hVary, "Vary")+    , (hVia, "Via")+    , (hWWWAuthenticate, "WWW-Authenticate")+    , (hWarning, "Warning")+    ]++headerCheck :: HeaderTuple -> Spec+headerCheck (hdr, msg) = do+    it (B8.unpack . pad $ original msg) $ hdr `shouldBe` msg+  where+    pad bs =+        let padding = B8.replicate (maxMsg - B.length bs) ' '+         in bs <> padding++maxMsg :: Int+maxMsg = maximum $ fmap (B.length . original . snd) allHeaders++-- | Generate valid ranges.+--+-- All values are positive and non-zero for easier testing.+instance Arbitrary ByteRange where+    arbitrary =+        oneof+            [ ByteRangeFrom <$> num+            , num >>= \from ->+                ByteRangeFromTo from . (from +) <$> num+            , ByteRangeSuffix <$> num+            ]+      where+        num =+            (+ 1) -- making sure it's non-zero+                . fromIntegral+                <$> (arbitrary :: Gen Word) -- making sure it's positive

@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Network.HTTP.Types.MethodSpec (main, spec) where++import Test.Hspec+import Test.QuickCheck (property)+import Test.QuickCheck.Instances ()++import Network.HTTP.Types++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+    describe "Regression tests" $ do+        it "GET    " $ methodGet `shouldBe` "GET"+        it "POST   " $ methodPost `shouldBe` "POST"+        it "HEAD   " $ methodHead `shouldBe` "HEAD"+        it "PUT    " $ methodPut `shouldBe` "PUT"+        it "DELETE " $ methodDelete `shouldBe` "DELETE"+        it "TRACE  " $ methodTrace `shouldBe` "TRACE"+        it "CONNECT" $ methodConnect `shouldBe` "CONNECT"+        it "OPTIONS" $ methodOptions `shouldBe` "OPTIONS"+        it "PATCH  " $ methodPatch `shouldBe` "PATCH"+        it "StdMethod has all constants" $+            let methodList =+                    [ methodGet+                    , methodPost+                    , methodHead+                    , methodPut+                    , methodDelete+                    , methodTrace+                    , methodConnect+                    , methodOptions+                    , methodPatch+                    ]+             in allMethods `shouldBe` methodList++    describe "parse/render method" $ do+        it "round trips" $ do+            renderMethod . parseMethod <$> allMethods `shouldBe` allMethods+        it "also round trips for any ByteString" $+            property $ \bs ->+                renderMethod (parseMethod bs) `shouldBe` bs++allMethods :: [Method]+allMethods =+    renderStdMethod <$> [minBound @StdMethod .. maxBound]

@@ -0,0 +1,145 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Network.HTTP.Types.StatusSpec (main, spec) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import Data.Function (on)+import qualified Data.List as L+import Test.Hspec+import Test.QuickCheck (Arbitrary (..), choose, property, resize)+import Test.QuickCheck.Instances ()++import Network.HTTP.Types++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+    describe "Regression tests" $ do+        mapM_ statusCheck allStatusses+        context "Category checks" $ do+            categoryCheck "statusIsInformational" statusIsInformational _100Statusses+            categoryCheck "statusIsSuccessful" statusIsSuccessful _200Statusses+            categoryCheck "statusIsRedirection" statusIsRedirection _300Statusses+            categoryCheck "statusIsClientError" statusIsClientError _400Statusses+            categoryCheck "statusIsServerError" statusIsServerError _500Statusses+    describe "Eq instance" $ do+        it "only matches on 'statusCode'" $+            property $+                \st1 st2 -> (st1 == st2) == ((==) `on` statusCode) st1 st2+    describe "Ord instance" $ do+        it "only orders on 'statusCode'" $+            property $+                \st1 st2 -> (st1 < st2) == ((<) `on` statusCode) st1 st2++categoryCheck :: String -> (Status -> Bool) -> [StatusTuple] -> Spec+categoryCheck name p shoulds = do+    it msg $ do+        mapM_ (\(st, _, _, _) -> st `shouldSatisfy` p) shoulds+        mapM_ (\(st, _, _, _) -> st `shouldNotSatisfy` p) $+            allStatusses L.\\ shoulds+  where+    msg = "'" <> name <> "' " <> "identifies correct statusses" <> extra+    extra = replicate (length ("statusIsInformational" :: String) - length name) ' '++type StatusTuple = (Status, Status, Int, B.ByteString)++_100Statusses :: [StatusTuple]+_100Statusses =+    [ (status100, continue100, 100, "Continue")+    , (status101, switchingProtocols101, 101, "Switching Protocols")+    ]++_200Statusses :: [StatusTuple]+_200Statusses =+    [ (status200, ok200, 200, "OK")+    , (status201, created201, 201, "Created")+    , (status202, accepted202, 202, "Accepted")+    , (status203, nonAuthoritative203, 203, "Non-Authoritative Information")+    , (status204, noContent204, 204, "No Content")+    , (status205, resetContent205, 205, "Reset Content")+    , (status206, partialContent206, 206, "Partial Content")+    ]++_300Statusses :: [StatusTuple]+_300Statusses =+    [ (status300, multipleChoices300, 300, "Multiple Choices")+    , (status301, movedPermanently301, 301, "Moved Permanently")+    , (status302, found302, 302, "Found")+    , (status303, seeOther303, 303, "See Other")+    , (status304, notModified304, 304, "Not Modified")+    , (status305, useProxy305, 305, "Use Proxy")+    , (status307, temporaryRedirect307, 307, "Temporary Redirect")+    , (status308, permanentRedirect308, 308, "Permanent Redirect")+    ]++_400Statusses :: [StatusTuple]+_400Statusses =+    [ (status400, badRequest400, 400, "Bad Request")+    , (status401, unauthorized401, 401, "Unauthorized")+    , (status402, paymentRequired402, 402, "Payment Required")+    , (status403, forbidden403, 403, "Forbidden")+    , (status404, notFound404, 404, "Not Found")+    , (status405, methodNotAllowed405, 405, "Method Not Allowed")+    , (status406, notAcceptable406, 406, "Not Acceptable")+    , (status407, proxyAuthenticationRequired407, 407, "Proxy Authentication Required")+    , (status408, requestTimeout408, 408, "Request Timeout")+    , (status409, conflict409, 409, "Conflict")+    , (status410, gone410, 410, "Gone")+    , (status411, lengthRequired411, 411, "Length Required")+    , (status412, preconditionFailed412, 412, "Precondition Failed")+    , (status413, requestEntityTooLarge413, 413, "Request Entity Too Large")+    , (status414, requestURITooLong414, 414, "Request-URI Too Long")+    , (status415, unsupportedMediaType415, 415, "Unsupported Media Type")+    , (status416, requestedRangeNotSatisfiable416, 416, "Requested Range Not Satisfiable")+    , (status417, expectationFailed417, 417, "Expectation Failed")+    , (status418, imATeapot418, 418, "I'm a teapot")+    , (status422, unprocessableEntity422, 422, "Unprocessable Entity")+    , (status426, upgradeRequired426, 426, "Upgrade Required")+    , (status428, preconditionRequired428, 428, "Precondition Required")+    , (status429, tooManyRequests429, 429, "Too Many Requests")+    , (status431, requestHeaderFieldsTooLarge431, 431, "Request Header Fields Too Large")+    , (status451, unavailableForLegalReasons451, 451, "Unavailable For Legal Reasons")+    ]++_500Statusses :: [StatusTuple]+_500Statusses =+    [ (status500, internalServerError500, 500, "Internal Server Error")+    , (status501, notImplemented501, 501, "Not Implemented")+    , (status502, badGateway502, 502, "Bad Gateway")+    , (status503, serviceUnavailable503, 503, "Service Unavailable")+    , (status504, gatewayTimeout504, 504, "Gateway Timeout")+    , (status505, httpVersionNotSupported505, 505, "HTTP Version Not Supported")+    , (status511, networkAuthenticationRequired511, 511, "Network Authentication Required")+    ]++allStatusses :: [StatusTuple]+allStatusses =+    concat+        [ _100Statusses+        , _200Statusses+        , _300Statusses+        , _400Statusses+        , _500Statusses+        ]++statusCheck :: (Status, Status, Int, B.ByteString) -> Spec+statusCheck (st, st', code, msg) = do+    it (show code <> " " <> B8.unpack (pad msg)) $ do+        st `shouldBe` st'+  where+    pad bs =+        let padding = B8.replicate (maxMsg - B.length bs) ' '+         in bs <> padding++maxMsg :: Int+maxMsg = maximum $ fmap (\(_, _, _, bs) -> B.length bs) allStatusses++instance Arbitrary Status where+    arbitrary =+        Status+            <$> choose (statusCode minBound, statusCode maxBound)+            <*> resize 20 arbitrary

@@ -0,0 +1,258 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++module Network.HTTP.Types.URISpec (main, spec) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL+import Data.Maybe (fromMaybe)+import Data.Text as T (Text, null)+import Debug.Trace (traceShow)+import System.FilePath ((</>))+import Test.Hspec+import Test.Hspec.Golden (Golden (..))+import Test.QuickCheck (+    Arbitrary (..),+    Gen,+    Property,+    listOf,+    property,+    suchThat,+    (.&&.),+    (==>),+ )+import Test.QuickCheck.Instances ()++import Network.HTTP.Types++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+    describe "encode/decode path" $ do+        it "is identity to encode and then decode" $+            property propEncodeDecodePath+        it "does not escape period and dash" $+            toStrictBS (encodePath ["foo-bar.baz"] [])+                `shouldBe` "/foo-bar.baz"+        -- FIXME: needs more path tests++    describe "encode/decode query" $ do+        it "is identity to encode and then decode" $+            property propEncodeDecodeQuery+        it "is identity to convert to and from Text" $+            property propConvertQueryText+        it "is identity to convert to and from Simple" $+            property propEncodeDecodeQuerySimple+        it "renderQuery is same as renderQueryText" $+            property propEncodeQueryText+        it "parseQuery is same as parseQueryText" $+            property propDecodeQueryText+        it "renderQuery is same as renderSimpleQuery" $+            property propEncodeSimpleQuery+        it "parseQuery is same as parseSimpleQuery" $+            property propDecodeSimpleQuery+        it "add ? in front of Query if and only if necessary" $+            property propQueryQuestionMark+        it "renders as expected" $+            renderQuery True [("a", Just "x"), ("b", Nothing), ("c", Just "")]+                `shouldBe` "?a=x&b&c="+        it "renders as expected without '?'" $+            renderQuery False [("a", Just "x"), ("b", Nothing), ("c", Just "")]+                `shouldBe` "a=x&b&c="++    describe "URL encode/decode" $ do+        it "is identity to encode and then decode" $+            property propEncodeDecodeURL+        let asciis = B.pack [0 .. 255]+        it "encodes all ASCII and decodes again" $ do+            urlDecode True (urlEncode True asciis) `shouldBe` asciis+            urlDecode False (urlEncode True asciis) `shouldBe` asciis+            -- FIXME: not encoding '+' doesn't cooperate with decoding while+            -- replacing the '+' with ' '.+            -- urlDecode True (urlEncode False asciis) `shouldBe` asciis+            urlDecode False (urlEncode False asciis) `shouldBe` asciis+        it "still encodes the same (path)" $+            mkGoldenFile "urlEncode-path" $+                urlEncode False asciis+        it "still encodes the same (query)" $+            mkGoldenFile "urlEncode-query" $+                urlEncode True asciis++    describe "decodePathSegments" $ do+        it "is inverse to encodePathSegments" $+            property $ \p ->+                (p /= [""]) ==> p == (decodePathSegments . toStrictBS . encodePathSegments) p++    describe "extractPath" $ do+        context "when used with a relative URL" $ do+            it "returns URL unmodified" $ do+                property $ \p ->+                    (not . B.null) p ==> extractPath p == p++            context "when path is empty" $ do+                it "returns /" $+                    extractPath "" `shouldBe` "/"++        context "when used with an absolute URL" $ do+            context "when used with a HTTP URL" $ do+                it "it extracts path" $+                    extractPath "http://example.com/foo" `shouldBe` "/foo"++                context "when path is empty" $+                    it "returns /" $+                        extractPath "http://example.com" `shouldBe` "/"++            context "when used with a HTTPS URL" $ do+                it "it extracts path" $+                    extractPath "https://example.com/foo" `shouldBe` "/foo"++                context "when path is empty" $ do+                    it "returns /" $+                        extractPath "https://example.com" `shouldBe` "/"++            context "when used without protocol" $ do+                it "returns unchanged" $+                    extractPath "www.example.com/foo" `shouldBe` "www.example.com/foo"++                context "even without path" $+                    it "returns unchanged" $+                        extractPath "www.example.com" `shouldBe` "www.example.com"++    -- FIXME: Add tests for the 'PartialEscapeQuery' types and functions.++    let sampleQuery = [("a", Just "b c d"), ("x", Just ""), ("y", Nothing)]+    describe "parseQuery" $ do+        it "returns value with '+' replaced to ' '" $+            parseQuery "?a=b+c+d&x=&y" `shouldBe` sampleQuery+        it "also does so without the question mark" $+            parseQuery "a=b+c+d&x=&y" `shouldBe` sampleQuery+        it "is parsed the same regardless of question mark" $+            property $ \(QueryGen q) -> do+                let q' = renderQuery False q+                parseQuery q' `shouldBe` parseQuery ("?" <> q')++    describe "parseQueryReplacePlus" $ do+        it "returns value with '+' replaced by ' '" $+            parseQueryReplacePlus True "?a=b+c+d&x=&y" `shouldBe` [("a", Just "b c d"), ("x", Just ""), ("y", Nothing)]+        it "returns value with '+' preserved" $+            parseQueryReplacePlus False "?a=b+c+d&x=&y" `shouldBe` [("a", Just "b+c+d"), ("x", Just ""), ("y", Nothing)]++goldenDir :: FilePath+goldenDir = "test" </> ".golden"++mkGoldenFile :: String -> B.ByteString -> Golden B.ByteString+mkGoldenFile name content =+    Golden {+        output = content,+        encodePretty = B8.unpack,+        writeToFile = B.writeFile,+        readFromFile = B.readFile,+        goldenFile = goldenDir </> name </> "golden",+        actualFile = Just (goldenDir </> name </> "actual"),+        failFirstTime = False+    }++propEncodeDecodePath :: ([Text], QueryGen B.ByteString) -> Bool+propEncodeDecodePath (p', QueryGen b) =+    if z then z else traceShow (a, b, x, y) z+  where+    a = if p' == [""] then [] else p'+    x = toStrictBS $ encodePath a b+    y = decodePath x+    z = y == (a, b)++propEncodeDecodeQuery :: QueryGen B.ByteString -> Bool -> Bool+propEncodeDecodeQuery (QueryGen q) b =+    q == parseQuery (renderQuery b q)++propQueryQuestionMark :: Bool -> Query -> Bool+propQueryQuestionMark useQuestionMark query =+    actual == expected+  where+    actual = case B8.uncons $ renderQuery useQuestionMark query of+        Just ('?', _) -> True+        _ -> False+    expected = useQuestionMark && not (Prelude.null query)++propConvertQueryText :: QueryGen Text -> Bool+propConvertQueryText (QueryGen q) =+    q == (queryToQueryText . queryTextToQuery) q++propEncodeQueryText :: QueryGen Text -> Bool -> Bool+propEncodeQueryText (QueryGen q) b =+    toStrictBS (renderQueryText b q) == renderQuery b (queryTextToQuery q)++propEncodeSimpleQuery :: QueryGen B.ByteString -> Bool -> Bool+propEncodeSimpleQuery (QueryGen q) b =+    renderSimpleQuery b simpleQuery == renderQuery b (simpleQueryToQuery simpleQuery)+  where+    simpleQuery = toSimpleQuery q++propDecodeQueryText :: QueryGen Text -> Property+propDecodeQueryText (QueryGen q) =+    (parseQueryText rq == queryToQueryText (parseQuery rq))+        .&&. (queryTextToQuery (parseQueryText rq) == parseQuery rq)+  where+    rq = toStrictBS (renderQueryText True q)++propDecodeSimpleQuery :: QueryGen B.ByteString -> Bool+propDecodeSimpleQuery (QueryGen q) =+    parseSimpleQuery rq == toSimpleQuery (parseQuery rq)+  where+    rq = renderQuery True q++propEncodeDecodeQuerySimple :: QueryGen B.ByteString -> Bool -> Bool+propEncodeDecodeQuerySimple (QueryGen q') b =+    q == (parseSimpleQuery . renderSimpleQuery b) q+  where+    q = fmap (fmap $ fromMaybe "") q'++propEncodeDecodeURL :: B.ByteString -> Bool -> Bool -> Bool+propEncodeDecodeURL bs b1 b2 =+    bs == urlDecode b1 (urlEncode b3 bs)+  where+    b3 = b1 || b2++newtype QueryGenItem b = QueryGenItem (b, Maybe b)+    deriving newtype (Show)+newtype QueryGen b = QueryGen [(b, Maybe b)]+    deriving newtype (Show)++instance Arbitrary (QueryGenItem B.ByteString) where+    arbitrary = arbQueryGenItem B.null++instance Arbitrary (QueryGenItem Text) where+    arbitrary = arbQueryGenItem T.null++instance Arbitrary (QueryGen B.ByteString) where+    arbitrary = arbQueryGen++instance Arbitrary (QueryGen Text) where+    arbitrary = arbQueryGen++arbQueryGenItem :: (Arbitrary a) => (a -> Bool) -> Gen (QueryGenItem a)+arbQueryGenItem p = do+    k <- arbitrary `suchThat` (not . p)+    v <- arbitrary+    pure $ QueryGenItem (k, v)++arbQueryGen :: (Arbitrary (QueryGenItem a)) => Gen (QueryGen a)+arbQueryGen = do+    items <- listOf arbitrary+    pure . QueryGen $ go <$> items+  where+    go (QueryGenItem i) = i++toStrictBS :: BB.Builder -> B.ByteString+toStrictBS = BL.toStrict . BB.toLazyByteString++toSimpleQuery :: Query -> SimpleQuery+toSimpleQuery q = fmap (fromMaybe "") <$> q

@@ -0,0 +1,29 @@+module Network.HTTP.Types.VersionSpec (main, spec) where++import Test.Hspec++import Network.HTTP.Types++main :: IO ()+main = hspec spec++spec :: Spec+spec =+    describe "Regression tests" $+        mapM_ checkVersion allVersions++-- | [("Rendered", {constant}, {literal})]+allVersions :: [(String, HttpVersion, HttpVersion)]+allVersions =+    [ ("HTTP/0.9", http09, HttpVersion 0 9)+    , ("HTTP/1.0", http10, HttpVersion 1 0)+    , ("HTTP/1.1", http11, HttpVersion 1 1)+    , ("HTTP/2.0", http20, HttpVersion 2 0)+    , ("HTTP/3.0", http30, HttpVersion 3 0)+    ]++checkVersion :: (String, HttpVersion, HttpVersion) -> Spec+checkVersion (str, v1, v2) =+    it str $ do+        v1 `shouldBe` v2+        show v1 `shouldBe` str

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,10 @@+module Main where++import Test.DocTest++main :: IO ()+main =+    doctest+        [ "-XOverloadedStrings"+        , "Network/HTTP/Types.hs"+        ]