http-client-openssl 0.2.2.0 → 0.3.3
raw patch · 4 files changed
Files
- ChangeLog.md +18/−0
- Network/HTTP/Client/OpenSSL.hs +111/−59
- http-client-openssl.cabal +7/−5
- test/Spec.hs +23/−3
ChangeLog.md view
@@ -1,3 +1,21 @@+## 0.3.3++* Use `hostAddress` from `Request`.++## 0.3.2.0++* http-client-openssl: added reasonable OpenSSL default settings++## 0.3.1.0+* Fix a bug with http-proxy that would cause SNI to be set incorrectly; (would+ use the domain of the proxy, instead of the server we're trying to reach+ _through_ the proxy)++## 0.3.0.0++* Wrap HsOpenSSL specific exceptions into http-clients own `HttpExceptionRequest`. This is a breaking change and might need adjustment with respect to exception handling in user code.+* More robust handling of unexpectedly closed connections+ ## 0.2.2.0 * Tell OpenSSL what host is being contacted, so it can use the SNI extension for certificate selection if the server requires it.
Network/HTTP/Client/OpenSSL.hs view
@@ -1,79 +1,131 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-} -- | Support for making connections via the OpenSSL library. module Network.HTTP.Client.OpenSSL- ( opensslManagerSettings- -- , defaultMakeContext- , withOpenSSL+ ( withOpenSSL+ , newOpenSSLManager+ , opensslManagerSettings+ , defaultMakeContext+ , OpenSSLSettings(..)+ , defaultOpenSSLSettings ) where import Network.HTTP.Client import Network.HTTP.Client.Internal import Control.Exception+import Control.Monad.IO.Class import Network.Socket.ByteString (sendAll, recv) import OpenSSL+import qualified Data.ByteString as S import qualified Network.Socket as N-import qualified OpenSSL.Session as SSL+import qualified OpenSSL.Session as SSL+import qualified OpenSSL.X509.SystemStore as SSL (contextLoadSystemCerts)+import Foreign.Storable (sizeOf) --- | Note that it is the caller's responsibility to pass in an appropriate--- context. Future versions of http-client-openssl will hopefully include a--- sane, safe default.+-- | Create a new 'Manager' using 'opensslManagerSettings' and 'defaultMakeContext'+-- with 'defaultOpenSSLSettings'.+newOpenSSLManager :: MonadIO m => m Manager+newOpenSSLManager = liftIO $ do+ -- sharing an SSL context between threads (without modifying it) is safe:+ -- https://github.com/openssl/openssl/issues/2165+ ctx <- defaultMakeContext defaultOpenSSLSettings+ newManager $ opensslManagerSettings (pure ctx)++-- | Note that it is the caller's responsibility to pass in an appropriate context. opensslManagerSettings :: IO SSL.SSLContext -> ManagerSettings opensslManagerSettings mkContext = defaultManagerSettings { managerTlsConnection = do ctx <- mkContext- return $ \_ha host' port' -> do- -- Copied/modified from openssl-streams- let hints = N.defaultHints- { N.addrFlags = [N.AI_ADDRCONFIG, N.AI_NUMERICSERV]- , N.addrFamily = N.AF_INET- , N.addrSocketType = N.Stream- }- (addrInfo:_) <- N.getAddrInfo (Just hints) (Just host') (Just $ show port')-- let family = N.addrFamily addrInfo- let socketType = N.addrSocketType addrInfo- let protocol = N.addrProtocol addrInfo- let address = N.addrAddress addrInfo-- bracketOnError (N.socket family socketType protocol) (N.close)- $ \sock -> do- N.connect sock address- ssl <- SSL.connection ctx sock- SSL.setTlsextHostName ssl host'- SSL.connect ssl- makeConnection- (SSL.read ssl 32752)- (SSL.write ssl)- (N.close sock)+ return $ \ha' host' port' ->+ withSocket (const $ return ()) ha' host' port' $ \sock ->+ makeSSLConnection ctx sock host' , managerTlsProxyConnection = do ctx <- mkContext- return $ \connstr checkConn _serverName _ha host' port' -> do- -- Copied/modified from openssl-streams- let hints = N.defaultHints- { N.addrFlags = [N.AI_ADDRCONFIG, N.AI_NUMERICSERV]- , N.addrFamily = N.AF_INET- , N.addrSocketType = N.Stream- }- (addrInfo:_) <- N.getAddrInfo (Just hints) (Just host') (Just $ show port')+ return $ \connstr checkConn serverName _ha host' port' ->+ withSocket (const $ return ()) Nothing host' port' $ \sock -> do+ conn <- makeConnection+ (recv sock bufSize)+ (sendAll sock)+ (return ())+ connectionWrite conn connstr+ checkConn conn+ makeSSLConnection ctx sock serverName - let family = N.addrFamily addrInfo- let socketType = N.addrSocketType addrInfo- let protocol = N.addrProtocol addrInfo- let address = N.addrAddress addrInfo+ , managerRetryableException = \se ->+ case () of+ ()+ | Just (_ :: SSL.ConnectionAbruptlyTerminated) <- fromException se -> True+ | otherwise -> managerRetryableException defaultManagerSettings se - bracketOnError (N.socket family socketType protocol) (N.close)- $ \sock -> do- N.connect sock address- conn <- makeConnection- (recv sock 32752)- (sendAll sock)- (return ())- connectionWrite conn connstr- checkConn conn- ssl <- SSL.connection ctx sock- SSL.setTlsextHostName ssl host'- SSL.connect ssl- makeConnection- (SSL.read ssl 32752)- (SSL.write ssl)- (N.close sock)+ , managerWrapException = \req ->+ let+ wrap se+ | Just (_ :: IOException) <- fromException se = se'+ | Just (_ :: SSL.SomeSSLException) <- fromException se = se'+ | Just (_ :: SSL.ConnectionAbruptlyTerminated) <- fromException se = se'+ | Just (_ :: SSL.ProtocolError) <- fromException se = se'+ | otherwise = se+ where+ se' = toException (HttpExceptionRequest req (InternalException se))+ in+ handle (throwIO . wrap)+ }+ where+ makeSSLConnection ctx sock host = do+ ssl <- SSL.connection ctx sock+ SSL.setTlsextHostName ssl host+ SSL.enableHostnameValidation ssl host+ SSL.connect ssl+ makeConnection+ (SSL.read ssl bufSize `catch` \(_ :: SSL.ConnectionAbruptlyTerminated) -> return S.empty)+ -- Handling SSL.ConnectionAbruptlyTerminated as a stream end+ -- (some sites terminate SSL connection right after returning the data).+ (SSL.write ssl)+ (N.close sock)++-- same as Data.ByteString.Lazy.Internal.defaultChunkSize+bufSize :: Int+bufSize = 32 * 1024 - overhead+ where overhead = 2 * sizeOf (undefined :: Int)++defaultMakeContext :: OpenSSLSettings -> IO SSL.SSLContext+defaultMakeContext OpenSSLSettings{..} = do+ ctx <- SSL.context+ SSL.contextSetVerificationMode ctx osslSettingsVerifyMode+ SSL.contextSetCiphers ctx osslSettingsCiphers+ mapM_ (SSL.contextAddOption ctx) osslSettingsOptions+ osslSettingsLoadCerts ctx+ return ctx++data OpenSSLSettings = OpenSSLSettings+ { osslSettingsOptions :: [SSL.SSLOption]+ , osslSettingsVerifyMode :: SSL.VerificationMode+ , osslSettingsCiphers :: String+ , osslSettingsLoadCerts :: SSL.SSLContext -> IO ()+ }++-- | Default OpenSSL settings. In particular:+--+-- * SSLv2 and SSLv3 are disabled+-- * Hostname validation+-- * @DEFAULT@ cipher list+-- * Certificates loaded from OS-specific store+--+-- Note that these settings might change in the future.+defaultOpenSSLSettings :: OpenSSLSettings+defaultOpenSSLSettings = OpenSSLSettings+ { osslSettingsOptions =+ [ SSL.SSL_OP_ALL -- enable bug workarounds+ , SSL.SSL_OP_NO_SSLv2+ , SSL.SSL_OP_NO_SSLv3+ ]+ , osslSettingsVerifyMode = SSL.VerifyPeer+ -- vpFailIfNoPeerCert and vpClientOnce are only relevant for servers+ { SSL.vpFailIfNoPeerCert = False+ , SSL.vpClientOnce = False+ , SSL.vpCallback = Nothing+ }+ , osslSettingsCiphers = "DEFAULT"+ , osslSettingsLoadCerts = SSL.contextLoadSystemCerts }
http-client-openssl.cabal view
@@ -1,12 +1,12 @@ name: http-client-openssl-version: 0.2.2.0+version: 0.3.3 synopsis: http-client backend using the OpenSSL library. description: Hackage documentation generation is not reliable. For up to date documentation, please see: <http://www.stackage.org/package/http-client>. homepage: https://github.com/snoyberg/http-client license: MIT license-file: LICENSE author: Michael Snoyman-maintainer: michael@snoyman.com+maintainer: michael@snoyman.com alexbiehl@gmail.com category: Network build-type: Simple cabal-version: >=1.10@@ -19,10 +19,12 @@ library exposed-modules: Network.HTTP.Client.OpenSSL other-extensions: ScopedTypeVariables- build-depends: base >= 4 && < 5- , http-client >= 0.2+ build-depends: base >= 4.10 && < 5+ , bytestring+ , http-client >= 0.7.3 , network- , HsOpenSSL+ , HsOpenSSL >= 0.11.4.20+ , HsOpenSSL-x509-system default-language: Haskell2010 test-suite spec
test/Spec.hs view
@@ -9,20 +9,20 @@ main :: IO () main = withOpenSSL $ hspec $ do it "make a TLS connection" $ do- manager <- newManager $ opensslManagerSettings SSL.context+ manager <- newOpenSSLManager withResponse (parseRequest_ "HEAD https://s3.amazonaws.com/hackage.fpcomplete.com/01-index.tar.gz") manager $ \res -> do responseStatus res `shouldBe` status200 lookup "content-type" (responseHeaders res) `shouldBe` Just "application/x-gzip" #ifdef USE_PROXY it "make a TLS connection with proxy" $ do- manager <- newManager $ opensslManagerSettings SSL.context+ manager <- newOpenSSLManager let req = addProxy "localhost" 8080 $ parseRequest_ "HEAD https://s3.amazonaws.com/hackage.fpcomplete.com/01-index.tar.gz" withResponse req manager $ \res -> do responseStatus res `shouldBe` status200 lookup "content-type" (responseHeaders res) `shouldBe` Just "application/x-gzip" it "compare responses without and with proxy" $ do- manager <- newManager $ opensslManagerSettings SSL.context+ manager <- newOpenSSLManager let req = parseRequest_ "GET https://raw.githubusercontent.com/snoyberg/http-client/master/README.md" v_org <- withResponse req manager $ \res -> do lbsResponse res@@ -30,3 +30,23 @@ lbsResponse res (responseBody v) `shouldBe` (responseBody v_org) #endif++ it "BadSSL: expired" $ do+ manager <- newOpenSSLManager+ let action = withResponse "https://expired.badssl.com/" manager (const (return ()))+ action `shouldThrow` anyException++ it "BadSSL: self-signed" $ do+ manager <- newOpenSSLManager+ let action = withResponse "https://self-signed.badssl.com/" manager (const (return ()))+ action `shouldThrow` anyException++ it "BadSSL: wrong.host" $ do+ manager <- newOpenSSLManager+ let action = withResponse "https://wrong.host.badssl.com/" manager (const (return ()))+ action `shouldThrow` anyException++ it "BadSSL: we do have case-insensitivity though" $ do+ manager <- newOpenSSLManager+ withResponse "https://BADSSL.COM" manager $ \res ->+ responseStatus res `shouldBe` status200