support building on debian stable

Specifically, http-client-0.4.31

This commit was supported by the NSF-funded DataLad project.
This commit is contained in:
Joey Hess 2018-06-19 11:25:10 -04:00
parent daac67c9b1
commit fc79f68404
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -8,6 +8,7 @@
-} -}
{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, LambdaCase, PatternGuards #-} {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, LambdaCase, PatternGuards #-}
{-# LANGUAGE CPP #-}
module Utility.HttpManagerRestricted ( module Utility.HttpManagerRestricted (
restrictManagerSettings, restrictManagerSettings,
@ -19,7 +20,7 @@ module Utility.HttpManagerRestricted (
import Network.HTTP.Client import Network.HTTP.Client
import Network.HTTP.Client.Internal import Network.HTTP.Client.Internal
(ManagerSettings(..), Connection, runProxyOverride) (ManagerSettings(..), Connection, runProxyOverride, makeConnection)
import Network.Socket import Network.Socket
import Network.BSD (getProtocolNumber) import Network.BSD (getProtocolNumber)
import Control.Exception import Control.Exception
@ -59,7 +60,11 @@ restrictManagerSettings
restrictManagerSettings cfg base = restrictProxy cfg $ base restrictManagerSettings cfg base = restrictProxy cfg $ base
{ managerRawConnection = restrictedRawConnection cfg { managerRawConnection = restrictedRawConnection cfg
, managerTlsConnection = restrictedTlsConnection cfg , managerTlsConnection = restrictedTlsConnection cfg
#if MIN_VERSION_http_client(0,5,0)
, managerWrapException = wrapOurExceptions , managerWrapException = wrapOurExceptions
#else
, managerWrapIOException = wrapOurExceptions
#endif
} }
restrictProxy restrictProxy
@ -121,6 +126,7 @@ restrictProxy cfg base = do
, proxyPort = fromIntegral pn , proxyPort = fromIntegral pn
} }
#if MIN_VERSION_http_client(0,5,0)
wrapOurExceptions :: Request -> IO a -> IO a wrapOurExceptions :: Request -> IO a -> IO a
wrapOurExceptions req = wrapOurExceptions req =
let wrapper se let wrapper se
@ -129,6 +135,18 @@ wrapOurExceptions req =
InternalException se InternalException se
| otherwise = se | otherwise = se
in handle $ throwIO . wrapper in handle $ throwIO . wrapper
#else
wrapOurExceptions :: IO a -> IO a
wrapOurExceptions =
let wrapper se = case fromException se of
Just (_ :: ConnectionRestricted) ->
-- Not really a TLS exception, but there is no
-- way to put SomeException in the
-- InternalIOException this old version uses.
toException $ TlsException se
Nothing -> se
in handle $ throwIO . wrapper
#endif
restrictedRawConnection :: Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection) restrictedRawConnection :: Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection)
restrictedRawConnection cfg = getConnection cfg Nothing restrictedRawConnection cfg = getConnection cfg Nothing