From ed569c0a0adcddb95658a4ef88aa6db4d4145f98 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Sun, 10 Apr 2016 19:52:53 -0400 Subject: canProvision will not check TLS cert validity --- acme-certify.cabal | 2 +- src/Network/ACME.hs | 18 +++++++++++++++++- 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/acme-certify.cabal b/acme-certify.cabal index 364e269..ac6427a 100644 --- a/acme-certify.cabal +++ b/acme-certify.cabal @@ -18,7 +18,7 @@ library cryptonite, aeson, bytestring, base64-bytestring, SHA, mtl, text, HsOpenSSL, wreq, lens, lens-aeson, time, email-validate, pipes, directory, network-uri, errors, - resourcet, file-embed + resourcet, file-embed, http-conduit, connection default-language: Haskell2010 executable acme diff --git a/src/Network/ACME.hs b/src/Network/ACME.hs index 97e6e10..4b96afc 100644 --- a/src/Network/ACME.hs +++ b/src/Network/ACME.hs @@ -31,6 +31,9 @@ import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Time.Clock.POSIX (getPOSIXTime) import Network.ACME.Encoding +import Network.Connection +import Network.HTTP.Conduit (Manager, mkManagerSettings, + newManager) import Network.URI import Network.Wreq (Response, checkStatus, defaults, responseBody, responseHeader, @@ -120,11 +123,24 @@ ensureWritableDir file name = do canProvision :: DomainName -> HttpProvisioner -> IO Bool canProvision domain provision = do token <- (".test." ++) . show <$> getPOSIXTime + clientManager <- noSSLVerifyManager + let opts = defaults & W.manager .~ Right clientManager r <- runResourceT $ do provision (fromString token) (fromString token) - liftIO $ W.get $ show $ acmeChallengeURI domain (fromString token) + liftIO $ W.getWith opts $ show $ acmeChallengeURI domain (fromString token) return $ r ^. responseBody == fromString token +-- From http://stackoverflow.com/questions/21310690/ +-- disable-ssl-tls-certificate-validation-in-network-http-conduit/21310691#21310691 +noSSLVerifyManager :: IO Manager +noSSLVerifyManager = newManager $ mkManagerSettings tlsSettings Nothing + where + tlsSettings = TLSSettingsSimple + { settingDisableCertificateValidation = True + , settingDisableSession = False + , settingUseServerName = True + } + canProvisionDir :: WritableDir -> DomainName -> IO Bool canProvisionDir challengeDir domain = canProvision domain (provisionViaFile challengeDir) -- cgit v1.2.3