{-# LANGUAGE DoAndIfThenElse #-}

module LWN.HTTP
where

import qualified Data.ByteString as B (hPut)

import Network.Curl (
  CurlCode(..),
  CurlOption(..),
  CurlResponse,
  URLString,
  do_curl_,
  initialize,
  respBody,
  respCurlCode,
  withCurlDo               
  )
import Network.Curl.Download (openURI)
import System.Directory (doesFileExist, getTemporaryDirectory)
import System.IO (hClose, hPutStrLn, stderr, stdout)
import System.IO.Temp (openBinaryTempFile, openTempFile)

import LWN.URI (filename)

login_url :: URLString
login_url = "https://lwn.net/login"

username_field :: String
username_field = "Username"

password_field :: String
password_field = "Password"

submit_field :: String
submit_field = "submit"


default_curl_opts :: [CurlOption]
default_curl_opts =
  [ -- The Global cache is not thread-friendly.
    CurlDNSUseGlobalCache False,
    
    -- And we don't want to use a DNS cache anyway.
    CurlDNSCacheTimeout 0,

    -- Follow redirects.
    CurlFollowLocation True,

    -- Give it a little time...
    CurlTimeout 45,

    -- For debugging.
    CurlVerbose True ]


make_cookie_jar :: IO FilePath
make_cookie_jar = do
  temp_dir <- getTemporaryDirectory
  let file_name_template = "lwn-epub-cookies.txt"
  (out_path, out_handle) <- openTempFile temp_dir file_name_template
  hClose out_handle -- We just want to create it for now.
  return out_path

get_page :: Maybe FilePath -> URLString -> IO (Maybe String)
get_page cookie_file url =
  withCurlDo $ do
    hPutStrLn stdout ("Getting page: " ++ url ++ "...")

    -- Create a curl instance.
    curl <- initialize

    -- Perform the request, and get back a CurlResponse object.
    -- The cast is needed to specify how we would like our headers
    -- and body returned (Strings).
    putStrLn "Curl options:"
    print curl_opts

    resp <- do_curl_ curl url curl_opts :: IO CurlResponse

    -- Pull out the response code as a CurlCode.
    let code = respCurlCode resp

    case code of
      CurlOK -> return $ Just (respBody resp)
      error_code -> do
        hPutStrLn stderr ("HTTP Error: " ++ (show error_code))
        -- If an error occurred, we want to dump as much information as
        -- possible. If this becomes a problem, we can use respGetInfo to
        -- query the response object for more information
        return Nothing
  where
    get_opts =
      case cookie_file of
        Nothing -> []
        Just cookies -> [ CurlCookieFile cookies ]

    curl_opts = default_curl_opts ++ get_opts


log_in :: FilePath -> String -> String -> IO Bool
log_in cookie_jar username password =
  withCurlDo $ do
    hPutStrLn stdout ("Logging " ++ username ++ " in...")

    -- Create a curl instance.
    curl <- initialize

    -- Perform the request, and get back a CurlResponse object.
    -- The cast is needed to specify how we would like our headers
    -- and body returned (Strings).
    resp <- do_curl_ curl login_url curl_opts :: IO CurlResponse

    -- Pull out the response code as a CurlCode.
    let code = respCurlCode resp

    case code of
      CurlOK -> return True
      error_code -> do
        hPutStrLn stderr ("HTTP Error: " ++ (show error_code))
        -- If an error occurred, we want to dump as much information as
        -- possible. If this becomes a problem, we can use respGetInfo to
        -- query the response object for more information
        return False
  where
    post_submit :: String
    post_submit = submit_field ++ "=Log+In"

    post_username :: String
    post_username = username_field ++ "=" ++ username

    post_password :: String
    post_password = password_field ++ "=" ++ password

    post_data :: [String]
    post_data = [post_username, post_password, post_submit]

    post_opts :: [CurlOption]
    post_opts =
      [ CurlCookieSession True,
        CurlCookieJar cookie_jar,
        CurlPost True,
        CurlPostFields post_data ]
        
    curl_opts :: [CurlOption]
    curl_opts = default_curl_opts ++ post_opts


-- | Save the image at 'url'. Saves to a temporary file, and
--   returns the path to that file if successful. Otherwise,
--   returns 'Nothing'.
--
--   We need to be able to parse the filename out of the URL
--   so that when we stick our image in the document, the reader
--   knows that type (jpg, png, etc.) it is.
save_image :: URLString -> IO (Maybe FilePath)
save_image url = do
  it_exists <- doesFileExist url
  if it_exists then do
    -- It's local, just use it.
    return $ Just url
  else do
    let fn = filename url
    case fn of
      Nothing -> return Nothing
      Just file -> do
        temp_dir <- getTemporaryDirectory
        (out_path, out_handle) <- openBinaryTempFile temp_dir file
        result <- openURI url
        case result of
          Left err -> do
            hPutStrLn stderr ("HTTP Error: " ++ err)
            return Nothing
          Right bs -> do
            B.hPut out_handle bs
            return $ Just out_path