mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

call base ManagerSetting's exception wrapper

Browse source 
This commit was sponsored by Henrik Riomar on Patreon.
This commit is contained in:
Joey Hess 2018-06-19 14:17:05 -04:00
parent f34faad9aa
commit 47cd8001bc
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 8 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
Utility/HttpManagerRestricted.hs
View file

@ -61,9 +61,9 @@ 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) #if MIN_VERSION_http_client(0,5,0)
, managerWrapException = wrapOurExceptions , managerWrapException = wrapOurExceptions base
#else #else
, managerWrapIOException = wrapOurExceptions , managerWrapIOException = wrapOurExceptions base
#endif #endif
} }
@ -127,17 +127,17 @@ restrictProxy cfg base = do
} }
#if MIN_VERSION_http_client(0,5,0) #if MIN_VERSION_http_client(0,5,0)
wrapOurExceptions :: Request -> IO a -> IO a wrapOurExceptions :: ManagerSettings -> Request -> IO a -> IO a
wrapOurExceptions req = wrapOurExceptions base req a =
let wrapper se let wrapper se
| Just (_ :: ConnectionRestricted) <- fromException se = | Just (_ :: ConnectionRestricted) <- fromException se =
toException $ HttpExceptionRequest req $ toException $ HttpExceptionRequest req $
InternalException se InternalException se
| otherwise = se | otherwise = se
in handle $ throwIO . wrapper in managerWrapException base req (handle (throwIO . wrapper) a)
#else #else
wrapOurExceptions :: IO a -> IO a wrapOurExceptions :: ManagerSettings -> IO a -> IO a
wrapOurExceptions = wrapOurExceptions base a =
let wrapper se = case fromException se of let wrapper se = case fromException se of
Just (_ :: ConnectionRestricted) -> Just (_ :: ConnectionRestricted) ->
-- Not really a TLS exception, but there is no -- Not really a TLS exception, but there is no
@ -145,7 +145,7 @@ wrapOurExceptions =
-- InternalIOException this old version uses. -- InternalIOException this old version uses.
toException $ TlsException se toException $ TlsException se
Nothing -> se Nothing -> se
in handle $ throwIO . wrapper in managerWrapIOException base (handle (throwIO . wrapper) a)
#endif #endif
restrictedRawConnection :: Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection) restrictedRawConnection :: Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection)