http-conduit-downloader 1.0.7 → 1.0.8
raw patch · 2 files changed
+53/−16 lines, 2 filesdep +old-localedep +timePVP ok
version bump matches the API change (PVP)
Dependencies added: old-locale, time
API changes (from Hackage documentation)
Files
Network/HTTP/Conduit/Downloader.hs view
@@ -85,6 +85,10 @@ import Codec.Compression.Zlib.Raw as Deflate import Network.URI -- import ADNS.Cache+import Data.Time.Format+import System.Locale+import Data.Time.Clock+import Data.Time.Clock.POSIX -- | Result of 'download' operation. data DownloadResult@@ -214,11 +218,12 @@ sinkByteString (dsMaxDownloadSize settings) -- liftIO $ print ("sink", mbb) case mbb of- Just b ->+ Just b -> do let c = C.responseStatus r h = C.responseHeaders r- d = tryDeflate h b in- return $ makeDownloadResultC url c h d+ d = tryDeflate h b+ curTime <- liftIO $ getCurrentTime+ return $ makeDownloadResultC curTime url c h d Nothing -> return $ DRError "Too much data") `E.catch` (fmap Just . httpExceptionToDR url)@@ -263,7 +268,8 @@ httpExceptionToDR :: Monad m => String -> C.HttpException -> m DownloadResult httpExceptionToDR url exn = return $ case exn of C.StatusCodeException c h _ -> -- trace "exception" $- makeDownloadResultC url c h ""+ makeDownloadResultC+ (posixSecondsToUTCTime 0) url c h "" C.InvalidUrlException _ e -> DRError $ "Invalid URL: " ++ e C.TooManyRedirects _ -> DRError "Too many redirects" C.UnparseableRedirect _ -> DRError "Unparseable redirect"@@ -333,9 +339,9 @@ let d = B.concat $ reverse (buf:acc) B.length d `seq` return $ Just d -makeDownloadResultC :: String -> N.Status -> N.ResponseHeaders+makeDownloadResultC :: UTCTime -> String -> N.Status -> N.ResponseHeaders -> B.ByteString -> DownloadResult-makeDownloadResultC url c headers b = do+makeDownloadResultC curTime url c headers b = do if N.statusCode c == 304 then DRNotModified else if N.statusCode c `elem`@@ -358,16 +364,30 @@ DRError $ "HTTP " ++ show (N.statusCode c) ++ " " ++ B.unpack (N.statusMessage c) else- DROK b (redownloadOpts headers)+ DROK b (redownloadOpts [] headers) where redirect r | r == url = DRError $ "HTTP redirect to the same url?" | otherwise = DRRedirect r- redownloadOpts [] = []- redownloadOpts (("ETag", tag):xs) =- ("If-None-Match: " ++ B.unpack tag) : redownloadOpts xs- redownloadOpts (("Last-Modified", time):xs) =- ("If-Modified-Since: " ++ B.unpack time) : redownloadOpts xs- redownloadOpts (_:xs) = redownloadOpts xs+ redownloadOpts acc [] = reverse acc+ redownloadOpts _ (("Pragma", B.map toLower -> tag) : _)+ | "no-cache" `B.isInfixOf` tag = []+ redownloadOpts _ (("Cache-Control", B.map toLower -> tag) : _)+ | any (`B.isInfixOf` tag)+ ["no-cache", "no-store", "must-revalidate", "max-age=0"] = []+ redownloadOpts acc (("Expires", time):xs)+ | ts <- B.unpack time+ , Just t <- parseHttpTime ts+ , t > curTime =+ redownloadOpts acc xs+ | otherwise = [] -- expires is non-valid or in the past+ redownloadOpts acc (("ETag", tag):xs) =+ redownloadOpts (("If-None-Match: " ++ B.unpack tag) : acc) xs+ redownloadOpts acc (("Last-Modified", time):xs)+ | ts <- B.unpack time+ , Just t <- parseHttpTime ts+ , t <= curTime = -- use only valid timestamps+ redownloadOpts (("If-Modified-Since: " ++ B.unpack time) : acc) xs+ redownloadOpts acc (_:xs) = redownloadOpts acc xs relUri r = fromMaybe r $ fmap (($ "") . uriToString id) $@@ -375,6 +395,22 @@ (parseURIReference $ trim r) (parseURI url) trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace++-- fmap utcTimeToPOSIXSeconds $++tryParseTime :: [String] -> String -> Maybe UTCTime+tryParseTime formats string =+ foldr mplus Nothing $+ map (\ fmt -> parseTime defaultTimeLocale fmt (trimString string)) formats+ where trimString = reverse . dropWhile isSpace . reverse . dropWhile isSpace++parseHttpTime :: String -> Maybe UTCTime+parseHttpTime =+ tryParseTime+ ["%a, %e %b %Y %k:%M:%S %Z" -- Sun, 06 Nov 1994 08:49:37 GMT+ ,"%A, %e-%b-%y %k:%M:%S %Z" -- Sunday, 06-Nov-94 08:49:37 GMT+ ,"%a %b %e %k:%M:%S %Y" -- Sun Nov 6 08:49:37 1994+ ] -- | Download single URL with default 'DownloaderSettings'. -- Fails if result is not 'DROK'.
http-conduit-downloader.cabal view
@@ -1,6 +1,6 @@ cabal-version: >= 1.6 name: http-conduit-downloader-version: 1.0.7+version: 1.0.8 copyright: Vladimir Shabanov 2013 author: Vladimir Shabanov <vshabanoff@gmail.com> maintainer: Vladimir Shabanov <vshabanoff@gmail.com>@@ -12,7 +12,7 @@ synopsis: HTTP downloader tailored for web-crawler needs. description: HTTP/HTTPS downloader built on top of @http-conduit@- and used in <http://bazqux.com> crawler.+ and used in <https://bazqux.com> crawler. . * Handles all possible http-conduit exceptions and returns human readable error messages.@@ -40,7 +40,8 @@ library build-depends: base == 4.*, http-conduit >= 1.9.4.1, network, zlib, lifted-base,- conduit, resourcet, http-types, tls, data-default, bytestring, mtl+ conduit, resourcet, http-types, tls, data-default, bytestring, mtl,+ time, old-locale exposed-modules: Network.HTTP.Conduit.Downloader