diff --git a/CHANGELOG b/CHANGELOG index 6e6f60a..9145096 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,43 +1,44 @@ -* 0.12.3 [2019-02-24] +# Changelog for `http-types` -Remove now-invalid doctest options from doctests.hs. +## 0.12.4 [2023-11-29] -* 0.12.2 [2018-09-26] +* Add `Data` and `Generic` instances to `ByteRange`, `StdMethod`, `Status` and `HttpVersion`. +* Rework of all the documentation, with the addition of `@since` notations. -Add new parseQueryReplacePlus function, which allows specifying whether to replace '+' with ' '. +## 0.12.3 [2019-02-24] -Add header name constants for "Prefer" and "Preference-Applied" (RFC 7240). +* Remove now-invalid doctest options from `doctests.hs`. -* 0.12.1 [2018-01-31] +## 0.12.2 [2018-09-26] -Add new functions for constructing a query URI where not all parts are escaped. +* Add new `parseQueryReplacePlus` function, which allows specifying whether to replace `'+'` with `' '`. +* Add header name constants for "Prefer" and "Preference-Applied" (RFC 7240). -* 0.12 [2018-01-28] +## 0.12.1 [2018-01-31] -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 functions for constructing a query URI where not all parts are escaped. -* 0.11 [2017-11-29] +## 0.12 [2018-01-28] -Remove dependency on blaze-builder. (Note that as a side effect of this, URI encoding is now using lower-case rather than uppercase hexadecimal.) +* 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 Bounded instance to Status. +## 0.11 [2017-11-29] -Re-export more status codes and http20 from Network.HTTP.Types. +* 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] +## 0.10 [2017-10-22] -New status codes, new headers. +* New status codes, new headers. +* Fixed typo in `imATeapot`, added missing `toEnum`. +* Oh, and `http20`. -Fixed typo in imATeapot, added missing toEnum. +## 0.9.1 [2016-06-04] -Oh, and http20. +* New function: `parseByteRanges`. +* Support for HTTP status 422 "Unprocessable Entity" (RFC 4918). -* 0.9.1 [2016-06-04] +## 0.9 [2015-10-09] -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. +* No changelog was maintained up to version `0.9`. diff --git a/Network/HTTP/Types.hs b/Network/HTTP/Types.hs index 2d9b306..8d957e9 100644 --- a/Network/HTTP/Types.hs +++ b/Network/HTTP/Types.hs @@ -1,6 +1,11 @@ module Network.HTTP.Types ( -- * Methods + + -- | __For more information__: "Network.HTTP.Types.Method" + Method, + + -- ** Constants methodGet, methodPost, methodHead, @@ -11,11 +16,16 @@ module Network.HTTP.Types ( methodOptions, methodPatch, StdMethod (..), + + -- ** Parsing and redering methods parseMethod, renderMethod, renderStdMethod, -- * Versions + + -- | __For more information__: "Network.HTTP.Types.Version" + HttpVersion (..), http09, http10, @@ -23,7 +33,12 @@ module Network.HTTP.Types ( http20, -- * Status + + -- | __For more information__: "Network.HTTP.Types.Status" + Status (..), + + -- ** Constants mkStatus, status100, continue100, @@ -127,6 +142,8 @@ module Network.HTTP.Types ( -- * Headers + -- | __For more information__: "Network.HTTP.Types.Header" + -- ** Types Header, HeaderName, @@ -165,24 +182,17 @@ module Network.HTTP.Types ( -- * URI - -- ** Query string - QueryItem, + -- | __For more extensive information__: "Network.HTTP.Types.URI" + + -- ** Query strings + + -- *** Query Query, - SimpleQueryItem, - SimpleQuery, - simpleQueryToQuery, + QueryItem, renderQuery, renderQueryBuilder, - renderSimpleQuery, parseQuery, - parseSimpleQuery, - - -- ** Escape only parts - renderQueryPartialEscape, - renderQueryBuilderPartialEscape, - EscapeItem (..), - PartialEscapeQueryItem, - PartialEscapeQuery, + parseQueryReplacePlus, -- *** Text query string (UTF8 encoded) QueryText, @@ -191,22 +201,38 @@ module Network.HTTP.Types ( renderQueryText, parseQueryText, + -- *** SimpleQuery + SimpleQuery, + SimpleQueryItem, + simpleQueryToQuery, + renderSimpleQuery, + parseSimpleQuery, + + -- *** PartialEscapeQuery + PartialEscapeQuery, + PartialEscapeQueryItem, + EscapeItem (..), + renderQueryPartialEscape, + renderQueryBuilderPartialEscape, + -- ** Generalized query types QueryLike (toQuery), - -- ** Path segments - encodePathSegments, - decodePathSegments, - encodePathSegmentsRelative, + -- ** Path - -- ** Path (segments + query string) + -- *** Segments + Query String extractPath, encodePath, decodePath, + -- *** Path Segments + encodePathSegments, + encodePathSegmentsRelative, + decodePathSegments, + -- ** URL encoding / decoding - urlEncodeBuilder, urlEncode, + urlEncodeBuilder, urlDecode, ) where diff --git a/Network/HTTP/Types/Header.hs b/Network/HTTP/Types/Header.hs index 3d81d76..4eae93f 100644 --- a/Network/HTTP/Types/Header.hs +++ b/Network/HTTP/Types/Header.hs @@ -5,14 +5,20 @@ {-# 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 ( - -- ** Types + -- * HTTP Headers Header, HeaderName, RequestHeaders, ResponseHeaders, -- ** Common headers + + -- | The following header constants are provided for convenience, + -- to prevent accidental spelling errors. hAccept, hAcceptCharset, hAcceptEncoding, @@ -23,6 +29,7 @@ module Network.HTTP.Types.Header ( hAuthorization, hCacheControl, hConnection, + hContentDisposition, hContentEncoding, hContentLanguage, hContentLength, @@ -30,6 +37,7 @@ module Network.HTTP.Types.Header ( hContentMD5, hContentRange, hContentType, + hCookie, hDate, hETag, hExpect, @@ -44,6 +52,7 @@ module Network.HTTP.Types.Header ( hLastModified, hLocation, hMaxForwards, + hMIMEVersion, hOrigin, hPragma, hPrefer, @@ -54,6 +63,7 @@ module Network.HTTP.Types.Header ( hReferer, hRetryAfter, hServer, + hSetCookie, hTE, hTrailer, hTransferEncoding, @@ -63,12 +73,12 @@ module Network.HTTP.Types.Header ( hVia, hWWWAuthenticate, hWarning, - hContentDisposition, - hMIMEVersion, - hCookie, - hSetCookie, -- ** 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, @@ -79,128 +89,429 @@ module Network.HTTP.Types.Header ( ) where -import Data.List -#if __GLASGOW_HASKELL__ < 710 -import Data.Monoid -#endif import qualified Data.ByteString as B import qualified Data.ByteString.Builder as B -import Data.ByteString.Char8 () import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL import qualified Data.CaseInsensitive as CI -{-IsString-} - import Data.Data (Data) +import Data.List (intersperse) +#if __GLASGOW_HASKELL__ < 710 +import Data.Monoid +#endif 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 +-- | [Accept](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept) +-- +-- @since 0.7.0 +hAccept :: HeaderName hAccept = "Accept" + +-- | [Accept-Charset](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept-charset) +-- +-- @since 0.9 +hAcceptCharset :: HeaderName hAcceptCharset = "Accept-Charset" + +-- | [Accept-Encoding](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept-encoding) +-- +-- @since 0.9 +hAcceptEncoding :: HeaderName hAcceptEncoding = "Accept-Encoding" + +-- | [Accept-Language](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept-language) +-- +-- @since 0.7.0 +hAcceptLanguage :: HeaderName hAcceptLanguage = "Accept-Language" + +-- | [Accept-Ranges](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept-ranges) +-- +-- @since 0.9 +hAcceptRanges :: HeaderName hAcceptRanges = "Accept-Ranges" + +-- | [Age](https://www.rfc-editor.org/rfc/rfc9111.html#name-age) +-- +-- @since 0.9 +hAge :: HeaderName hAge = "Age" + +-- | [Allow](https://www.rfc-editor.org/rfc/rfc9110.html#name-allow) +-- +-- @since 0.9 +hAllow :: HeaderName hAllow = "Allow" + +-- | [Authorization](https://www.rfc-editor.org/rfc/rfc9110.html#name-authorization) +-- +-- @since 0.7.0 +hAuthorization :: HeaderName hAuthorization = "Authorization" + +-- | [Cache-Control](https://www.rfc-editor.org/rfc/rfc9111.html#name-cache-control) +-- +-- @since 0.7.0 +hCacheControl :: HeaderName hCacheControl = "Cache-Control" + +-- | [Connection](https://www.rfc-editor.org/rfc/rfc9110.html#name-connection) +-- +-- @since 0.7.0 +hConnection :: HeaderName hConnection = "Connection" + +-- | [Content-Encoding](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-encoding) +-- +-- @since 0.7.0 +hContentEncoding :: HeaderName hContentEncoding = "Content-Encoding" + +-- | [Content-Language](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-language) +-- +-- @since 0.9 +hContentLanguage :: HeaderName hContentLanguage = "Content-Language" + +-- | [Content-Length](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-length) +-- +-- @since 0.7.0 +hContentLength :: HeaderName hContentLength = "Content-Length" + +-- | [Content-Location](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-location) +-- +-- @since 0.9 +hContentLocation :: HeaderName hContentLocation = "Content-Location" + +-- | [Content-MD5](https://www.rfc-editor.org/rfc/rfc2616.html#section-14.15) +-- +-- /This header has been obsoleted in RFC 9110./ +-- +-- @since 0.7.0 +hContentMD5 :: HeaderName hContentMD5 = "Content-MD5" + +-- | [Content-Range](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-range) +-- +-- @since 0.9 +hContentRange :: HeaderName hContentRange = "Content-Range" + +-- | [Content-Type](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-type) +-- +-- @since 0.7.0 +hContentType :: HeaderName hContentType = "Content-Type" + +-- | [Date](https://www.rfc-editor.org/rfc/rfc9110.html#name-date) +-- +-- @since 0.7.0 +hDate :: HeaderName hDate = "Date" + +-- | [ETag](https://www.rfc-editor.org/rfc/rfc9110.html#name-etag) +-- +-- @since 0.9 +hETag :: HeaderName hETag = "ETag" + +-- | [Expect](https://www.rfc-editor.org/rfc/rfc9110.html#name-expect) +-- +-- @since 0.9 +hExpect :: HeaderName hExpect = "Expect" + +-- | [Expires](https://www.rfc-editor.org/rfc/rfc9111.html#name-expires) +-- +-- @since 0.9 +hExpires :: HeaderName hExpires = "Expires" + +-- | [From](https://www.rfc-editor.org/rfc/rfc9110.html#name-from) +-- +-- @since 0.9 +hFrom :: HeaderName hFrom = "From" + +-- | [Host](https://www.rfc-editor.org/rfc/rfc9110.html#name-host-and-authority) +-- +-- @since 0.9 +hHost :: HeaderName hHost = "Host" + +-- | [If-Match](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-match) +-- +-- @since 0.9 +hIfMatch :: HeaderName hIfMatch = "If-Match" + +-- | [If-Modified-Since](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-modified-since) +-- +-- @since 0.7.0 +hIfModifiedSince :: HeaderName hIfModifiedSince = "If-Modified-Since" + +-- | [If-None-Match](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-none-match) +-- +-- @since 0.9 +hIfNoneMatch :: HeaderName hIfNoneMatch = "If-None-Match" + +-- | [If-Range](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-range) +-- +-- @since 0.7.0 +hIfRange :: HeaderName hIfRange = "If-Range" + +-- | [If-Unmodified-Since](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-unmodified-since) +-- +-- @since 0.9 +hIfUnmodifiedSince :: HeaderName hIfUnmodifiedSince = "If-Unmodified-Since" + +-- | [Last-Modified](https://www.rfc-editor.org/rfc/rfc9110.html#name-last-modified) +-- +-- @since 0.7.0 +hLastModified :: HeaderName hLastModified = "Last-Modified" + +-- | [Location](https://www.rfc-editor.org/rfc/rfc9110.html#name-location) +-- +-- @since 0.7.1 +hLocation :: HeaderName hLocation = "Location" + +-- | [Max-Forwards](https://www.rfc-editor.org/rfc/rfc9110.html#name-max-forwards) +-- +-- @since 0.9 +hMaxForwards :: HeaderName hMaxForwards = "Max-Forwards" + +-- | [Pragma](https://www.rfc-editor.org/rfc/rfc9111.html#name-pragma) +-- +-- /This header has been deprecated in RFC 9111 in favor of "Cache-Control"./ +-- +-- @since 0.9 +hPragma :: HeaderName hPragma = "Pragma" + +-- | [Proxy-Authenticate](https://www.rfc-editor.org/rfc/rfc9110.html#name-proxy-authenticate) +-- +-- @since 0.9 +hProxyAuthenticate :: HeaderName hProxyAuthenticate = "Proxy-Authenticate" + +-- | [Proxy-Authorization](https://www.rfc-editor.org/rfc/rfc9110.html#name-proxy-authorization) +-- +-- @since 0.9 +hProxyAuthorization :: HeaderName hProxyAuthorization = "Proxy-Authorization" + +-- | [Range](https://www.rfc-editor.org/rfc/rfc9110.html#name-range) +-- +-- @since 0.7.0 +hRange :: HeaderName hRange = "Range" + +-- | [Referer](https://www.rfc-editor.org/rfc/rfc9110.html#name-referer) +-- +-- @since 0.7.0 +hReferer :: HeaderName hReferer = "Referer" + +-- | [Retry-After](https://www.rfc-editor.org/rfc/rfc9110.html#name-retry-after) +-- +-- @since 0.9 +hRetryAfter :: HeaderName hRetryAfter = "Retry-After" + +-- | [Server](https://www.rfc-editor.org/rfc/rfc9110.html#name-server) +-- +-- @since 0.7.1 +hServer :: HeaderName hServer = "Server" + +-- | [TE](https://www.rfc-editor.org/rfc/rfc9110.html#name-te) +-- +-- @since 0.9 +hTE :: HeaderName hTE = "TE" + +-- | [Trailer](https://www.rfc-editor.org/rfc/rfc9110.html#name-trailer) +-- +-- @since 0.9 +hTrailer :: HeaderName hTrailer = "Trailer" + +-- | [Transfer-Encoding](https://www.rfc-editor.org/rfc/rfc9112#name-transfer-encoding) +-- +-- @since 0.9 +hTransferEncoding :: HeaderName hTransferEncoding = "Transfer-Encoding" + +-- | [Upgrade](https://www.rfc-editor.org/rfc/rfc9110.html#name-upgrade) +-- +-- @since 0.9 +hUpgrade :: HeaderName hUpgrade = "Upgrade" + +-- | [User-Agent](https://www.rfc-editor.org/rfc/rfc9110.html#name-user-agent) +-- +-- @since 0.7.0 +hUserAgent :: HeaderName hUserAgent = "User-Agent" + +-- | [Vary](https://www.rfc-editor.org/rfc/rfc9110.html#name-vary) +-- +-- @since 0.9 +hVary :: HeaderName hVary = "Vary" + +-- | [Via](https://www.rfc-editor.org/rfc/rfc9110.html#name-via) +-- +-- @since 0.9 +hVia :: HeaderName hVia = "Via" + +-- | [WWW-Authenticate](https://www.rfc-editor.org/rfc/rfc9110.html#name-www-authenticate) +-- +-- @since 0.9 +hWWWAuthenticate :: HeaderName hWWWAuthenticate = "WWW-Authenticate" + +-- | [Warning](https://www.rfc-editor.org/rfc/rfc9111.html#name-warning) +-- +-- /This header has been obsoleted in RFC 9110./ +-- +-- @since 0.9 +hWarning :: HeaderName hWarning = "Warning" --- | HTTP Header names according to http://www.w3.org/Protocols/rfc2616/rfc2616-sec19.html -hContentDisposition, hMIMEVersion :: HeaderName +-- | [Content-Disposition](https://www.rfc-editor.org/rfc/rfc6266.html) +-- +-- @since 0.10 +hContentDisposition :: HeaderName hContentDisposition = "Content-Disposition" + +-- | [MIME-Version](https://www.rfc-editor.org/rfc/rfc2616.html#section-19.4.1) +-- +-- @since 0.10 +hMIMEVersion :: HeaderName hMIMEVersion = "MIME-Version" --- | HTTP Header names according to https://tools.ietf.org/html/rfc6265#section-4 -hCookie, hSetCookie :: HeaderName +-- | [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" --- | HTTP Header names according to https://tools.ietf.org/html/rfc6454 +-- | [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, Generic) + 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)) + `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 @@ -222,6 +533,8 @@ renderByteRanges = BL.toStrict . B.toLazyByteString . renderByteRangesBuilder -- 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 @@ -244,6 +557,8 @@ parseByteRanges bs1 = do (r, bs5) <- range bs4 ranges (front . (r :)) bs5 + -- FIXME: Use 'stripPrefix' from the 'bytestring' package. + -- Might have to update the dependency constraints though. stripPrefixB x y | x `B.isPrefixOf` y = Just (B.drop (B.length x) y) | otherwise = Nothing diff --git a/Network/HTTP/Types/Method.hs b/Network/HTTP/Types/Method.hs index ac69eb5..c142dbe 100644 --- a/Network/HTTP/Types/Method.hs +++ b/Network/HTTP/Types/Method.hs @@ -1,8 +1,17 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +-- | Types and constants for HTTP methods. +-- +-- The HTTP standard defines a set of standard methods, when to use them, +-- and how to handle them. The standard set has been provided as a separate +-- data type 'StdMethod', but since you can also use custom methods, the +-- basic type 'Method' is just a synonym for 'ByteString'. module Network.HTTP.Types.Method ( + -- * HTTP methods Method, + + -- ** Constants methodGet, methodPost, methodHead, @@ -12,6 +21,10 @@ module Network.HTTP.Types.Method ( methodConnect, methodOptions, methodPatch, + + -- ** Standard Methods + + -- | One data type that holds all standard HTTP methods. StdMethod (..), parseMethod, renderMethod, @@ -20,30 +33,58 @@ module Network.HTTP.Types.Method ( where import Control.Arrow ((|||)) -import Data.Array +import Data.Array (Array, Ix, assocs, listArray, (!)) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import Data.Data (Data) import Data.Typeable (Typeable) import GHC.Generics (Generic) --- | HTTP method (flat string type). +-- | HTTP method (flat 'ByteString' type). type Method = B.ByteString --- | HTTP Method constants. -methodGet, methodPost, methodHead, methodPut, methodDelete, methodTrace, methodConnect, methodOptions, methodPatch :: Method +-- | 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 + +-- | 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 @@ -53,27 +94,51 @@ data StdMethod | TRACE | CONNECT | OPTIONS - | PATCH - deriving (Read, Show, Eq, Ord, Enum, Bounded, Ix, Typeable, Data, Generic) + | -- | @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 diff --git a/Network/HTTP/Types/QueryLike.hs b/Network/HTTP/Types/QueryLike.hs index a99902f..de1d9e4 100644 --- a/Network/HTTP/Types/QueryLike.hs +++ b/Network/HTTP/Types/QueryLike.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} +-- | Some type classes to make more general functions when handling query strings. module Network.HTTP.Types.QueryLike ( QueryLike (..), QueryKeyLike (..), @@ -7,13 +8,14 @@ module Network.HTTP.Types.QueryLike ( ) where -import Control.Arrow -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as L -import Data.Maybe -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import Network.HTTP.Types.URI +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. -- @@ -21,15 +23,21 @@ import Network.HTTP.Types.URI -- 'L.ByteString'), 'T.Text', or 'String' as the key/value types. You can also have the value -- type lifted into a Maybe to support keys without values; and finally it is possible to put -- each pair into a Maybe for key-value pairs that aren't always present. +-- +-- @since 0.7.0 class QueryLike a where -- | Convert to 'Query'. toQuery :: a -> Query -- | Types which, in a Query-like key-value list, are used in the Key position. +-- +-- @since 0.7.0 class QueryKeyLike a where toQueryKey :: a -> B.ByteString -- | Types which, in a Query-like key-value list, are used in the Value position. +-- +-- @since 0.7.0 class QueryValueLike a where toQueryValue :: a -> Maybe B.ByteString @@ -48,6 +56,5 @@ instance QueryValueLike B.ByteString where toQueryValue = Just instance QueryValueLike L.ByteString where toQueryValue = Just . B.concat . L.toChunks instance QueryValueLike T.Text where toQueryValue = Just . T.encodeUtf8 instance QueryValueLike [Char] where toQueryValue = Just . T.encodeUtf8 . T.pack - instance QueryValueLike a => QueryValueLike (Maybe a) where toQueryValue = maybe Nothing toQueryValue diff --git a/Network/HTTP/Types/Status.hs b/Network/HTTP/Types/Status.hs index eef2be3..4bae2c8 100644 --- a/Network/HTTP/Types/Status.hs +++ b/Network/HTTP/Types/Status.hs @@ -1,134 +1,179 @@ -{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric #-} -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 (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 + , -- | @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. -- --- Note that the Show instance is only for debugging. -data Status - = Status { statusCode :: Int - , statusMessage :: B.ByteString - } deriving (Show, Typeable, Data, Generic) +-- > 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 @@ -179,29 +224,38 @@ instance Enum Status where 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 @@ -222,42 +276,62 @@ created201 :: Status created201 = status201 -- | Accepted 202 +-- +-- @since 0.6.6 status202 :: Status status202 = mkStatus 202 "Accepted" -- | Accepted 202 +-- +-- @since 0.6.6 accepted202 :: Status accepted202 = status202 -- | Non-Authoritative Information 203 +-- +-- @since 0.6.6 status203 :: Status status203 = mkStatus 203 "Non-Authoritative Information" -- | Non-Authoritative Information 203 +-- +-- @since 0.6.6 nonAuthoritative203 :: Status nonAuthoritative203 = status203 -- | No Content 204 +-- +-- @since 0.6.6 status204 :: Status status204 = mkStatus 204 "No Content" -- | No Content 204 +-- +-- @since 0.6.6 noContent204 :: Status noContent204 = status204 -- | Reset Content 205 +-- +-- @since 0.6.6 status205 :: Status status205 = mkStatus 205 "Reset Content" -- | Reset Content 205 +-- +-- @since 0.6.6 resetContent205 :: Status resetContent205 = status205 -- | Partial Content 206 +-- +-- @since 0.5.1 status206 :: Status status206 = mkStatus 206 "Partial Content" -- | Partial Content 206 +-- +-- @since 0.5.1 partialContent206 :: Status partialContent206 = status206 @@ -294,34 +368,50 @@ seeOther303 :: Status seeOther303 = status303 -- | Not Modified 304 +-- +-- @since 0.6.1 status304 :: Status status304 = mkStatus 304 "Not Modified" -- | Not Modified 304 +-- +-- @since 0.6.1 notModified304 :: Status notModified304 = status304 -- | Use Proxy 305 +-- +-- @since 0.6.6 status305 :: Status status305 = mkStatus 305 "Use Proxy" -- | Use Proxy 305 +-- +-- @since 0.6.6 useProxy305 :: Status useProxy305 = status305 -- | Temporary Redirect 307 +-- +-- @since 0.6.6 status307 :: Status status307 = mkStatus 307 "Temporary Redirect" -- | Temporary Redirect 307 +-- +-- @since 0.6.6 temporaryRedirect307 :: Status temporaryRedirect307 = status307 -- | Permanent Redirect 308 +-- +-- @since 0.9 status308 :: Status status308 = mkStatus 308 "Permanent Redirect" -- | Permanent Redirect 308 +-- +-- @since 0.9 permanentRedirect308 :: Status permanentRedirect308 = status308 @@ -342,10 +432,14 @@ unauthorized401 :: Status unauthorized401 = status401 -- | Payment Required 402 +-- +-- @since 0.6.6 status402 :: Status status402 = mkStatus 402 "Payment Required" -- | Payment Required 402 +-- +-- @since 0.6.6 paymentRequired402 :: Status paymentRequired402 = status402 @@ -374,156 +468,228 @@ methodNotAllowed405 :: Status methodNotAllowed405 = status405 -- | Not Acceptable 406 +-- +-- @since 0.6.6 status406 :: Status status406 = mkStatus 406 "Not Acceptable" -- | Not Acceptable 406 +-- +-- @since 0.6.6 notAcceptable406 :: Status notAcceptable406 = status406 -- | Proxy Authentication Required 407 +-- +-- @since 0.6.6 status407 :: Status status407 = mkStatus 407 "Proxy Authentication Required" -- | Proxy Authentication Required 407 +-- +-- @since 0.6.6 proxyAuthenticationRequired407 :: Status proxyAuthenticationRequired407 = status407 -- | Request Timeout 408 +-- +-- @since 0.6.6 status408 :: Status status408 = mkStatus 408 "Request Timeout" -- | Request Timeout 408 +-- +-- @since 0.6.6 requestTimeout408 :: Status requestTimeout408 = status408 -- | Conflict 409 +-- +-- @since 0.6.6 status409 :: Status status409 = mkStatus 409 "Conflict" -- | Conflict 409 +-- +-- @since 0.6.6 conflict409 :: Status conflict409 = status409 -- | Gone 410 +-- +-- @since 0.6.6 status410 :: Status status410 = mkStatus 410 "Gone" -- | Gone 410 +-- +-- @since 0.6.6 gone410 :: Status gone410 = status410 -- | Length Required 411 +-- +-- @since 0.6.6 status411 :: Status status411 = mkStatus 411 "Length Required" -- | Length Required 411 +-- +-- @since 0.6.6 lengthRequired411 :: Status lengthRequired411 = status411 -- | Precondition Failed 412 +-- +-- @since 0.6.1 status412 :: Status status412 = mkStatus 412 "Precondition Failed" -- | Precondition Failed 412 +-- +-- @since 0.6.1 preconditionFailed412 :: Status preconditionFailed412 = status412 -- | Request Entity Too Large 413 +-- +-- @since 0.6.6 status413 :: Status status413 = mkStatus 413 "Request Entity Too Large" -- | Request Entity Too Large 413 +-- +-- @since 0.6.6 requestEntityTooLarge413 :: Status requestEntityTooLarge413 = status413 -- | Request-URI Too Long 414 +-- +-- @since 0.6.6 status414 :: Status status414 = mkStatus 414 "Request-URI Too Long" -- | Request-URI Too Long 414 +-- +-- @since 0.6.6 requestURITooLong414 :: Status requestURITooLong414 = status414 -- | Unsupported Media Type 415 +-- +-- @since 0.6.6 status415 :: Status status415 = mkStatus 415 "Unsupported Media Type" -- | Unsupported Media Type 415 +-- +-- @since 0.6.6 unsupportedMediaType415 :: Status unsupportedMediaType415 = status415 -- | Requested Range Not Satisfiable 416 +-- +-- @since 0.6.1 status416 :: Status status416 = mkStatus 416 "Requested Range Not Satisfiable" -- | Requested Range Not Satisfiable 416 +-- +-- @since 0.6.1 requestedRangeNotSatisfiable416 :: Status requestedRangeNotSatisfiable416 = status416 -- | Expectation Failed 417 +-- +-- @since 0.6.6 status417 :: Status status417 = mkStatus 417 "Expectation Failed" -- | Expectation Failed 417 +-- +-- @since 0.6.6 expectationFailed417 :: Status expectationFailed417 = status417 -- | 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 -- () +-- +-- @since 0.9.1 status422 :: Status status422 = mkStatus 422 "Unprocessable Entity" -- | Unprocessable Entity 422 -- () +-- +-- @since 0.9.1 unprocessableEntity422 :: Status unprocessableEntity422 = status422 -- | Upgrade Required 426 -- () +-- +-- @since 0.10 status426 :: Status status426 = mkStatus 426 "Upgrade Required" -- | Upgrade Required 426 -- () +-- +-- @since 0.10 upgradeRequired426 :: Status upgradeRequired426 = status426 -- | Precondition Required 428 -- () +-- +-- @since 0.8.5 status428 :: Status status428 = mkStatus 428 "Precondition Required" -- | Precondition Required 428 -- () +-- +-- @since 0.8.5 preconditionRequired428 :: Status preconditionRequired428 = status428 -- | Too Many Requests 429 -- () +-- +-- @since 0.8.5 status429 :: Status status429 = mkStatus 429 "Too Many Requests" -- | Too Many Requests 429 -- () +-- +-- @since 0.8.5 tooManyRequests429 :: Status tooManyRequests429 = status429 -- | Request Header Fields Too Large 431 -- () +-- +-- @since 0.8.5 status431 :: Status status431 = mkStatus 431 "Request Header Fields Too Large" -- | Request Header Fields Too Large 431 -- () +-- +-- @since 0.8.5 requestHeaderFieldsTooLarge431 :: Status requestHeaderFieldsTooLarge431 = status431 @@ -536,71 +702,115 @@ internalServerError500 :: Status internalServerError500 = status500 -- | Not Implemented 501 +-- +-- @since 0.6.1 status501 :: Status status501 = mkStatus 501 "Not Implemented" -- | Not Implemented 501 +-- +-- @since 0.6.1 notImplemented501 :: Status notImplemented501 = status501 -- | Bad Gateway 502 +-- +-- @since 0.6.6 status502 :: Status status502 = mkStatus 502 "Bad Gateway" -- | Bad Gateway 502 +-- +-- @since 0.6.6 badGateway502 :: Status badGateway502 = status502 -- | Service Unavailable 503 +-- +-- @since 0.6.6 status503 :: Status status503 = mkStatus 503 "Service Unavailable" -- | Service Unavailable 503 +-- +-- @since 0.6.6 serviceUnavailable503 :: Status serviceUnavailable503 = status503 -- | Gateway Timeout 504 +-- +-- @since 0.6.6 status504 :: Status status504 = mkStatus 504 "Gateway Timeout" -- | Gateway Timeout 504 +-- +-- @since 0.6.6 gatewayTimeout504 :: Status gatewayTimeout504 = status504 -- | HTTP Version Not Supported 505 +-- +-- @since 0.6.6 status505 :: Status status505 = mkStatus 505 "HTTP Version Not Supported" -- | HTTP Version Not Supported 505 +-- +-- @since 0.6.6 httpVersionNotSupported505 :: Status httpVersionNotSupported505 = status505 -- | Network Authentication Required 511 -- () +-- +-- @since 0.8.5 status511 :: Status status511 = mkStatus 511 "Network Authentication Required" -- | Network Authentication Required 511 -- () +-- +-- @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 diff --git a/Network/HTTP/Types/URI.hs b/Network/HTTP/Types/URI.hs index af61689..a73ca3a 100644 --- a/Network/HTTP/Types/URI.hs +++ b/Network/HTTP/Types/URI.hs @@ -1,124 +1,174 @@ {-# 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 string - QueryItem, + -- * Query strings + + -- ** Query Query, - SimpleQueryItem, - SimpleQuery, - simpleQueryToQuery, + QueryItem, renderQuery, renderQueryBuilder, - renderSimpleQuery, parseQuery, parseQueryReplacePlus, - parseSimpleQuery, - -- ** Escape only parts - renderQueryPartialEscape, - renderQueryBuilderPartialEscape, - EscapeItem (..), - PartialEscapeQueryItem, - PartialEscapeQuery, - - -- ** Text query string (UTF8 encoded) + -- *** Query (Text) QueryText, queryTextToQuery, queryToQueryText, renderQueryText, parseQueryText, - -- * Path segments - encodePathSegments, - decodePathSegments, - encodePathSegmentsRelative, + -- ** 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, - -- * Path (segments + query string) + -- ** 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 - urlEncodeBuilder, 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 -#endif +import Control.Arrow (second, (***)) +import Data.Bits (shiftL, (.|.)) import qualified Data.ByteString as B import qualified Data.ByteString.Builder as B -import Data.ByteString.Char8 () 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 +#endif import Data.Text (Text) import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) -import Data.Word - -{-IsString-} +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 :: - -- | prepend a question mark? - Bool -> - 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 :: - -- | prepend a question mark? - Bool -> - 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) = + -- FIXME: replace mconcat + map with foldr mconcat $ go (if qmark' then qmark else mempty) p : map (go amp) ps @@ -135,20 +185,20 @@ renderQueryBuilder qmark' (p : ps) = Just v -> equal `mappend` urlEncodeBuilder True v ] --- | Convert 'Query' to 'ByteString'. -renderQuery :: - -- | prepend question mark? - Bool -> - 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 :: - -- | prepend question mark? - Bool -> - 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 @@ -162,11 +212,17 @@ renderSimpleQuery useQuestionMark = renderQuery useQuestionMark . simpleQueryToQ -- @"%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 @@ -198,6 +254,11 @@ breakDiscard seps s = 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 @@ -206,11 +267,22 @@ ord8 = fromIntegral . ord 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 +urlEncodeBuilder' extraUnreserved = + mconcat . map encodeChar . B.unpack where encodeChar ch | unreserved ch = B.word8 ch @@ -230,39 +302,54 @@ urlEncodeBuilder' extraUnreserved = mconcat . map encodeChar . B.unpack | i < 10 = 48 + i -- zero (0) | otherwise = 65 + i - 10 -- 65: A --- | Percent-encoding for URLs (using 'B.Builder'). -urlEncodeBuilder :: - -- | Whether input is in query string. True: Query string, False: Path element - Bool -> - B.ByteString -> - B.Builder +-- | 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 :: - -- | Whether to decode @\'+\'@ to @\' \'@ - Bool -> - -- | The ByteString to encode as URL - B.ByteString -> - -- | The encoded URL - B.ByteString +-- +-- 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 :: - -- | Whether to decode @\'+\'@ to @\' \'@ - Bool -> - 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 + -- plus to space + Just (43, ws) | replacePlus -> Just (32, ws) + -- percent Just (37, ws) -> Just $ fromMaybe (37, ws) $ do - -- percent (x, xs) <- B.uncons ws x' <- hexVal x (y, ys) <- B.uncons xs @@ -283,28 +370,38 @@ urlDecode replacePlus z = fst $ B.unfoldrN (B.length z) go z -- -- * 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", "bar1", "~baz"] +-- "/foo/bar1/~baz" -- --- > encodePathSegments [\"foo bar\", \"baz\/bin\"] --- \"\/foo\%20bar\/baz\%2Fbin\" +-- >>> encodePathSegments ["foo bar", "baz/bin"] +-- "/foo%20bar/baz%2Fbin" -- --- > encodePathSegments [\"שלום\"] --- \"\/%D7%A9%D7%9C%D7%95%D7%9D\" +-- >>> encodePathSegments ["שלום"] +-- "/%D7%A9%D7%9C%D7%95%D7%9D" -- --- Huge thanks to Jeremy Shaw who created the original implementation of this +-- 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) @@ -312,6 +409,10 @@ 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 "/" = [] @@ -333,7 +434,14 @@ decodePathSegment :: B.ByteString -> Text decodePathSegment = decodeUtf8With lenientDecode . urlDecode False -- | Extract whole path (path segments + query) from a --- . +-- [RFC 2616 Request-URI](http://tools.ietf.org/html/rfc2616#section-5.1.2). +-- +-- Though a more accurate description of this function's behaviour is that +-- it removes the domain/origin if the string starts with an HTTP protocol. +-- (i.e. @http://@ or @https://@) +-- +-- This function will not change anything when given any other 'B.ByteString'. +-- (except return a root path @\"\/\"@ if given an empty string) -- -- >>> extractPath "/path" -- "/path" @@ -346,6 +454,11 @@ decodePathSegment = decodeUtf8With lenientDecode . urlDecode False -- -- >>> 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 @@ -358,11 +471,15 @@ extractPath = ensureNonEmpty . extract 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 @@ -370,38 +487,51 @@ decodePath b = ----------------------------------------------------------------------------------------- --- | 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@. +-- | 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 - = QE B.ByteString -- will be URL encoded - | QN B.ByteString -- will not be url encoded, e.g. @\'+\'@ or @\':\'@ + = -- | 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 :: - -- | prepend question mark? - Bool -> - PartialEscapeQuery -> - B.ByteString -renderQueryPartialEscape qm = BL.toStrict . B.toLazyByteString . renderQueryBuilderPartialEscape qm - --- | Convert 'PartialEscapeQuery' to a 'Builder'. -renderQueryBuilderPartialEscape :: - -- | prepend a question mark? - Bool -> - PartialEscapeQuery -> - B.Builder +-- +-- 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) = @@ -418,7 +548,7 @@ renderQueryBuilderPartialEscape qmark' (p : ps) = , urlEncodeBuilder True k , case mv of [] -> mempty - vs -> equal `mappend` (mconcat (map encode vs)) + vs -> equal `mappend` mconcat (map encode vs) ] encode (QE v) = urlEncodeBuilder True v encode (QN v) = B.byteString v diff --git a/Network/HTTP/Types/Version.hs b/Network/HTTP/Types/Version.hs index f2ccfe7..ccdd7aa 100644 --- a/Network/HTTP/Types/Version.hs +++ b/Network/HTTP/Types/Version.hs @@ -1,14 +1,14 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +-- | Types and constants to describe the HTTP version. module Network.HTTP.Types.Version ( HttpVersion (..), http09, http10, http11, http20, -) -where +) where import Data.Data (Data) import Data.Typeable (Typeable) @@ -16,13 +16,23 @@ import GHC.Generics (Generic) -- | HTTP Version. -- --- Note that the Show instance is intended merely for debugging. +-- Note that the 'Show' instance is intended merely for debugging. data HttpVersion = HttpVersion { httpMajor :: !Int , httpMinor :: !Int } - deriving (Eq, Ord, Typeable, Data, Generic) - + 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 @@ -39,5 +49,7 @@ http11 :: HttpVersion http11 = HttpVersion 1 1 -- | HTTP 2.0 +-- +-- @since 0.10 http20 :: HttpVersion http20 = HttpVersion 2 0 diff --git a/http-types.cabal b/http-types.cabal index 41b6b07..67a607b 100644 --- a/http-types.cabal +++ b/http-types.cabal @@ -1,12 +1,13 @@ 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 +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: BSD3 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 @@ -15,12 +16,12 @@ 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