http-types 0.6.11 → 0.7.0
raw patch · 9 files changed
+1109/−1018 lines, 9 filesdep ~hspecPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hspec
API changes (from Hackage documentation)
- Network.HTTP.Types: instance Bounded StdMethod
- Network.HTTP.Types: instance Enum StdMethod
- Network.HTTP.Types: instance Eq HttpVersion
- Network.HTTP.Types: instance Eq Status
- Network.HTTP.Types: instance Eq StdMethod
- Network.HTTP.Types: instance Ix StdMethod
- Network.HTTP.Types: instance Ord HttpVersion
- Network.HTTP.Types: instance Ord Status
- Network.HTTP.Types: instance Ord StdMethod
- Network.HTTP.Types: instance Read StdMethod
- Network.HTTP.Types: instance Show HttpVersion
- Network.HTTP.Types: instance Show Status
- Network.HTTP.Types: instance Show StdMethod
- Network.HTTP.Types: statusAccepted :: Status
- Network.HTTP.Types: statusBadGateway :: Status
- Network.HTTP.Types: statusBadRequest :: Status
- Network.HTTP.Types: statusConflict :: Status
- Network.HTTP.Types: statusContinue :: Status
- Network.HTTP.Types: statusCreated :: Status
- Network.HTTP.Types: statusExpectationFailed :: Status
- Network.HTTP.Types: statusForbidden :: Status
- Network.HTTP.Types: statusFound :: Status
- Network.HTTP.Types: statusGatewayTimeout :: Status
- Network.HTTP.Types: statusGone :: Status
- Network.HTTP.Types: statusHTTPVersionNotSupported :: Status
- Network.HTTP.Types: statusImATeapot :: Status
- Network.HTTP.Types: statusLengthRequired :: Status
- Network.HTTP.Types: statusMovedPermanently :: Status
- Network.HTTP.Types: statusMultipleChoices :: Status
- Network.HTTP.Types: statusNoContent :: Status
- Network.HTTP.Types: statusNonAuthoritative :: Status
- Network.HTTP.Types: statusNotAcceptable :: Status
- Network.HTTP.Types: statusNotAllowed :: Status
- Network.HTTP.Types: statusNotFound :: Status
- Network.HTTP.Types: statusNotImplemented :: Status
- Network.HTTP.Types: statusNotModified :: Status
- Network.HTTP.Types: statusOK :: Status
- Network.HTTP.Types: statusPartialContent :: Status
- Network.HTTP.Types: statusPaymentRequired :: Status
- Network.HTTP.Types: statusPreconditionFailed :: Status
- Network.HTTP.Types: statusProxyAuthenticationRequired :: Status
- Network.HTTP.Types: statusRequestEntityTooLarge :: Status
- Network.HTTP.Types: statusRequestTimeout :: Status
- Network.HTTP.Types: statusRequestURITooLong :: Status
- Network.HTTP.Types: statusRequestedRangeNotSatisfiable :: Status
- Network.HTTP.Types: statusResetContent :: Status
- Network.HTTP.Types: statusSeeOther :: Status
- Network.HTTP.Types: statusServerError :: Status
- Network.HTTP.Types: statusServiceUnavailable :: Status
- Network.HTTP.Types: statusSwitchingProtocols :: Status
- Network.HTTP.Types: statusTemporaryRedirect :: Status
- Network.HTTP.Types: statusUnauthorized :: Status
- Network.HTTP.Types: statusUnsupportedMediaType :: Status
- Network.HTTP.Types: statusUseProxy :: Status
+ Network.HTTP.Types: class QueryLike a
+ Network.HTTP.Types: hAccept, hUserAgent, hReferer, hRange, hLastModified, hIfRange, hIfModifiedSince, hDate, hCookie, hContentType, hContentMD5, hContentLength, hContentEncoding, hConnection, hCacheControl, hAuthorization, hAcceptLanguage :: HeaderName
+ Network.HTTP.Types: toQuery :: QueryLike a => a -> Query
+ Network.HTTP.Types.Header: ByteRangeFrom :: !Integer -> ByteRange
+ Network.HTTP.Types.Header: ByteRangeFromTo :: !Integer -> !Integer -> ByteRange
+ Network.HTTP.Types.Header: ByteRangeSuffix :: !Integer -> ByteRange
+ Network.HTTP.Types.Header: data ByteRange
+ Network.HTTP.Types.Header: hAccept, hUserAgent, hReferer, hRange, hLastModified, hIfRange, hIfModifiedSince, hDate, hCookie, hContentType, hContentMD5, hContentLength, hContentEncoding, hConnection, hCacheControl, hAuthorization, hAcceptLanguage :: HeaderName
+ Network.HTTP.Types.Header: headerAccept, headerDate, headerContentMD5, headerContentType, headerContentLength, headerConnection, headerCacheControl, headerAuthorization :: ByteString -> Header
+ Network.HTTP.Types.Header: renderByteRange :: ByteRange -> ByteString
+ Network.HTTP.Types.Header: renderByteRangeBuilder :: ByteRange -> Builder
+ Network.HTTP.Types.Header: renderByteRanges :: ByteRanges -> ByteString
+ Network.HTTP.Types.Header: renderByteRangesBuilder :: ByteRanges -> Builder
+ Network.HTTP.Types.Header: type ByteRanges = [ByteRange]
+ Network.HTTP.Types.Header: type Header = (HeaderName, ByteString)
+ Network.HTTP.Types.Header: type HeaderName = CI ByteString
+ Network.HTTP.Types.Header: type RequestHeaders = [Header]
+ Network.HTTP.Types.Header: type ResponseHeaders = [Header]
+ Network.HTTP.Types.Method: CONNECT :: StdMethod
+ Network.HTTP.Types.Method: DELETE :: StdMethod
+ Network.HTTP.Types.Method: GET :: StdMethod
+ Network.HTTP.Types.Method: HEAD :: StdMethod
+ Network.HTTP.Types.Method: OPTIONS :: StdMethod
+ Network.HTTP.Types.Method: POST :: StdMethod
+ Network.HTTP.Types.Method: PUT :: StdMethod
+ Network.HTTP.Types.Method: TRACE :: StdMethod
+ Network.HTTP.Types.Method: data StdMethod
+ Network.HTTP.Types.Method: instance Bounded StdMethod
+ Network.HTTP.Types.Method: instance Enum StdMethod
+ Network.HTTP.Types.Method: instance Eq StdMethod
+ Network.HTTP.Types.Method: instance Ix StdMethod
+ Network.HTTP.Types.Method: instance Ord StdMethod
+ Network.HTTP.Types.Method: instance Read StdMethod
+ Network.HTTP.Types.Method: instance Show StdMethod
+ Network.HTTP.Types.Method: methodGet, methodOptions, methodConnect, methodTrace, methodDelete, methodPut, methodHead, methodPost :: Method
+ Network.HTTP.Types.Method: parseMethod :: Method -> Either ByteString StdMethod
+ Network.HTTP.Types.Method: renderMethod :: Either ByteString StdMethod -> Method
+ Network.HTTP.Types.Method: renderStdMethod :: StdMethod -> Method
+ Network.HTTP.Types.Method: type Method = ByteString
+ Network.HTTP.Types.QueryLike: class QueryKeyLike a
+ Network.HTTP.Types.QueryLike: class QueryLike a
+ Network.HTTP.Types.QueryLike: class QueryValueLike a
+ Network.HTTP.Types.QueryLike: instance (QueryKeyLike k, QueryValueLike v) => QueryLike [(k, v)]
+ Network.HTTP.Types.QueryLike: instance (QueryKeyLike k, QueryValueLike v) => QueryLike [Maybe (k, v)]
+ Network.HTTP.Types.QueryLike: instance QueryKeyLike ByteString
+ Network.HTTP.Types.QueryLike: instance QueryKeyLike Text
+ Network.HTTP.Types.QueryLike: instance QueryKeyLike [Char]
+ Network.HTTP.Types.QueryLike: instance QueryValueLike ByteString
+ Network.HTTP.Types.QueryLike: instance QueryValueLike Text
+ Network.HTTP.Types.QueryLike: instance QueryValueLike [Char]
+ Network.HTTP.Types.QueryLike: instance QueryValueLike a => QueryValueLike (Maybe a)
+ Network.HTTP.Types.QueryLike: toQuery :: QueryLike a => a -> Query
+ Network.HTTP.Types.QueryLike: toQueryKey :: QueryKeyLike a => a -> ByteString
+ Network.HTTP.Types.QueryLike: toQueryValue :: QueryValueLike a => a -> Maybe ByteString
+ Network.HTTP.Types.Status: Status :: Int -> ByteString -> Status
+ Network.HTTP.Types.Status: accepted202 :: Status
+ Network.HTTP.Types.Status: badGateway502 :: Status
+ Network.HTTP.Types.Status: badRequest400 :: Status
+ Network.HTTP.Types.Status: conflict409 :: Status
+ Network.HTTP.Types.Status: continue100 :: Status
+ Network.HTTP.Types.Status: created201 :: Status
+ Network.HTTP.Types.Status: data Status
+ Network.HTTP.Types.Status: expectationFailed417 :: Status
+ Network.HTTP.Types.Status: forbidden403 :: Status
+ Network.HTTP.Types.Status: found302 :: Status
+ Network.HTTP.Types.Status: gatewayTimeout504 :: Status
+ Network.HTTP.Types.Status: gone410 :: Status
+ Network.HTTP.Types.Status: httpVersionNotSupported505 :: Status
+ Network.HTTP.Types.Status: imATeaPot418 :: Status
+ Network.HTTP.Types.Status: instance Eq Status
+ Network.HTTP.Types.Status: instance Ord Status
+ Network.HTTP.Types.Status: instance Show Status
+ Network.HTTP.Types.Status: internalServerError500 :: Status
+ Network.HTTP.Types.Status: lengthRequired411 :: Status
+ Network.HTTP.Types.Status: methodNotAllowed405 :: Status
+ Network.HTTP.Types.Status: movedPermanently301 :: Status
+ Network.HTTP.Types.Status: multipleChoices300 :: Status
+ Network.HTTP.Types.Status: noContent204 :: Status
+ Network.HTTP.Types.Status: nonAuthoritative203 :: Status
+ Network.HTTP.Types.Status: notAcceptable406 :: Status
+ Network.HTTP.Types.Status: notFound404 :: Status
+ Network.HTTP.Types.Status: notImplemented501 :: Status
+ Network.HTTP.Types.Status: notModified304 :: Status
+ Network.HTTP.Types.Status: ok200 :: Status
+ Network.HTTP.Types.Status: partialContent206 :: Status
+ Network.HTTP.Types.Status: paymentRequired402 :: Status
+ Network.HTTP.Types.Status: preconditionFailed412 :: Status
+ Network.HTTP.Types.Status: proxyAuthenticationRequired407 :: Status
+ Network.HTTP.Types.Status: requestEntityTooLarge413 :: Status
+ Network.HTTP.Types.Status: requestTimeout408 :: Status
+ Network.HTTP.Types.Status: requestURITooLong414 :: Status
+ Network.HTTP.Types.Status: requestedRangeNotSatisfiable416 :: Status
+ Network.HTTP.Types.Status: resetContent205 :: Status
+ Network.HTTP.Types.Status: seeOther303 :: Status
+ Network.HTTP.Types.Status: serviceUnavailable503 :: Status
+ Network.HTTP.Types.Status: status100 :: Status
+ Network.HTTP.Types.Status: status101 :: Status
+ Network.HTTP.Types.Status: status200 :: Status
+ Network.HTTP.Types.Status: status201 :: Status
+ Network.HTTP.Types.Status: status202 :: Status
+ Network.HTTP.Types.Status: status203 :: Status
+ Network.HTTP.Types.Status: status204 :: Status
+ Network.HTTP.Types.Status: status205 :: Status
+ Network.HTTP.Types.Status: status206 :: Status
+ Network.HTTP.Types.Status: status300 :: Status
+ Network.HTTP.Types.Status: status301 :: Status
+ Network.HTTP.Types.Status: status302 :: Status
+ Network.HTTP.Types.Status: status303 :: Status
+ Network.HTTP.Types.Status: status304 :: Status
+ Network.HTTP.Types.Status: status305 :: Status
+ Network.HTTP.Types.Status: status307 :: Status
+ Network.HTTP.Types.Status: status400 :: Status
+ Network.HTTP.Types.Status: status401 :: Status
+ Network.HTTP.Types.Status: status402 :: Status
+ Network.HTTP.Types.Status: status403 :: Status
+ Network.HTTP.Types.Status: status404 :: Status
+ Network.HTTP.Types.Status: status405 :: Status
+ Network.HTTP.Types.Status: status406 :: Status
+ Network.HTTP.Types.Status: status407 :: Status
+ Network.HTTP.Types.Status: status408 :: Status
+ Network.HTTP.Types.Status: status409 :: Status
+ Network.HTTP.Types.Status: status410 :: Status
+ Network.HTTP.Types.Status: status411 :: Status
+ Network.HTTP.Types.Status: status412 :: Status
+ Network.HTTP.Types.Status: status413 :: Status
+ Network.HTTP.Types.Status: status414 :: Status
+ Network.HTTP.Types.Status: status415 :: Status
+ Network.HTTP.Types.Status: status416 :: Status
+ Network.HTTP.Types.Status: status417 :: Status
+ Network.HTTP.Types.Status: status418 :: Status
+ Network.HTTP.Types.Status: status500 :: Status
+ Network.HTTP.Types.Status: status501 :: Status
+ Network.HTTP.Types.Status: status502 :: Status
+ Network.HTTP.Types.Status: status503 :: Status
+ Network.HTTP.Types.Status: status504 :: Status
+ Network.HTTP.Types.Status: status505 :: Status
+ Network.HTTP.Types.Status: statusCode :: Status -> Int
+ Network.HTTP.Types.Status: statusMessage :: Status -> ByteString
+ Network.HTTP.Types.Status: switchingProtocols101 :: Status
+ Network.HTTP.Types.Status: temporaryRedirect307 :: Status
+ Network.HTTP.Types.Status: unauthorized401 :: Status
+ Network.HTTP.Types.Status: unsupportedMediaType415 :: Status
+ Network.HTTP.Types.Status: useProxy305 :: Status
+ Network.HTTP.Types.URI: decodePath :: ByteString -> ([Text], Query)
+ Network.HTTP.Types.URI: decodePathSegments :: ByteString -> [Text]
+ Network.HTTP.Types.URI: encodePath :: [Text] -> Query -> Builder
+ Network.HTTP.Types.URI: encodePathSegments :: [Text] -> Builder
+ Network.HTTP.Types.URI: encodePathSegmentsRelative :: [Text] -> Builder
+ Network.HTTP.Types.URI: parseQuery :: ByteString -> Query
+ Network.HTTP.Types.URI: parseQueryText :: ByteString -> QueryText
+ Network.HTTP.Types.URI: parseSimpleQuery :: ByteString -> SimpleQuery
+ Network.HTTP.Types.URI: queryTextToQuery :: QueryText -> Query
+ Network.HTTP.Types.URI: queryToQueryText :: Query -> QueryText
+ Network.HTTP.Types.URI: renderQuery :: Bool -> Query -> ByteString
+ Network.HTTP.Types.URI: renderQueryBuilder :: Bool -> Query -> Builder
+ Network.HTTP.Types.URI: renderQueryText :: Bool -> QueryText -> Builder
+ Network.HTTP.Types.URI: renderSimpleQuery :: Bool -> SimpleQuery -> ByteString
+ Network.HTTP.Types.URI: simpleQueryToQuery :: SimpleQuery -> Query
+ Network.HTTP.Types.URI: type Query = [QueryItem]
+ Network.HTTP.Types.URI: type QueryItem = (ByteString, Maybe ByteString)
+ Network.HTTP.Types.URI: type QueryText = [(Text, Maybe Text)]
+ Network.HTTP.Types.URI: type SimpleQuery = [SimpleQueryItem]
+ Network.HTTP.Types.URI: type SimpleQueryItem = (ByteString, ByteString)
+ Network.HTTP.Types.URI: urlDecode :: Bool -> ByteString -> ByteString
+ Network.HTTP.Types.URI: urlEncode :: Bool -> ByteString -> ByteString
+ Network.HTTP.Types.URI: urlEncodeBuilder :: Bool -> ByteString -> Builder
+ Network.HTTP.Types.Version: HttpVersion :: !Int -> !Int -> HttpVersion
+ Network.HTTP.Types.Version: data HttpVersion
+ Network.HTTP.Types.Version: http09 :: HttpVersion
+ Network.HTTP.Types.Version: http10 :: HttpVersion
+ Network.HTTP.Types.Version: http11 :: HttpVersion
+ Network.HTTP.Types.Version: httpMajor :: HttpVersion -> !Int
+ Network.HTTP.Types.Version: httpMinor :: HttpVersion -> !Int
+ Network.HTTP.Types.Version: instance Eq HttpVersion
+ Network.HTTP.Types.Version: instance Ord HttpVersion
+ Network.HTTP.Types.Version: instance Show HttpVersion
- Network.HTTP.Types: Status :: Int -> Ascii -> Status
+ Network.HTTP.Types: Status :: Int -> ByteString -> Status
- Network.HTTP.Types: headerAccept, headerDate, headerContentMD5, headerContentType, headerContentLength, headerConnection, headerCacheControl, headerAuthorization :: Ascii -> Header
+ Network.HTTP.Types: headerAccept, headerDate, headerContentMD5, headerContentType, headerContentLength, headerConnection, headerCacheControl, headerAuthorization :: ByteString -> Header
- Network.HTTP.Types: parseMethod :: Method -> Either Ascii StdMethod
+ Network.HTTP.Types: parseMethod :: Method -> Either ByteString StdMethod
- Network.HTTP.Types: renderByteRange :: ByteRange -> Ascii
+ Network.HTTP.Types: renderByteRange :: ByteRange -> ByteString
- Network.HTTP.Types: renderByteRanges :: ByteRanges -> Ascii
+ Network.HTTP.Types: renderByteRanges :: ByteRanges -> ByteString
- Network.HTTP.Types: renderMethod :: Either Ascii StdMethod -> Method
+ Network.HTTP.Types: renderMethod :: Either ByteString StdMethod -> Method
- Network.HTTP.Types: renderQuery :: Bool -> Query -> Ascii
+ Network.HTTP.Types: renderQuery :: Bool -> Query -> ByteString
- Network.HTTP.Types: renderSimpleQuery :: Bool -> SimpleQuery -> Ascii
+ Network.HTTP.Types: renderSimpleQuery :: Bool -> SimpleQuery -> ByteString
- Network.HTTP.Types: statusMessage :: Status -> Ascii
+ Network.HTTP.Types: statusMessage :: Status -> ByteString
- Network.HTTP.Types: type Header = (CI Ascii, Ascii)
+ Network.HTTP.Types: type Header = (HeaderName, ByteString)
- Network.HTTP.Types: type Method = Ascii
+ Network.HTTP.Types: type Method = ByteString
- Network.HTTP.Types: urlEncode :: Bool -> ByteString -> Ascii
+ Network.HTTP.Types: urlEncode :: Bool -> ByteString -> ByteString
Files
- Network/HTTP/Types.hs +81/−1013
- Network/HTTP/Types/Header.hs +129/−0
- Network/HTTP/Types/Method.hs +69/−0
- Network/HTTP/Types/QueryLike.hs +53/−0
- Network/HTTP/Types/Status.hs +437/−0
- Network/HTTP/Types/URI.hs +296/−0
- Network/HTTP/Types/Version.hs +33/−0
- http-types.cabal +8/−2
- runtests.hs +3/−3
Network/HTTP/Types.hs view
@@ -112,1016 +112,84 @@ , RequestHeaders , ResponseHeaders -- ** Common headers-, headerAccept-, headerAuthorization-, headerCacheControl-, headerConnection-, headerContentLength-, headerContentType-, headerContentMD5-, headerDate- -- ** Byte ranges-, ByteRange(..)-, renderByteRangeBuilder-, renderByteRange-, ByteRanges-, renderByteRangesBuilder-, renderByteRanges- -- * Query string-, QueryItem-, Query-, SimpleQueryItem-, SimpleQuery-, simpleQueryToQuery-, renderQuery-, renderQueryBuilder-, renderSimpleQuery-, parseQuery-, parseSimpleQuery- -- ** Text query string (UTF8 encoded)-, QueryText-, queryTextToQuery-, queryToQueryText-, renderQueryText-, parseQueryText- -- * Path segments-, encodePathSegments-, decodePathSegments-, encodePathSegmentsRelative- -- * Path (segments + query string)-, encodePath-, decodePath- -- * URL encoding / decoding-, urlEncodeBuilder-, urlEncode-, urlDecode- -- * Deprecated functions-, statusNotAllowed-, statusContinue-, statusSwitchingProtocols-, statusOK-, statusCreated-, statusAccepted-, statusNonAuthoritative-, statusNoContent-, statusResetContent-, statusPartialContent-, statusMultipleChoices-, statusMovedPermanently-, statusFound-, statusSeeOther-, statusNotModified-, statusUseProxy-, statusTemporaryRedirect-, statusBadRequest-, statusUnauthorized-, statusPaymentRequired-, statusForbidden-, statusNotFound-, statusNotAcceptable-, statusProxyAuthenticationRequired-, statusRequestTimeout-, statusConflict-, statusGone-, statusLengthRequired-, statusPreconditionFailed-, statusRequestEntityTooLarge-, statusRequestURITooLong-, statusUnsupportedMediaType-, statusRequestedRangeNotSatisfiable-, statusExpectationFailed-, statusImATeapot-, statusServerError-, statusNotImplemented-, statusBadGateway-, statusServiceUnavailable-, statusGatewayTimeout-, statusHTTPVersionNotSupported-)-where--import Control.Arrow (second, (|||), (***))-import Data.Array-import Data.Bits (shiftL, (.|.))-import Data.Char-import Data.Maybe-import Data.Monoid (mempty, mappend, mconcat)-import Data.Text (Text)-import Data.Text.Encoding (encodeUtf8, decodeUtf8With)-import Data.Text.Encoding.Error (lenientDecode)-import Data.Word (Word8)-import Data.List (intersperse)-import qualified Blaze.ByteString.Builder as Blaze-import qualified Blaze.ByteString.Builder.Char8 as Blaze-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import qualified Data.CaseInsensitive as CI--type Ascii = B.ByteString---- | HTTP method (flat string type).-type Method = Ascii---- | HTTP Method constants.-methodGet, methodPost, methodHead, methodPut, methodDelete, methodTrace, methodConnect, methodOptions :: Method-methodGet = renderStdMethod GET-methodPost = renderStdMethod POST-methodHead = renderStdMethod HEAD-methodPut = renderStdMethod PUT-methodDelete = renderStdMethod DELETE-methodTrace = renderStdMethod TRACE-methodConnect = renderStdMethod CONNECT-methodOptions = renderStdMethod OPTIONS---- | HTTP standard method (as defined by RFC 2616).-data StdMethod- = GET- | POST- | HEAD - | PUT- | DELETE- | TRACE- | CONNECT- | OPTIONS- deriving (Read, Show, Eq, Ord, Enum, Bounded, Ix)--- These are ordered by suspected frequency. More popular methods should go first.--- The reason is that methodList is used with lookup.--- lookup is probably faster for these few cases than setting up an elaborate data structure.--methodArray :: Array StdMethod Method-methodArray = listArray (minBound, maxBound) $ map (B8.pack . show) [minBound :: StdMethod .. maxBound]--methodList :: [(Method, StdMethod)]-methodList = map (\(a, b) -> (b, a)) (assocs methodArray)---- | Convert a method 'ByteString' to a 'StdMethod' if possible.-parseMethod :: Method -> Either Ascii StdMethod-parseMethod bs = maybe (Left bs) Right $ lookup bs methodList---- | Convert an algebraic method to a 'ByteString'.-renderMethod :: Either Ascii StdMethod -> Method-renderMethod = id ||| renderStdMethod---- | Convert a 'StdMethod' to a 'ByteString'.-renderStdMethod :: StdMethod -> Method-renderStdMethod m = methodArray ! m---- | HTTP Version.--- --- Note that the Show instance is intended merely for debugging.-data HttpVersion - = HttpVersion {- httpMajor :: !Int - , httpMinor :: !Int- }- deriving (Eq, Ord)--instance Show HttpVersion where- show (HttpVersion major minor) = "HTTP/" ++ show major ++ "." ++ show minor---- | HTTP 0.9-http09 :: HttpVersion-http09 = HttpVersion 0 9---- | HTTP 1.0-http10 :: HttpVersion-http10 = HttpVersion 1 0---- | HTTP 1.1-http11 :: HttpVersion-http11 = HttpVersion 1 1---- | HTTP Status.--- --- Only the 'statusCode' is used for comparisons.--- --- Note that the Show instance is only for debugging.-data Status- = Status {- statusCode :: Int- , statusMessage :: Ascii- }- deriving (Show)--instance Eq Status where- Status { statusCode = a } == Status { statusCode = b } = a == b--instance Ord Status where- compare Status { statusCode = a } Status { statusCode = b } = a `compare` b---- | Continue 100-status100 :: Status-status100 = Status 100 "Continue"---- | Continue 100-continue100 :: Status-continue100 = status100---- | Continue 100 (DEPRECATED)-statusContinue :: Status-statusContinue = status100-{-# DEPRECATED statusContinue "Deprecated" #-}---- | Switching Protocols 101-status101 :: Status-status101 = Status 101 "Switching Protocols"---- | Switching Protocols 101-switchingProtocols101 :: Status-switchingProtocols101 = status101---- | Switching Protocols 101 (DEPRECATED)-statusSwitchingProtocols :: Status-statusSwitchingProtocols = status101-{-# DEPRECATED statusSwitchingProtocols "Deprecated" #-}---- | OK 200-status200 :: Status-status200 = Status 200 "OK"---- | OK 200-ok200 :: Status-ok200 = status200---- | OK 200 (DEPRECATED)-statusOK :: Status-statusOK = status200-{-# DEPRECATED statusOK "Deprecated" #-}---- | Created 201-status201 :: Status-status201 = Status 201 "Created"---- | Created 201-created201 :: Status-created201 = status201---- | Created 201 (DEPRECATED)-statusCreated :: Status-statusCreated = status201-{-# DEPRECATED statusCreated "Deprecated" #-}---- | Accepted 202-status202 :: Status-status202 = Status 202 "Accepted"---- | Accepted 202-accepted202 :: Status-accepted202 = status202---- | Accepted 202 (DEPRECATED)-statusAccepted :: Status-statusAccepted = status202-{-# DEPRECATED statusAccepted "Deprecated" #-}---- | Non-Authoritative Information 203-status203 :: Status-status203 = Status 203 "Non-Authoritative Information"---- | Non-Authoritative Information 203-nonAuthoritative203 :: Status-nonAuthoritative203 = status203---- | Non-Authoritative Information 203 (DEPRECATED)-statusNonAuthoritative :: Status-statusNonAuthoritative = status203-{-# DEPRECATED statusNonAuthoritative "Deprecated" #-}---- | No Content 204-status204 :: Status-status204 = Status 204 "No Content"---- | No Content 204-noContent204 :: Status-noContent204 = status204---- | No Content 204 (DEPRECATED)-statusNoContent :: Status-statusNoContent = status204-{-# DEPRECATED statusNoContent "Deprecated" #-}---- | Reset Content 205-status205 :: Status-status205 = Status 205 "Reset Content"---- | Reset Content 205-resetContent205 :: Status-resetContent205 = status205---- | Reset Content 205 (DEPRECATED)-statusResetContent :: Status-statusResetContent = status205-{-# DEPRECATED statusResetContent "Deprecated" #-}---- | Partial Content 206-status206 :: Status-status206 = Status 206 "Partial Content"---- | Partial Content 206-partialContent206 :: Status-partialContent206 = status206---- | Partial Content 206 (DEPRECATED)-statusPartialContent :: Status-statusPartialContent = status206-{-# DEPRECATED statusPartialContent "Deprecated" #-}---- | Multiple Choices 300-status300 :: Status-status300 = Status 300 "Multiple Choices"---- | Multiple Choices 300-multipleChoices300 :: Status-multipleChoices300 = status300---- | Multiple Choices 300 (DEPRECATED)-statusMultipleChoices :: Status-statusMultipleChoices = status300-{-# DEPRECATED statusMultipleChoices "Deprecated" #-}---- | Moved Permanently 301-status301 :: Status-status301 = Status 301 "Moved Permanently"---- | Moved Permanently 301-movedPermanently301 :: Status-movedPermanently301 = status301---- | Moved Permanently 301 (DEPRECATED)-statusMovedPermanently :: Status-statusMovedPermanently = status301-{-# DEPRECATED statusMovedPermanently "Deprecated" #-}---- | Found 302-status302 :: Status-status302 = Status 302 "Found"---- | Found 302-found302 :: Status-found302 = status302---- | Found 302 (DEPRECATED)-statusFound :: Status-statusFound = status302-{-# DEPRECATED statusFound "Deprecated" #-}---- | See Other 303-status303 :: Status-status303 = Status 303 "See Other"---- | See Other 303-seeOther303 :: Status-seeOther303 = status303---- | See Other 303 (DEPRECATED)-statusSeeOther :: Status-statusSeeOther = status303-{-# DEPRECATED statusSeeOther "Deprecated" #-}---- | Not Modified 304-status304 :: Status-status304 = Status 304 "Not Modified"---- | Not Modified 304-notModified304 :: Status-notModified304 = status304---- | Not Modified 304 (DEPRECATED)-statusNotModified :: Status-statusNotModified = status304-{-# DEPRECATED statusNotModified "Deprecated" #-}---- | Use Proxy 305-status305 :: Status-status305 = Status 305 "Use Proxy"---- | Use Proxy 305-useProxy305 :: Status-useProxy305 = status305---- | Use Proxy 305 (DEPRECATED)-statusUseProxy :: Status-statusUseProxy = status305-{-# DEPRECATED statusUseProxy "Deprecated" #-}---- | Temporary Redirect 307-status307 :: Status-status307 = Status 307 "Temporary Redirect"---- | Temporary Redirect 307-temporaryRedirect307 :: Status-temporaryRedirect307 = status307---- | Temporary Redirect 307 (DEPRECATED)-statusTemporaryRedirect :: Status-statusTemporaryRedirect = status307-{-# DEPRECATED statusTemporaryRedirect "Deprecated" #-}---- | Bad Request 400-status400 :: Status-status400 = Status 400 "Bad Request"---- | Bad Request 400-badRequest400 :: Status-badRequest400 = status400---- | Bad Request 400 (DEPRECATED)-statusBadRequest :: Status-statusBadRequest = status400-{-# DEPRECATED statusBadRequest "Deprecated" #-}---- | Unauthorized 401-status401 :: Status-status401 = Status 401 "Unauthorized"---- | Unauthorized 401-unauthorized401 :: Status-unauthorized401 = status401---- | Unauthorized 401 (DEPRECATED)-statusUnauthorized :: Status-statusUnauthorized = status401-{-# DEPRECATED statusUnauthorized "Deprecated" #-}---- | Payment Required 402-status402 :: Status-status402 = Status 402 "Payment Required"---- | Payment Required 402-paymentRequired402 :: Status-paymentRequired402 = status402---- | Payment Required 402 (DEPRECATED)-statusPaymentRequired :: Status-statusPaymentRequired = status402-{-# DEPRECATED statusPaymentRequired "Deprecated" #-}---- | Forbidden 403-status403 :: Status-status403 = Status 403 "Forbidden"---- | Forbidden 403-forbidden403 :: Status-forbidden403 = status403---- | Forbidden 403 (DEPRECATED)-statusForbidden :: Status-statusForbidden = status403-{-# DEPRECATED statusForbidden "Deprecated" #-}---- | Not Found 404-status404 :: Status-status404 = Status 404 "Not Found"---- | Not Found 404-notFound404 :: Status-notFound404 = status404---- | Not Found 404 (DEPRECATED)-statusNotFound :: Status-statusNotFound = status404-{-# DEPRECATED statusNotFound "Deprecated" #-}---- | Method Not Allowed 405-status405 :: Status-status405 = Status 405 "Method Not Allowed"---- | Method Not Allowed 405-methodNotAllowed405 :: Status-methodNotAllowed405 = status405---- | Method Not Allowed 405 (DEPRECATED!)-statusNotAllowed :: Status-statusNotAllowed = status405-{-# DEPRECATED statusNotAllowed "Use status405 or methodNotAllowed405 instead" #-}---- | Not Acceptable 406-status406 :: Status-status406 = Status 406 "Not Acceptable"---- | Not Acceptable 406-notAcceptable406 :: Status-notAcceptable406 = status406---- | Not Acceptable 406 (DEPRECATED)-statusNotAcceptable :: Status-statusNotAcceptable = status406-{-# DEPRECATED statusNotAcceptable "Deprecated" #-}---- | Proxy Authentication Required 407-status407 :: Status-status407 = Status 407 "Proxy Authentication Required"---- | Proxy Authentication Required 407-proxyAuthenticationRequired407 :: Status-proxyAuthenticationRequired407 = status407---- | Proxy Authentication Required 407-statusProxyAuthenticationRequired :: Status-statusProxyAuthenticationRequired = status407-{-# DEPRECATED statusProxyAuthenticationRequired "Deprecated" #-}---- | Request Timeout 408-status408 :: Status-status408 = Status 408 "Request Timeout"---- | Request Timeout 408-requestTimeout408 :: Status-requestTimeout408 = status408---- | Request Timeout 408 (DEPRECATED)-statusRequestTimeout :: Status-statusRequestTimeout = status408-{-# DEPRECATED statusRequestTimeout "Deprecated" #-}---- | Conflict 409-status409 :: Status-status409 = Status 409 "Conflict"---- | Conflict 409-conflict409 :: Status-conflict409 = status409---- | Conflict 409 (DEPRECATED)-statusConflict :: Status-statusConflict = status409-{-# DEPRECATED statusConflict "Deprecated" #-}---- | Gone 410-status410 :: Status-status410 = Status 410 "Gone"---- | Gone 410-gone410 :: Status-gone410 = status410---- | Gone 410 (DEPRECATED)-statusGone :: Status-statusGone = status410-{-# DEPRECATED #-}---- | Length Required 411-status411 :: Status-status411 = Status 411 "Length Required"---- | Length Required 411-lengthRequired411 :: Status-lengthRequired411 = status411---- | Length Required 411 (DEPRECATED)-statusLengthRequired :: Status-statusLengthRequired = status411-{-# DEPRECATED statusLengthRequired "Deprecated" #-}---- | Precondition Failed 412-status412 :: Status-status412 = Status 412 "Precondition Failed"---- | Precondition Failed 412-preconditionFailed412 :: Status-preconditionFailed412 = status412---- | Precondition Failed 412 (DEPRECATED)-statusPreconditionFailed :: Status-statusPreconditionFailed = status412-{-# DEPRECATED statusPreconditionFailed "Deprecated" #-}---- | Request Entity Too Large 413-status413 :: Status-status413 = Status 413 "Request Entity Too Large"---- | Request Entity Too Large 413-requestEntityTooLarge413 :: Status-requestEntityTooLarge413 = status413---- | Request Entity Too Large 413 (DEPRECATED)-statusRequestEntityTooLarge :: Status-statusRequestEntityTooLarge = status413-{-# DEPRECATED statusRequestEntityTooLarge "Deprecated" #-}---- | Request-URI Too Long 414-status414 :: Status-status414 = Status 414 "Request-URI Too Long"---- | Request-URI Too Long 414-requestURITooLong414 :: Status-requestURITooLong414 = status414---- | Request-URI Too Long 414 (DEPRECATED)-statusRequestURITooLong :: Status-statusRequestURITooLong = status414-{-# DEPRECATED statusRequestURITooLong "Deprecated" #-}---- | Unsupported Media Type 415-status415 :: Status-status415 = Status 415 "Unsupported Media Type"---- | Unsupported Media Type 415-unsupportedMediaType415 :: Status-unsupportedMediaType415 = status415---- | Unsupported Media Type 415 (DEPRECATED)-statusUnsupportedMediaType :: Status-statusUnsupportedMediaType = status415-{-# DEPRECATED statusUnsupportedMediaType "Deprecated" #-}---- | Requested Range Not Satisfiable 416-status416 :: Status-status416 = Status 416 "Requested Range Not Satisfiable"---- | Requested Range Not Satisfiable 416-requestedRangeNotSatisfiable416 :: Status-requestedRangeNotSatisfiable416 = status416---- | Requested Range Not Satisfiable 416 (DEPRECATED)-statusRequestedRangeNotSatisfiable :: Status-statusRequestedRangeNotSatisfiable = status416-{-# DEPRECATED statusRequestedRangeNotSatisfiable "Deprecated" #-}---- | Expectation Failed 417-status417 :: Status-status417 = Status 417 "Expectation Failed"---- | Expectation Failed 417-expectationFailed417 :: Status-expectationFailed417 = status417---- | Expectation Failed 417 (DEPRECATED)-statusExpectationFailed :: Status-statusExpectationFailed = status417-{-# DEPRECATED statusExpectationFailed "Deprecated" #-}---- | I'm a teapot 418-status418 :: Status-status418 = Status 418 "I'm a teapot"---- | I'm a teapot 418-imATeaPot418 :: Status-imATeaPot418 = status418---- | I'm a teapot 418 (DEPRECATED)-statusImATeapot :: Status-statusImATeapot = status418-{-# DEPRECATED statusImATeapot "Deprecated" #-}---- | Internal Server Error 500-status500 :: Status-status500 = Status 500 "Internal Server Error"---- | Internal Server Error 500-internalServerError500 :: Status-internalServerError500 = status500---- | Internal Server Error 500 (DEPRECATED)-statusServerError :: Status-statusServerError = status500-{-# DEPRECATED statusServerError "Deprecated" #-}---- | Not Implemented 501-status501 :: Status-status501 = Status 501 "Not Implemented"---- | Not Implemented 501-notImplemented501 :: Status-notImplemented501 = status501---- | Not Implemented 501 (DEPRECATED)-statusNotImplemented :: Status-statusNotImplemented = status501-{-# DEPRECATED statusNotImplemented "Deprecated" #-}---- | Bad Gateway 502-status502 :: Status-status502 = Status 502 "Bad Gateway"---- | Bad Gateway 502-badGateway502 :: Status-badGateway502 = status502---- | Bad Gateway 502 (DEPRECATED)-statusBadGateway :: Status-statusBadGateway = status502-{-# DEPRECATED statusBadGateway "Deprecated" #-}---- | Service Unavailable 503-status503 :: Status-status503 = Status 503 "Service Unavailable"---- | Service Unavailable 503-serviceUnavailable503 :: Status-serviceUnavailable503 = status503---- | Service Unavailable 503 (DEPRECATED)-statusServiceUnavailable :: Status-statusServiceUnavailable = status503-{-# DEPRECATED statusServiceUnavailable "Deprecated" #-}---- | Gateway Timeout 504-status504 :: Status-status504 = Status 504 "Gateway Timeout"---- | Gateway Timeout 504-gatewayTimeout504 :: Status-gatewayTimeout504 = status504---- | Gateway Timeout 504 (DEPRECATED)-statusGatewayTimeout :: Status-statusGatewayTimeout = status504-{-# DEPRECATED statusGatewayTimeout "Deprecated" #-}---- | HTTP Version Not Supported 505-status505 :: Status-status505 = Status 505 "HTTP Version Not Supported"---- | HTTP Version Not Supported 505-httpVersionNotSupported505 :: Status-httpVersionNotSupported505 = status505---- | HTTP Version Not Supported 505 (DEPRECATED)-statusHTTPVersionNotSupported :: Status-statusHTTPVersionNotSupported = status505-{-# DEPRECATED statusHTTPVersionNotSupported "Deprecated" #-}---- | Header-type Header = (CI.CI Ascii, Ascii)---- | Request Headers-type RequestHeaders = [Header]---- | Response Headers-type ResponseHeaders = [Header]---- | HTTP Headers-headerAccept, headerAuthorization, headerCacheControl, headerConnection, headerContentLength, headerContentType, headerContentMD5, headerDate :: Ascii -> Header-headerAccept = (,) "Accept"-headerAuthorization = (,) "Authorization"-headerCacheControl = (,) "Cache-Control"-headerConnection = (,) "Connection"-headerContentLength = (,) "Content-Length"-headerContentType = (,) "Content-Type"-headerContentMD5 = (,) "Content-MD5"-headerDate = (,) "Date"---- | RFC 2616 Byte range (individual). --- --- Negative indices are not allowed!-data ByteRange - = ByteRangeFrom !Integer- | ByteRangeFromTo !Integer !Integer- | ByteRangeSuffix !Integer--renderByteRangeBuilder :: ByteRange -> Blaze.Builder-renderByteRangeBuilder (ByteRangeFrom from) = Blaze.fromShow from `mappend` Blaze.fromChar '-'-renderByteRangeBuilder (ByteRangeFromTo from to) = Blaze.fromShow from `mappend` Blaze.fromChar '-' `mappend` Blaze.fromShow to-renderByteRangeBuilder (ByteRangeSuffix suffix) = Blaze.fromChar '-' `mappend` Blaze.fromShow suffix--renderByteRange :: ByteRange -> Ascii-renderByteRange = Blaze.toByteString . renderByteRangeBuilder---- | RFC 2616 Byte ranges (set).-type ByteRanges = [ByteRange]--renderByteRangesBuilder :: ByteRanges -> Blaze.Builder-renderByteRangesBuilder xs = Blaze.copyByteString "bytes=" `mappend` - mconcat (intersperse (Blaze.fromChar ',') (map renderByteRangeBuilder xs))--renderByteRanges :: ByteRanges -> Ascii-renderByteRanges = Blaze.toByteString . renderByteRangesBuilder---- | Query item-type QueryItem = (B.ByteString, Maybe B.ByteString)---- | Query.--- --- General form: a=b&c=d, but if the value is Nothing, it becomes--- a&c=d.-type Query = [QueryItem]--type QueryText = [(Text, Maybe Text)]--queryTextToQuery :: QueryText -> Query-queryTextToQuery = map $ encodeUtf8 *** fmap encodeUtf8--renderQueryText :: Bool -- ^ prepend a question mark?- -> QueryText- -> Blaze.Builder-renderQueryText b = renderQueryBuilder b . queryTextToQuery--queryToQueryText :: Query -> QueryText-queryToQueryText =- map $ go *** fmap go- where- go = decodeUtf8With lenientDecode--parseQueryText :: B.ByteString -> QueryText-parseQueryText = queryToQueryText . parseQuery---- | Simplified Query item type without support for parameter-less items.-type SimpleQueryItem = (B.ByteString, B.ByteString)---- | Simplified Query type without support for parameter-less items.-type SimpleQuery = [SimpleQueryItem]---- | Convert 'SimpleQuery' to 'Query'.-simpleQueryToQuery :: SimpleQuery -> Query-simpleQueryToQuery = map (\(a, b) -> (a, Just b))--renderQueryBuilder :: Bool -- ^ prepend a question mark?- -> Query- -> Blaze.Builder-renderQueryBuilder _ [] = mempty--- FIXME replace mconcat + map with foldr-renderQueryBuilder qmark' (p:ps) = mconcat- $ go (if qmark' then qmark else mempty) p- : map (go amp) ps- where- qmark = Blaze.copyByteString "?"- amp = Blaze.copyByteString "&"- equal = Blaze.copyByteString "="- go sep (k, mv) = mconcat [- sep- , urlEncodeBuilder True k- , case mv of- Nothing -> mempty- Just v -> equal `mappend` urlEncodeBuilder True v- ]---- | Convert 'Query' to 'ByteString'.-renderQuery :: Bool -- ^ prepend question mark?- -> Query -> Ascii-renderQuery qm = Blaze.toByteString . renderQueryBuilder qm---- | Convert 'SimpleQuery' to 'ByteString'.-renderSimpleQuery :: Bool -- ^ prepend question mark?- -> SimpleQuery -> Ascii-renderSimpleQuery useQuestionMark = renderQuery useQuestionMark . simpleQueryToQuery---- | Split out the query string into a list of keys and values. A few--- importants points:------ * The result returned is still bytestrings, since we perform no character--- decoding here. Most likely, you will want to use UTF-8 decoding, but this is--- left to the user of the library.------ * Percent decoding errors are ignored. In particular, "%Q" will be output as--- "%Q".-parseQuery :: B.ByteString -> Query-parseQuery = parseQueryString' . dropQuestion- where- dropQuestion q =- case B.uncons q of- Just (63, q') -> q'- _ -> q- parseQueryString' q | B.null q = []- parseQueryString' q =- let (x, xs) = breakDiscard queryStringSeparators q- in parsePair x : parseQueryString' xs- where- parsePair x =- let (k, v) = B.breakByte 61 x -- equal sign- v'' =- case B.uncons v of- Just (_, v') -> Just $ urlDecode True v'- _ -> Nothing- in (urlDecode True k, v'')--queryStringSeparators :: B.ByteString-queryStringSeparators = B.pack [38,59] -- ampersand, semicolon---- | Break the second bytestring at the first occurence of any bytes from--- the first bytestring, discarding that byte.-breakDiscard :: B.ByteString -> B.ByteString -> (B.ByteString, B.ByteString)-breakDiscard seps s =- let (x, y) = B.break (`B.elem` seps) s- in (x, B.drop 1 y)---- | Parse 'SimpleQuery' from a 'ByteString'.-parseSimpleQuery :: B.ByteString -> SimpleQuery-parseSimpleQuery = map (second $ fromMaybe B.empty) . parseQuery--ord8 :: Char -> Word8-ord8 = fromIntegral . ord--unreservedQS, unreservedPI :: [Word8]-unreservedQS = map ord8 "-_.~"-unreservedPI = map ord8 "-_.~:@&=+$,"---- | Percent-encoding for URLs.-urlEncodeBuilder' :: [Word8] -> B.ByteString -> Blaze.Builder-urlEncodeBuilder' extraUnreserved = mconcat . map encodeChar . B.unpack- where- encodeChar ch | unreserved ch = Blaze.fromWord8 ch- | otherwise = h2 ch- - unreserved ch | ch >= 65 && ch <= 90 = True -- A-Z- | ch >= 97 && ch <= 122 = True -- a-z- | ch >= 48 && ch <= 57 = True -- 0-9- unreserved c = c `elem` extraUnreserved- - h2 v = let (a, b) = v `divMod` 16 in Blaze.fromWord8s [37, h a, h b] -- percent (%)- h i | i < 10 = 48 + i -- zero (0)- | otherwise = 65 + i - 10 -- 65: A--urlEncodeBuilder- :: Bool -- ^ Whether input is in query string. True: Query string, False: Path element- -> B.ByteString- -> Blaze.Builder-urlEncodeBuilder True = urlEncodeBuilder' unreservedQS-urlEncodeBuilder False = urlEncodeBuilder' unreservedPI--urlEncode :: Bool -> B.ByteString -> Ascii-urlEncode q = Blaze.toByteString . urlEncodeBuilder q---- | Percent-decoding.-urlDecode :: Bool -- ^ Whether to decode '+' to ' '- -> B.ByteString -> B.ByteString-urlDecode replacePlus z = fst $ B.unfoldrN (B.length z) go z- where- go bs =- case B.uncons bs of- Nothing -> Nothing- Just (43, ws) | replacePlus -> Just (32, ws) -- plus to space- Just (37, ws) -> Just $ fromMaybe (37, ws) $ do -- percent- (x, xs) <- B.uncons ws- x' <- hexVal x- (y, ys) <- B.uncons xs- y' <- hexVal y- Just $ (combine x' y', ys)- Just (w, ws) -> Just (w, ws)- hexVal w- | 48 <= w && w <= 57 = Just $ w - 48 -- 0 - 9- | 65 <= w && w <= 70 = Just $ w - 55 -- A - F- | 97 <= w && w <= 102 = Just $ w - 87 -- a - f- | otherwise = Nothing- combine :: Word8 -> Word8 -> Word8- combine a b = shiftL a 4 .|. b---- | Encodes a list of path segments into a valid URL fragment.------ This function takes the following three steps:------ * UTF-8 encodes the characters.------ * Performs percent encoding on all unreserved characters, as well as \:\@\=\+\$,------ * Prepends each segment with a slash.------ For example:------ > encodePathSegments [\"foo\", \"bar\", \"baz\"]------ \"\/foo\/bar\/baz\"------ > encodePathSegments [\"foo bar\", \"baz\/bin\"]------ \"\/foo\%20bar\/baz\%2Fbin\"------ > encodePathSegments [\"שלום\"]------ \"\/%D7%A9%D7%9C%D7%95%D7%9D\"------ Huge thanks to Jeremy Shaw who created the original implementation of this--- function in web-routes and did such thorough research to determine all--- correct escaping procedures.-encodePathSegments :: [Text] -> Blaze.Builder-encodePathSegments [] = mempty-encodePathSegments (x:xs) =- Blaze.copyByteString "/"- `mappend` encodePathSegment x- `mappend` encodePathSegments xs---- | Like encodePathSegments, but without the initial slash.-encodePathSegmentsRelative :: [Text] -> Blaze.Builder-encodePathSegmentsRelative xs = mconcat $ intersperse (Blaze.copyByteString "/") (map encodePathSegment xs)--encodePathSegment :: Text -> Blaze.Builder-encodePathSegment = urlEncodeBuilder False . encodeUtf8--decodePathSegments :: B.ByteString -> [Text]-decodePathSegments "" = []-decodePathSegments "/" = []-decodePathSegments a =- go $ drop1Slash a- where- drop1Slash bs =- case B.uncons bs of- Just (47, bs') -> bs' -- 47 == /- _ -> bs- go bs =- let (x, y) = B.breakByte 47 bs- in decodePathSegment x :- if B.null y- then []- else go $ B.drop 1 y--decodePathSegment :: B.ByteString -> Text-decodePathSegment = decodeUtf8With lenientDecode . urlDecode False--encodePath :: [Text] -> Query -> Blaze.Builder-encodePath x [] = encodePathSegments x-encodePath x y = encodePathSegments x `mappend` renderQueryBuilder True y--decodePath :: B.ByteString -> ([Text], Query)-decodePath b =- let (x, y) = B.breakByte 63 b -- question mark- in (decodePathSegments x, parseQuery y)+, hAccept+, hAcceptLanguage+, hAuthorization+, hCacheControl+, hCookie+, hConnection+, hContentEncoding+, hContentLength+, hContentMD5+, hContentType+, hDate+, hIfModifiedSince+, hIfRange+, hLastModified+, hRange+, hReferer+, hUserAgent+ -- ** Byte ranges+, ByteRange(..)+, renderByteRangeBuilder+, renderByteRange+, ByteRanges+, renderByteRangesBuilder+, renderByteRanges+ -- * URI+ -- ** Query string+, QueryItem+, Query+, SimpleQueryItem+, SimpleQuery+, simpleQueryToQuery+, renderQuery+, renderQueryBuilder+, renderSimpleQuery+, parseQuery+, parseSimpleQuery+ -- *** Text query string (UTF8 encoded)+, QueryText+, queryTextToQuery+, queryToQueryText+, renderQueryText+, parseQueryText+ -- ** Generalized query types+, QueryLike(toQuery)+ -- ** Path segments+, encodePathSegments+, decodePathSegments+, encodePathSegmentsRelative+ -- ** Path (segments + query string)+, encodePath+, decodePath+ -- ** URL encoding / decoding+, urlEncodeBuilder+, urlEncode+, urlDecode+ -- * Deprecated functions+ -- ** as of 0.7.0+, headerAccept+, headerAuthorization+, headerCacheControl+, headerConnection+, headerContentLength+, headerContentType+, headerContentMD5+, headerDate+)+where++import Network.HTTP.Types.Method+import Network.HTTP.Types.Version+import Network.HTTP.Types.Status+import Network.HTTP.Types.Header+import Network.HTTP.Types.URI+import Network.HTTP.Types.QueryLike+import qualified Data.ByteString as B++-- | Type synonym for ASCII ByteStrings (deprecated).+type Ascii = B.ByteString+{-# DEPRECATED Ascii "Deprecated Ascii type" #-}++
+ Network/HTTP/Types/Header.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-}+module 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+, hRange+, hReferer+, hUserAgent+ -- ** Byte ranges+, ByteRange(..)+, renderByteRangeBuilder+, renderByteRange+, ByteRanges+, renderByteRangesBuilder+, renderByteRanges+ -- ** Deprecated+, headerAccept+, headerAuthorization+, headerCacheControl+, headerConnection+, headerContentLength+, headerContentType+, headerContentMD5+, headerDate+)+where++import Data.List+import Data.Monoid+import qualified Blaze.ByteString.Builder as Blaze+import qualified Blaze.ByteString.Builder.Char8 as Blaze+import qualified Data.ByteString as B+import qualified Data.CaseInsensitive as CI+import Data.ByteString.Char8 () {-IsString-}++-- | Header+type Header = (HeaderName, B.ByteString)++-- | Header name+type HeaderName = CI.CI B.ByteString++-- | Request Headers+type RequestHeaders = [Header]++-- | Response Headers+type ResponseHeaders = [Header]++-- | HTTP Header names+hAccept, hAcceptLanguage, hAuthorization, hCacheControl, hConnection, hContentEncoding, hContentLength, hContentMD5, hContentType, hCookie, hDate, hIfModifiedSince, hIfRange, hLastModified, hRange, hReferer, hUserAgent :: HeaderName+hAccept = "Accept"+hAcceptLanguage = "Accept-Language"+hAuthorization = "Authorization"+hCacheControl = "Cache-Control"+hConnection = "Connection"+hContentEncoding = "Content-Encoding"+hContentLength = "Content-Length"+hContentMD5 = "Content-MD5"+hContentType = "Content-Type"+hCookie = "Cookie"+hDate = "Date"+hIfModifiedSince = "If-Modified-Since"+hIfRange = "If-Range"+hLastModified = "Last-Modified"+hRange = "Range"+hReferer = "Referer"+hUserAgent = "User-Agent"++-- | HTTP Headers+headerAccept, headerAuthorization, headerCacheControl, headerConnection, headerContentLength, headerContentType, headerContentMD5, headerDate :: B.ByteString -> Header+headerAccept = (,) hAccept+{-# DEPRECATED headerAccept "Use hAccept instead" #-}+headerAuthorization = (,) hAuthorization+{-# DEPRECATED headerAuthorization "Use hAuthorization instead" #-}+headerCacheControl = (,) hCacheControl+{-# DEPRECATED headerCacheControl "Use hCacheControl instead" #-}+headerConnection = (,) hConnection+{-# DEPRECATED headerConnection "Use hConnection instead" #-}+headerContentLength = (,) hContentLength+{-# DEPRECATED headerContentLength "Use hContentLength instead" #-}+headerContentMD5 = (,) hContentMD5+{-# DEPRECATED headerContentMD5 "Use hContentMD5 instead" #-}+headerContentType = (,) hContentType+{-# DEPRECATED headerContentType "Use hContentType instead" #-}+headerDate = (,) hDate+{-# DEPRECATED headerDate "Use hDate instead" #-}++-- | RFC 2616 Byte range (individual). +-- +-- Negative indices are not allowed!+data ByteRange + = ByteRangeFrom !Integer+ | ByteRangeFromTo !Integer !Integer+ | ByteRangeSuffix !Integer++renderByteRangeBuilder :: ByteRange -> Blaze.Builder+renderByteRangeBuilder (ByteRangeFrom from) = Blaze.fromShow from `mappend` Blaze.fromChar '-'+renderByteRangeBuilder (ByteRangeFromTo from to) = Blaze.fromShow from `mappend` Blaze.fromChar '-' `mappend` Blaze.fromShow to+renderByteRangeBuilder (ByteRangeSuffix suffix) = Blaze.fromChar '-' `mappend` Blaze.fromShow suffix++renderByteRange :: ByteRange -> B.ByteString+renderByteRange = Blaze.toByteString . renderByteRangeBuilder++-- | RFC 2616 Byte ranges (set).+type ByteRanges = [ByteRange]++renderByteRangesBuilder :: ByteRanges -> Blaze.Builder+renderByteRangesBuilder xs = Blaze.copyByteString "bytes=" `mappend` + mconcat (intersperse (Blaze.fromChar ',') (map renderByteRangeBuilder xs))++renderByteRanges :: ByteRanges -> B.ByteString+renderByteRanges = Blaze.toByteString . renderByteRangesBuilder
+ Network/HTTP/Types/Method.hs view
@@ -0,0 +1,69 @@+module Network.HTTP.Types.Method+(+ Method+, methodGet+, methodPost+, methodHead+, methodPut+, methodDelete+, methodTrace+, methodConnect+, methodOptions+, StdMethod(..)+, parseMethod+, renderMethod+, renderStdMethod+)+where++import Control.Arrow ((|||))+import Data.Array+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8++-- | HTTP method (flat string type).+type Method = B.ByteString++-- | HTTP Method constants.+methodGet, methodPost, methodHead, methodPut, methodDelete, methodTrace, methodConnect, methodOptions :: Method+methodGet = renderStdMethod GET+methodPost = renderStdMethod POST+methodHead = renderStdMethod HEAD+methodPut = renderStdMethod PUT+methodDelete = renderStdMethod DELETE+methodTrace = renderStdMethod TRACE+methodConnect = renderStdMethod CONNECT+methodOptions = renderStdMethod OPTIONS++-- | HTTP standard method (as defined by RFC 2616).+data StdMethod+ = GET+ | POST+ | HEAD + | PUT+ | DELETE+ | TRACE+ | CONNECT+ | OPTIONS+ deriving (Read, Show, Eq, Ord, Enum, Bounded, Ix)+-- These are ordered by suspected frequency. More popular methods should go first.+-- The reason is that methodList is used with lookup.+-- lookup is probably faster for these few cases than setting up an elaborate data structure.++methodArray :: Array StdMethod Method+methodArray = listArray (minBound, maxBound) $ map (B8.pack . show) [minBound :: StdMethod .. maxBound]++methodList :: [(Method, StdMethod)]+methodList = map (\(a, b) -> (b, a)) (assocs methodArray)++-- | Convert a method 'ByteString' to a 'StdMethod' if possible.+parseMethod :: Method -> Either B.ByteString StdMethod+parseMethod bs = maybe (Left bs) Right $ lookup bs methodList++-- | Convert an algebraic method to a 'ByteString'.+renderMethod :: Either B.ByteString StdMethod -> Method+renderMethod = id ||| renderStdMethod++-- | Convert a 'StdMethod' to a 'ByteString'.+renderStdMethod :: StdMethod -> Method+renderStdMethod m = methodArray ! m
+ Network/HTTP/Types/QueryLike.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE FlexibleInstances #-}+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++-- | Types which can, and commonly are, converted to 'Query' are in this class.+-- +-- You can use lists of simple key value pairs, with 'B.ByteString' (strict, or lazy: +-- 'L.ByteString'), 'T.Text', or 'String' as the key/value types. You can also have the value+-- type lifted into a Maybe to support keys without values; and finally it is possible to put+-- each pair into a Maybe for key-value pairs that aren't always present.+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.+class QueryKeyLike a where+ toQueryKey :: a -> B.ByteString++-- | Types which, in a Query-like key-value list, are used in the Value position.+class QueryValueLike a where+ toQueryValue :: a -> Maybe B.ByteString++instance (QueryKeyLike k, QueryValueLike v) => QueryLike [(k, v)] where+ toQuery = map (toQueryKey *** toQueryValue)++instance (QueryKeyLike k, QueryValueLike v) => QueryLike [Maybe (k, v)] where+ toQuery = toQuery . catMaybes++instance QueryKeyLike B.ByteString where toQueryKey = id+instance QueryKeyLike L.ByteString where toQueryKey = B.concat . L.toChunks+instance QueryKeyLike T.Text where toQueryKey = T.encodeUtf8+instance QueryKeyLike [Char] where toQueryKey = T.encodeUtf8 . T.pack++instance QueryValueLike B.ByteString where toQueryValue = Just+instance QueryValueLike L.ByteString where toQueryValue = Just . B.concat . L.toChunks+instance QueryValueLike T.Text where toQueryValue = Just . T.encodeUtf8+instance QueryValueLike [Char] where toQueryValue = Just . T.encodeUtf8 . T.pack++instance QueryValueLike a => QueryValueLike (Maybe a) where+ toQueryValue = maybe Nothing toQueryValue
+ Network/HTTP/Types/Status.hs view
@@ -0,0 +1,437 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.HTTP.Types.Status+(+ Status(..)+, status100+, continue100+, status101+, switchingProtocols101+, status200+, ok200+, status201+, created201+, status202+, accepted202+, status203+, nonAuthoritative203+, status204+, noContent204+, status205+, resetContent205+, status206+, partialContent206+, status300+, multipleChoices300+, status301+, movedPermanently301+, status302+, found302+, status303+, seeOther303+, status304+, notModified304+, status305+, useProxy305+, status307+, temporaryRedirect307+, status400+, badRequest400+, status401+, unauthorized401+, status402+, paymentRequired402+, status403+, forbidden403+, status404+, notFound404+, status405+, methodNotAllowed405+, status406+, notAcceptable406+, status407+, proxyAuthenticationRequired407+, status408+, requestTimeout408+, status409+, conflict409+, status410+, gone410+, status411+, lengthRequired411+, status412+, preconditionFailed412+, status413+, requestEntityTooLarge413+, status414+, requestURITooLong414+, status415+, unsupportedMediaType415+, status416+, requestedRangeNotSatisfiable416+, status417+, expectationFailed417+, status418+, imATeaPot418+, status500+, internalServerError500+, status501+, notImplemented501+, status502+, badGateway502+, status503+, serviceUnavailable503+, status504+, gatewayTimeout504+, status505+, httpVersionNotSupported505+)+where++import qualified Data.ByteString as B+import Data.ByteString.Char8 () {- IsString -}++-- | HTTP Status.+-- +-- Only the 'statusCode' is used for comparisons.+-- +-- Note that the Show instance is only for debugging.+data Status+ = Status {+ statusCode :: Int+ , statusMessage :: B.ByteString+ }+ deriving (Show)++instance Eq Status where+ Status { statusCode = a } == Status { statusCode = b } = a == b++instance Ord Status where+ compare Status { statusCode = a } Status { statusCode = b } = a `compare` b++-- | Continue 100+status100 :: Status+status100 = Status 100 "Continue"++-- | Continue 100+continue100 :: Status+continue100 = status100++-- | Switching Protocols 101+status101 :: Status+status101 = Status 101 "Switching Protocols"++-- | Switching Protocols 101+switchingProtocols101 :: Status+switchingProtocols101 = status101++-- | OK 200+status200 :: Status+status200 = Status 200 "OK"++-- | OK 200+ok200 :: Status+ok200 = status200++-- | Created 201+status201 :: Status+status201 = Status 201 "Created"++-- | Created 201+created201 :: Status+created201 = status201++-- | Accepted 202+status202 :: Status+status202 = Status 202 "Accepted"++-- | Accepted 202+accepted202 :: Status+accepted202 = status202++-- | Non-Authoritative Information 203+status203 :: Status+status203 = Status 203 "Non-Authoritative Information"++-- | Non-Authoritative Information 203+nonAuthoritative203 :: Status+nonAuthoritative203 = status203++-- | No Content 204+status204 :: Status+status204 = Status 204 "No Content"++-- | No Content 204+noContent204 :: Status+noContent204 = status204++-- | Reset Content 205+status205 :: Status+status205 = Status 205 "Reset Content"++-- | Reset Content 205+resetContent205 :: Status+resetContent205 = status205++-- | Partial Content 206+status206 :: Status+status206 = Status 206 "Partial Content"++-- | Partial Content 206+partialContent206 :: Status+partialContent206 = status206++-- | Multiple Choices 300+status300 :: Status+status300 = Status 300 "Multiple Choices"++-- | Multiple Choices 300+multipleChoices300 :: Status+multipleChoices300 = status300++-- | Moved Permanently 301+status301 :: Status+status301 = Status 301 "Moved Permanently"++-- | Moved Permanently 301+movedPermanently301 :: Status+movedPermanently301 = status301++-- | Found 302+status302 :: Status+status302 = Status 302 "Found"++-- | Found 302+found302 :: Status+found302 = status302++-- | See Other 303+status303 :: Status+status303 = Status 303 "See Other"++-- | See Other 303+seeOther303 :: Status+seeOther303 = status303++-- | Not Modified 304+status304 :: Status+status304 = Status 304 "Not Modified"++-- | Not Modified 304+notModified304 :: Status+notModified304 = status304++-- | Use Proxy 305+status305 :: Status+status305 = Status 305 "Use Proxy"++-- | Use Proxy 305+useProxy305 :: Status+useProxy305 = status305++-- | Temporary Redirect 307+status307 :: Status+status307 = Status 307 "Temporary Redirect"++-- | Temporary Redirect 307+temporaryRedirect307 :: Status+temporaryRedirect307 = status307++-- | Bad Request 400+status400 :: Status+status400 = Status 400 "Bad Request"++-- | Bad Request 400+badRequest400 :: Status+badRequest400 = status400++-- | Unauthorized 401+status401 :: Status+status401 = Status 401 "Unauthorized"++-- | Unauthorized 401+unauthorized401 :: Status+unauthorized401 = status401++-- | Payment Required 402+status402 :: Status+status402 = Status 402 "Payment Required"++-- | Payment Required 402+paymentRequired402 :: Status+paymentRequired402 = status402++-- | Forbidden 403+status403 :: Status+status403 = Status 403 "Forbidden"++-- | Forbidden 403+forbidden403 :: Status+forbidden403 = status403++-- | Not Found 404+status404 :: Status+status404 = Status 404 "Not Found"++-- | Not Found 404+notFound404 :: Status+notFound404 = status404++-- | Method Not Allowed 405+status405 :: Status+status405 = Status 405 "Method Not Allowed"++-- | Method Not Allowed 405+methodNotAllowed405 :: Status+methodNotAllowed405 = status405++-- | Not Acceptable 406+status406 :: Status+status406 = Status 406 "Not Acceptable"++-- | Not Acceptable 406+notAcceptable406 :: Status+notAcceptable406 = status406++-- | Proxy Authentication Required 407+status407 :: Status+status407 = Status 407 "Proxy Authentication Required"++-- | Proxy Authentication Required 407+proxyAuthenticationRequired407 :: Status+proxyAuthenticationRequired407 = status407++-- | Request Timeout 408+status408 :: Status+status408 = Status 408 "Request Timeout"++-- | Request Timeout 408+requestTimeout408 :: Status+requestTimeout408 = status408++-- | Conflict 409+status409 :: Status+status409 = Status 409 "Conflict"++-- | Conflict 409+conflict409 :: Status+conflict409 = status409++-- | Gone 410+status410 :: Status+status410 = Status 410 "Gone"++-- | Gone 410+gone410 :: Status+gone410 = status410++-- | Length Required 411+status411 :: Status+status411 = Status 411 "Length Required"++-- | Length Required 411+lengthRequired411 :: Status+lengthRequired411 = status411++-- | Precondition Failed 412+status412 :: Status+status412 = Status 412 "Precondition Failed"++-- | Precondition Failed 412+preconditionFailed412 :: Status+preconditionFailed412 = status412++-- | Request Entity Too Large 413+status413 :: Status+status413 = Status 413 "Request Entity Too Large"++-- | Request Entity Too Large 413+requestEntityTooLarge413 :: Status+requestEntityTooLarge413 = status413++-- | Request-URI Too Long 414+status414 :: Status+status414 = Status 414 "Request-URI Too Long"++-- | Request-URI Too Long 414+requestURITooLong414 :: Status+requestURITooLong414 = status414++-- | Unsupported Media Type 415+status415 :: Status+status415 = Status 415 "Unsupported Media Type"++-- | Unsupported Media Type 415+unsupportedMediaType415 :: Status+unsupportedMediaType415 = status415++-- | Requested Range Not Satisfiable 416+status416 :: Status+status416 = Status 416 "Requested Range Not Satisfiable"++-- | Requested Range Not Satisfiable 416+requestedRangeNotSatisfiable416 :: Status+requestedRangeNotSatisfiable416 = status416++-- | Expectation Failed 417+status417 :: Status+status417 = Status 417 "Expectation Failed"++-- | Expectation Failed 417+expectationFailed417 :: Status+expectationFailed417 = status417++-- | I'm a teapot 418+status418 :: Status+status418 = Status 418 "I'm a teapot"++-- | I'm a teapot 418+imATeaPot418 :: Status+imATeaPot418 = status418++-- | Internal Server Error 500+status500 :: Status+status500 = Status 500 "Internal Server Error"++-- | Internal Server Error 500+internalServerError500 :: Status+internalServerError500 = status500++-- | Not Implemented 501+status501 :: Status+status501 = Status 501 "Not Implemented"++-- | Not Implemented 501+notImplemented501 :: Status+notImplemented501 = status501++-- | Bad Gateway 502+status502 :: Status+status502 = Status 502 "Bad Gateway"++-- | Bad Gateway 502+badGateway502 :: Status+badGateway502 = status502++-- | Service Unavailable 503+status503 :: Status+status503 = Status 503 "Service Unavailable"++-- | Service Unavailable 503+serviceUnavailable503 :: Status+serviceUnavailable503 = status503++-- | Gateway Timeout 504+status504 :: Status+status504 = Status 504 "Gateway Timeout"++-- | Gateway Timeout 504+gatewayTimeout504 :: Status+gatewayTimeout504 = status504++-- | HTTP Version Not Supported 505+status505 :: Status+status505 = Status 505 "HTTP Version Not Supported"++-- | HTTP Version Not Supported 505+httpVersionNotSupported505 :: Status+httpVersionNotSupported505 = status505
+ Network/HTTP/Types/URI.hs view
@@ -0,0 +1,296 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.HTTP.Types.URI+(+ -- * Query string+ QueryItem+, Query+, SimpleQueryItem+, SimpleQuery+, simpleQueryToQuery+, renderQuery+, renderQueryBuilder+, renderSimpleQuery+, parseQuery+, parseSimpleQuery+ -- ** Text query string (UTF8 encoded)+, QueryText+, queryTextToQuery+, queryToQueryText+, renderQueryText+, parseQueryText+ -- * Path segments+, encodePathSegments+, decodePathSegments+, encodePathSegmentsRelative+ -- * Path (segments + query string)+, encodePath+, decodePath+ -- * URL encoding / decoding+, urlEncodeBuilder+, urlEncode+, urlDecode+)+where++import Control.Arrow+import Data.Bits+import Data.Char+import Data.List+import Data.Maybe+import Data.Monoid+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8, decodeUtf8With)+import Data.Text.Encoding.Error (lenientDecode)+import Data.Word+import qualified Blaze.ByteString.Builder as Blaze+import qualified Data.ByteString as B+import Data.ByteString.Char8 () {-IsString-}++-- | Query item+type QueryItem = (B.ByteString, Maybe B.ByteString)++-- | Query.+-- +-- General form: a=b&c=d, but if the value is Nothing, it becomes+-- a&c=d.+type Query = [QueryItem]++-- | Like Query, but with 'Text' instead of 'B.ByteString' (UTF8-encoded).+type QueryText = [(Text, Maybe Text)]++-- | Convert 'QueryText' to 'Query'.+queryTextToQuery :: QueryText -> Query+queryTextToQuery = map $ encodeUtf8 *** fmap encodeUtf8++-- | Convert 'QueryText' to a 'Blaze.Builder'.+renderQueryText :: Bool -- ^ prepend a question mark?+ -> QueryText+ -> Blaze.Builder+renderQueryText b = renderQueryBuilder b . queryTextToQuery++-- | Convert 'Query' to 'QueryText' (leniently decoding the UTF-8).+queryToQueryText :: Query -> QueryText+queryToQueryText =+ map $ go *** fmap go+ where+ go = decodeUtf8With lenientDecode++-- | Parse 'QueryText' from a 'B.ByteString'. See 'parseQuery' for details.+parseQueryText :: B.ByteString -> QueryText+parseQueryText = queryToQueryText . parseQuery++-- | Simplified Query item type without support for parameter-less items.+type SimpleQueryItem = (B.ByteString, B.ByteString)++-- | Simplified Query type without support for parameter-less items.+type SimpleQuery = [SimpleQueryItem]++-- | Convert 'SimpleQuery' to 'Query'.+simpleQueryToQuery :: SimpleQuery -> Query+simpleQueryToQuery = map (\(a, b) -> (a, Just b))++-- | Convert 'Query' to a 'Builder'.+renderQueryBuilder :: Bool -- ^ prepend a question mark?+ -> Query+ -> Blaze.Builder+renderQueryBuilder _ [] = mempty+-- FIXME replace mconcat + map with foldr+renderQueryBuilder qmark' (p:ps) = mconcat+ $ go (if qmark' then qmark else mempty) p+ : map (go amp) ps+ where+ qmark = Blaze.copyByteString "?"+ amp = Blaze.copyByteString "&"+ equal = Blaze.copyByteString "="+ go sep (k, mv) = mconcat [+ sep+ , urlEncodeBuilder True k+ , case mv of+ Nothing -> mempty+ Just v -> equal `mappend` urlEncodeBuilder True v+ ]++-- | Convert 'Query' to 'ByteString'.+renderQuery :: Bool -- ^ prepend question mark?+ -> Query -> B.ByteString+renderQuery qm = Blaze.toByteString . renderQueryBuilder qm++-- | Convert 'SimpleQuery' to 'ByteString'.+renderSimpleQuery :: Bool -- ^ prepend question mark?+ -> 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".+parseQuery :: B.ByteString -> Query+parseQuery = parseQueryString' . dropQuestion+ where+ dropQuestion q =+ case B.uncons q of+ Just (63, q') -> q'+ _ -> q+ parseQueryString' q | B.null q = []+ parseQueryString' q =+ let (x, xs) = breakDiscard queryStringSeparators q+ in parsePair x : parseQueryString' xs+ where+ parsePair x =+ let (k, v) = B.breakByte 61 x -- equal sign+ v'' =+ case B.uncons v of+ Just (_, v') -> Just $ urlDecode True v'+ _ -> Nothing+ in (urlDecode True k, v'')++queryStringSeparators :: B.ByteString+queryStringSeparators = B.pack [38,59] -- ampersand, semicolon++-- | Break the second bytestring at the first occurence of any bytes from+-- the first bytestring, discarding that byte.+breakDiscard :: B.ByteString -> B.ByteString -> (B.ByteString, B.ByteString)+breakDiscard seps s =+ let (x, y) = B.break (`B.elem` seps) s+ in (x, B.drop 1 y)++-- | Parse 'SimpleQuery' from a 'ByteString'.+parseSimpleQuery :: B.ByteString -> SimpleQuery+parseSimpleQuery = map (second $ fromMaybe B.empty) . parseQuery++ord8 :: Char -> Word8+ord8 = fromIntegral . ord++unreservedQS, unreservedPI :: [Word8]+unreservedQS = map ord8 "-_.~"+unreservedPI = map ord8 "-_.~:@&=+$,"++-- | Percent-encoding for URLs.+urlEncodeBuilder' :: [Word8] -> B.ByteString -> Blaze.Builder+urlEncodeBuilder' extraUnreserved = mconcat . map encodeChar . B.unpack+ where+ encodeChar ch | unreserved ch = Blaze.fromWord8 ch+ | otherwise = h2 ch+ + unreserved ch | ch >= 65 && ch <= 90 = True -- A-Z+ | ch >= 97 && ch <= 122 = True -- a-z+ | ch >= 48 && ch <= 57 = True -- 0-9+ unreserved c = c `elem` extraUnreserved+ + h2 v = let (a, b) = v `divMod` 16 in Blaze.fromWord8s [37, h a, h b] -- percent (%)+ h i | i < 10 = 48 + i -- zero (0)+ | otherwise = 65 + i - 10 -- 65: A++-- | Percent-encoding for URLs (using 'Blaze.Builder').+urlEncodeBuilder+ :: Bool -- ^ Whether input is in query string. True: Query string, False: Path element+ -> B.ByteString+ -> Blaze.Builder+urlEncodeBuilder True = urlEncodeBuilder' unreservedQS+urlEncodeBuilder False = urlEncodeBuilder' unreservedPI++-- | Percent-encoding for URLs.+urlEncode :: Bool -> B.ByteString -> B.ByteString+urlEncode q = Blaze.toByteString . urlEncodeBuilder q++-- | Percent-decoding.+urlDecode :: Bool -- ^ Whether to decode '+' to ' '+ -> B.ByteString -> B.ByteString+urlDecode replacePlus z = fst $ B.unfoldrN (B.length z) go z+ where+ go bs =+ case B.uncons bs of+ Nothing -> Nothing+ Just (43, ws) | replacePlus -> Just (32, ws) -- plus to space+ Just (37, ws) -> Just $ fromMaybe (37, ws) $ do -- percent+ (x, xs) <- B.uncons ws+ x' <- hexVal x+ (y, ys) <- B.uncons xs+ y' <- hexVal y+ Just $ (combine x' y', ys)+ Just (w, ws) -> Just (w, ws)+ hexVal w+ | 48 <= w && w <= 57 = Just $ w - 48 -- 0 - 9+ | 65 <= w && w <= 70 = Just $ w - 55 -- A - F+ | 97 <= w && w <= 102 = Just $ w - 87 -- a - f+ | otherwise = Nothing+ combine :: Word8 -> Word8 -> Word8+ combine a b = shiftL a 4 .|. b++-- | Encodes a list of path segments into a valid URL fragment.+-- +-- This function takes the following three steps:+-- +-- * UTF-8 encodes the characters.+-- +-- * Performs percent encoding on all unreserved characters, as well as \:\@\=\+\$,+-- +-- * Prepends each segment with a slash.+-- +-- For example:+-- +-- > encodePathSegments [\"foo\", \"bar\", \"baz\"]+-- +-- \"\/foo\/bar\/baz\"+-- +-- > encodePathSegments [\"foo bar\", \"baz\/bin\"]+-- +-- \"\/foo\%20bar\/baz\%2Fbin\"+-- +-- > encodePathSegments [\"שלום\"]+-- +-- \"\/%D7%A9%D7%9C%D7%95%D7%9D\"+-- +-- Huge thanks to Jeremy Shaw who created the original implementation of this+-- function in web-routes and did such thorough research to determine all+-- correct escaping procedures.+encodePathSegments :: [Text] -> Blaze.Builder+encodePathSegments [] = mempty+encodePathSegments (x:xs) =+ Blaze.copyByteString "/"+ `mappend` encodePathSegment x+ `mappend` encodePathSegments xs++-- | Like encodePathSegments, but without the initial slash.+encodePathSegmentsRelative :: [Text] -> Blaze.Builder+encodePathSegmentsRelative xs = mconcat $ intersperse (Blaze.copyByteString "/") (map encodePathSegment xs)++encodePathSegment :: Text -> Blaze.Builder+encodePathSegment = urlEncodeBuilder False . encodeUtf8++-- | Parse a list of path segments from a valid URL fragment.+decodePathSegments :: B.ByteString -> [Text]+decodePathSegments "" = []+decodePathSegments "/" = []+decodePathSegments a =+ go $ drop1Slash a+ where+ drop1Slash bs =+ case B.uncons bs of+ Just (47, bs') -> bs' -- 47 == /+ _ -> bs+ go bs =+ let (x, y) = B.breakByte 47 bs+ in decodePathSegment x :+ if B.null y+ then []+ else go $ B.drop 1 y++decodePathSegment :: B.ByteString -> Text+decodePathSegment = decodeUtf8With lenientDecode . urlDecode False++-- | Encode a whole path (path segments + query).+encodePath :: [Text] -> Query -> Blaze.Builder+encodePath x [] = encodePathSegments x+encodePath x y = encodePathSegments x `mappend` renderQueryBuilder True y++-- | Decode a whole path (path segments + query).+decodePath :: B.ByteString -> ([Text], Query)+decodePath b =+ let (x, y) = B.breakByte 63 b -- question mark+ in (decodePathSegments x, parseQuery y)
+ Network/HTTP/Types/Version.hs view
@@ -0,0 +1,33 @@+module Network.HTTP.Types.Version+(+ HttpVersion(..)+, http09+, http10+, http11+)+where++-- | HTTP Version.+-- +-- Note that the Show instance is intended merely for debugging.+data HttpVersion + = HttpVersion {+ httpMajor :: !Int + , httpMinor :: !Int+ }+ deriving (Eq, Ord)++instance Show HttpVersion where+ show (HttpVersion major minor) = "HTTP/" ++ show major ++ "." ++ show minor++-- | HTTP 0.9+http09 :: HttpVersion+http09 = HttpVersion 0 9++-- | HTTP 1.0+http10 :: HttpVersion+http10 = HttpVersion 1 0++-- | HTTP 1.1+http11 :: HttpVersion+http11 = HttpVersion 1 1
http-types.cabal view
@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.6.11+Version: 0.7.0 -- A short (one-line) description of the package. Synopsis: Generic HTTP types for Haskell (for both client and server code).@@ -48,6 +48,12 @@ Library -- Modules exported by the library. Exposed-modules: Network.HTTP.Types+ Network.HTTP.Types.Header+ Network.HTTP.Types.Method+ Network.HTTP.Types.QueryLike+ Network.HTTP.Types.Status+ Network.HTTP.Types.URI+ Network.HTTP.Types.Version -- GHC Options. GHC-Options: -Wall@@ -70,4 +76,4 @@ Test-suite runtests main-is: runtests.hs type: exitcode-stdio-1.0- build-depends: text, bytestring, base, blaze-builder, array, case-insensitive, QuickCheck, HUnit, hspec >= 1.0+ build-depends: text, bytestring, base, blaze-builder, array, case-insensitive, QuickCheck, HUnit, hspec >= 1.2
runtests.hs view
@@ -5,7 +5,7 @@ import Data.Text (Text) import Debug.Trace import Network.HTTP.Types-import Test.Hspec+import Test.Hspec.Core import Test.Hspec.QuickCheck import Test.Hspec.HUnit import Test.QuickCheck (Arbitrary (..))@@ -15,8 +15,8 @@ import qualified Data.ByteString.Char8 as S8 import qualified Data.Text as T ---main :: IO ()-main = hspecX+main :: IO ()+main = hspec [ describe "encode/decode path" [ it "is identity to encode and then decode" $ property propEncodeDecodePath