{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wall #-}
-- | Re: cabal-install update fails going through a HTTP proxy
-- [hackage ticket #562]
--
-- See http://hackage.haskell.org/trac/hackage/ticket/562#comment:9
--
module Main where

import Network.HTTP.Proxy (fetchProxy)
import Network.HTTP (Request(..), Response(..), Header(..), RequestMethod(..),
                     HeaderName(..))
import Network.HTTP.Headers (lookupHeader)
import Network.Browser (browse, request, setProxy, setOutHandler, setErrHandler)
import Network.Stream (Result)

import System.Environment (getArgs)
import Network.URI (URI(..), parseURI)
import Distribution.Simple.Utils (warn, debug)
import Distribution.Verbosity (normal, {-deafening,-} Verbosity)
import Data.Maybe (fromMaybe)
import Control.Monad (when)

--- Problems (with downloading via a proxy) disappear once strict
--- ByteStrings are used.  Thus the fix is to remove `.Lazy' suffixes.

-- #define STRICT
#ifdef STRICT
import qualified Data.ByteString as BS
import Data.ByteString (ByteString)
#else
import qualified Data.ByteString.Lazy as BS
import Data.ByteString.Lazy (ByteString)
#endif

{-----------------------------------------------------------------------
vvv@takeshi:~/src$ time runhaskell proxy-POC.hs
Content-Length:   1200593
bytes downloaded: 2408
proxy-POC.hs: user error (sizes differ)

real    0m1.210s
user    0m0.556s
sys     0m0.052s
vvv@takeshi:~/src$ time runhaskell -DSTRICT proxy-POC.hs
Content-Length:   1200593
bytes downloaded: 1200593

real    0m17.956s
user    0m0.620s
sys     0m0.028s
-----------------------------------------------------------------------}

main :: IO ()
main = do
  args <- getArgs
  rsp  <- fetch $ (args ++ ["http://hackage.haskell.org/packages/archive/"
                            ++ "00-index.tar.gz"]) !! 0
  let lenHeader = fromMaybe "" $ lookupHeader HdrContentLength (rspHeaders rsp)
      lenBody   = show $ BS.length $ rspBody rsp
  report lenHeader lenBody

report :: String -> String -> IO ()
report hdr bdy = do
  when (avail hdr) (putStrLn $ "Content-Length:   " ++ hdr)
  putStrLn ("bytes downloaded: " ++ bdy)
  when (avail hdr && hdr /= bdy) (fail "sizes differ")
    where avail = not . null

fetch :: String -> IO (Response ByteString)
fetch s = do
  case parseURI s of
    Nothing -> fail ("fetch: unable to parse URI: " ++ s)
    Just u  -> do
            Right rsp <- getHTTP normal u
            return rsp

------------------------------------------------------------------------
-- The following functions are copied (with minimal changes) from
-- cabal-install's 'Distribution.Client.HttpUtils'.

-- |Carry out a GET request, using the local proxy settings
getHTTP :: Verbosity -> URI -> IO (Result (Response ByteString))
getHTTP verbosity uri = do
                 -- p   <- proxy verbosity
                 p <- fetchProxy False
                 let req = mkRequest uri
                 (_, resp) <-
                     browse $ do
                          setErrHandler (warn verbosity . ("http error: "++))
                          setOutHandler (debug verbosity)
                          setProxy p
                          request req
                 return (Right resp)

mkRequest :: URI -> Request ByteString
mkRequest uri = Request{ rqURI     = uri
                       , rqMethod  = GET
                       , rqHeaders = [Header HdrUserAgent userAgent]
                         ++ [Header HdrCacheControl "no-cache"] -- XXX *new*
                       , rqBody    = BS.empty }
  -- where userAgent = "cabal-install/" ++ display Paths_cabal_install.version
  where userAgent = "proxy-POC.hs"