Merge pull request haskell-github#410 from phadej/issue-402-operational-sample

phadej · web-flow · commit 078c0926620d · 2019-10-22T19:35:52.000+03:00
Resolve haskell-github#402: Use openssl in operational sample
diff --git a/samples/Operational/Operational.hs b/samples/Operational/Operational.hs
@@ -7,11 +7,13 @@ import Common
 import Prelude ()
 
 import Control.Monad.Operational
-import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
-import Network.HTTP.Client        (Manager, newManager)
-import Network.HTTP.Client.TLS    (tlsManagerSettings)
+import Control.Monad.Trans.Except  (ExceptT (..), runExceptT)
+import Network.HTTP.Client         (Manager, newManager, ManagerSettings)
+import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL)
 
-import qualified GitHub as GH
+import qualified GitHub                   as GH
+import qualified OpenSSL.Session          as SSL
+import qualified OpenSSL.X509.SystemStore as SSL
 
 data R a where
     R :: FromJSON a => GH.Request 'GH.RA a -> R a
@@ -29,7 +31,7 @@ githubRequest :: FromJSON a => GH.Request 'GH.RA a -> GithubMonad a
 githubRequest = singleton . R
 
 main :: IO ()
-main = do
+main = withOpenSSL $ do
     manager <- newManager tlsManagerSettings
     auth' <- getAuth
     case auth' of
@@ -39,3 +41,14 @@ main = do
                 repo <- githubRequest $ GH.repositoryR "phadej" "github"
                 githubRequest $ GH.ownerInfoForR (GH.simpleOwnerLogin . GH.repoOwner $ repo)
             print owner
+
+tlsManagerSettings :: 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
diff --git a/samples/github-samples.cabal b/samples/github-samples.cabal
@@ -29,23 +29,25 @@ library
   exposed-modules:  Common
   default-language: Haskell2010
 
--- executable github-operational
---   main-is: Operational.hs
---   hs-source-dirs:
---       Operational
---   ghc-options: -Wall
---   build-depends:
---       base <5
---     , base-compat-batteries
---     , github
---     , text
---     , github-samples
---     , http-client
---     , http-client-tls
---     , operational
---     , transformers
---     , transformers-compat
---   default-language: Haskell2010
+executable github-operational
+  main-is:          Operational.hs
+  hs-source-dirs:   Operational
+  ghc-options:      -Wall -threaded
+  build-depends:
+    , base                   >=0 && <5
+    , base-compat-batteries
+    , github
+    , github-samples
+    , HsOpenSSL
+    , HsOpenSSL-x509-system
+    , http-client
+    , http-client-openssl
+    , operational
+    , text
+    , transformers
+    , transformers-compat
+
+  default-language: Haskell2010
 
 common deps
   default-language: Haskell2010
