From 5c4125e55b40ff4be98a827298f4173f4e54b41e Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
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..
---
 Utility/Url.hs | 33 +++++++++++++++++++++++----------
 1 file changed, 23 insertions(+), 10 deletions(-)

(limited to 'Utility/Url.hs')

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