From aa76db464725dace34b87f452f9ebb9675226e40 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Thu, 17 Jul 2014 15:28:13 -0400 Subject: [PATCH 1/1] Disable TLS certificate verification to make it more worky. --- halcyon.cabal | 2 ++ src/Mail.hs | 3 +-- src/Twitter/Http.hs | 26 ++++++++++++++++++++++++-- 3 files changed, 27 insertions(+), 4 deletions(-) diff --git a/halcyon.cabal b/halcyon.cabal index da45e30..ee35e16 100644 --- a/halcyon.cabal +++ b/halcyon.cabal @@ -20,6 +20,7 @@ executable halcyon base >= 4.6 && < 5, bytestring >= 0.10, cmdargs >= 0.10.5, + connection >= 0.2.1, configurator >= 0.2, directory >= 1.2, filepath >= 1.3, @@ -83,6 +84,7 @@ test-suite testsuite base >= 4.6 && < 5, bytestring >= 0.10, cmdargs >= 0.10.5, + connection >= 0.2.1, configurator >= 0.2, directory >= 1.2, filepath >= 1.3, diff --git a/src/Mail.hs b/src/Mail.hs index 3faa789..dcb686c 100644 --- a/src/Mail.hs +++ b/src/Mail.hs @@ -10,7 +10,6 @@ where import Control.Concurrent ( forkIO, newEmptyMVar, putMVar, readMVar ) import Control.Exception ( evaluate ) import Control.Monad ( liftM ) -import Data.List ( intercalate ) import Data.Time ( formatTime, getZonedTime ) import System.Console.CmdArgs.Default ( Default(..) ) import System.Exit ( ExitCode(..) ) @@ -81,7 +80,7 @@ to_rfc822 m = formatted_headers = if null (headers m) then "" - else (intercalate "\n" (headers m)) ++ "\n" + else unlines (headers m) diff --git a/src/Twitter/Http.hs b/src/Twitter/Http.hs index 21e47ba..6862ffc 100644 --- a/src/Twitter/Http.hs +++ b/src/Twitter/Http.hs @@ -6,12 +6,14 @@ where import qualified Data.ByteString.Lazy as B ( ByteString ) import qualified Data.ByteString.Char8 as BC ( pack ) +import Network.Connection ( TLSSettings(..) ) import Network.HTTP.Client ( + ManagerSettings, httpLbs, newManager, parseUrl, responseBody ) -import Network.HTTP.Client.TLS ( tlsManagerSettings ) +import Network.HTTP.Client.TLS ( mkManagerSettings ) import Web.Authenticate.OAuth ( OAuth(..), Credential, @@ -74,12 +76,32 @@ get_user_new_statuses cfg username last_status_id = do http_get cfg uri +-- | The default 'tlsManagerSettings' attempts to verify the +-- certificate that we get from the server, but it's quite pointless +-- for our purposes. +-- +-- The default 'tlsManagerSettings' is constructed is like, +-- +-- tlsManagerSettings = mkManagerSettings def Nothing +-- +-- and the 'def' passes in a 'TLSSettings' from +-- \"Network.Connection\". By constructing our own 'TLSSettings', we +-- can disable the certificate validation. +-- +novalidate_tls_manager_settings :: ManagerSettings +novalidate_tls_manager_settings = + mkManagerSettings mytls Nothing + where + -- The first field is "disable validation" + mytls = TLSSettingsSimple True False False + + -- | Retrieve a URL, or crash. The request is signed using all of the -- OAuth junk contained in the configuration. -- http_get :: Cfg -> String -> IO B.ByteString http_get cfg url = do - manager <- newManager tlsManagerSettings + manager <- newManager novalidate_tls_manager_settings request <- parseUrl url signed_request <- signOAuth oauth credential request response <- httpLbs signed_request manager -- 2.43.2