    {-# OPTIONS_GHC -cpp #-}
    {-# LANGUAGE CPP #-}

    module HTTP( fetchUrl, postUrl, request_url, wait_next_url ) where

    import Darcs.Global ( debugFail )

    #ifdef HAVE_HTTP
    import Control.Monad ( when )
    import Data.IORef ( newIORef, readIORef, writeIORef, IORef )
    import Network.HTTP
    import Network.URI
    import System.Environment ( getEnv )
    import System.IO.Error ( ioeGetErrorString )
    import System.IO.Unsafe ( unsafePerformIO )
    import Darcs.Global ( debugMessage )
    import qualified Data.ByteString as B
    import qualified Data.ByteString.Char8 as BC
    #endif

    fetchUrl :: String -> IO String
    postUrl
        :: String     -- ^ url
        -> String     -- ^ body
        -> String     -- ^ mime type
        -> IO ()  -- ^ result

    request_url :: String -> FilePath -> a -> IO String
    wait_next_url :: IO (String, String)

    #ifdef HAVE_HTTP

    headers :: [Header]
    headers =  [Header HdrUserAgent $ "darcs-HTTP/" ++ PACKAGE_VERSION]

    fetchUrl url = case parseURI url of
        Nothing -> fail $ "Invalid URI: " ++ url
        Just uri -> do debugMessage $ "Fetching over HTTP:  "++url
                       proxy <- getProxy
                       when (not $ null proxy) $
                         debugFail "No proxy support for HTTP package yet (try libcurl)!"
                       resp <- simpleHTTP $ Request { rqURI = uri,
                                                      rqMethod = GET,
                                                      rqHeaders = headers,
                                                      rqBody = "" }
                       case resp of
                         Right res@Response { rspCode = (2,0,0) } -> return (rspBody res)
                         Right Response { rspCode = (x,y,z) } ->
                             debugFail $ "HTTP " ++ show x ++ show y ++ show z ++ " error getting " ++ show uri
                         Left err -> debugFail $ show err

    postUrl url body mime = case parseURI url of
        Nothing -> fail $ "Invalid URI: " ++ url
        Just uri -> do debugMessage $ "Posting to HTTP:  "++url
                       proxy <- getProxy
                       when (not $ null proxy) $
                         debugFail "No proxy support for HTTP package yet (try libcurl)!"
                       resp <- simpleHTTP $ Request { rqURI = uri,
                                                      rqMethod = POST,
                                                      rqHeaders = headers ++ [Header HdrContentType mime,
                                                                              Header HdrAccept "text/plain",
                                                                              Header HdrContentLength
                                                                                         (show $ length body) ],
                                                      rqBody = body }
                       case resp of
                         Right res@Response { rspCode = (2,y,z) } -> do
                            putStrLn $ "Success 2" ++ show y ++ show z
                            putStrLn (rspBody res)
                            return ()
                         Right res@Response { rspCode = (x,y,z) } -> do
                            putStrLn $ rspBody res
                            debugFail $ "HTTP " ++ show x ++ show y ++ show z ++ " error posting to " ++ show uri
                         Left err -> debugFail $ show err

    requestedUrl :: IORef (String, FilePath)
    requestedUrl = unsafePerformIO $ newIORef ("", "")

    request_url u f _ = do
      (u', _) <- readIORef requestedUrl
      if null u'
         then do writeIORef requestedUrl (u, f)
                 return ""
         else return "URL already requested"

    wait_next_url = do
      (u, f) <- readIORef requestedUrl
      if null u
         then return ("", "No URL requested")
         else do writeIORef requestedUrl ("", "")
                 e <- (fetchUrl u >>= \s -> B.writeFile f (BC.pack s) >> return "") `catch` h
                 return (u, e)
        where h = return . ioeGetErrorString

    getProxy :: IO String
    getProxy =
      getEnv "http_proxy"
      `catch` \_ -> getEnv "HTTP_PROXY"
      `catch` \_ -> return ""
    #else

    fetchUrl _ = debugFail "Network.HTTP does not exist"
    postUrl _ _ _ = debugFail "Cannot use http POST because darcs was not compiled with Network.HTTP."

    request_url _ _ _ = debugFail "Network.HTTP does not exist"
    wait_next_url = debugFail "Network.HTTP does not exist"

    #endif