http-client-restricted 0.0.1 → 0.0.2
raw patch · 3 files changed
+25/−39 lines, 3 filesdep ~basedep ~http-client
Dependency ranges changed: base, http-client
Files
- CHANGELOG +8/−0
- Network/HTTP/Client/Restricted.hs +14/−36
- http-client-restricted.cabal +3/−3
CHANGELOG view
@@ -1,3 +1,11 @@+http-client-restricted (0.0.2) unstable; urgency=medium++ * Added checkAddressRestriction.+ * Drop support for building with ghc older than 8.4.4.+ * Drop support for http-client 0.4.x.++ -- Joey Hess <id@joeyh.name> Tue, 25 Feb 2020 14:48:41 -0400+ http-client-restricted (0.0.1) unstable; urgency=medium * Initial release.
Network/HTTP/Client/Restricted.hs view
@@ -2,10 +2,10 @@ -} {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, LambdaCase, PatternGuards #-}-{-# LANGUAGE CPP #-} module Network.HTTP.Client.Restricted ( Restriction,+ checkAddressRestriction, addressRestriction, mkRestrictedManagerSettings, ConnectionRestricted(..),@@ -26,9 +26,7 @@ import Data.Maybe import Data.Default import Data.Typeable-#if MIN_VERSION_base(4,9,0) import qualified Data.Semigroup as Sem-#endif import Data.Monoid import Control.Applicative import Prelude@@ -36,7 +34,7 @@ -- | Configuration of which HTTP connections to allow and which to -- restrict. data Restriction = Restriction- { _addressRestriction :: AddrInfo -> Maybe ConnectionRestricted+ { checkAddressRestriction :: AddrInfo -> Maybe ConnectionRestricted } -- | Decide if a HTTP connection is allowed based on the IP address@@ -53,30 +51,22 @@ -- > ("blocked connection to private IP address " ++) -- > else Nothing addressRestriction :: (AddrInfo -> Maybe ConnectionRestricted) -> Restriction-addressRestriction f = mempty { _addressRestriction = f }+addressRestriction f = mempty { checkAddressRestriction = f } appendRestrictions :: Restriction -> Restriction -> Restriction appendRestrictions a b = Restriction- { _addressRestriction = \addr ->- _addressRestriction a addr <|> _addressRestriction b addr+ { checkAddressRestriction = \addr ->+ checkAddressRestriction a addr <|> checkAddressRestriction b addr } -- | mempty does not restrict HTTP connections in any way instance Monoid Restriction where mempty = Restriction- { _addressRestriction = \_ -> Nothing+ { checkAddressRestriction = \_ -> Nothing }-#if MIN_VERSION_base(4,11,0)-#elif MIN_VERSION_base(4,9,0)- mappend = (Sem.<>)-#else- mappend = appendRestrictions-#endif -#if MIN_VERSION_base(4,9,0) instance Sem.Semigroup Restriction where (<>) = appendRestrictions-#endif -- | Value indicating that a connection was restricted, and giving the -- reason why.@@ -98,7 +88,9 @@ data ProxyRestricted = ProxyRestricted deriving (Show) --- Adjusts a ManagerSettings to enforce a Restriction.+-- Adjusts a ManagerSettings to enforce a Restriction. The restriction+-- will be checked each time a Request is made, and for each redirect+-- followed. -- -- This overrides the `managerRawConnection` -- and `managerTlsConnection` with its own implementations that check @@ -108,6 +100,9 @@ -- This function is not exported, because using it with a ManagerSettings -- produced by something other than http-client-tls would result in -- surprising behavior, since its connection methods would not be used.+--+-- The http proxy is also checked against the Restriction, and if+-- access to it is blocked, the http proxy will not be used. restrictManagerSettings :: Maybe NC.ConnectionContext -> Maybe NC.TLSSettings@@ -117,11 +112,7 @@ restrictManagerSettings mcontext mtls cfg base = restrictProxy cfg $ base { managerRawConnection = restrictedRawConnection cfg , managerTlsConnection = restrictedTlsConnection mcontext mtls cfg-#if MIN_VERSION_http_client(0,5,0) , managerWrapException = wrapOurExceptions base-#else- , managerWrapIOException = wrapOurExceptions base-#endif } -- | Makes a TLS-capable ManagerSettings with a Restriction applied to it.@@ -202,7 +193,7 @@ return $ proxy $ f $ dummyreq https mkproxy Nothing = (noProxy, Nothing)- mkproxy (Just proxyaddr) = case _addressRestriction cfg proxyaddr of+ mkproxy (Just proxyaddr) = case checkAddressRestriction cfg proxyaddr of Nothing -> (addrtoproxy (addrAddress proxyaddr), Nothing) Just _ -> (noProxy, Just ProxyRestricted) @@ -216,7 +207,6 @@ , proxyPort = fromIntegral pn } -#if MIN_VERSION_http_client(0,5,0) wrapOurExceptions :: ManagerSettings -> Request -> IO a -> IO a wrapOurExceptions base req a = let wrapper se@@ -225,18 +215,6 @@ InternalException se | otherwise = se in managerWrapException base req (handle (throwIO . wrapper) a)-#else-wrapOurExceptions :: ManagerSettings -> IO a -> IO a-wrapOurExceptions base a =- 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 managerWrapIOException base (handle (throwIO . wrapper) a)-#endif restrictedRawConnection :: Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection) restrictedRawConnection cfg = getConnection cfg Nothing Nothing@@ -282,7 +260,7 @@ close (\sock -> NC.connectFromSocket context sock connparams) where- tryToConnect addr = case _addressRestriction cfg addr of+ tryToConnect addr = case checkAddressRestriction cfg addr of Nothing -> bracketOnError (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) close
http-client-restricted.cabal view
@@ -1,5 +1,5 @@ Name: http-client-restricted-Version: 0.0.1+Version: 0.0.2 Cabal-Version: >= 1.6 Maintainer: Joey Hess <id@joeyh.name> Author: Joey Hess@@ -25,8 +25,8 @@ Exposed-Modules: Network.HTTP.Client.Restricted Build-Depends: - base >= 4.6 && < 5- , http-client >= 0.4.31 && < 0.6+ base >= 4.11.1.0 && < 5.0+ , http-client >= 0.5 && < 0.6 , http-client-tls >= 0.3.2 && < 0.4 , connection >= 0.2.5 , data-default