summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-10-01 13:47:54 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-10-01 13:48:56 -0400
commit5c4125e55b40ff4be98a827298f4173f4e54b41e (patch)
treea336a4be3a961a403f4be961490dee24e3c5d790
parente3969aeb3c1d8a91a31d4da31097ab5c59436774 (diff)
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..
-rw-r--r--Remote/S3.hs4
-rw-r--r--Utility/Url.hs33
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