Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to handle TlsNotSupported and call an HTTPS URL with Network.HTTP.Client?

Tags:

http

ssl

haskell

I'm trying to call an API using Network.HTTP.Client and am trying to figure out how to properly handle a TlsNotSupported exception and call the API over SSL. There are no examples in the documentation and there are not (surprisingly) any examples I can find elsewhere on the web.

Here is my existing code:

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

Here's an example session:

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

Thanks in advance!

like image 795
dwlz Avatar asked Aug 25 '14 16:08

dwlz


1 Answers

You need to use http-client-tls. In particular, replace your usage of defaultManagerSettings with tlsManagerSettings.

like image 88
Michael Snoyman Avatar answered Oct 13 '22 20:10

Michael Snoyman