http-types 0.8.4 → 0.8.5
raw patch · 7 files changed
+112/−96 lines, 7 filesdep +doctestdep +quickcheck-instancesdep ~base
Dependencies added: doctest, quickcheck-instances
Dependency ranges changed: base
Files
- Network/HTTP/Types.hs +1/−0
- Network/HTTP/Types/Status.hs +51/−3
- Network/HTTP/Types/URI.hs +26/−0
- http-types.cabal +21/−8
- test/Spec.hs +1/−0
- test/doctests.hs +12/−0
- test/runtests.hs +0/−85
Network/HTTP/Types.hs view
@@ -169,6 +169,7 @@ , decodePathSegments , encodePathSegmentsRelative -- ** Path (segments + query string)+, extractPath , encodePath , decodePath -- ** URL encoding / decoding
Network/HTTP/Types/Status.hs view
@@ -73,6 +73,12 @@ , expectationFailed417 , status418 , imATeaPot418+, status428+, preconditionRequired428+, status429+, tooManyRequests429+, status431+, requestHeaderFieldsTooLarge431 , status500 , internalServerError500 , status501@@ -84,6 +90,8 @@ , status504 , gatewayTimeout504 , status505+, status511+, networkAuthenticationRequired511 , httpVersionNotSupported505 , statusIsInformational , statusIsSuccessful@@ -96,12 +104,12 @@ import qualified Data.ByteString as B -- | 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 {@@ -444,6 +452,36 @@ imATeaPot418 :: Status imATeaPot418 = status418 +-- | Precondition Required 428+-- (<https://tools.ietf.org/html/rfc6585 RFC 6585>)+status428 :: Status+status428 = mkStatus 428 "Precondition Required"++-- | Precondition Required 428+-- (<https://tools.ietf.org/html/rfc6585 RFC 6585>)+preconditionRequired428 :: Status+preconditionRequired428 = status428++-- | Too Many Requests 429+-- (<https://tools.ietf.org/html/rfc6585 RFC 6585>)+status429 :: Status+status429 = mkStatus 429 "Too Many Requests"++-- | Too Many Requests 429+-- (<https://tools.ietf.org/html/rfc6585 RFC 6585>)+tooManyRequests429 :: Status+tooManyRequests429 = status429++-- | Request Header Fields Too Large 431+-- (<https://tools.ietf.org/html/rfc6585 RFC 6585>)+status431 :: Status+status431 = mkStatus 431 "Request Header Fields Too Large"++-- | Request Header Fields Too Large 431+-- (<https://tools.ietf.org/html/rfc6585 RFC 6585>)+requestHeaderFieldsTooLarge431 :: Status+requestHeaderFieldsTooLarge431 = status431+ -- | Internal Server Error 500 status500 :: Status status500 = mkStatus 500 "Internal Server Error"@@ -491,6 +529,16 @@ -- | HTTP Version Not Supported 505 httpVersionNotSupported505 :: Status httpVersionNotSupported505 = status505++-- | Network Authentication Required 511+-- (<https://tools.ietf.org/html/rfc6585 RFC 6585>)+status511 :: Status+status511 = mkStatus 511 "Network Authentication Required"++-- | Network Authentication Required 511+-- (<https://tools.ietf.org/html/rfc6585 RFC 6585>)+networkAuthenticationRequired511 :: Status+networkAuthenticationRequired511 = status511 -- | Informational class statusIsInformational :: Status -> Bool
Network/HTTP/Types/URI.hs view
@@ -23,6 +23,7 @@ , decodePathSegments , encodePathSegmentsRelative -- * Path (segments + query string)+, extractPath , encodePath , decodePath -- * URL encoding / decoding@@ -283,6 +284,31 @@ decodePathSegment :: B.ByteString -> Text decodePathSegment = decodeUtf8With lenientDecode . urlDecode False++-- | Extract whole path (path segments + query) from a+-- <http://tools.ietf.org/html/rfc2616#section-5.1.2 RFC 2616 Request-URI>.+--+-- >>> 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
http-types.cabal view
@@ -1,5 +1,5 @@ Name: http-types-Version: 0.8.4+Version: 0.8.5 Synopsis: Generic HTTP types for Haskell (for both client and server code). Description: Generic HTTP types for Haskell (for both client and server code). Homepage: https://github.com/aristidb/http-types@@ -37,11 +37,24 @@ case-insensitive >=0.2 && <1.3, blaze-builder >= 0.2.1.4 && < 0.4, text >= 0.11.0.2- -- Other-modules: - -- Build-tools: -Test-suite runtests- main-is: runtests.hs- hs-source-dirs: test- type: exitcode-stdio-1.0- build-depends: base, http-types, text, bytestring, blaze-builder, QuickCheck, hspec >= 1.3+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
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/doctests.hs view
@@ -0,0 +1,12 @@+module 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"+ ]
− test/runtests.hs
@@ -1,85 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-import Data.Text (Text)-import Debug.Trace-import Network.HTTP.Types-import Test.Hspec-import Test.QuickCheck-import qualified Blaze.ByteString.Builder as Blaze-import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as S8-import qualified Data.Text as T--main :: IO ()-main = hspec $ do- describe "encode/decode path" $ do- it "is identity to encode and then decode" $- property propEncodeDecodePath- it "does not escape period and dash" $- Blaze.toByteString (encodePath ["foo-bar.baz"] []) `shouldBe` "/foo-bar.baz"-- describe "encode/decode query" $ do- it "is identity to encode and then decode" $- property propEncodeDecodeQuery- it "add ? in front of Query if and only if necessary" $- property propQueryQuestionMark-- describe "encode/decode path segments" $ do- it "is identity to encode and then decode" $- property propEncodeDecodePathSegments-- describe "encode ByteRanges" $ do- it "first 500 bytes" $- renderByteRanges [ByteRangeFromTo 0 499] `shouldBe` "bytes=0-499"- it "second 500 bytes" $- renderByteRanges [ByteRangeFromTo 500 999] `shouldBe` "bytes=500-999"- it "final 500 bytes" $- renderByteRanges [ByteRangeSuffix 500] `shouldBe` "bytes=-500"- it "final 500 bytes (of 1000, absolute)" $- renderByteRanges [ByteRangeFrom 9500] `shouldBe` "bytes=9500-"- it "first and last bytes only" $- renderByteRanges [ByteRangeFromTo 0 0, ByteRangeSuffix 1] `shouldBe` "bytes=0-0,-1"- it "non-canonical second 500 bytes (1)" $- renderByteRanges [ByteRangeFromTo 500 600, ByteRangeFromTo 601 999] `shouldBe` "bytes=500-600,601-999"- it "non-canonical second 500 bytes (2)" $- renderByteRanges [ByteRangeFromTo 500 700, ByteRangeFromTo 601 999] `shouldBe` "bytes=500-700,601-999"--propEncodeDecodePath :: ([Text], Query) -> Bool-propEncodeDecodePath (p', q') =- let x = Blaze.toByteString $ encodePath a b- y = decodePath x- z = y == (a, b)- in if z then z else traceShow (a, b, x, y) z- where- a = if p' == [""] then [] else p'- b = filter (\(x, _) -> not (S.null x)) q'--propEncodeDecodeQuery :: Query -> Bool-propEncodeDecodeQuery q' =- q == parseQuery (renderQuery True q)- where- q = filter (\(x, _) -> not (S.null x)) q'--propQueryQuestionMark :: (Bool, Query) -> Bool-propQueryQuestionMark (useQuestionMark, query) = actual == expected- where- actual = case S8.uncons $ renderQuery useQuestionMark query of- Nothing -> False- Just ('?', _) -> True- _ -> False- expected = case (useQuestionMark, null query) of- (False, _) -> False- (True, True) -> False- (True, False) -> True--propEncodeDecodePathSegments :: [Text] -> Bool-propEncodeDecodePathSegments p' =- p == decodePathSegments (Blaze.toByteString $ encodePathSegments p)- where- p = if p' == [""] then [] else p'--instance Arbitrary Text where- arbitrary = fmap T.pack arbitrary--instance Arbitrary S.ByteString where- arbitrary = fmap S.pack arbitrary