hxt-http 9.1.1 → 9.1.2
raw patch · 4 files changed
+57/−33 lines, 4 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Setup.hs +0/−3
- Setup.lhs +8/−0
- hxt-http.cabal +3/−3
- src/Text/XML/HXT/IO/GetHTTPNative.hs +46/−27
− Setup.hs
@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-import Distribution.Simple-main = defaultMain
+ Setup.lhs view
@@ -0,0 +1,8 @@+#!/usr/bin/runhaskell++> module Main where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain
hxt-http.cabal view
@@ -1,18 +1,18 @@ -- arch-tag: Haskell XML Toolbox main description file Name: hxt-http-Version: 9.1.1+Version: 9.1.2 Synopsis: Interface to native Haskell HTTP package HTTP Description: Interface to native Haskell HTTP package HTTP. This package can be used as alternative for the hxt-curl package for accessing documents via HTTP-License: OtherLicense+License: MIT License-file: LICENSE Author: Uwe Schmidt Maintainer: Uwe Schmidt <uwe@fh-wedel.de> Stability: Experimental Category: XML Homepage: http://www.fh-wedel.de/~si/HXmlToolbox/index.html-Copyright: Copyright (c) 2010 Uwe Schmidt+Copyright: Copyright (c) 2011 Uwe Schmidt Build-type: Simple Cabal-version: >=1.6
src/Text/XML/HXT/IO/GetHTTPNative.hs view
@@ -38,11 +38,10 @@ import Data.Char ( isDigit )+import Data.Int ( Int64 ) import Data.List ( isPrefixOf )-import Data.Maybe ( fromJust- )-+import Data.Maybe import System.IO ( hPutStrLn , stderr )@@ -74,6 +73,7 @@ , parseURIReference ) +import qualified Debug.Trace as T -- ------------------------------------------------------------ -- -- the native http protocol handler@@ -106,27 +106,32 @@ ) processResponse response- | (rc >= 200 && rc < 300)- ||- rc == 304 -- not modified is o.k., this rc only occurs together with if-modified-since- = if strictInput- then B.length cs `seq` return res- else return res-+ | ( (rc >= 200 && rc < 300)+ ||+ rc == 304 -- not modified is o.k., this rc only occurs together with if-modified-since+ ) + &&+ fileSizeOK+ = do+ if strictInput+ then B.length cs `seq` return res+ else return res+ + | not fileSizeOK+ = return $+ ers "999 max-filesize exceeded"+ | otherwise = return $- Left ( rs- , "http error when accessing URI "- ++ show uri- ++ ": "- ++ show rc- ++ " "- ++ rr- )+ ers (show rc ++ " " ++ rr) where+ fileSizeOK = case getCurlMaxFileSize options of+ Nothing -> True+ Just mx -> B.length cs <= mx rc = convertResponseStatus $ rspCode response rr = rspReason response- res = Right (rs, cs)+ res = Right (rs, cs)+ ers e = Left (rs, "http error when accessing URI " ++ show uri ++ ": " ++ e) rs = rst ++ rsh rst = [ (transferStatus, show rc) , (transferMessage, rr)@@ -209,9 +214,7 @@ setOption :: String -> String -> [BrowserAction t ()]-setOption k v- | curlPrefix `isPrefixOf` k = setOption (drop (length curlPrefix) k) v-+setOption k0 v | k == "max-redirs" && isIntArg v = [setMaxRedirects (Just $ read v)]@@ -220,14 +223,19 @@ null v = [setMaxRedirects Nothing] | otherwise = []-+ where+ k = dropCurlPrefix k0+ curlPrefix :: String curlPrefix = "curl--" -setHOption :: String -> String -> [(HeaderName, String)]-setHOption k v- | curlPrefix `isPrefixOf` k = setHOption (drop (length curlPrefix) k) v+dropCurlPrefix :: String -> String+dropCurlPrefix k+ | curlPrefix `isPrefixOf` k = drop (length curlPrefix) k+ | otherwise = k +setHOption :: String -> String -> [(HeaderName, String)]+setHOption k0 v | k `elem` [ "-A" , "user-agent" , "curl--user-agent"@@ -237,9 +245,20 @@ | k == a_if_modified_since = [(HdrIfModifiedSince, v)] | k == a_if_unmodified_since = [(HdrIfUnmodifiedSince, v)] | otherwise = []-+ where+ k = dropCurlPrefix k0 isIntArg :: String -> Bool isIntArg s = not (null s) && all isDigit s +getCurlMaxFileSize :: Attributes -> Maybe Int64+getCurlMaxFileSize options+ = (\ s -> if isIntArg s + then Just (read s) + else Nothing+ )+ . fromMaybe ""+ . lookup (curlPrefix ++ "max-filesize") + $ options+ -- ------------------------------------------------------------