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:
parent
daac67c9b1
commit
fc79f68404
1 changed files with 19 additions and 1 deletions
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue