X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FLWN%2FHTTP.hs;h=63079fd127aa853e6b69eef96588153dace02d30;hp=7da6ed1488d97114247091476c26b57ace5cc7d8;hb=fc0052e451aa03675ebd9a128dfa46573b9357d7;hpb=aad40cd8e1e8c84c5fc294674a7159bb40838440 diff --git a/src/LWN/HTTP.hs b/src/LWN/HTTP.hs index 7da6ed1..63079fd 100644 --- a/src/LWN/HTTP.hs +++ b/src/LWN/HTTP.hs @@ -5,7 +5,7 @@ where import qualified Data.ByteString as B (hPut) import qualified Data.Map as Map (Map, empty, insert) -import Data.Maybe (fromJust) +import Data.Maybe (fromJust, isNothing) import Network.Curl ( CurlCode(..), CurlOption(..), @@ -22,7 +22,7 @@ import System.IO (hClose, hPutStrLn, stderr) import qualified System.IO.UTF8 as Utf8 (readFile) import System.IO.Temp (openBinaryTempFile, openTempFile) -import qualified Configuration as C (Cfg, password, use_account, username) +import qualified Configuration as C (Cfg(..)) import LWN.Article (real_article_path) import LWN.URI (URL, filename) @@ -188,6 +188,29 @@ download_image_urls image_urls = do my_insert dict (k, Just v) = Map.insert k v dict + + + +get_login_cookie :: C.Cfg -> IO C.Cfg +get_login_cookie cfg + | isNothing (C.username cfg) = return cfg + | isNothing (C.password cfg) = return cfg + | otherwise = do + let uname = fromJust $ C.username cfg + let pword = fromJust $ C.password cfg + cj <- make_cookie_jar + li_result <- log_in cj uname pword + + case li_result of + Left err -> do + let msg = "Failed to log in. " ++ err + hPutStrLn stderr msg + Right response_body -> do + hPutStrLn stderr response_body + + return $ cfg { C.cookie_jar = Just cj } + + -- | Try to parse the given article using HXT. We try a few different -- methods; if none of them work, we return 'Nothing'. get_article_contents :: C.Cfg -> URL -> IO (Maybe String) @@ -200,33 +223,11 @@ get_article_contents cfg article_name = do return $ Just $ contents False -> do -- Download the URL and try to parse it. - if C.use_account cfg then do - -- use_account would be false if these fromJusts would fail. - cj <- make_cookie_jar - li_result <- log_in cj - (fromJust $ C.username cfg) - (fromJust $ C.password cfg) - - case li_result of - Left err -> do - let msg = "Failed to log in. " ++ err - hPutStrLn stderr msg - Right response_body -> do - hPutStrLn stderr response_body - - html <- get_page (Just cj) my_article - - case html of - Left err -> do - let msg = "Failed to retrieve page. " ++ err - hPutStrLn stderr msg - return Nothing - Right h -> return $ Just h - else do - html <- get_page Nothing my_article - case html of - Left err -> do - let msg = "Failed to retrieve page. " ++ err - hPutStrLn stderr msg - return Nothing - Right h -> return $ Just h + html <- get_page (C.cookie_jar cfg) my_article + + case html of + Left err -> do + let msg = "Failed to retrieve page. " ++ err + hPutStrLn stderr msg + return Nothing + Right h -> return $ Just h