Merge pull request haskell-github#378 from phadej/openssl

Add openssl flag

Author: phadej

cabal.project

@@ -10,3 +10,5 @@ constraints: semigroups ^>=0.19
 
 allow-newer: aeson-1.4.3.0:hashable
 allow-newer: aeson-1.4.3.0:semigroups
+
+constraints: github +openssl

github.cabal

@@ -47,6 +47,11 @@ source-repository head
   type:     git
   location: git://github.com/phadej/github.git
 
+flag openssl
+  description: "Use http-client-openssl"
+  manual:  True
+  default: False
+
 library
   default-language:   Haskell2010
   ghc-options:        -Wall
@@ -165,18 +170,26 @@ library
     , exceptions            >=0.10.2     && <0.11
     , hashable              >=1.2.7.0    && <1.4
     , http-client           >=0.5.12     && <0.7
-    , http-client-tls       >=0.3.5.3    && <0.4
     , http-link-header      >=1.0.3.1    && <1.1
     , http-types            >=0.12.3     && <0.13
     , iso8601-time          >=0.1.5      && <0.2
     , network-uri           >=2.6.1.0    && <2.7
-    , tagged
-    , tls                   >=1.4.1
+    , tagged                >=0.8.5      && <0.9
     , transformers-compat   >=0.6.5      && <0.7
     , unordered-containers  >=0.2.10.0   && <0.3
     , vector                >=0.12.0.1   && <0.13
     , vector-instances      >=3.4        && <3.5
 
+  if flag(openssl)
+    build-depends:
+        http-client-openssl   >=0.3.0.0   && <0.4
+      , HsOpenSSL             >=0.11.4.16 && <0.12
+      , HsOpenSSL-x509-system >=0.1.0.3   && <0.2
+  else
+    build-depends:
+        http-client-tls     >=0.3.5.3   && <0.4
+      , tls                 >=1.4.1
+
   if !impl(ghc >= 8.0)
     build-depends:
       semigroups            >=0.18.5     && <0.20
@@ -186,8 +199,8 @@ test-suite github-test
   type:               exitcode-stdio-1.0
   hs-source-dirs:     spec
   main-is:            Spec.hs
-  ghc-options:        -Wall
-  build-tool-depends: hspec-discover:hspec-discover >=2.6.1 && <2.8
+  ghc-options:        -Wall -threaded
+  build-tool-depends: hspec-discover:hspec-discover >=2.7.1 && <2.8
   other-extensions:   TemplateHaskell
   other-modules:
     GitHub.ActivitySpec

src/GitHub/Request.hs

@@ -74,7 +74,6 @@ import Network.HTTP.Client
        (HttpException (..), Manager, RequestBody (..), Response (..), getUri,
        httpLbs, method, newManager, redirectCount, requestBody, requestHeaders,
        setQueryString, setRequestIgnoreStatus)
-import Network.HTTP.Client.TLS  (tlsManagerSettings)
 import Network.HTTP.Link.Parser (parseLinkHeaderBS)
 import Network.HTTP.Link.Types  (Link (..), LinkParam (..), href, linkParams)
 import Network.HTTP.Types       (Method, RequestHeaders, Status (..))
@@ -88,18 +87,43 @@ import qualified Data.Vector                  as V
 import qualified Network.HTTP.Client          as HTTP
 import qualified Network.HTTP.Client.Internal as HTTP
 
+#ifdef MIN_VERSION_http_client_tls
+import Network.HTTP.Client.TLS  (tlsManagerSettings)
+#else
+import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL)
+
+import qualified OpenSSL.Session as SSL
+import qualified OpenSSL.X509.SystemStore as SSL
+#endif
+
 import GitHub.Auth              (Auth, AuthMethod, endpoint, setAuthRequest)
 import GitHub.Data              (Error (..))
 import GitHub.Data.PullRequests (MergeResult (..))
 import GitHub.Data.Request
 
+#ifdef MIN_VERSION_http_client_tls
+withOpenSSL :: IO a -> IO a
+withOpenSSL = id
+#else
+tlsManagerSettings :: HTTP.ManagerSettings
+tlsManagerSettings = opensslManagerSettings $ do
+    ctx <- SSL.context
+    SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2
+    SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3
+    SSL.contextAddOption ctx SSL.SSL_OP_NO_TLSv1
+    SSL.contextSetCiphers ctx "ECDHE-ECDSA-AES256-GCM-SHA384:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-CHACHA20-POLY1305:ECDHE-RSA-CHACHA20-POLY1305:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA256"
+    SSL.contextLoadSystemCerts ctx
+    SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing
+    return ctx
+#endif
+
 -- | Execute 'Request' in 'IO'
 executeRequest
     :: (AuthMethod am, ParseResponse mt a)
     => am
     -> GenRequest mt rw a
     -> IO (Either Error a)
-executeRequest auth req = do
+executeRequest auth req = withOpenSSL $ withOpenSSL $ do
     manager <- newManager tlsManagerSettings
     executeRequestWithMgr manager auth req
 
@@ -137,7 +161,7 @@ executeRequestWithMgr mgr auth req = runExceptT $ do
 
 -- | Like 'executeRequest' but without authentication.
 executeRequest' :: ParseResponse mt a => GenRequest mt 'RO a -> IO (Either Error a)
-executeRequest' req = do
+executeRequest' req = withOpenSSL $ do
     manager <- newManager tlsManagerSettings
     executeRequestWithMgr' manager req