http-types 0.10 → 0.12.5
raw patch · 20 files changed
Files
- CHANGELOG +0/−16
- CHANGELOG.md +57/−0
- Network/HTTP/Types.hs +278/−179
- Network/HTTP/Types/Header.hs +495/−161
- Network/HTTP/Types/Method.hs +112/−35
- Network/HTTP/Types/QueryLike.hs +29/−22
- Network/HTTP/Types/Status.hs +376/−134
- Network/HTTP/Types/URI.hs +404/−164
- Network/HTTP/Types/Version.hs +36/−17
- README +0/−5
- README.md +21/−0
- http-types.cabal +41/−23
- 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/doctests.hs +5/−7
− CHANGELOG
@@ -1,16 +0,0 @@-* 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.
+ CHANGELOG.md view
@@ -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`.
Network/HTTP/Types.hs view
@@ -1,182 +1,281 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.HTTP.Types-(- -- * Methods- Method-, methodGet-, methodPost-, methodHead-, methodPut-, methodDelete-, methodTrace-, methodConnect-, methodOptions-, methodPatch-, StdMethod(..)-, parseMethod-, renderMethod-, renderStdMethod- -- * Versions-, HttpVersion(..)-, http09-, http10-, http11- -- * Status-, Status(..)-, 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-, 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-, statusIsInformational-, statusIsSuccessful-, statusIsRedirection-, statusIsClientError-, statusIsServerError- -- * Headers- -- ** Types-, Header-, HeaderName-, RequestHeaders-, ResponseHeaders- -- ** Common headers-, hAccept-, hAcceptLanguage-, hAuthorization-, hCacheControl-, hCookie-, hConnection-, hContentEncoding-, hContentLength-, hContentMD5-, hContentType-, hDate-, hIfModifiedSince-, hIfRange-, hLastModified-, hLocation-, hRange-, hReferer-, hServer-, hUserAgent- -- ** Byte ranges-, ByteRange(..)-, renderByteRangeBuilder-, renderByteRange-, ByteRanges-, renderByteRangesBuilder-, renderByteRanges-, parseByteRanges- -- * URI- -- ** Query string-, QueryItem-, Query-, SimpleQueryItem-, SimpleQuery-, simpleQueryToQuery-, renderQuery-, renderQueryBuilder-, renderSimpleQuery-, parseQuery-, parseSimpleQuery- -- *** Text query string (UTF8 encoded)-, QueryText-, queryTextToQuery-, queryToQueryText-, renderQueryText-, parseQueryText- -- ** Generalized query types-, QueryLike(toQuery)- -- ** Path segments-, encodePathSegments-, decodePathSegments-, encodePathSegmentsRelative- -- ** Path (segments + query string)-, extractPath-, encodePath-, decodePath- -- ** URL encoding / decoding-, urlEncodeBuilder-, urlEncode-, urlDecode+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
Network/HTTP/Types/Header.hs view
@@ -1,190 +1,515 @@-{-# LANGUAGE OverloadedStrings, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, CPP #-}-module Network.HTTP.Types.Header-(- -- ** Types- Header-, HeaderName-, RequestHeaders-, ResponseHeaders- -- ** Common headers-, hAccept-, hAcceptCharset-, hAcceptEncoding-, hAcceptLanguage-, hAcceptRanges-, hAge-, hAllow-, hAuthorization-, hCacheControl-, hConnection-, hContentEncoding-, hContentLanguage-, hContentLength-, hContentLocation-, hContentMD5-, hContentRange-, hContentType-, hDate-, hETag-, hExpect-, hExpires-, hFrom-, hHost-, hIfMatch-, hIfModifiedSince-, hIfNoneMatch-, hIfRange-, hIfUnmodifiedSince-, hLastModified-, hLocation-, hMaxForwards-, hOrigin-, hPragma-, hProxyAuthenticate-, hProxyAuthorization-, hRange-, hReferer-, hRetryAfter-, hServer-, hTE-, hTrailer-, hTransferEncoding-, hUpgrade-, hUserAgent-, hVary-, hVia-, hWWWAuthenticate-, hWarning-, hContentDisposition-, hMIMEVersion-, hCookie-, hSetCookie- -- ** Byte ranges-, ByteRange(..)-, renderByteRangeBuilder-, renderByteRange-, ByteRanges-, renderByteRangesBuilder-, renderByteRanges-, parseByteRanges+{-# 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 Data.List-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid-#endif-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-import Data.ByteString.Char8 () {-IsString-}-import Data.Typeable (Typeable)-import Data.Data (Data)+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) --- | Header+-- | 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) --- | Header name+-- | 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 --- | Request Headers+-- | A list of 'Header's.+--+-- Same type as 'ResponseHeaders', but useful to differentiate in type signatures. type RequestHeaders = [Header] --- | Response Headers+-- | A list of 'Header's.+--+-- Same type as 'RequestHeaders', but useful to differentiate in type signatures. type ResponseHeaders = [Header] --- | HTTP Header names according to http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html-hAccept, hAcceptCharset, hAcceptEncoding, hAcceptLanguage, hAcceptRanges, hAge, hAllow, hAuthorization, hCacheControl, hConnection, hContentEncoding, hContentLanguage, hContentLength, hContentLocation, hContentMD5, hContentRange, hContentType, hDate, hETag, hExpect, hExpires, hFrom, hHost, hIfMatch, hIfModifiedSince, hIfNoneMatch, hIfRange, hIfUnmodifiedSince, hLastModified, hLocation, hMaxForwards, hPragma, hProxyAuthenticate, hProxyAuthorization, hRange, hReferer, hRetryAfter, hServer, hTE, hTrailer, hTransferEncoding, hUpgrade, hUserAgent, hVary, hVia, hWWWAuthenticate, hWarning :: HeaderName-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"-hContentEncoding = "Content-Encoding"-hContentLanguage = "Content-Language"-hContentLength = "Content-Length"-hContentLocation = "Content-Location"-hContentMD5 = "Content-MD5"-hContentRange = "Content-Range"-hContentType = "Content-Type"-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"-hPragma = "Pragma"-hProxyAuthenticate = "Proxy-Authenticate"+-- | [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"-hRange = "Range"-hReferer = "Referer"-hRetryAfter = "Retry-After"-hServer = "Server"-hTE = "TE"-hTrailer = "Trailer"-hTransferEncoding = "Transfer-Encoding"-hUpgrade = "Upgrade"-hUserAgent = "User-Agent"-hVary = "Vary"-hVia = "Via"-hWWWAuthenticate = "WWW-Authenticate"-hWarning = "Warning" --- | HTTP Header names according to http://www.w3.org/Protocols/rfc2616/rfc2616-sec19.html-hContentDisposition, hMIMEVersion :: HeaderName+-- | [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"-hMIMEVersion = "MIME-Version" --- | HTTP Header names according to https://tools.ietf.org/html/rfc6265#section-4-hCookie, hSetCookie :: HeaderName-hCookie = "Cookie"-hSetCookie = "Set-Cookie"+-- | [MIME-Version](https://www.rfc-editor.org/rfc/rfc2616.html#section-19.4.1)+--+-- @since 0.10+hMIMEVersion :: HeaderName+hMIMEVersion = "MIME-Version" --- | HTTP Header names according to https://tools.ietf.org/html/rfc6454+-- | [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" --- | RFC 2616 Byte range (individual).+-- | [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 (Show, Eq, Ord, Typeable, Data)+ = 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+ ) -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+-- | 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 = Blaze.toByteString . renderByteRangeBuilder+renderByteRange = BL.toStrict . B.toLazyByteString . renderByteRangeBuilder --- | RFC 2616 Byte ranges (set).+-- | A list of byte ranges.+--+-- @since 0.6.11 type ByteRanges = [ByteRange] -renderByteRangesBuilder :: ByteRanges -> Blaze.Builder-renderByteRangesBuilder xs = Blaze.copyByteString "bytes=" `mappend` - mconcat (intersperse (Blaze.fromChar ',') (map renderByteRangeBuilder xs))+-- | 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 = Blaze.toByteString . renderByteRangesBuilder+renderByteRanges = BL.toStrict . B.toLazyByteString . renderByteRangesBuilder -- | Parse the value of a Range header into a 'ByteRanges'. --@@ -204,11 +529,13 @@ -- 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+ ranges (r :) bs3 where range bs2 = do (i, bs3) <- B8.readInteger bs2@@ -224,8 +551,15 @@ | otherwise = do bs4 <- stripPrefixB "," bs3 (r, bs5) <- range bs4- ranges (front . (r:)) bs5+ ranges (front . (r :)) bs5 - stripPrefixB x y- | x `B.isPrefixOf` y = Just (B.drop (B.length x) y)- | otherwise = Nothing+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
Network/HTTP/Types/Method.hs view
@@ -1,46 +1,99 @@ {-# LANGUAGE DeriveDataTypeable #-}-module Network.HTTP.Types.Method-(- Method-, methodGet-, methodPost-, methodHead-, methodPut-, methodDelete-, methodTrace-, methodConnect-, methodOptions-, methodPatch-, StdMethod(..)-, parseMethod-, renderMethod-, renderStdMethod+{-# 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-import qualified Data.ByteString as B+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.Typeable+import Data.Data (Data)+import GHC.Generics (Generic) --- | HTTP method (flat string type).+-- $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 --- | HTTP Method constants.-methodGet, methodPost, methodHead, methodPut, methodDelete, methodTrace, methodConnect, methodOptions, methodPatch :: Method-methodGet = renderStdMethod GET-methodPost = renderStdMethod POST-methodHead = renderStdMethod HEAD-methodPut = renderStdMethod PUT-methodDelete = renderStdMethod DELETE-methodTrace = renderStdMethod TRACE+-- | 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-methodPatch = renderStdMethod PATCH +-- | 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@@ -50,26 +103,50 @@ | TRACE | CONNECT | OPTIONS- | PATCH- deriving (Read, Show, Eq, Ord, Enum, Bounded, Ix, Typeable)+ | -- | @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 'ByteString' to a 'StdMethod' if possible.+-- | 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 'ByteString'.+-- | 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 'ByteString'.+-- | Convert a 'StdMethod' to a 'B.ByteString'.+--+-- @since 0.2.0 renderStdMethod :: StdMethod -> Method renderStdMethod m = methodArray ! m
Network/HTTP/Types/QueryLike.hs view
@@ -1,43 +1,51 @@ {-# LANGUAGE FlexibleInstances #-}-module Network.HTTP.Types.QueryLike-(- QueryLike(..)-, QueryKeyLike(..)-, QueryValueLike(..)++-- | Some type classes to make more general functions when handling query strings.+module Network.HTTP.Types.QueryLike (+ QueryLike (..),+ QueryKeyLike (..),+ QueryValueLike (..), ) where -import Network.HTTP.Types.URI-import Data.Maybe-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import Control.Arrow+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: +--+-- 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+ -- | 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+ 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+ toQueryValue :: a -> Maybe B.ByteString instance (QueryKeyLike k, QueryValueLike v) => QueryLike [(k, v)] where- toQuery = map (toQueryKey *** toQueryValue)+ toQuery = map (toQueryKey *** toQueryValue) instance (QueryKeyLike k, QueryValueLike v) => QueryLike [Maybe (k, v)] where- toQuery = toQuery . catMaybes+ toQuery = toQuery . catMaybes instance QueryKeyLike B.ByteString where toQueryKey = id instance QueryKeyLike L.ByteString where toQueryKey = B.concat . L.toChunks@@ -48,6 +56,5 @@ 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 = maybe Nothing toQueryValue+ toQueryValue mVal = mVal >>= toQueryValue
Network/HTTP/Types/Status.hs view
@@ -1,132 +1,185 @@-{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}-module Network.HTTP.Types.Status-( Status(..)-, 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-, status500-, internalServerError500-, status501-, notImplemented501-, status502-, badGateway502-, status503-, serviceUnavailable503-, status504-, gatewayTimeout504-, status505-, status511-, networkAuthenticationRequired511-, httpVersionNotSupported505-, statusIsInformational-, statusIsSuccessful-, statusIsRedirection-, statusIsClientError-, statusIsServerError+{-# 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 qualified Data.ByteString as B-import Data.Typeable+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.+-- /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- , statusMessage :: B.ByteString- } deriving (Show, Typeable)+-- 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{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+ 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@@ -170,6 +223,7 @@ toEnum 428 = status428 toEnum 429 = status429 toEnum 431 = status431+ toEnum 451 = status451 toEnum 500 = status500 toEnum 501 = status501 toEnum 502 = status502@@ -177,25 +231,40 @@ toEnum 504 = status504 toEnum 505 = status505 toEnum 511 = status511- toEnum c = mkStatus c B.empty+ toEnum c = mkStatus c B.empty --- | Create a Status from status code and message.+-- | @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 i m = Status i m+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 @@ -216,42 +285,62 @@ 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 @@ -288,34 +377,50 @@ 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 @@ -336,10 +441,14 @@ 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 @@ -368,159 +477,248 @@ 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>)+-- (<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>)+-- (<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 RFC 6585>)+-- (<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 RFC 6585>)+-- (<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 RFC 6585>)+-- (<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 RFC 6585>)+-- (<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 RFC 6585>)+-- (<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 RFC 6585>)+-- (<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"@@ -530,71 +728,115 @@ 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 RFC 6585>)+-- (<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 RFC 6585>)+-- (<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+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+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+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+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+statusIsServerError (Status{statusCode = code}) = code >= 500 && code < 600
Network/HTTP/Types/URI.hs view
@@ -1,139 +1,236 @@-{-# LANGUAGE OverloadedStrings, CPP #-}-module Network.HTTP.Types.URI-(- -- * 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)-, extractPath-, encodePath-, decodePath- -- * URL encoding / decoding-, urlEncodeBuilder-, urlEncode-, urlDecode+{-# 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-import Data.Bits-import Data.Char-import Data.List-import Data.Maybe-#if __GLASGOW_HASKELL__ < 710-import Data.Monoid+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-import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8, decodeUtf8With)-import Data.Text.Encoding.Error (lenientDecode)-import Data.Word-import qualified Blaze.ByteString.Builder as Blaze-import qualified Data.ByteString as B-import Data.ByteString.Char8 () {-IsString-} --- | Query item+-- | 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) --- | Query.--- --- General form: a=b&c=d, but if the value is Nothing, it becomes--- a&c=d.+-- | 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 'Blaze.Builder'.-renderQueryText :: Bool -- ^ prepend a question mark?- -> QueryText- -> Blaze.Builder+-- | 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 'QueryText' from a 'B.ByteString'. See 'parseQuery' for details.+-- | 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.+-- | Simplified query item type without support for parameter-less items.+--+-- @since 0.2.0 type SimpleQueryItem = (B.ByteString, B.ByteString) --- | Simplified Query type without support for parameter-less items.+-- | A sequence of 'SimpleQueryItem's. type SimpleQuery = [SimpleQueryItem] -- | Convert 'SimpleQuery' to 'Query'.+--+-- @since 0.5 simpleQueryToQuery :: SimpleQuery -> Query-simpleQueryToQuery = map (\(a, b) -> (a, Just b))+simpleQueryToQuery = map (second Just) --- | Convert 'Query' to a 'Builder'.-renderQueryBuilder :: Bool -- ^ prepend a question mark?- -> Query- -> Blaze.Builder+-- | 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--- FIXME replace mconcat + map with foldr-renderQueryBuilder qmark' (p:ps) = mconcat- $ go (if qmark' then qmark else mempty) p- : map (go amp) ps+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 = 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- ]+ 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+ ] --- | Convert 'Query' to 'ByteString'.-renderQuery :: Bool -- ^ prepend question mark?- -> Query -> B.ByteString-renderQuery qm = Blaze.toByteString . renderQueryBuilder qm+-- | 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 --- | Convert 'SimpleQuery' to 'ByteString'.-renderSimpleQuery :: Bool -- ^ prepend question mark?- -> SimpleQuery -> B.ByteString+-- | 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".+--+-- * 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 = parseQueryString' . dropQuestion+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@@ -148,12 +245,12 @@ let (k, v) = B.break (== 61) x -- equal sign v'' = case B.uncons v of- Just (_, v') -> Just $ urlDecode True v'+ Just (_, v') -> Just $ urlDecode replacePlus v' _ -> Nothing- in (urlDecode True k, v'')+ in (urlDecode replacePlus k, v'') queryStringSeparators :: B.ByteString-queryStringSeparators = B.pack [38,59] -- ampersand, semicolon+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.@@ -162,7 +259,12 @@ let (x, y) = B.break (`B.elem` seps) s in (x, B.drop 1 y) --- | Parse 'SimpleQuery' from a 'ByteString'.+-- | 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 @@ -170,49 +272,96 @@ 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.-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+--+-- 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 --- | Percent-encoding for URLs (using 'Blaze.Builder').-urlEncodeBuilder- :: Bool -- ^ Whether input is in query string. True: Query string, False: Path element- -> B.ByteString- -> Blaze.Builder-urlEncodeBuilder True = urlEncodeBuilder' unreservedQS+ 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.-urlEncode :: Bool -- ^ Whether to decode '+' to ' '- -> B.ByteString -- ^ The ByteString to encode as URL- -> B.ByteString -- ^ The encoded URL-urlEncode q = Blaze.toByteString . urlEncodeBuilder q+--+-- 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.-urlDecode :: Bool -- ^ Whether to decode '+' to ' '- -> B.ByteString -> B.ByteString+--+-- 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- Just (43, ws) | replacePlus -> Just (32, ws) -- plus to space- Just (37, ws) -> Just $ fromMaybe (37, ws) $ do -- percent+ -- 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@@ -220,55 +369,62 @@ 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+ | 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.--- +--+-- * 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\", \"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+--+-- >>> 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.-encodePathSegments :: [Text] -> Blaze.Builder-encodePathSegments [] = mempty-encodePathSegments (x:xs) =- Blaze.copyByteString "/"- `mappend` encodePathSegment x- `mappend` encodePathSegments xs+--+-- @since 0.5+encodePathSegments :: [Text] -> B.Builder+encodePathSegments = foldr (\x -> mappend (B.byteString "/" `mappend` encodePathSegment x)) mempty --- | Like encodePathSegments, but without the initial slash.-encodePathSegmentsRelative :: [Text] -> Blaze.Builder-encodePathSegmentsRelative xs = mconcat $ intersperse (Blaze.copyByteString "/") (map encodePathSegment xs)+-- | 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 -> Blaze.Builder+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 "/" = []@@ -281,17 +437,24 @@ _ -> bs go bs = let (x, y) = B.break (== 47) bs- in decodePathSegment x :- if B.null y- then []- else go $ B.drop 1 y+ 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--- <http://tools.ietf.org/html/rfc2616#section-5.1.2 RFC 2616 Request-URI>.+-- [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" --@@ -303,24 +466,101 @@ -- -- >>> 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+ | "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+ ensureNonEmpty p = p -- | Encode a whole path (path segments + query).-encodePath :: [Text] -> Query -> Blaze.Builder+--+-- @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)+ 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
Network/HTTP/Types/Version.hs view
@@ -1,26 +1,37 @@ {-# LANGUAGE DeriveDataTypeable #-}-module Network.HTTP.Types.Version-(- HttpVersion(..)-, http09-, http10-, http11-, http20-)-where+{-# LANGUAGE DeriveGeneric #-} -import Data.Typeable+-- | 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, Typeable)+-- 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 @@ -37,5 +48,13 @@ 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
− README
@@ -1,5 +0,0 @@-Generic HTTP types for Haskell (for both client and server code).--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.
+ README.md view
@@ -0,0 +1,21 @@++[](https://hackage.haskell.org/package/http-types)+[](http://stackage.org/lts/package/http-types)+[](http://stackage.org/nightly/package/http-types)+[](./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.
http-types.cabal view
@@ -1,26 +1,34 @@+Cabal-version: 2.2 Name: http-types-Version: 0.10+Version: 0.12.5 Synopsis: Generic HTTP types for Haskell (for both client and server code).-Description: Generic HTTP types for Haskell (for both client and server code).-Homepage: https://github.com/aristidb/http-types-License: BSD3+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 Author: Aristid Breitkreuz, Michael Snoyman-Maintainer: aristidb@googlemail.com-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-Extra-source-files: README, CHANGELOG-Cabal-version: >=1.8+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 Source-repository this type: git- location: https://github.com/aristidb/http-types.git- tag: 0.10+ location: https://github.com/Vlix/http-types.git+ tag: v0.12.5 Source-repository head type: git- location: https://github.com/aristidb/http-types.git+ location: https://github.com/Vlix/http-types.git Library Exposed-modules: Network.HTTP.Types@@ -31,30 +39,40 @@ Network.HTTP.Types.URI Network.HTTP.Types.Version GHC-Options: -Wall- Build-depends: base >= 4 && < 5,- bytestring >=0.9.1.5 && <0.11,- array >=0.2 && <0.6,- case-insensitive >=0.2 && <1.3,- blaze-builder >= 0.2.1.4 && < 0.5,- text >= 0.11.0.2+ 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 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- build-depends: base,- http-types,- text,+ default-language: Haskell2010+ build-tool-depends: hspec-discover:hspec-discover+ build-depends: base < 5, bytestring,- blaze-builder,+ case-insensitive,+ filepath,+ hspec >= 1.3,+ hspec-golden >= 0.2,+ http-types, QuickCheck, quickcheck-instances,- hspec >= 1.3+ text Test-Suite doctests main-is: doctests.hs hs-source-dirs: test type: exitcode-stdio-1.0 ghc-options: -threaded -Wall- build-depends: base, doctest >= 0.9.3+ default-language: Haskell2010+ build-depends: base < 5, doctest >= 0.19.0
+ test/.golden/urlEncode-path/golden view
@@ -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
+ test/.golden/urlEncode-query/golden view
@@ -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
+ test/Network/HTTP/Types/HeaderSpec.hs view
@@ -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
+ test/Network/HTTP/Types/MethodSpec.hs view
@@ -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]
+ test/Network/HTTP/Types/StatusSpec.hs view
@@ -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
+ test/Network/HTTP/Types/URISpec.hs view
@@ -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
+ test/Network/HTTP/Types/VersionSpec.hs view
@@ -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
test/doctests.hs view
@@ -3,10 +3,8 @@ import Test.DocTest main :: IO ()-main = doctest [- "-idist/build/autogen/"- , "-optP-include"- , "-optPdist/build/autogen/cabal_macros.h"- , "-XOverloadedStrings"- , "Network/HTTP/Types.hs"- ]+main =+ doctest+ [ "-XOverloadedStrings"+ , "Network/HTTP/Types.hs"+ ]