http - 如何处理 TlsNotSupported 并使用 Network.HTTP.Client 调用 HTTPS URL？

Question

我正在尝试使用 Network.HTTP.Client 调用 API，并试图找出如何正确处理 TlsNotSupported 异常并通过 SSL 调用 API。 documentation 中没有示例而且我在网络上的其他地方找不到(令人惊讶的)任何示例。

这是我现有的代码:

module Main where

import Network.URL
import qualified Network.URI as URI
import qualified Network.HTTP as HTTP
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Base64 as B64
import qualified Network.HTTP.Client as HTTPClient
import qualified Network.HTTP.Types.Header as HTTPHeaders
import qualified Data.ByteString.Char8 as C
import qualified Network.HTTP.Types.Status as HTTPStatus

import qualified Data.Text as T
import qualified Control.Exception as E
import qualified Data.Text.Encoding as TE

import Data.Aeson
import Control.Applicative ((<*>), (<$>), pure)
import Control.Monad (mzero)

data Bookmark = Bookmark {
    url :: T.Text,
    title :: Maybe T.Text
} deriving Show

data Note = Note {
    author :: T.Text,
    text :: T.Text
} deriving Show

instance FromJSON Bookmark where
    parseJSON (Object v) = Bookmark <$>
        v .: T.pack "href" <*>
        v .: T.pack "description"

    parseJSON _ = mzero

b64Encode :: String -> String
b64Encode = T.unpack . TE.decodeUtf8 . B64.encode . TE.encodeUtf8 . T.pack

basicAuthHeader :: String -> String -> String
basicAuthHeader username password = "Authorization: " ++
    b64Encode (username ++ ":" ++ username)

postsURL token = "https://api.pinboard.in/posts/all?format=json&auth_token=" ++ token

parse :: BS.ByteString -> Maybe [Bookmark]
parse response = decode (LBS.fromStrict response)

transform = LBS.fromStrict . C.pack

errorHandler :: HTTPClient.HttpException -> IO (Maybe a)
errorHandler (HTTPClient.StatusCodeException status _ _) = return Nothing
errorHandler (HTTPClient.InvalidUrlException _ _) = return Nothing
errorHandler (HTTPClient.HttpParserException _) = return Nothing
errorHandler e = do
    case e of
         HTTPClient.TlsNotSupported -> (putStrLn $ "Bummer. " ++ show e) >> return Nothing

main = do
    putStrLn "Enter auth token: "
    token <- getLine
    manager <- HTTPClient.newManager HTTPClient.defaultManagerSettings
    request <- HTTPClient.parseUrl $ postsURL token
    putStrLn $ "Calling " ++ postsURL token
    response <- (Just <$> HTTPClient.httpLbs request manager) `E.catch` errorHandler
    return ()

这是一个示例 session :

$ runhaskell Pinboard.hs
Enter auth token:
blah
Calling https://api.pinboard.in/posts/all?format=json&auth_token=asd
Bummer. TlsNotSupported

提前致谢!

Answer 1

您需要使用 http-client-tls .特别是，将 defaultManagerSettings 的用法替换为 tlsManagerSettings .