{-# 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