From 5c4125e55b40ff4be98a827298f4173f4e54b41e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 1 Oct 2015 13:47:54 -0400 Subject: avoid deprecation warnings when built with http-client >= 0.4.18 Since I want git-annex to keep building on debian stable, I need to still support the old http-client, which required explicit calls to closeManager, or use of withManager to get Managers to close at appropriate times. This is not needed in the new version, and so they added a deprecation warning. IMHO much too early, because look at the mess I had to go through to avoid that deprecation warning while supporting both versions.. --- Remote/S3.hs | 4 ++-- Utility/Url.hs | 33 +++++++++++++++++++++++---------- 2 files changed, 25 insertions(+), 12 deletions(-) diff --git a/Remote/S3.hs b/Remote/S3.hs index 7b71df2b0..c8a34f2e7 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -21,7 +21,7 @@ import qualified Data.ByteString as S import qualified Data.Map as M import Data.Char import Network.Socket (HostName) -import Network.HTTP.Conduit (Manager, newManager, closeManager) +import Network.HTTP.Conduit (Manager, newManager) import Network.HTTP.Client (defaultManagerSettings, managerResponseTimeout, responseStatus, responseBody, RequestBody(..)) import Network.HTTP.Types import Control.Monad.Trans.Resource @@ -48,7 +48,7 @@ import Utility.Metered import Utility.DataUnits import Annex.Content import Annex.Url (withUrlOptions) -import Utility.Url (checkBoth) +import Utility.Url (checkBoth, closeManager) type BucketName = String diff --git a/Utility/Url.hs b/Utility/Url.hs index 976fe975d..47bee5043 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -11,6 +11,7 @@ {-# LANGUAGE FlexibleContexts #-} module Utility.Url ( + closeManager, URLString, UserAgent, UrlOptions, @@ -31,11 +32,21 @@ import Utility.Tmp import qualified Build.SysConfig import Network.URI -import Network.HTTP.Conduit import Network.HTTP.Types import qualified Data.CaseInsensitive as CI import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as B8 +import Control.Monad.Trans.Resource +import Network.HTTP.Conduit hiding (closeManager) + +-- closeManager is needed with older versions of http-client, +-- but not new versions, which warn about using it. Urgh. +#if ! MIN_VERSION_http_client(0,4,18) +import Network.HTTP.Client (closeManager) +#else +closeManager :: Manager -> IO () +closeManager _ = return () +#endif type URLString = String @@ -164,16 +175,18 @@ getUrlInfo url uo = case parseURIRelaxed url of firstheader h = headMaybe . map snd . filter (\p -> fst p == h) . responseHeaders - existsconduit req = withManager $ \mgr -> do + existsconduit req = do + mgr <- newManager tlsManagerSettings let req' = headRequest (applyRequest uo req) - resp <- http req' mgr - -- forces processing the response before the - -- manager is closed - ret <- liftIO $ if responseStatus resp == ok200 - then found - (extractlen resp) - (extractfilename resp) - else dne + ret <- runResourceT $ do + resp <- http req' mgr + -- forces processing the response before the + -- manager is closed + liftIO $ if responseStatus resp == ok200 + then found + (extractlen resp) + (extractfilename resp) + else dne liftIO $ closeManager mgr return ret -- cgit v1.2.3