Skip to content

Commit

Permalink
Reintroduce dropped functions and bump to 0.1.7.0
Browse files Browse the repository at this point in the history
Due to an oversight the two functions introduced in
6039cd2 and released as part of the
(retroactively deprecated) 0.1.6.0 release were lost in the
0.1.6.1 release.

This merge-commit tries to rectify the situation by finally
reintroducing them in a PVP-gnostic way by tagging a new 0.1.7.0
release and treating 0.1.6.0 as if it didn't exist (by deprecation
on Hackage).
  • Loading branch information
hvr committed Feb 6, 2024
2 parents 59d4e48 + 6039cd2 commit 36411a4
Show file tree
Hide file tree
Showing 4 changed files with 69 additions and 14 deletions.
12 changes: 11 additions & 1 deletion CHANGELOG.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,12 @@
See also http://pvp.haskell.org/faq

### 0.1.7.0

* New function `voidContextSSL` for creating a _void_ SSL Context which rejects any TLS handshake attempts
* New function `contextSetCASystemStore` exposing functionality embedded in `baselineContextSSL`

NB: These functions were originally introduced in the retroactively deprecated 0.1.6.0 release but due to an oversight were dropped again in 0.1.6.1 inadvertently. This minor release reintroduces them in a PVP-compliant way.

#### 0.1.6.4

* Depend on `directory` rather than `system-fileio` ([PR #18](https://github.com/haskell-hvr/http-io-streams/pull/18)).
Expand All @@ -26,9 +33,12 @@ Tested with GHC 7.4 - 9.6.
#### 0.1.6.1

* Build with GHC 9.2 and `ghc-prim-0.8` (via `base-4.16`).
* Accidentally removed function `voidContextSSL` and `contextSetCASystemStore` introduced in 0.1.6.0

### 0.1.6.0
### 0.1.6.0 **deprecated**

* 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`.
Expand Down
2 changes: 1 addition & 1 deletion http-io-streams.cabal
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: 2.2
name: http-io-streams
version: 0.1.6.4
version: 0.1.7.0

synopsis: HTTP and WebSocket client based on io-streams
description:
Expand Down
2 changes: 2 additions & 0 deletions http-streams/lib/Network/Http/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -177,6 +177,8 @@ module Network.Http.Client (
openConnectionSSL,
openConnectionSSL',
baselineContextSSL,
voidContextSSL,
contextSetCASystemStore,
modifyContextSSL,
getContextSSL,
establishConnection,
Expand Down
67 changes: 55 additions & 12 deletions http-streams/lib/Network/Http/Inconvenience.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,8 @@ module Network.Http.Inconvenience (
encodedFormBody,
put,
baselineContextSSL,
voidContextSSL,
contextSetCASystemStore,
concatHandler',
TooManyRedirects(..),
HttpClientError(..),
Expand Down Expand Up @@ -402,6 +404,7 @@ connectionAddressFromURI u = fmap addxinfo $
-- 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
Expand All @@ -412,26 +415,66 @@ baselineContextSSL :: IO SSLContext
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
Expand Down

0 comments on commit 36411a4

Please sign in to comment.