]> gitweb.michael.orlitzky.com - dead/lwn-epub.git/blobdiff - src/LWN/HTTP.hs
Move some IO out of the HTTP module.
[dead/lwn-epub.git] / src / LWN / HTTP.hs
index ea7174ad1e5b70d8ec9a6a9bc8b9ad3f0411fbba..1b6bcfd3c966a060ea326a06245f67811f66ba9a 100644 (file)
@@ -18,7 +18,7 @@ import Network.Curl (
   )
 import Network.Curl.Download (openURI)
 import System.Directory (doesFileExist, getTemporaryDirectory)
-import System.IO (hClose, hPutStrLn, stderr, stdout)
+import System.IO (hClose, hPutStrLn, stderr)
 import System.IO.Temp (openBinaryTempFile, openTempFile)
 
 import LWN.URI (filename)
@@ -62,33 +62,27 @@ make_cookie_jar = do
   hClose out_handle -- We just want to create it for now.
   return out_path
 
-get_page :: Maybe FilePath -> URLString -> IO (Maybe String)
+get_page :: Maybe FilePath -> URLString -> IO (Either String 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))
+    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_file of
@@ -98,11 +92,12 @@ get_page cookie_file url =
     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
-    hPutStrLn stdout ("Logging " ++ username ++ " in...")
-
     -- Create a curl instance.
     curl <- initialize
 
@@ -114,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"