http-client-openssl 0.3.1.0 → 0.3.2.0
raw patch · 4 files changed
+132/−66 lines, 4 filesdep +HsOpenSSL-x509-systemdep ~HsOpenSSL
Dependencies added: HsOpenSSL-x509-system
Dependency ranges changed: HsOpenSSL
Files
- ChangeLog.md +4/−0
- Network/HTTP/Client/OpenSSL.hs +102/−61
- http-client-openssl.cabal +3/−2
- test/Spec.hs +23/−3
ChangeLog.md view
@@ -1,3 +1,7 @@+## 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
Network/HTTP/Client/OpenSSL.hs view
@@ -1,83 +1,55 @@+{-# 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) --- | 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 `catch` \(_ :: SSL.ConnectionAbruptlyTerminated) -> return S.empty)- (SSL.write ssl)- (N.close sock)+ return $ \_ha host' port' ->+ withSocket 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')-- 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- conn <- makeConnection- (recv sock 32752)- (sendAll sock)- (return ())- connectionWrite conn connstr- checkConn conn- ssl <- SSL.connection ctx sock- SSL.setTlsextHostName ssl serverName- SSL.connect ssl- makeConnection- (SSL.read ssl 32752 `catch` \(_ :: SSL.ConnectionAbruptlyTerminated) -> return S.empty)- (SSL.write ssl)- (N.close sock)+ return $ \connstr checkConn serverName _ha host' port' ->+ withSocket host' port' $ \sock -> do+ conn <- makeConnection+ (recv sock 32752)+ (sendAll sock)+ (return ())+ connectionWrite conn connstr+ checkConn conn+ makeSSLConnection ctx sock serverName , managerRetryableException = \se -> case () of@@ -97,4 +69,73 @@ se' = toException (HttpExceptionRequest req (InternalException se)) in handle (throwIO . wrap)+ }+ where+ withSocket host port use = 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 -> N.connect sock address *> use sock++ 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 32752 `catch` \(_ :: SSL.ConnectionAbruptlyTerminated) -> return S.empty)+ (SSL.write ssl)+ (N.close sock)++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,5 +1,5 @@ name: http-client-openssl-version: 0.3.1.0+version: 0.3.2.0 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@@ -23,7 +23,8 @@ , bytestring , http-client >= 0.2 , network- , HsOpenSSL >= 0.11.2.0+ , 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