http-conduit-downloader 1.0.25 → 1.0.30

raw patch · 2 files changed

+64/−59 lines, 2 filesdep −old-localedep ~HsOpenSSLdep ~http-clientdep ~http-conduitPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: old-locale

Dependency ranges changed: HsOpenSSL, http-client, http-conduit, time

API changes (from Hackage documentation)

Files

• Network/HTTP/Conduit/Downloader.hs +61/−56
• http-conduit-downloader.cabal +3/−3

@@ -95,10 +95,8 @@ import Network.URI -- import ADNS.Cache import Data.Time.Format-import System.Locale import Data.Time.Clock import Data.Time.Clock.POSIX-import System.IO  -- | Result of 'download' operation. data DownloadResult@@ -150,7 +148,7 @@         { dsUserAgent = "Mozilla/5.0 (compatible; HttpConduitDownloader/1.0; +http://hackage.haskell.org/package/http-conduit-downloader)"         , dsTimeout = 30         , dsManagerSettings =-            C.conduitManagerSettings+            C.tlsManagerSettings             { C.managerTlsConnection =               -- IO (Maybe HostAddress -> String -> Int -> IO Connection)               getOpenSSLConnection@@ -173,11 +171,16 @@                             -> IO Connection) getOpenSSLConnection = do     ctx <- SSL.context+--     SSL.contextSetCiphers ctx "DEFAULT"+--     SSL.contextSetVerificationMode ctx SSL.VerifyNone+--     SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3+--     SSL.contextAddOption ctx SSL.SSL_OP_ALL     return $ \ mbha host port -> do         sock <- case mbha of             Nothing -> openSocketByName host port             Just ha -> openSocket ha port         ssl <- SSL.connection ctx sock+        SSL.setTlsextHostName ssl host         SSL.connect ssl         makeConnection             (SSL.read ssl bufSize@@ -188,7 +191,7 @@             -- Closing an SSL connection gracefully involves writing/reading             -- on the socket.  But when this is called the socket might be             -- already closed, and we get a @ResourceVanished@.-            (NS.sClose sock `E.catch` \(_ :: E.IOException) -> return ())+            (NS.close sock `E.catch` \(_ :: E.IOException) -> return ()) --            ((SSL.shutdown ssl SSL.Bidirectional >> return ()) `E.catch` \(_ :: E.IOException) -> return ()) -- segmentation fault in GHCi with SSL.shutdown / tryShutdown SSL.Unidirectional -- hang with SSL.Bidirectional@@ -238,16 +241,18 @@         , NS.addrAddress = NS.SockAddrInet (toEnum port) ha         , NS.addrCanonName = Nothing         }+openSocket' :: NS.AddrInfo -> IO NS.Socket openSocket' addr = do     E.bracketOnError         (NS.socket (NS.addrFamily addr) (NS.addrSocketType addr)                    (NS.addrProtocol addr))-        (NS.sClose)+        (NS.close)         (\sock -> do             NS.setSocketOption sock NS.NoDelay 1             NS.connect sock (NS.addrAddress addr)             return sock) +openSocketByName :: Show a => NS.HostName -> a -> IO NS.Socket openSocketByName host port = do     let hints = NS.defaultHints                 { NS.addrFlags = []-- [NS.AI_ADDRCONFIG, NS.AI_NUMERICSERV]@@ -280,12 +285,10 @@ -- | Create a new 'Downloader' with provided settings, -- use it in the provided function, and then release it. withDownloaderSettings :: DownloaderSettings -> (Downloader -> IO a) -> IO a-withDownloaderSettings s f = SSL.withOpenSSL $ C.runResourceT $ do-    (_, m) <- C.allocate (C.newManager $ dsManagerSettings s) C.closeManager-    liftIO $ f (Downloader m s)+withDownloaderSettings s f = f =<< newDownloader s  parseUrl :: String -> Either E.SomeException C.Request-parseUrl = C.parseUrl . takeWhile (/= '#')+parseUrl = C.parseRequest . takeWhile (/= '#')  -- | Perform download download  ::    Downloader@@ -339,24 +342,6 @@         maybe (return $ DRError $ show e) (httpExceptionToDR url)               (E.fromException e)     Right rq -> do-        let rq1 = rq { C.requestHeaders =-                               [("Accept", "*/*")-                               ,("User-Agent", dsUserAgent settings)-                               ]-                               ++ map toHeader opts-                               ++ C.requestHeaders rq-                     , C.redirectCount = 0-                     , C.responseTimeout = Nothing-                       -- We have timeout for connect and downloading-                       -- while http-conduit timeouts only when waits for-                       -- headers.-                     , C.hostAddress = hostAddress-                     , C.checkStatus = \ _ _ _ -> Nothing-                     }-            disableCompression rq =-                rq { C.requestHeaders =-                       ("Accept-Encoding", "") : C.requestHeaders rq }-        req <- C.runResourceT $ f rq1         let dl req firstTime = do                 r <- C.runResourceT (timeout (dsTimeout settings * 1000000) $ do                     r <- C.http req manager@@ -405,16 +390,28 @@                             dl (disableCompression req) False                     _ ->                         return $ fromMaybe (DRError "Timeout", Nothing) r+            disableCompression req =+                req { C.requestHeaders =+                          ("Accept-Encoding", "") : C.requestHeaders req }+            rq1 = rq { C.requestHeaders =+                               [("Accept", "*/*")+                               ,("User-Agent", dsUserAgent settings)+                               ]+                               ++ map toHeader opts+                               ++ C.requestHeaders rq+                     , C.redirectCount = 0+                     , C.responseTimeout = C.responseTimeoutNone+                       -- We have timeout for connect and downloading+                       -- while http-conduit timeouts only when waits for+                       -- headers.+                     , C.hostAddress = hostAddress+                     , C.checkResponse = \ _ _ -> return ()+                     }+        req <- C.runResourceT $ f rq1         dl req True     where toHeader :: String -> N.Header           toHeader h = let (a,b) = break (== ':') h in                        (fromString a, fromString (tail b))---           handshakeFailed (TLS.Terminated _ e tlsError) =---               DRError $ "SSL terminated:\n" ++ show tlsError---           handshakeFailed (TLS.HandshakeFailed tlsError) =---               DRError $ "SSL handshake failed:\n" ++ show tlsError---           handshakeFailed TLS.ConnectionNotEstablished =---               DRError $ "SSL connection not established"           someException :: E.SomeException -> DownloadResult           someException e = case show e of               "<<timeout>>" -> DRError "Timeout"@@ -425,40 +422,45 @@                   = BL.toStrict $ Deflate.decompress $ BL.fromStrict b               | otherwise = b -- httpExceptionToDR :: Monad m => String -> C.HttpException -> m DownloadResult httpExceptionToDR url exn = return $ case exn of-    C.StatusCodeException c h _ -> -- trace "exception" $-                                 makeDownloadResultC-                                 (posixSecondsToUTCTime 0) url c h ""+    C.HttpExceptionRequest _ ec -> httpExceptionContentToDR url ec     C.InvalidUrlException _ e -> DRError $ "Invalid URL: " ++ e++httpExceptionContentToDR :: String -> C.HttpExceptionContent -> DownloadResult+httpExceptionContentToDR url ec = case ec of+    C.StatusCodeException r b ->+      makeDownloadResultC (posixSecondsToUTCTime 0) url+      (C.responseStatus r) (C.responseHeaders r) b     C.TooManyRedirects _ -> DRError "Too many redirects"-    C.UnparseableRedirect _ -> DRError "Unparseable redirect"-    C.TooManyRetries -> DRError "Too many retries"-    C.HttpParserException e -> DRError $ "HTTP parser error: " ++ e-    C.HandshakeFailed -> DRError "Handshake failed"     C.OverlongHeaders -> DRError "Overlong HTTP headers"     C.ResponseTimeout -> DRError "Timeout"-    C.FailedConnectionException _host _port -> DRError "Connection failed"-    C.FailedConnectionException2 _ _ _ exn -> DRError $ "Connection failed: " ++ show exn-    C.InvalidDestinationHost _ -> DRError "Invalid destination host"-    C.HttpZlibException e -> DRError $ show e-    C.ExpectedBlankAfter100Continue -> DRError "Expected blank after 100 (Continue)"+    C.ConnectionTimeout -> DRError "Connection timeout"+    C.ConnectionFailure e -> DRError $ "Connection failed: " ++ show e     C.InvalidStatusLine l -> DRError $ "Invalid HTTP status line:\n" ++ B.unpack l-    C.NoResponseDataReceived -> DRError "No response data received"-    C.TlsException e -> DRError $ "TLS exception:\n" ++ show e     C.InvalidHeader h -> DRError $ "Invalid HTTP header:\n" ++ B.unpack h-    C.InternalIOException e ->+    C.InternalException e ->         case show e of             "<<timeout>>" -> DRError "Timeout"             s -> DRError s-    C.ProxyConnectException {..} -> DRError "Can't connect to proxy"-    C.ResponseBodyTooShort _ _ -> DRError "Response body too short"-    C.InvalidChunkHeaders -> DRError "Invalid chunk headers"+    C.ProxyConnectException _ _ _ -> DRError "Can't connect to proxy"+    C.NoResponseDataReceived -> DRError "No response data received"     C.TlsNotSupported -> DRError "TLS not supported"+    C.WrongRequestBodyStreamSize e a ->+        DRError $ "The request body provided did not match the expected size "+        ++ ea e a+    C.ResponseBodyTooShort e a -> DRError $ "Response body too short " ++ ea e a+    C.InvalidChunkHeaders -> DRError "Invalid chunk headers"     C.IncompleteHeaders -> DRError "Incomplete headers"-    C.InvalidProxyEnvironmentVariable n v -> DRError $ "Invalid proxy environment variable " ++ show n ++ "=" ++ show v+    C.InvalidDestinationHost _ -> DRError "Invalid destination host"+    C.HttpZlibException e -> DRError $ show e+    C.InvalidProxyEnvironmentVariable n v ->+        DRError $ "Invalid proxy environment variable "+        ++ show n ++ "=" ++ show v+    C.ConnectionClosed -> DRError "Connection closed"+    where ea expected actual =+              "(expected " ++ show expected ++ " bytes, actual is "+              ++ show actual ++ " bytes)"  bufSize :: Int bufSize = 32 * 1024 - overhead -- Copied from Data.ByteString.Lazy.@@ -554,7 +556,8 @@               redownloadOpts (("If-Modified-Since: " ++ B.unpack time) : acc) xs           redownloadOpts acc (_:xs) = redownloadOpts acc xs           fixNonAscii =-              escapeURIString (\ c -> ord c <= 0x7f && c `notElem` " []{}|\"") .+              escapeURIString+                  (\ x -> ord x <= 0x7f && x `notElem` (" []{}|\"" :: String)) .               trimString           relUri (fixNonAscii -> r) =               fromMaybe r $@@ -568,8 +571,10 @@ tryParseTime :: [String] -> String -> Maybe UTCTime tryParseTime formats string =     foldr mplus Nothing $-    map (\ fmt -> parseTime defaultTimeLocale fmt (trimString string)) formats+    map (\ fmt -> parseTimeM True defaultTimeLocale fmt (trimString string))+        formats +trimString :: String -> String trimString = reverse . dropWhile isSpace . reverse . dropWhile isSpace  parseHttpTime :: String -> Maybe UTCTime

@@ -1,6 +1,6 @@ cabal-version:  >= 1.6 name:           http-conduit-downloader-version:        1.0.25+version:        1.0.30 author:         Vladimir Shabanov <vshabanoff@gmail.com> maintainer:     Vladimir Shabanov <vshabanoff@gmail.com> homepage:       https://github.com/bazqux/http-conduit-downloader@@ -41,9 +41,9 @@  library     build-depends:-        base == 4.*, http-conduit >= 2.1.5, http-client >= 0.4.7, connection, zlib, lifted-base,+        base == 4.*, http-conduit >= 2.2.0, http-client >= 0.5.0, connection, zlib, lifted-base,         conduit, resourcet, http-types, data-default, bytestring, mtl,-        time, old-locale, HsOpenSSL, network-uri >= 2.6, network >= 2.6+        time >= 1.5.0, HsOpenSSL >= 0.11.2, network-uri >= 2.6, network >= 2.6      exposed-modules:         Network.HTTP.Conduit.Downloader