http-types 0.12.3 → 0.12.4
raw patch · 10 files changed
+1704/−748 lines, 10 filesnew-uploader
Files
- CHANGELOG +26/−25
- Network/HTTP/Types.hs +236/−198
- Network/HTTP/Types/Header.hs +479/−153
- Network/HTTP/Types/Method.hs +111/−32
- Network/HTTP/Types/QueryLike.hs +29/−22
- Network/HTTP/Types/Status.hs +330/−118
- Network/HTTP/Types/URI.hs +344/−174
- Network/HTTP/Types/Version.hs +31/−17
- http-types.cabal +14/−9
- test/Network/HTTP/Types/URISpec.hs +104/−0
CHANGELOG view
@@ -1,43 +1,44 @@-* 0.12.3 [2019-02-24]--Remove now-invalid doctest options from doctests.hs.--* 0.12.2 [2018-09-26]+# Changelog for `http-types` -Add new parseQueryReplacePlus function, which allows specifying whether to replace '+' with ' '.+## 0.12.4 [2023-11-29] -Add header name constants for "Prefer" and "Preference-Applied" (RFC 7240).+* Add `Data` and `Generic` instances to `ByteRange`, `StdMethod`, `Status` and `HttpVersion`.+* Rework of all the documentation, with the addition of `@since` notations. -* 0.12.1 [2018-01-31]+## 0.12.3 [2019-02-24] -Add new functions for constructing a query URI where not all parts are escaped.+* Remove now-invalid doctest options from `doctests.hs`. -* 0.12 [2018-01-28]+## 0.12.2 [2018-09-26] -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.+* Add new `parseQueryReplacePlus` function, which allows specifying whether to replace `'+'` with `' '`.+* Add header name constants for "Prefer" and "Preference-Applied" (RFC 7240). -* 0.11 [2017-11-29]+## 0.12.1 [2018-01-31] -Remove dependency on blaze-builder. (Note that as a side effect of this, URI encoding is now using lower-case rather than uppercase hexadecimal.)+* Add new functions for constructing a query URI where not all parts are escaped. -Add Bounded instance to Status.+## 0.12 [2018-01-28] -Re-export more status codes and http20 from Network.HTTP.Types.+* 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.10 [2017-10-22]+## 0.11 [2017-11-29] -New status codes, new headers.+* 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`. -Fixed typo in imATeapot, added missing toEnum.+## 0.10 [2017-10-22] -Oh, and http20.+* New status codes, new headers.+* Fixed typo in `imATeapot`, added missing `toEnum`.+* Oh, and `http20`. -* 0.9.1 [2016-06-04]+## 0.9.1 [2016-06-04] -New function: parseByteRanges.-Support for HTTP status 422 "Unprocessable Entity" (RFC 4918).+* New function: `parseByteRanges`.+* Support for HTTP status 422 "Unprocessable Entity" (RFC 4918). -* 0.9 [2015-10-09]+## 0.9 [2015-10-09] -No changelog was maintained up to version 0.9.+* No changelog was maintained up to version `0.9`.
Network/HTTP/Types.hs view
@@ -1,201 +1,239 @@-{-# 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-, http20--- * 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-, status428-, preconditionRequired428-, status429-, tooManyRequests429-, status431-, requestHeaderFieldsTooLarge431-, status500-, internalServerError500-, status501-, notImplemented501-, status502-, badGateway502-, status503-, serviceUnavailable503-, status504-, gatewayTimeout504-, status505-, httpVersionNotSupported505-, status511-, networkAuthenticationRequired511-, 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- -- **Escape only parts-, renderQueryPartialEscape-, renderQueryBuilderPartialEscape-, EscapeItem(..)-, PartialEscapeQueryItem-, PartialEscapeQuery- -- *** 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,++ -- * 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,+ status428,+ preconditionRequired428,+ status429,+ tooManyRequests429,+ status431,+ requestHeaderFieldsTooLarge431,+ 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,++ -- ** 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++ -- | __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 (toQuery),++ -- ** 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,195 +1,517 @@-{-# 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-, hPrefer-, hPreferenceApplied-, 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+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL+import qualified Data.CaseInsensitive as CI+import Data.Data (Data)+import Data.List (intersperse) #if __GLASGOW_HASKELL__ < 710-import Data.Monoid+import Data.Monoid #endif-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString.Builder as B-import qualified Data.ByteString.Lazy as BL-import qualified Data.CaseInsensitive as CI-import Data.ByteString.Char8 () {-IsString-}-import Data.Typeable (Typeable)-import Data.Data (Data)+import Data.Typeable (Typeable)+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 9110./+--+-- @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" --- | HTTP Header names according to https://tools.ietf.org/html/rfc7240-hPrefer, hPreferenceApplied :: HeaderName+-- | [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" --- | RFC 2616 Byte range (individual).+-- | An individual byte range. -- -- 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+ Typeable+ , -- | @since 0.8.4+ Data+ , -- | @since 0.12.4+ Generic+ ) +-- | Turns a byte range into a byte string 'B.Builder'.+--+-- @since 0.6.11 renderByteRangeBuilder :: ByteRange -> B.Builder renderByteRangeBuilder (ByteRangeFrom from) = B.integerDec from `mappend` B.char7 '-' renderByteRangeBuilder (ByteRangeFromTo from to) = B.integerDec from `mappend` B.char7 '-' `mappend` B.integerDec to renderByteRangeBuilder (ByteRangeSuffix suffix) = B.char7 '-' `mappend` B.integerDec suffix +-- | Renders a byte range into a 'B.ByteString'.+--+-- >>> renderByteRange (ByteRangeFrom 2048)+-- "2048-"+--+-- @since 0.6.11 renderByteRange :: ByteRange -> B.ByteString renderByteRange = BL.toStrict . B.toLazyByteString . renderByteRangeBuilder --- | RFC 2616 Byte ranges (set).+-- | A list of byte ranges.+--+-- @since 0.6.11 type ByteRanges = [ByteRange] +-- | Turns a list of byte ranges into a byte string 'B.Builder'.+--+-- @since 0.6.11 renderByteRangesBuilder :: ByteRanges -> B.Builder-renderByteRangesBuilder xs = B.byteString "bytes=" `mappend`- mconcat (intersperse (B.char7 ',') (map renderByteRangeBuilder xs))+renderByteRangesBuilder xs =+ B.byteString "bytes="+ `mappend` mconcat (intersperse (B.char7 ',') $ map renderByteRangeBuilder xs) +-- | Renders a list of byte ranges into a 'B.ByteString'.+--+-- >>> renderByteRanges [ByteRangeFrom 2048, ByteRangeSuffix 20]+-- "bytes=2048-,-20"+--+-- @since 0.6.11 renderByteRanges :: ByteRanges -> B.ByteString renderByteRanges = BL.toStrict . B.toLazyByteString . renderByteRangesBuilder @@ -211,11 +533,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@@ -231,8 +555,10 @@ | otherwise = do bs4 <- stripPrefixB "," bs3 (r, bs5) <- range bs4- ranges (front . (r:)) bs5+ ranges (front . (r :)) bs5 + -- FIXME: Use 'stripPrefix' from the 'bytestring' package.+ -- Might have to update the dependency constraints though. stripPrefixB x y | x `B.isPrefixOf` y = Just (B.drop (B.length x) y) | otherwise = Nothing
Network/HTTP/Types/Method.hs view
@@ -1,46 +1,100 @@ {-# 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 '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 Data.Typeable (Typeable)+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 '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+-- | HTTP GET Method+methodGet :: Method+methodGet = renderStdMethod GET++-- | HTTP POST Method+methodPost :: Method+methodPost = renderStdMethod POST++-- | HTTP HEAD Method+methodHead :: Method+methodHead = renderStdMethod HEAD++-- | HTTP PUT Method+methodPut :: Method+methodPut = renderStdMethod PUT++-- | HTTP DELETE Method+methodDelete :: Method+methodDelete = renderStdMethod DELETE++-- | HTTP TRACE Method+methodTrace :: Method+methodTrace = renderStdMethod TRACE++-- | HTTP CONNECT Method+methodConnect :: Method methodConnect = renderStdMethod CONNECT++-- | HTTP OPTIONS Method+methodOptions :: Method methodOptions = renderStdMethod OPTIONS-methodPatch = renderStdMethod PATCH +-- | HTTP 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 +104,51 @@ | 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+ , Typeable+ , -- | @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.+--+-- @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'.+--+-- prop> renderMethod (parseMethod bs) == bs+--+-- @since 0.3.0 renderMethod :: Either B.ByteString StdMethod -> Method renderMethod = id ||| renderStdMethod -- | Convert a 'StdMethod' to a '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 = maybe Nothing toQueryValue
Network/HTTP/Types/Status.hs view
@@ -1,132 +1,179 @@-{-# 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,+ status500,+ internalServerError500,+ status501,+ notImplemented501,+ status502,+ badGateway502,+ status503,+ serviceUnavailable503,+ status504,+ gatewayTimeout504,+ status505,+ status511,+ networkAuthenticationRequired511,+ httpVersionNotSupported505,++ -- * 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 Data.Typeable (Typeable)+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+ , statusMessage :: B.ByteString+ }+ deriving+ ( Show+ , Typeable+ , -- | @since 0.12.4+ Data+ , -- | @since 0.12.4+ Generic+ ) +-- FIXME: If the data constructor of 'Status' is ever deprecated, we should define+-- a pattern synonym to minimize any breakage. This also involves changing the+-- name of the constructor, so that it doesn't clash with the new pattern synonym+-- that's replacing it.+--+-- > data Status = MkStatus ...+-- > pattern Status code msg = MkStatus code msg++-- | A 'Status' is equal to another 'Status' if the status codes are equal. instance Eq Status where Status { statusCode = a } == Status { statusCode = b } = a == b +-- | 'Status'es are ordered according to their status codes only. instance Ord Status where compare Status { statusCode = a } Status { statusCode = b } = a `compare` b +-- | Be advised, that when using the \"enumFrom*\" family of methods or+-- ranges in lists, it will generate all possible status codes.+--+-- E.g. @[status100 .. status200]@ generates 'Status'es of @100, 101, 102 .. 198, 199, 200@+--+-- The statuses not included in this library will have an empty message.+--+-- @since 0.7.3 instance Enum Status where fromEnum = statusCode toEnum 100 = status100@@ -177,29 +224,38 @@ toEnum 504 = status504 toEnum 505 = status505 toEnum 511 = status511- toEnum c = mkStatus c B.empty+ toEnum c = mkStatus c B.empty +-- | @since 0.11 instance Bounded Status where- minBound = status100- maxBound = status511+ minBound = status100+ maxBound = status511 --- | Create a Status from status code and message.+-- | Create a 'Status' from a status code and message. mkStatus :: Int -> B.ByteString -> Status mkStatus = Status -- | Continue 100+--+-- @since 0.6.6 status100 :: Status status100 = mkStatus 100 "Continue" -- | Continue 100+--+-- @since 0.6.6 continue100 :: Status continue100 = status100 -- | Switching Protocols 101+--+-- @since 0.6.6 status101 :: Status status101 = mkStatus 101 "Switching Protocols" -- | Switching Protocols 101+--+-- @since 0.6.6 switchingProtocols101 :: Status switchingProtocols101 = status101 @@ -220,42 +276,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 @@ -292,34 +368,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 @@ -340,10 +432,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 @@ -372,156 +468,228 @@ 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 -- | 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>)+--+-- @since 0.10 status426 :: Status status426 = mkStatus 426 "Upgrade Required" -- | Upgrade Required 426 -- (<https://tools.ietf.org/html/rfc7231#section-6.5.15>)+--+-- @since 0.10 upgradeRequired426 :: Status upgradeRequired426 = status426 -- | Precondition Required 428 -- (<https://tools.ietf.org/html/rfc6585 RFC 6585>)+--+-- @since 0.8.5 status428 :: Status status428 = mkStatus 428 "Precondition Required" -- | Precondition Required 428 -- (<https://tools.ietf.org/html/rfc6585 RFC 6585>)+--+-- @since 0.8.5 preconditionRequired428 :: Status preconditionRequired428 = status428 -- | Too Many Requests 429 -- (<https://tools.ietf.org/html/rfc6585 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>)+--+-- @since 0.8.5 tooManyRequests429 :: Status tooManyRequests429 = status429 -- | Request Header Fields Too Large 431 -- (<https://tools.ietf.org/html/rfc6585 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>)+--+-- @since 0.8.5 requestHeaderFieldsTooLarge431 :: Status requestHeaderFieldsTooLarge431 = status431 @@ -534,71 +702,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>)+--+-- @since 0.8.5 status511 :: Status status511 = mkStatus 511 "Network Authentication Required" -- | Network Authentication Required 511 -- (<https://tools.ietf.org/html/rfc6585 RFC 6585>)+--+-- @since 0.8.5 networkAuthenticationRequired511 :: Status networkAuthenticationRequired511 = status511 -- | Informational class+--+-- Checks if the status is in the 1XX range.+--+-- @since 0.8.0 statusIsInformational :: Status -> Bool statusIsInformational (Status {statusCode=code}) = code >= 100 && code < 200 -- | Successful class+--+-- Checks if the status is in the 2XX range.+--+-- @since 0.8.0 statusIsSuccessful :: Status -> Bool statusIsSuccessful (Status {statusCode=code}) = code >= 200 && code < 300 -- | Redirection class+--+-- Checks if the status is in the 3XX range.+--+-- @since 0.8.0 statusIsRedirection :: Status -> Bool statusIsRedirection (Status {statusCode=code}) = code >= 300 && code < 400 -- | Client Error class+--+-- Checks if the status is in the 4XX range.+--+-- @since 0.8.0 statusIsClientError :: Status -> Bool statusIsClientError (Status {statusCode=code}) = code >= 400 && code < 500 -- | Server Error class+--+-- Checks if the status is in the 5XX range.+--+-- @since 0.8.0 statusIsServerError :: Status -> Bool statusIsServerError (Status {statusCode=code}) = code >= 500 && code < 600
Network/HTTP/Types/URI.hs view
@@ -1,152 +1,228 @@-{-# LANGUAGE OverloadedStrings, CPP #-}-module Network.HTTP.Types.URI-(- -- * Query string- QueryItem-, Query-, SimpleQueryItem-, SimpleQuery-, simpleQueryToQuery-, renderQuery-, renderQueryBuilder-, renderSimpleQuery-, parseQuery-, parseQueryReplacePlus-, parseSimpleQuery- -- **Escape only parts-, renderQueryPartialEscape-, renderQueryBuilderPartialEscape-, EscapeItem(..)-, PartialEscapeQueryItem-, PartialEscapeQuery- -- ** 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+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) #if __GLASGOW_HASKELL__ < 710-import Data.Monoid+import Data.Monoid #endif-import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8, decodeUtf8With)-import Data.Text.Encoding.Error (lenientDecode)-import Data.Word-import qualified Data.ByteString as B-import qualified Data.ByteString.Builder as B-import qualified Data.ByteString.Lazy as BL-import Data.ByteString.Char8 () {-IsString-}+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8With, encodeUtf8)+import Data.Text.Encoding.Error (lenientDecode)+import Data.Word (Word8) --- | 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 'B.Builder'.-renderQueryText :: Bool -- ^ prepend a question mark?- -> QueryText- -> 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 (second Just) --- | Convert 'Query' to a 'Builder'.-renderQueryBuilder :: Bool -- ^ prepend a question mark?- -> Query- -> B.Builder+-- | Renders the given 'Query' into a '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 = 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- ]+ 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+-- | 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 'ByteString'.+--+-- If you want a question mark (@?@) added to the front of the result, use 'True'.+--+-- @since 0.2.0+renderSimpleQuery :: Bool -> SimpleQuery -> B.ByteString renderSimpleQuery useQuestionMark = renderQuery useQuestionMark . simpleQueryToQuery -- | Split out the query string into a list of keys and values. A few -- importants points:--- +-- -- * The result returned is still bytestrings, since we perform no character -- decoding here. Most likely, you will want to use UTF-8 decoding, but this is -- left to the user of the library.--- +-- -- * Percent decoding errors are ignored. In particular, @"%Q"@ will be output as -- @"%Q"@. -- -- * It decodes @\'+\'@ characters to @\' \'@+--+-- @since 0.2.0 parseQuery :: B.ByteString -> Query parseQuery = parseQueryReplacePlus True --- | Same functionality as 'parseQuery' with the option to decode @\'+\'@ characters to @\' \'@--- or preserve @\'+\'@+-- | 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@@ -168,7 +244,7 @@ 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.@@ -178,6 +254,11 @@ in (x, B.drop 1 y) -- | Parse 'SimpleQuery' from a '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 @@ -186,50 +267,89 @@ unreservedQS, unreservedPI :: [Word8] unreservedQS = map ord8 "-_.~"+-- FIXME: According to RFC 3986, the following are also allowed in path segments:+-- "!'()*;"+--+-- https://www.rfc-editor.org/rfc/rfc3986#section-3.3 unreservedPI = map ord8 "-_.~:@&=+$," -- | Percent-encoding for URLs.+--+-- This will substitute every byte with its percent-encoded equivalent unless:+--+-- * The byte is alphanumeric. (i.e. one of @/[A-Za-z0-9]/@)+--+-- * The byte is one of the 'Word8' listed in the first argument. urlEncodeBuilder' :: [Word8] -> B.ByteString -> B.Builder-urlEncodeBuilder' extraUnreserved = mconcat . map encodeChar . B.unpack- where- encodeChar ch | unreserved ch = B.word8 ch- | otherwise = h2 ch+urlEncodeBuilder' extraUnreserved =+ mconcat . map encodeChar . B.unpack+ where+ encodeChar ch+ | unreserved ch = B.word8 ch+ | otherwise = h2 ch - unreserved ch | ch >= 65 && ch <= 90 = True -- A-Z- | ch >= 97 && ch <= 122 = True -- a-z- | ch >= 48 && ch <= 57 = True -- 0-9- unreserved c = c `elem` extraUnreserved+ 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+ -- 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 (using 'B.Builder').-urlEncodeBuilder- :: Bool -- ^ Whether input is in query string. True: Query string, False: Path element- -> B.ByteString- -> B.Builder-urlEncodeBuilder True = urlEncodeBuilder' unreservedQS+-- | 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+--+-- 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@@ -237,41 +357,51 @@ 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.+--+-- @since 0.5 encodePathSegments :: [Text] -> B.Builder encodePathSegments = foldr (\x -> mappend (B.byteString "/" `mappend` encodePathSegment x)) mempty --- | Like encodePathSegments, but without the initial slash.+-- | Like 'encodePathSegments', but without the initial slash.+--+-- @since 0.6.10 encodePathSegmentsRelative :: [Text] -> B.Builder encodePathSegmentsRelative xs = mconcat $ intersperse (B.byteString "/") (map encodePathSegment xs) @@ -279,6 +409,10 @@ 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 "/" = []@@ -291,17 +425,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" --@@ -313,72 +454,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).+--+-- @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) ----------------------------------------------------------------------------------------- --- | For some URIs characters must not be URI encoded,--- e.g. @\'+\'@ or @\':\'@ in @q=a+language:haskell+created:2009-01-01..2009-02-01&sort=stars@--- The character list unreservedPI instead of unreservedQS would solve this.--- But we explicitly decide what part to encode.--- This is mandatory when searching for @\'+\'@: @q=%2B+language:haskell@.-data EscapeItem = QE B.ByteString -- will be URL encoded- | QN B.ByteString -- will not be url encoded, e.g. @\'+\'@ or @\':\'@+-- | 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) --- | Query item+-- | 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 chars that should not be escaped.--- +-- | 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 'ByteString'.-renderQueryPartialEscape :: Bool -- ^ prepend question mark?- -> PartialEscapeQuery -> B.ByteString-renderQueryPartialEscape qm = BL.toStrict . B.toLazyByteString . renderQueryBuilderPartialEscape qm+--+-- 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 'PartialEscapeQuery' to a 'Builder'.-renderQueryBuilderPartialEscape :: Bool -- ^ prepend a question mark?- -> PartialEscapeQuery- -> B.Builder+-- | 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+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))- ]+ 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,38 @@ {-# 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,+) where +import Data.Data (Data)+import Data.Typeable (Typeable)+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+ , Typeable+ , -- | @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 +49,7 @@ http11 = HttpVersion 1 1 -- | HTTP 2.0+--+-- @since 0.10 http20 :: HttpVersion http20 = HttpVersion 2 0
http-types.cabal view
@@ -1,26 +1,27 @@+Cabal-version: 3.0 Name: http-types-Version: 0.12.3+Version: 0.12.4 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+Maintainer: felix.paulusma@gmail.com Copyright: (C) 2011 Aristid Breitkreuz Category: Network, Web Build-type: Simple Extra-source-files: README, CHANGELOG-Cabal-version: >=1.8 Source-repository this type: git- location: https://github.com/aristidb/http-types.git- tag: 0.12.3+ location: https://github.com/Vlix/http-types.git+ tag: 0.12.4 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@@ -36,12 +37,15 @@ array >=0.2 && <0.6, case-insensitive >=0.2 && <1.3, text >= 0.11.0.2+ Default-language: Haskell2010 Test-suite spec main-is: Spec.hs hs-source-dirs: test+ other-modules: Network.HTTP.Types.URISpec type: exitcode-stdio-1.0 GHC-Options: -Wall+ default-language: Haskell2010 build-depends: base, http-types, text,@@ -55,4 +59,5 @@ hs-source-dirs: test type: exitcode-stdio-1.0 ghc-options: -threaded -Wall+ default-language: Haskell2010 build-depends: base, doctest >= 0.9.3
+ test/Network/HTTP/Types/URISpec.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.HTTP.Types.URISpec (main, spec) where++import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Instances ()++import Debug.Trace+import Data.Text (Text)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Lazy as BL++import Network.HTTP.Types.URI++main :: IO ()+main = hspec spec++propEncodeDecodePath :: ([Text], Query) -> Bool+propEncodeDecodePath (p', q') =+ let x = BL.toStrict . B.toLazyByteString $ encodePath a b+ y = decodePath x+ z = y == (a, b)+ in if z then z else traceShow (a, b, x, y) z+ where+ a = if p' == [""] then [] else p'+ b = filter (\(x, _) -> not (B.null x)) q'++propEncodeDecodeQuery :: Query -> Bool+propEncodeDecodeQuery q' =+ q == parseQuery (renderQuery True q)+ where+ q = filter (\(x, _) -> not (B.null x)) q'++propQueryQuestionMark :: (Bool, Query) -> Bool+propQueryQuestionMark (useQuestionMark, query) = actual == expected+ where+ actual = case B8.uncons $ renderQuery useQuestionMark query of+ Nothing -> False+ Just ('?', _) -> True+ _ -> False+ expected = case (useQuestionMark, null query) of+ (False, _) -> False+ (True, True) -> False+ (True, False) -> True++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" $+ BL.toStrict (B.toLazyByteString (encodePath ["foo-bar.baz"] [])) `shouldBe` "/foo-bar.baz"++ describe "encode/decode query" $ do+ it "is identity to encode and then decode" $+ property propEncodeDecodeQuery++ it "add ? in front of Query if and only if necessary" $+ property propQueryQuestionMark++ describe "decodePathSegments" $ do+ it "is inverse to encodePathSegments" $+ property $ \p -> not (p == [""]) ==> do+ (decodePathSegments . BL.toStrict . B.toLazyByteString . encodePathSegments) p `shouldBe` 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 `shouldBe` p++ context "when path is empty" $ do+ it "returns /" $ do+ extractPath "" `shouldBe` "/"++ context "when used with an absolute URL" $ do+ context "when used with a HTTP URL" $ do+ it "it extracts path" $ do+ extractPath "http://example.com/foo" `shouldBe` "/foo"++ context "when path is empty" $ do+ it "returns /" $ do+ extractPath "http://example.com" `shouldBe` "/"++ context "when used with a HTTPS URL" $ do+ it "it extracts path" $ do+ extractPath "https://example.com/foo" `shouldBe` "/foo"++ context "when path is empty" $ do+ it "returns /" $ do+ extractPath "https://example.com" `shouldBe` "/"++ describe "parseQuery" $ do+ it "returns value with '+' replaced to ' '" $ do+ parseQuery "?a=b+c+d" `shouldBe` [("a", Just "b c d")]++ describe "parseQueryReplacePlus" $ do+ it "returns value with '+' replaced to ' '" $ do+ parseQueryReplacePlus True "?a=b+c+d" `shouldBe` [("a", Just "b c d")]++ it "returns value with '+' preserved" $ do+ parseQueryReplacePlus False "?a=b+c+d" `shouldBe` [("a", Just "b+c+d")]