Robb.re

Examining headers with http-conduit

Posted on July 31, 2015

In this simple case I was testing a service that performs geoip redirection to confirm if IP addresses for a known region were being redirected to the expected location. They were not.

I was using a fairly recent stackage nightly build (2015-07-05) but the newest version of http-conduit it had was 2.1.5 whereas the newest version (at the time of writing) is 2.1.7 which deprecates the withManager function I used.

{-# LANGUAGE OverloadedStrings #-}
module Lib
    ( examine
    ) where

import Network (withSocketsDo)
import Network.HTTP.Conduit
import Network.HTTP.Types
import Control.Monad
import qualified Data.ByteString as B
import Addresses (addresses)
import qualified Data.HashMap.Strict as M


getHeaders fwd = [
            ("X-Forwarded-proto", "https"),
            ("X-Forwarded-for", fwd),
            ("Host", "www.myspace.com") ]


addresses' = take 100 addresses


expectedLocation = "https://www.myspace.com"


getResponseHeaders :: B.ByteString -> IO ResponseHeaders
getResponseHeaders fwd = withSocketsDo $ do
    request' <- parseUrl "http://<some_ip>"
    let request = request' { requestHeaders = getHeaders fwd
                           , redirectCount = 0
                           , checkStatus = \_ _ _ -> Nothing}
    withManager $ \manager -> do
        response <- http request manager
        return $ responseHeaders response


examine :: IO ()
examine = do
    results <- forM addresses' getMatchingness
    forM_ (filter doesNotMatch results) $ \x -> print x
        where
            doesNotMatch (_, _, b) = not b
            convHeaders = M.lookupDefault "" "Location"
            getMatchingness url = do
                headers <- getResponseHeaders url
                let location = convHeaders $ M.fromList headers
                B.putStrLn url
                return (url, location, location == expectedLocation)

Examining headers with http-conduit