From ed569c0a0adcddb95658a4ef88aa6db4d4145f98 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Sun, 10 Apr 2016 19:52:53 -0400
Subject: canProvision will not check TLS cert validity

---
 src/Network/ACME.hs | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

(limited to 'src')

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