http-client-restricted-0.0.1/0000755000000000000000000000000013314464176014310 5ustar0000000000000000http-client-restricted-0.0.1/Setup.hs0000644000000000000000000000010713314464176015742 0ustar0000000000000000{- cabal setup file -} import Distribution.Simple main = defaultMain http-client-restricted-0.0.1/LICENSE0000644000000000000000000000220213314464176015311 0ustar0000000000000000Copyright 2018 Joey Hess . Portions from http-client-tls Copyright (c) 2013 Michael Snoyman The MIT License (MIT) Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. http-client-restricted-0.0.1/http-client-restricted.cabal0000644000000000000000000000221213314464176021672 0ustar0000000000000000Name: http-client-restricted Version: 0.0.1 Cabal-Version: >= 1.6 Maintainer: Joey Hess Author: Joey Hess Copyright: 2018 Joey Hess, 2013 Michael Snoyman License-File: LICENSE License: MIT Build-Type: Simple Category: Network Extra-Source-Files: CHANGELOG Synopsis: restricting the servers that http-client will use Description: Addition to the http-client and http-client-tls libraries, that restricts the HTTP servers that can be used. . This is useful when a security policy needs to eg, prevent connections to HTTP servers on localhost or a local network, or only allow connections to a specific HTTP server. . It handles restricting redirects as well as the initial HTTP connection, and it also guards against DNS poisoning attacks. Library GHC-Options: -Wall -fno-warn-tabs Exposed-Modules: Network.HTTP.Client.Restricted Build-Depends: base >= 4.6 && < 5 , http-client >= 0.4.31 && < 0.6 , http-client-tls >= 0.3.2 && < 0.4 , connection >= 0.2.5 , data-default , network , utf8-string source-repository head type: git location: git://git.joeyh.name/haskell-http-client-restricted.git http-client-restricted-0.0.1/CHANGELOG0000644000000000000000000000021613314464176015521 0ustar0000000000000000http-client-restricted (0.0.1) unstable; urgency=medium * Initial release. -- Joey Hess Tue, 26 Jun 2018 12:22:48 -0400 http-client-restricted-0.0.1/Network/0000755000000000000000000000000013314464176015741 5ustar0000000000000000http-client-restricted-0.0.1/Network/HTTP/0000755000000000000000000000000013314464176016520 5ustar0000000000000000http-client-restricted-0.0.1/Network/HTTP/Client/0000755000000000000000000000000013314464176017736 5ustar0000000000000000http-client-restricted-0.0.1/Network/HTTP/Client/Restricted.hs0000644000000000000000000002477613314464176022422 0ustar0000000000000000{- | Restricted `ManagerSettings` for -} {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, LambdaCase, PatternGuards #-} {-# LANGUAGE CPP #-} module Network.HTTP.Client.Restricted ( Restriction, addressRestriction, mkRestrictedManagerSettings, ConnectionRestricted(..), connectionRestricted, ProxyRestricted(..), IPAddrString, ) where import Network.HTTP.Client import Network.HTTP.Client.Internal (ManagerSettings(..), Connection, runProxyOverride, makeConnection) import Network.HTTP.Client.TLS (mkManagerSettingsContext) import Network.Socket import Network.BSD (getProtocolNumber) import Control.Exception import qualified Network.Connection as NC import qualified Data.ByteString.UTF8 as BU 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 -- | Configuration of which HTTP connections to allow and which to -- restrict. data Restriction = Restriction { _addressRestriction :: AddrInfo -> Maybe ConnectionRestricted } -- | Decide if a HTTP connection is allowed based on the IP address -- of the server. -- -- After the restriction is checked, the same IP address is used -- to connect to the server. This avoids DNS rebinding attacks -- being used to bypass the restriction. -- -- > myRestriction :: Restriction -- > myRestriction = addressRestriction $ \addr -> -- > if isPrivateAddress addr -- > then Just $ connectionRestricted -- > ("blocked connection to private IP address " ++) -- > else Nothing addressRestriction :: (AddrInfo -> Maybe ConnectionRestricted) -> Restriction addressRestriction f = mempty { _addressRestriction = f } appendRestrictions :: Restriction -> Restriction -> Restriction appendRestrictions a b = Restriction { _addressRestriction = \addr -> _addressRestriction a addr <|> _addressRestriction b addr } -- | mempty does not restrict HTTP connections in any way instance Monoid Restriction where mempty = Restriction { _addressRestriction = \_ -> 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. data ConnectionRestricted = ConnectionRestricted String deriving (Show, Typeable) instance Exception ConnectionRestricted -- | A string containing an IP address, for display to a user. type IPAddrString = String -- | Constructs a ConnectionRestricted, passing the function a string -- containing the IP address of the HTTP server. connectionRestricted :: (IPAddrString -> String) -> AddrInfo -> ConnectionRestricted connectionRestricted mkmessage = ConnectionRestricted . mkmessage . showSockAddress . addrAddress -- | Value indicating that the http proxy will not be used. data ProxyRestricted = ProxyRestricted deriving (Show) -- Adjusts a ManagerSettings to enforce a Restriction. -- -- This overrides the `managerRawConnection` -- and `managerTlsConnection` with its own implementations that check -- the Restriction. They should otherwise behave the same as the -- ones provided by http-client-tls. -- -- 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. restrictManagerSettings :: Maybe NC.ConnectionContext -> Maybe NC.TLSSettings -> Restriction -> ManagerSettings -> IO (ManagerSettings, Maybe ProxyRestricted) 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. -- -- The Restriction will be checked each time a Request is made, and for -- each redirect followed. -- -- Aside from checking the Restriction, it should behave the same as -- `Network.HTTP.Client.TLS.mkManagerSettingsContext` -- from http-client-tls. -- -- > main = do -- > manager <- newManager . fst -- > =<< mkRestrictedManagerSettings myRestriction Nothing Nothing -- > request <- parseRequest "http://httpbin.org/get" -- > response <- httpLbs request manager -- > print $ responseBody response -- -- The HTTP proxy is also checked against the Restriction, and will not be -- used if the Restriction does not allow it. Just ProxyRestricted -- is returned when the HTTP proxy has been restricted. -- -- See `mkManagerSettingsContext` for why -- it can be useful to provide a `NC.ConnectionContext`. -- -- Note that SOCKS is not supported. mkRestrictedManagerSettings :: Restriction -> Maybe NC.ConnectionContext -> Maybe NC.TLSSettings -> IO (ManagerSettings, Maybe ProxyRestricted) mkRestrictedManagerSettings cfg mcontext mtls = restrictManagerSettings mcontext mtls cfg $ mkManagerSettingsContext mcontext (fromMaybe def mtls) Nothing restrictProxy :: Restriction -> ManagerSettings -> IO (ManagerSettings, Maybe ProxyRestricted) restrictProxy cfg base = do http_proxy_addr <- getproxyaddr False https_proxy_addr <- getproxyaddr True let (http_proxy, http_r) = mkproxy http_proxy_addr let (https_proxy, https_r) = mkproxy https_proxy_addr let ms = managerSetInsecureProxy http_proxy $ managerSetSecureProxy https_proxy base return (ms, http_r <|> https_r) where -- This does not use localhost because http-client may choose -- not to use the proxy for localhost. testnetip = "198.51.100.1" dummyreq https = parseRequest_ $ "http" ++ (if https then "s" else "") ++ "://" ++ testnetip getproxyaddr https = extractproxy >>= \case Nothing -> return Nothing Just p -> do proto <- getProtocolNumber "tcp" let serv = show (proxyPort p) let hints = defaultHints { addrFlags = [AI_ADDRCONFIG] , addrProtocol = proto , addrSocketType = Stream } let h = BU.toString $ proxyHost p getAddrInfo (Just hints) (Just h) (Just serv) >>= \case [] -> return Nothing (addr:_) -> return $ Just addr where -- These contortions are necessary until this issue -- is fixed: -- https://github.com/snoyberg/http-client/issues/355 extractproxy = do let po = if https then managerProxySecure base else managerProxyInsecure base f <- runProxyOverride po https return $ proxy $ f $ dummyreq https mkproxy Nothing = (noProxy, Nothing) mkproxy (Just proxyaddr) = case _addressRestriction cfg proxyaddr of Nothing -> (addrtoproxy (addrAddress proxyaddr), Nothing) Just _ -> (noProxy, Just ProxyRestricted) addrtoproxy addr = case addr of SockAddrInet pn _ -> mk pn SockAddrInet6 pn _ _ _ -> mk pn _ -> noProxy where mk pn = useProxy Network.HTTP.Client.Proxy { proxyHost = BU.fromString (showSockAddress addr) , 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 | Just (_ :: ConnectionRestricted) <- fromException se = toException $ HttpExceptionRequest req $ 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 restrictedTlsConnection :: Maybe NC.ConnectionContext -> Maybe NC.TLSSettings -> Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection) restrictedTlsConnection mcontext mtls cfg = getConnection cfg (Just (fromMaybe def mtls)) mcontext -- Based on Network.HTTP.Client.TLS.getTlsConnection. -- -- Checks the Restriction -- -- Does not support SOCKS. getConnection :: Restriction -> Maybe NC.TLSSettings -> Maybe NC.ConnectionContext -> IO (Maybe HostAddress -> String -> Int -> IO Connection) getConnection cfg tls mcontext = do context <- maybe NC.initConnectionContext return mcontext return $ \_ha h p -> bracketOnError (go context h p) NC.connectionClose convertConnection where go context h p = do let connparams = NC.ConnectionParams { NC.connectionHostname = h , NC.connectionPort = fromIntegral p , NC.connectionUseSecure = tls , NC.connectionUseSocks = Nothing -- unsupprted } proto <- getProtocolNumber "tcp" let serv = show p let hints = defaultHints { addrFlags = [AI_ADDRCONFIG] , addrProtocol = proto , addrSocketType = Stream } addrs <- getAddrInfo (Just hints) (Just h) (Just serv) bracketOnError (firstSuccessful $ map tryToConnect addrs) close (\sock -> NC.connectFromSocket context sock connparams) where tryToConnect addr = case _addressRestriction cfg addr of Nothing -> bracketOnError (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)) close (\sock -> connect sock (addrAddress addr) >> return sock) Just r -> throwIO r firstSuccessful [] = throwIO $ NC.HostNotResolved h firstSuccessful (a:as) = a `catch` \(e ::IOException) -> case as of [] -> throwIO e _ -> firstSuccessful as -- Copied from Network.HTTP.Client.TLS, unfortunately not exported. convertConnection :: NC.Connection -> IO Connection convertConnection conn = makeConnection (NC.connectionGetChunk conn) (NC.connectionPut conn) -- Closing an SSL connection gracefully involves writing/reading -- on the socket. But when this is called the socket might be -- already closed, and we get a @ResourceVanished@. (NC.connectionClose conn `Control.Exception.catch` \(_ :: IOException) -> return ()) -- For ipv4 and ipv6, the string will contain only the IP address, -- omitting the port that the Show instance includes. showSockAddress :: SockAddr -> IPAddrString showSockAddress a@(SockAddrInet _ _) = takeWhile (/= ':') $ show a showSockAddress a@(SockAddrInet6 _ _ _ _) = takeWhile (/= ']') $ drop 1 $ show a showSockAddress a = show a