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..
This commit is contained in:
Joey Hess 2015-10-01 13:47:54 -04:00
parent cad3349001
commit 9e3ac97608
2 changed files with 25 additions and 12 deletions

View file

@ -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

View file

@ -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