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

Question

我正在尝试使用Network.HTTP.Client调用API,并试图找出如何正确处理TlsNotSupported异常并通过SSL调用API.文档中没有示例,也没有(令人惊讶的)我可以在网络上找到的任何示例.

这是我现有的代码:

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 ()

这是一个示例会话:

$ 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替换你的用法.