Skip to content

Resolve #402: Use openssl in operational sample #410

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
phadej merged 1 commit into from
Oct 22, 2019
Merged

Resolve #402: Use openssl in operational sample #410

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
23 changes: 18 additions & 5 deletions samples/Operational/Operational.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
36 changes: 19 additions & 17 deletions samples/github-samples.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down