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:
parent
cad3349001
commit
9e3ac97608
2 changed files with 25 additions and 12 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in a new issue