http-types-0.9.1/0000755000000000000000000000000012724576246012047 5ustar0000000000000000http-types-0.9.1/LICENSE0000644000000000000000000000304212724576246013053 0ustar0000000000000000Copyright (c) 2011, Aristid Breitkreuz Copyright (c) 2011, Michael Snoyman All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Aristid Breitkreuz nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. http-types-0.9.1/CHANGELOG0000644000000000000000000000027012724576246013260 0ustar0000000000000000* 0.9.1 [2016-06-04] New function: parseByteRanges. Support for HTTP status 422 "Unprocessable Entity" (RFC 4918). * 0.9 [2015-10-09] No changelog was maintained up to version 0.9. http-types-0.9.1/http-types.cabal0000644000000000000000000000412112724576246015152 0ustar0000000000000000Name: http-types Version: 0.9.1 Synopsis: Generic HTTP types for Haskell (for both client and server code). Description: Generic HTTP types for Haskell (for both client and server code). Homepage: https://github.com/aristidb/http-types License: BSD3 License-file: LICENSE Author: Aristid Breitkreuz, Michael Snoyman Maintainer: aristidb@googlemail.com Copyright: (C) 2011 Aristid Breitkreuz Category: Network, Web Build-type: Simple Extra-source-files: README, CHANGELOG Cabal-version: >=1.8 Source-repository this type: git location: https://github.com/aristidb/http-types.git tag: 0.9.1 Source-repository head type: git location: https://github.com/aristidb/http-types.git Library Exposed-modules: Network.HTTP.Types Network.HTTP.Types.Header Network.HTTP.Types.Method Network.HTTP.Types.QueryLike Network.HTTP.Types.Status Network.HTTP.Types.URI Network.HTTP.Types.Version GHC-Options: -Wall Build-depends: base >= 4 && < 5, bytestring >=0.9.1.5 && <0.11, array >=0.2 && <0.6, case-insensitive >=0.2 && <1.3, blaze-builder >= 0.2.1.4 && < 0.5, text >= 0.11.0.2 Test-suite spec main-is: Spec.hs hs-source-dirs: test type: exitcode-stdio-1.0 GHC-Options: -Wall build-depends: base, http-types, text, bytestring, blaze-builder, QuickCheck, quickcheck-instances, hspec >= 1.3 Test-Suite doctests main-is: doctests.hs hs-source-dirs: test type: exitcode-stdio-1.0 ghc-options: -threaded -Wall build-depends: base, doctest >= 0.9.3 http-types-0.9.1/README0000644000000000000000000000044412724576246012731 0ustar0000000000000000Generic HTTP types for Haskell (for both client and server code). This library also contains some utility functions, e.g. related to URI handling, that are not necessarily restricted in use to HTTP, but the scope is restricted to things that are useful inside HTTP, i.e. no FTP URI parsing. http-types-0.9.1/Setup.hs0000644000000000000000000000005612724576246013504 0ustar0000000000000000import Distribution.Simple main = defaultMain http-types-0.9.1/Network/0000755000000000000000000000000012724576246013500 5ustar0000000000000000http-types-0.9.1/Network/HTTP/0000755000000000000000000000000012724576246014257 5ustar0000000000000000http-types-0.9.1/Network/HTTP/Types.hs0000644000000000000000000000606512724576246015726 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Types ( -- * Methods Method , methodGet , methodPost , methodHead , methodPut , methodDelete , methodTrace , methodConnect , methodOptions , methodPatch , StdMethod(..) , parseMethod , renderMethod , renderStdMethod -- * Versions , HttpVersion(..) , http09 , http10 , http11 -- * Status , Status(..) , mkStatus , status100 , continue100 , status101 , switchingProtocols101 , status200 , ok200 , status201 , created201 , status202 , accepted202 , status203 , nonAuthoritative203 , status204 , noContent204 , status205 , resetContent205 , status206 , partialContent206 , status300 , multipleChoices300 , status301 , movedPermanently301 , status302 , found302 , status303 , seeOther303 , status304 , notModified304 , status305 , useProxy305 , status307 , temporaryRedirect307 , status400 , badRequest400 , status401 , unauthorized401 , status402 , paymentRequired402 , status403 , forbidden403 , status404 , notFound404 , status405 , methodNotAllowed405 , status406 , notAcceptable406 , status407 , proxyAuthenticationRequired407 , status408 , requestTimeout408 , status409 , conflict409 , status410 , gone410 , status411 , lengthRequired411 , status412 , preconditionFailed412 , status413 , requestEntityTooLarge413 , status414 , requestURITooLong414 , status415 , unsupportedMediaType415 , status416 , requestedRangeNotSatisfiable416 , status417 , expectationFailed417 , status418 , imATeaPot418 , status500 , internalServerError500 , status501 , notImplemented501 , status502 , badGateway502 , status503 , serviceUnavailable503 , status504 , gatewayTimeout504 , status505 , httpVersionNotSupported505 , statusIsInformational , statusIsSuccessful , statusIsRedirection , statusIsClientError , statusIsServerError -- * Headers -- ** Types , Header , HeaderName , RequestHeaders , ResponseHeaders -- ** Common headers , hAccept , hAcceptLanguage , hAuthorization , hCacheControl , hCookie , hConnection , hContentEncoding , hContentLength , hContentMD5 , hContentType , hDate , hIfModifiedSince , hIfRange , hLastModified , hLocation , hRange , hReferer , hServer , hUserAgent -- ** Byte ranges , ByteRange(..) , renderByteRangeBuilder , renderByteRange , ByteRanges , renderByteRangesBuilder , renderByteRanges , parseByteRanges -- * URI -- ** Query string , QueryItem , Query , SimpleQueryItem , SimpleQuery , simpleQueryToQuery , renderQuery , renderQueryBuilder , renderSimpleQuery , parseQuery , parseSimpleQuery -- *** Text query string (UTF8 encoded) , QueryText , queryTextToQuery , queryToQueryText , renderQueryText , parseQueryText -- ** Generalized query types , QueryLike(toQuery) -- ** Path segments , encodePathSegments , decodePathSegments , encodePathSegmentsRelative -- ** Path (segments + query string) , extractPath , encodePath , decodePath -- ** URL encoding / decoding , urlEncodeBuilder , urlEncode , urlDecode ) where import Network.HTTP.Types.Header import Network.HTTP.Types.Method import Network.HTTP.Types.QueryLike import Network.HTTP.Types.Status import Network.HTTP.Types.URI import Network.HTTP.Types.Version http-types-0.9.1/Network/HTTP/Types/0000755000000000000000000000000012724576246015363 5ustar0000000000000000http-types-0.9.1/Network/HTTP/Types/QueryLike.hs0000644000000000000000000000411512724576246017632 0ustar0000000000000000{-# 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 toQueryValuehttp-types-0.9.1/Network/HTTP/Types/Header.hs0000644000000000000000000001537112724576246017116 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, CPP #-} module Network.HTTP.Types.Header ( -- ** Types Header , HeaderName , RequestHeaders , ResponseHeaders -- ** Common headers , hAccept , hAcceptCharset , hAcceptEncoding , hAcceptLanguage , hAcceptRanges , hAge , hAllow , hAuthorization , hCacheControl , hConnection , hContentEncoding , hContentLanguage , hContentLength , hContentLocation , hContentMD5 , hContentRange , hContentType , hCookie , 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 -- ** Byte ranges , ByteRange(..) , renderByteRangeBuilder , renderByteRange , ByteRanges , renderByteRangesBuilder , renderByteRanges , parseByteRanges ) where import Data.List #if __GLASGOW_HASKELL__ < 710 import Data.Monoid #endif import qualified Blaze.ByteString.Builder as Blaze import qualified Blaze.ByteString.Builder.Char8 as Blaze import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.CaseInsensitive as CI import Data.ByteString.Char8 () {-IsString-} import Data.Typeable (Typeable) import Data.Data (Data) -- | 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 -- 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, hCookie, hDate, hETag, hExpect, hExpires, hFrom, hHost, hIfMatch, hIfModifiedSince, hIfNoneMatch, hIfRange, hIfUnmodifiedSince, hLastModified, hLocation, hMaxForwards, hPragma, hProxyAuthenticate, hProxyAuthorization, hRange, hReferer, hRetryAfter, hServer, hTE, hTrailer, hTransferEncoding, hUpgrade, hUserAgent, hVary, hVia, hWWWAuthenticate, hWarning :: HeaderName hAccept = "Accept" hAcceptCharset = "Accept-Charset" hAcceptEncoding = "Accept-Encoding" hAcceptLanguage = "Accept-Language" hAcceptRanges = "Accept-Ranges" hAge = "Age" hAllow = "Allow" hAuthorization = "Authorization" hCacheControl = "Cache-Control" hConnection = "Connection" hContentEncoding = "Content-Encoding" hContentLanguage = "Content-Language" hContentLength = "Content-Length" hContentLocation = "Content-Location" hContentMD5 = "Content-MD5" hContentRange = "Content-Range" hContentType = "Content-Type" hCookie = "Cookie" hDate = "Date" hETag = "ETag" hExpect = "Expect" hExpires = "Expires" hFrom = "From" hHost = "Host" hIfMatch = "If-Match" hIfModifiedSince = "If-Modified-Since" hIfNoneMatch = "If-None-Match" hIfRange = "If-Range" hIfUnmodifiedSince = "If-Unmodified-Since" hLastModified = "Last-Modified" hLocation = "Location" hMaxForwards = "Max-Forwards" hPragma = "Pragma" hProxyAuthenticate = "Proxy-Authenticate" hProxyAuthorization = "Proxy-Authorization" hRange = "Range" hReferer = "Referer" hRetryAfter = "Retry-After" hServer = "Server" hTE = "TE" hTrailer = "Trailer" hTransferEncoding = "Transfer-Encoding" hUpgrade = "Upgrade" hUserAgent = "User-Agent" hVary = "Vary" hVia = "Via" hWWWAuthenticate = "WWW-Authenticate" hWarning = "Warning" -- | RFC 2616 Byte range (individual). -- -- Negative indices are not allowed! data ByteRange = ByteRangeFrom !Integer | ByteRangeFromTo !Integer !Integer | ByteRangeSuffix !Integer deriving (Show, Eq, Ord, Typeable, Data) 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 -- | Parse the value of a Range header into a 'ByteRanges'. -- -- >>> parseByteRanges "error" -- Nothing -- >>> parseByteRanges "bytes=0-499" -- Just [ByteRangeFromTo 0 499] -- >>> parseByteRanges "bytes=500-999" -- Just [ByteRangeFromTo 500 999] -- >>> parseByteRanges "bytes=-500" -- Just [ByteRangeSuffix 500] -- >>> parseByteRanges "bytes=9500-" -- Just [ByteRangeFrom 9500] -- >>> parseByteRanges "bytes=0-0,-1" -- Just [ByteRangeFromTo 0 0,ByteRangeSuffix 1] -- >>> parseByteRanges "bytes=500-600,601-999" -- Just [ByteRangeFromTo 500 600,ByteRangeFromTo 601 999] -- >>> parseByteRanges "bytes=500-700,601-999" -- Just [ByteRangeFromTo 500 700,ByteRangeFromTo 601 999] parseByteRanges :: B.ByteString -> Maybe ByteRanges parseByteRanges bs1 = do bs2 <- stripPrefixB "bytes=" bs1 (r, bs3) <- range bs2 ranges (r:) bs3 where range bs2 = do (i, bs3) <- B8.readInteger bs2 if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-") then Just (ByteRangeSuffix (negate i), bs3) else do bs4 <- stripPrefixB "-" bs3 case B8.readInteger bs4 of Just (j, bs5) | j >= i -> Just (ByteRangeFromTo i j, bs5) _ -> Just (ByteRangeFrom i, bs4) ranges front bs3 | B.null bs3 = Just (front []) | otherwise = do bs4 <- stripPrefixB "," bs3 (r, bs5) <- range bs4 ranges (front . (r:)) bs5 stripPrefixB x y | x `B.isPrefixOf` y = Just (B.drop (B.length x) y) | otherwise = Nothing http-types-0.9.1/Network/HTTP/Types/Method.hs0000644000000000000000000000427512724576246017147 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Network.HTTP.Types.Method ( Method , methodGet , methodPost , methodHead , methodPut , methodDelete , methodTrace , methodConnect , methodOptions , methodPatch , StdMethod(..) , parseMethod , renderMethod , renderStdMethod ) where import Control.Arrow ((|||)) import Data.Array import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import Data.Typeable -- | HTTP method (flat string type). type Method = B.ByteString -- | HTTP Method constants. methodGet, methodPost, methodHead, methodPut, methodDelete, methodTrace, methodConnect, methodOptions, methodPatch :: Method methodGet = renderStdMethod GET methodPost = renderStdMethod POST methodHead = renderStdMethod HEAD methodPut = renderStdMethod PUT methodDelete = renderStdMethod DELETE methodTrace = renderStdMethod TRACE methodConnect = renderStdMethod CONNECT methodOptions = renderStdMethod OPTIONS methodPatch = renderStdMethod PATCH -- | HTTP standard method (as defined by RFC 2616, and PATCH which is defined -- by RFC 5789). data StdMethod = GET | POST | HEAD | PUT | DELETE | TRACE | CONNECT | OPTIONS | PATCH deriving (Read, Show, Eq, Ord, Enum, Bounded, Ix, Typeable) -- 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 http-types-0.9.1/Network/HTTP/Types/URI.hs0000644000000000000000000002473612724576246016372 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, CPP #-} module Network.HTTP.Types.URI ( -- * Query string QueryItem , Query , SimpleQueryItem , SimpleQuery , simpleQueryToQuery , renderQuery , renderQueryBuilder , renderSimpleQuery , parseQuery , parseSimpleQuery -- ** Text query string (UTF8 encoded) , QueryText , queryTextToQuery , queryToQueryText , renderQueryText , parseQueryText -- * Path segments , encodePathSegments , decodePathSegments , encodePathSegmentsRelative -- * Path (segments + query string) , extractPath , encodePath , decodePath -- * URL encoding / decoding , urlEncodeBuilder , urlEncode , urlDecode ) 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 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 -- ^ Whether to decode '+' to ' ' -> B.ByteString -- ^ The ByteString to encode as URL -> B.ByteString -- ^ The encoded URL 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 -- | Extract whole path (path segments + query) from a -- . -- -- >>> extractPath "/path" -- "/path" -- -- >>> extractPath "http://example.com:8080/path" -- "/path" -- -- >>> extractPath "http://example.com" -- "/" -- -- >>> extractPath "" -- "/" extractPath :: B.ByteString -> B.ByteString extractPath = ensureNonEmpty . extract where extract path | "http://" `B.isPrefixOf` path = (snd . breakOnSlash . B.drop 7) path | "https://" `B.isPrefixOf` path = (snd . breakOnSlash . B.drop 8) path | otherwise = path breakOnSlash = B.breakByte 47 ensureNonEmpty "" = "/" ensureNonEmpty p = p -- | 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) http-types-0.9.1/Network/HTTP/Types/Status.hs0000644000000000000000000003220212724576246017201 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-} module Network.HTTP.Types.Status ( Status(..) , mkStatus , status100 , continue100 , status101 , switchingProtocols101 , status200 , ok200 , status201 , created201 , status202 , accepted202 , status203 , nonAuthoritative203 , status204 , noContent204 , status205 , resetContent205 , status206 , partialContent206 , status300 , multipleChoices300 , status301 , movedPermanently301 , status302 , found302 , status303 , seeOther303 , status304 , notModified304 , status305 , useProxy305 , status307 , temporaryRedirect307 , status308 , permanentRedirect308 , status400 , badRequest400 , status401 , unauthorized401 , status402 , paymentRequired402 , status403 , forbidden403 , status404 , notFound404 , status405 , methodNotAllowed405 , status406 , notAcceptable406 , status407 , proxyAuthenticationRequired407 , status408 , requestTimeout408 , status409 , conflict409 , status410 , gone410 , status411 , lengthRequired411 , status412 , preconditionFailed412 , status413 , requestEntityTooLarge413 , status414 , requestURITooLong414 , status415 , unsupportedMediaType415 , status416 , requestedRangeNotSatisfiable416 , status417 , expectationFailed417 , status418 , imATeaPot418 , status422 , unprocessableEntity422 , 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 ) where import qualified Data.ByteString as B import Data.Typeable -- | HTTP Status. -- -- Only the 'statusCode' is used for comparisons. -- -- Please use 'mkStatus' to create status codes from code and message, or the 'Enum' instance or the -- status code constants (like 'ok200'). There might be additional record members in the future. -- -- Note that the Show instance is only for debugging. data Status = Status { statusCode :: Int , statusMessage :: B.ByteString } deriving (Show, Typeable) 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 instance Enum Status where fromEnum = statusCode toEnum 100 = status100 toEnum 101 = status101 toEnum 200 = status200 toEnum 201 = status201 toEnum 202 = status202 toEnum 203 = status203 toEnum 204 = status204 toEnum 205 = status205 toEnum 206 = status206 toEnum 300 = status300 toEnum 301 = status301 toEnum 302 = status302 toEnum 303 = status303 toEnum 304 = status304 toEnum 305 = status305 toEnum 307 = status307 toEnum 308 = status308 toEnum 400 = status400 toEnum 401 = status401 toEnum 402 = status402 toEnum 403 = status403 toEnum 404 = status404 toEnum 405 = status405 toEnum 406 = status406 toEnum 407 = status407 toEnum 408 = status408 toEnum 409 = status409 toEnum 410 = status410 toEnum 411 = status411 toEnum 412 = status412 toEnum 413 = status413 toEnum 414 = status414 toEnum 415 = status415 toEnum 416 = status416 toEnum 417 = status417 toEnum 422 = status422 toEnum 428 = status428 toEnum 429 = status429 toEnum 431 = status431 toEnum 500 = status500 toEnum 501 = status501 toEnum 502 = status502 toEnum 503 = status503 toEnum 504 = status504 toEnum 505 = status505 toEnum 511 = status511 toEnum c = mkStatus c B.empty -- | Create a Status from status code and message. mkStatus :: Int -> B.ByteString -> Status mkStatus i m = Status i m -- | Continue 100 status100 :: Status status100 = mkStatus 100 "Continue" -- | Continue 100 continue100 :: Status continue100 = status100 -- | Switching Protocols 101 status101 :: Status status101 = mkStatus 101 "Switching Protocols" -- | Switching Protocols 101 switchingProtocols101 :: Status switchingProtocols101 = status101 -- | OK 200 status200 :: Status status200 = mkStatus 200 "OK" -- | OK 200 ok200 :: Status ok200 = status200 -- | Created 201 status201 :: Status status201 = mkStatus 201 "Created" -- | Created 201 created201 :: Status created201 = status201 -- | Accepted 202 status202 :: Status status202 = mkStatus 202 "Accepted" -- | Accepted 202 accepted202 :: Status accepted202 = status202 -- | Non-Authoritative Information 203 status203 :: Status status203 = mkStatus 203 "Non-Authoritative Information" -- | Non-Authoritative Information 203 nonAuthoritative203 :: Status nonAuthoritative203 = status203 -- | No Content 204 status204 :: Status status204 = mkStatus 204 "No Content" -- | No Content 204 noContent204 :: Status noContent204 = status204 -- | Reset Content 205 status205 :: Status status205 = mkStatus 205 "Reset Content" -- | Reset Content 205 resetContent205 :: Status resetContent205 = status205 -- | Partial Content 206 status206 :: Status status206 = mkStatus 206 "Partial Content" -- | Partial Content 206 partialContent206 :: Status partialContent206 = status206 -- | Multiple Choices 300 status300 :: Status status300 = mkStatus 300 "Multiple Choices" -- | Multiple Choices 300 multipleChoices300 :: Status multipleChoices300 = status300 -- | Moved Permanently 301 status301 :: Status status301 = mkStatus 301 "Moved Permanently" -- | Moved Permanently 301 movedPermanently301 :: Status movedPermanently301 = status301 -- | Found 302 status302 :: Status status302 = mkStatus 302 "Found" -- | Found 302 found302 :: Status found302 = status302 -- | See Other 303 status303 :: Status status303 = mkStatus 303 "See Other" -- | See Other 303 seeOther303 :: Status seeOther303 = status303 -- | Not Modified 304 status304 :: Status status304 = mkStatus 304 "Not Modified" -- | Not Modified 304 notModified304 :: Status notModified304 = status304 -- | Use Proxy 305 status305 :: Status status305 = mkStatus 305 "Use Proxy" -- | Use Proxy 305 useProxy305 :: Status useProxy305 = status305 -- | Temporary Redirect 307 status307 :: Status status307 = mkStatus 307 "Temporary Redirect" -- | Temporary Redirect 307 temporaryRedirect307 :: Status temporaryRedirect307 = status307 -- | Permanent Redirect 308 status308 :: Status status308 = mkStatus 308 "Permanent Redirect" -- | Permanent Redirect 308 permanentRedirect308 :: Status permanentRedirect308 = status308 -- | Bad Request 400 status400 :: Status status400 = mkStatus 400 "Bad Request" -- | Bad Request 400 badRequest400 :: Status badRequest400 = status400 -- | Unauthorized 401 status401 :: Status status401 = mkStatus 401 "Unauthorized" -- | Unauthorized 401 unauthorized401 :: Status unauthorized401 = status401 -- | Payment Required 402 status402 :: Status status402 = mkStatus 402 "Payment Required" -- | Payment Required 402 paymentRequired402 :: Status paymentRequired402 = status402 -- | Forbidden 403 status403 :: Status status403 = mkStatus 403 "Forbidden" -- | Forbidden 403 forbidden403 :: Status forbidden403 = status403 -- | Not Found 404 status404 :: Status status404 = mkStatus 404 "Not Found" -- | Not Found 404 notFound404 :: Status notFound404 = status404 -- | Method Not Allowed 405 status405 :: Status status405 = mkStatus 405 "Method Not Allowed" -- | Method Not Allowed 405 methodNotAllowed405 :: Status methodNotAllowed405 = status405 -- | Not Acceptable 406 status406 :: Status status406 = mkStatus 406 "Not Acceptable" -- | Not Acceptable 406 notAcceptable406 :: Status notAcceptable406 = status406 -- | Proxy Authentication Required 407 status407 :: Status status407 = mkStatus 407 "Proxy Authentication Required" -- | Proxy Authentication Required 407 proxyAuthenticationRequired407 :: Status proxyAuthenticationRequired407 = status407 -- | Request Timeout 408 status408 :: Status status408 = mkStatus 408 "Request Timeout" -- | Request Timeout 408 requestTimeout408 :: Status requestTimeout408 = status408 -- | Conflict 409 status409 :: Status status409 = mkStatus 409 "Conflict" -- | Conflict 409 conflict409 :: Status conflict409 = status409 -- | Gone 410 status410 :: Status status410 = mkStatus 410 "Gone" -- | Gone 410 gone410 :: Status gone410 = status410 -- | Length Required 411 status411 :: Status status411 = mkStatus 411 "Length Required" -- | Length Required 411 lengthRequired411 :: Status lengthRequired411 = status411 -- | Precondition Failed 412 status412 :: Status status412 = mkStatus 412 "Precondition Failed" -- | Precondition Failed 412 preconditionFailed412 :: Status preconditionFailed412 = status412 -- | Request Entity Too Large 413 status413 :: Status status413 = mkStatus 413 "Request Entity Too Large" -- | Request Entity Too Large 413 requestEntityTooLarge413 :: Status requestEntityTooLarge413 = status413 -- | Request-URI Too Long 414 status414 :: Status status414 = mkStatus 414 "Request-URI Too Long" -- | Request-URI Too Long 414 requestURITooLong414 :: Status requestURITooLong414 = status414 -- | Unsupported Media Type 415 status415 :: Status status415 = mkStatus 415 "Unsupported Media Type" -- | Unsupported Media Type 415 unsupportedMediaType415 :: Status unsupportedMediaType415 = status415 -- | Requested Range Not Satisfiable 416 status416 :: Status status416 = mkStatus 416 "Requested Range Not Satisfiable" -- | Requested Range Not Satisfiable 416 requestedRangeNotSatisfiable416 :: Status requestedRangeNotSatisfiable416 = status416 -- | Expectation Failed 417 status417 :: Status status417 = mkStatus 417 "Expectation Failed" -- | Expectation Failed 417 expectationFailed417 :: Status expectationFailed417 = status417 -- | I'm a teapot 418 status418 :: Status status418 = mkStatus 418 "I'm a teapot" -- | I'm a teapot 418 imATeaPot418 :: Status imATeaPot418 = status418 -- | Unprocessable Entity 422 -- () status422 :: Status status422 = mkStatus 422 "Unprocessable Entity" -- | Unprocessable Entity 422 -- () unprocessableEntity422 :: Status unprocessableEntity422 = status422 -- | Precondition Required 428 -- () status428 :: Status status428 = mkStatus 428 "Precondition Required" -- | Precondition Required 428 -- () preconditionRequired428 :: Status preconditionRequired428 = status428 -- | Too Many Requests 429 -- () status429 :: Status status429 = mkStatus 429 "Too Many Requests" -- | Too Many Requests 429 -- () tooManyRequests429 :: Status tooManyRequests429 = status429 -- | Request Header Fields Too Large 431 -- () status431 :: Status status431 = mkStatus 431 "Request Header Fields Too Large" -- | Request Header Fields Too Large 431 -- () requestHeaderFieldsTooLarge431 :: Status requestHeaderFieldsTooLarge431 = status431 -- | Internal Server Error 500 status500 :: Status status500 = mkStatus 500 "Internal Server Error" -- | Internal Server Error 500 internalServerError500 :: Status internalServerError500 = status500 -- | Not Implemented 501 status501 :: Status status501 = mkStatus 501 "Not Implemented" -- | Not Implemented 501 notImplemented501 :: Status notImplemented501 = status501 -- | Bad Gateway 502 status502 :: Status status502 = mkStatus 502 "Bad Gateway" -- | Bad Gateway 502 badGateway502 :: Status badGateway502 = status502 -- | Service Unavailable 503 status503 :: Status status503 = mkStatus 503 "Service Unavailable" -- | Service Unavailable 503 serviceUnavailable503 :: Status serviceUnavailable503 = status503 -- | Gateway Timeout 504 status504 :: Status status504 = mkStatus 504 "Gateway Timeout" -- | Gateway Timeout 504 gatewayTimeout504 :: Status gatewayTimeout504 = status504 -- | HTTP Version Not Supported 505 status505 :: Status status505 = mkStatus 505 "HTTP Version Not Supported" -- | HTTP Version Not Supported 505 httpVersionNotSupported505 :: Status httpVersionNotSupported505 = status505 -- | Network Authentication Required 511 -- () status511 :: Status status511 = mkStatus 511 "Network Authentication Required" -- | Network Authentication Required 511 -- () networkAuthenticationRequired511 :: Status networkAuthenticationRequired511 = status511 -- | Informational class statusIsInformational :: Status -> Bool statusIsInformational (Status {statusCode=code}) = code >= 100 && code < 200 -- | Successful class statusIsSuccessful :: Status -> Bool statusIsSuccessful (Status {statusCode=code}) = code >= 200 && code < 300 -- | Redirection class statusIsRedirection :: Status -> Bool statusIsRedirection (Status {statusCode=code}) = code >= 300 && code < 400 -- | Client Error class statusIsClientError :: Status -> Bool statusIsClientError (Status {statusCode=code}) = code >= 400 && code < 500 -- | Server Error class statusIsServerError :: Status -> Bool statusIsServerError (Status {statusCode=code}) = code >= 500 && code < 600 http-types-0.9.1/Network/HTTP/Types/Version.hs0000644000000000000000000000123012724576246017340 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} module Network.HTTP.Types.Version ( HttpVersion(..) , http09 , http10 , http11 ) where import Data.Typeable -- | HTTP Version. -- -- Note that the Show instance is intended merely for debugging. data HttpVersion = HttpVersion { httpMajor :: !Int , httpMinor :: !Int } deriving (Eq, Ord, Typeable) 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-0.9.1/test/0000755000000000000000000000000012724576246013026 5ustar0000000000000000http-types-0.9.1/test/Spec.hs0000644000000000000000000000005412724576246014253 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} http-types-0.9.1/test/doctests.hs0000644000000000000000000000033612724576246015214 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest [ "-idist/build/autogen/" , "-optP-include" , "-optPdist/build/autogen/cabal_macros.h" , "-XOverloadedStrings" , "Network/HTTP/Types.hs" ]