aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Class
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Class')
-rw-r--r--src/Text/Pandoc/Class/CommonState.hs3
-rw-r--r--src/Text/Pandoc/Class/PandocIO.hs6
-rw-r--r--src/Text/Pandoc/Class/PandocMonad.hs5
3 files changed, 12 insertions, 2 deletions
diff --git a/src/Text/Pandoc/Class/CommonState.hs b/src/Text/Pandoc/Class/CommonState.hs
index 4a0f66859..7e1735c2b 100644
--- a/src/Text/Pandoc/Class/CommonState.hs
+++ b/src/Text/Pandoc/Class/CommonState.hs
@@ -37,6 +37,8 @@ data CommonState = CommonState
-- ^ Absolute URL + dir of 1st source file
, stRequestHeaders :: [(Text, Text)]
-- ^ Headers to add for HTTP requests
+ , stNoCheckCertificate :: Bool
+ -- ^ Controls whether certificate validation is disabled
, stMediaBag :: MediaBag
-- ^ Media parsed from binary containers
, stTranslations :: Maybe (Lang, Maybe Translations)
@@ -67,6 +69,7 @@ defaultCommonState = CommonState
, stUserDataDir = Nothing
, stSourceURL = Nothing
, stRequestHeaders = []
+ , stNoCheckCertificate = False
, stMediaBag = mempty
, stTranslations = Nothing
, stInputFiles = []
diff --git a/src/Text/Pandoc/Class/PandocIO.hs b/src/Text/Pandoc/Class/PandocIO.hs
index 1cbfd680e..ee6a041ba 100644
--- a/src/Text/Pandoc/Class/PandocIO.hs
+++ b/src/Text/Pandoc/Class/PandocIO.hs
@@ -54,7 +54,8 @@ import Network.HTTP.Client
(httpLbs, responseBody, responseHeaders,
Request(port, host, requestHeaders), parseRequest, newManager)
import Network.HTTP.Client.Internal (addProxy)
-import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Network.HTTP.Client.TLS (mkManagerSettings)
+import Network.Connection (TLSSettings (..))
import Network.HTTP.Types.Header ( hContentType )
import Network.Socket (withSocketsDo)
import Network.URI ( unEscapeString )
@@ -139,6 +140,7 @@ instance PandocMonad PandocIO where
| otherwise = do
let toReqHeader (n, v) = (CI.mk (UTF8.fromText n), UTF8.fromText v)
customHeaders <- map toReqHeader <$> getsCommonState stRequestHeaders
+ disableCertificateValidation <- getsCommonState stNoCheckCertificate
report $ Fetching u
res <- liftIO $ E.try $ withSocketsDo $ do
let parseReq = parseRequest
@@ -149,7 +151,7 @@ instance PandocMonad PandocIO where
return (addProxy (host r) (port r) x)
req <- parseReq (T.unpack u) >>= addProxy'
let req' = req{requestHeaders = customHeaders ++ requestHeaders req}
- resp <- newManager tlsManagerSettings >>= httpLbs req'
+ resp <- newManager (mkManagerSettings (TLSSettingsSimple disableCertificateValidation False False) Nothing) >>= httpLbs req'
return (B.concat $ toChunks $ responseBody resp,
UTF8.toText `fmap` lookup hContentType (responseHeaders resp))
diff --git a/src/Text/Pandoc/Class/PandocMonad.hs b/src/Text/Pandoc/Class/PandocMonad.hs
index 8229668e7..991aeed41 100644
--- a/src/Text/Pandoc/Class/PandocMonad.hs
+++ b/src/Text/Pandoc/Class/PandocMonad.hs
@@ -27,6 +27,7 @@ module Text.Pandoc.Class.PandocMonad
, report
, setTrace
, setRequestHeader
+ , setNoCheckCertificate
, getLog
, setVerbosity
, getVerbosity
@@ -189,6 +190,10 @@ setRequestHeader name val = modifyCommonState $ \st ->
st{ stRequestHeaders =
(name, val) : filter (\(n,_) -> n /= name) (stRequestHeaders st) }
+-- | Determine whether certificate validation is disabled
+setNoCheckCertificate :: PandocMonad m => Bool -> m ()
+setNoCheckCertificate noCheckCertificate = modifyCommonState $ \st -> st{stNoCheckCertificate = noCheckCertificate}
+
-- | Initialize the media bag.
setMediaBag :: PandocMonad m => MediaBag -> m ()
setMediaBag mb = modifyCommonState $ \st -> st{stMediaBag = mb}