Move some IO out of the HTTP module.

[dead/lwn-epub.git] / src / LWN / HTTP.hs

diff --git a/src/LWN/HTTP.hs b/src/LWN/HTTP.hs
index 743a99c8fa0fb98429a114e13e621e074b5b825d..1b6bcfd3c966a060ea326a06245f67811f66ba9a 100644 (file)
--- a/src/LWN/HTTP.hs
+++ b/src/LWN/HTTP.hs
@@ -14,12 +14,12 @@ import Network.Curl (
   initialize,
   respBody,
   respCurlCode,
-  withCurlDo               
+  withCurlDo
   )
 import Network.Curl.Download (openURI)
 import System.Directory (doesFileExist, getTemporaryDirectory)
-import System.IO (hPutStrLn, stderr)
-import System.IO.Temp (openBinaryTempFile)
+import System.IO (hClose, hPutStrLn, stderr)
+import System.IO.Temp (openBinaryTempFile, openTempFile)
 
 import LWN.URI (filename)
 
@@ -44,16 +44,26 @@ default_curl_opts =
     -- And we don't want to use a DNS cache anyway.
     CurlDNSCacheTimeout 0,
 
+    -- Follow redirects.
+    CurlFollowLocation True,
+
     -- Give it a little time...
     CurlTimeout 45,
 
-    -- And let us know when things go wrong.
+    -- 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_jar url =
+get_page :: Maybe FilePath -> URLString -> IO (Either String String)
+get_page cookie_file url =
   withCurlDo $ do
     -- Create a curl instance.
     curl <- initialize
@@ -66,24 +76,26 @@ get_page cookie_jar url =
     -- 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))
+    return $
+      case code of
+        CurlOK -> Right (respBody resp)
+        error_code -> Left ("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_jar of
+      case cookie_file of
         Nothing -> []
-        Just cookies -> [ CurlCookieJar cookies ]
+        Just cookies -> [ CurlCookieFile cookies ]
 
     curl_opts = default_curl_opts ++ get_opts
 
 
-log_in :: FilePath -> String -> String -> IO Bool
+-- | Log in using curl. Store the resulting session cookies in the
+--   supplied file.Warning: This returns an error if the function
+--   fails!
+log_in :: FilePath -> String -> String -> IO (Maybe String)
 log_in cookie_jar username password =
   withCurlDo $ do
     -- Create a curl instance.
@@ -97,14 +109,13 @@ log_in cookie_jar username password =
     -- 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))
+    return $
+      case code of
+        CurlOK -> Nothing
+        error_code -> Just $ "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"