http-io-streams 0.1.5.0 → 0.1.6.0

raw patch · 5 files changed

+129/−16 lines, 5 filesdep ~attoparsecdep ~basedep ~base64-bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: attoparsec, base, base64-bytestring

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• http-io-streams.cabal +1/−1
• http-streams/lib/Network/Http/Client.hs +5/−0
• http-streams/lib/Network/Http/Connection.hs +27/−2
• http-streams/lib/Network/Http/Inconvenience.hs +88/−13

@@ -1,5 +1,13 @@ See also http://pvp.haskell.org/faq +### 0.1.6.0++* New function `voidContextSSL` for creating a _void_ SSL Context which rejects any TLS handshake attempts+* New function `contextSetCASystemStore` exposing functionality embedded in `baselineContextSSL`+* New function `openConnectionAddress''` supporting supplying local `SSLContext`s as well as modifying the `SSL` connection before initiating the client SSL handshake.+* New function `openConnectionSSL'` which allows to customize the 'SSL' connection /before/ a client SSL handshake is attempted.+* New convenience function `getContextSSL` function allowing to retrieve global `SSLContext`.+ ### 0.1.5.0  * New function `openConnectionAddress'` function supporting supplying local `SSLContext`s.

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                http-io-streams-version:             0.1.5.0+version:             0.1.6.0  synopsis:            HTTP and WebSocket client based on io-streams description:

@@ -175,8 +175,12 @@      -- * Secure connections     openConnectionSSL,+    openConnectionSSL',     baselineContextSSL,+    voidContextSSL,+    contextSetCASystemStore,     modifyContextSSL,+    getContextSSL,     establishConnection,      -- * Alternative 'ConnectionAddress' API@@ -185,6 +189,7 @@     connectionAddressFromURL,     openConnectionAddress,     openConnectionAddress',+    openConnectionAddress'',      -- -- * Testing support     -- makeConnection,

@@ -22,6 +22,7 @@     withConnection,     openConnection,     openConnectionSSL,+    openConnectionSSL',     openConnectionUnix,     closeConnection,     getHostname,@@ -234,7 +235,31 @@ -- NB: /There is no longer a need to call 'OpenSSL.withOpenSSL' explicitly; the initialization is invoked once per process for you/ -- openConnectionSSL :: SSLContext -> Hostname -> Port -> IO Connection-openConnectionSSL ctx h1' p = withOpenSSL $ do+openConnectionSSL ctx h1' = openConnectionSSL' modssl ctx h1'+  where+    modssl ssl = SSL.setTlsextHostName ssl h1+    h1         = S.unpack h1'++-- | Variant of 'openConnectionSSL' which allows to customize the+-- 'SSL' connection /before/ a client SSL handshake is+-- attempted. This is useful if you want to have more control over+-- the use of TLS extensions such as+-- <https://en.wikipedia.org/wiki/Server_Name_Indication SNI> or+-- enable features such as+-- <https://www.openssl.org/docs/manmaster/man3/X509_check_host.html hostname validation>.+--+-- For reference, the 'openConnectionSSL' function can be defined in+-- terms of 'openConnectionSSL'' like so+--+-- > openConnectionSSL :: SSLContext -> Hostname -> Port -> IO Connection+-- > openConnectionSSL ctx h1' = openConnectionSSL' modssl ctx h1'+-- >   where+-- >     modssl ssl = SSL.setTlsextHostName ssl h1+-- >     h1         = S.unpack h1'+--+-- @since 0.1.6.0+openConnectionSSL' :: (SSL -> IO ()) -> SSLContext -> Hostname -> Port -> IO Connection+openConnectionSSL' modssl ctx h1' p = withOpenSSL $ do     is <- getAddrInfo Nothing (Just h1) (Just $ show p)      let a = addrAddress $ head is@@ -244,7 +269,7 @@     connect s a      ssl <- SSL.connection ctx s-    SSL.setTlsextHostName ssl h1+    modssl ssl     SSL.connect ssl      (i,o1) <- Streams.sslToStreams ssl

@@ -20,6 +20,7 @@ module Network.Http.Inconvenience (     URL,     modifyContextSSL,+    getContextSSL,     establishConnection,     get,     post,@@ -27,6 +28,8 @@     encodedFormBody,     put,     baselineContextSSL,+    voidContextSSL,+    contextSetCASystemStore,     concatHandler',     TooManyRedirects(..),     HttpClientError(..),@@ -36,6 +39,7 @@     connectionAddressFromURL,     openConnectionAddress,     openConnectionAddress',+    openConnectionAddress'',          -- for testing     splitURI@@ -166,8 +170,12 @@ -- -- | Modify the context being used to configure the SSL tunnel used by -- the convenience API functions to make @https://@ connections. The--- default is that setup by 'baselineContextSSL'.+-- default is that setup by 'baselineContextSSL'. See also 'getContextSSL'. --+-- __NOTE__: This operation is /not/ reentrant; it is assumed this+-- operation is called once during program initialization and thus+-- there is currently no provision implemented to protected against+-- parallel execution from multiple threads! modifyContextSSL :: (SSLContext -> IO SSLContext) -> IO () modifyContextSSL f = do     ctx <- readIORef global@@ -175,6 +183,15 @@     writeIORef global ctx'  --+-- | Retrieve the /global/ context being used to configure the SSL+-- connection used by the convenience API functions to make @https://@+-- connections. See also 'modifyContextSSL'.+--+-- @since 0.1.6.0+getContextSSL :: IO SSLContext+getContextSSL = readIORef global++-- -- | Given a URL, work out whether it is normal, secure, or unix domain, -- and then open the connection to the webserver including setting the -- appropriate default port if one was not specified in the URL. This@@ -268,6 +285,23 @@     c <- openConnectionUnix (S.unpack fp)     return c { cHost = mempty } -- NB: HTTP RFC allows empty Host: headers +-- | Yet another variant of 'openConnectionAddress' allowing to supply local 'SSLContext' as well as an 'SSL.SSL' connection modifier (see 'openConnectionSSL'' for details).+--+-- The @IO (SSLContext@ action is only evaluated in case of a 'ConnectionAddressHttps' target.+--+-- See also 'baselineContextSSL' which may be convenient to use as a starting point; you may want to implement your own variant of 'baselineContextSSL'.+--+-- @since 0.1.6.0+openConnectionAddress'' :: ((Hostname,Word16) -> IO (SSLContext, SSL.SSL -> IO ())) -> ConnectionAddress -> IO Connection+openConnectionAddress'' getCtx ca = case ca of+  ConnectionAddressHttp  host port  -> openConnection host port+  ConnectionAddressHttps host ports -> do+    (ctx,modssl) <- getCtx (host,ports)+    openConnectionSSL' modssl ctx host ports+  ConnectionAddressHttpUnix fp -> do+    c <- openConnectionUnix (S.unpack fp)+    return c { cHost = mempty } -- NB: HTTP RFC allows empty Host: headers+ -- | Decode 'URL' into 'ConnectionAddress', user-info-part, (escaped) URL path, and optional fragment. -- -- The 'URL' argument is expected to be properly escaped according to RFC 3986.@@ -365,6 +399,7 @@ -- you are encouraged to install the system -- certificates somewhere and create your own 'SSLContext'. --+-- See also 'contextSetCASystemStore' {-     We would like to turn certificate verification on for everyone, but     this has proved contingent on leveraging platform specific mechanisms@@ -375,26 +410,66 @@ baselineContextSSL = withOpenSSL $ do     ctx <- SSL.context     SSL.contextSetDefaultCiphers ctx++    caSet <- contextSetCASystemStore ctx+    if caSet+      then SSL.contextSetVerificationMode ctx (SSL.VerifyPeer True True Nothing)+      else SSL.contextSetVerificationMode ctx SSL.VerifyNone++    return ctx++-- | Construct a /void/ 'SSL.Context' in a configuration which uses+-- the @HIGH@ cipher-suite and rejects /any/ presented server+-- certificate.+--+-- This is mostly useful for testing purposes or intentionally+-- thwarting any attempt to connect to @https://@ uris.+--+-- @since 0.1.6.0+voidContextSSL :: IO SSLContext+voidContextSSL = do+    ctx <- SSL.context+    SSL.contextSetCiphers ctx "HIGH"+    SSL.contextSetVerificationMode ctx (SSL.VerifyPeer True True (Just (\_ _ -> return False)))+    return ctx+    +-- | Configure system-wide certificate store based on OS-specific heuristics.+--+-- This function returns 'True' if the 'SSLContext' was configured; or+-- 'False' if the location couldn't be termined for the current OS.+--+-- This function is used by 'baselineContextSSL' but in contrast does+-- *not* invoke 'SSL.contextSetDefaultCiphers' nor+-- 'SSL.contextSetVerificationMode'. See source-code for details on+-- the heuristic used to determine the location of the system+-- certificate store.+--+-- @since 0.1.6.0+contextSetCASystemStore :: SSLContext -> IO Bool+contextSetCASystemStore ctx = do #if defined(darwin_HOST_OS)-    SSL.contextSetVerificationMode ctx SSL.VerifyNone+    return False #elif defined(mingw32_HOST_OS)-    SSL.contextSetVerificationMode ctx SSL.VerifyNone+    return False #elif defined(freebsd_HOST_OS)     SSL.contextSetCAFile ctx "/usr/local/etc/ssl/cert.pem"-    SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing+    return True #elif defined(openbsd_HOST_OS)     SSL.contextSetCAFile ctx "/etc/ssl/cert.pem"-    SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing+    return True #else-    fedora <- doesDirectoryExist "/etc/pki/tls"-    if fedora-        then do-            SSL.contextSetCAFile ctx "/etc/pki/tls/certs/ca-bundle.crt"-        else do-            SSL.contextSetCADirectory ctx "/etc/ssl/certs"-    SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing+    hasFedoraEtcPkiTls <- doesDirectoryExist "/etc/pki/tls"+    if hasFedoraEtcPkiTls+      then do+        SSL.contextSetCAFile ctx "/etc/pki/tls/certs/ca-bundle.crt"+        return True+      else do+        -- Setting this as fallback effectively will cause systems to+        -- either fail to verify any certificates (if peer+        -- verification is enabled) if the folder doesn't exist.+        SSL.contextSetCADirectory ctx "/etc/ssl/certs"+        return True #endif-    return ctx   parseURL :: URL -> URI