1 {-# LANGUAGE DoAndIfThenElse #-}
6 import qualified Data.ByteString as B (hPut)
7 import qualified Data.Map as Map (Map, empty, insert)
18 import Network.Curl.Download (openURI)
19 import System.Directory (doesFileExist, getTemporaryDirectory)
20 import System.IO (hClose, hPutStrLn, stderr)
21 import System.IO.Temp (openBinaryTempFile, openTempFile)
23 import LWN.URI (URL, filename)
26 login_url = "https://lwn.net/login"
28 username_field :: String
29 username_field = "Username"
31 password_field :: String
32 password_field = "Password"
34 submit_field :: String
35 submit_field = "submit"
38 default_curl_opts :: [CurlOption]
40 [ -- The Global cache is not thread-friendly.
41 CurlDNSUseGlobalCache False,
43 -- And we don't want to use a DNS cache anyway.
44 CurlDNSCacheTimeout 0,
47 CurlFollowLocation True,
49 -- Give it a little time...
53 make_cookie_jar :: IO FilePath
55 temp_dir <- getTemporaryDirectory
56 let file_name_template = "lwn-epub-cookies.txt"
57 (out_path, out_handle) <- openTempFile temp_dir file_name_template
58 hClose out_handle -- We just want to create it for now.
61 get_page :: Maybe FilePath -> URL -> IO (Either String String)
62 get_page cookie_file url =
64 -- Create a curl instance.
67 -- Perform the request, and get back a CurlResponse object.
68 -- The cast is needed to specify how we would like our headers
69 -- and body returned (Strings).
70 resp <- do_curl_ curl url curl_opts :: IO CurlResponse
72 -- Pull out the response code as a CurlCode.
73 let code = respCurlCode resp
77 CurlOK -> Right (respBody resp)
78 error_code -> Left ("HTTP Error: " ++ (show error_code))
79 -- If an error occurred, we want to dump as much information as
80 -- possible. If this becomes a problem, we can use respGetInfo to
81 -- query the response object for more information
86 Just cookies -> [ CurlCookieFile cookies ]
88 curl_opts = default_curl_opts ++ get_opts
91 -- | Log in using curl. Store the resulting session cookies in the
93 log_in :: FilePath -> String -> String -> IO (Either String String)
94 log_in cookie_jar username password =
96 -- Create a curl instance.
99 -- Perform the request, and get back a CurlResponse object.
100 -- The cast is needed to specify how we would like our headers
101 -- and body returned (Strings).
102 resp <- do_curl_ curl login_url curl_opts :: IO CurlResponse
104 -- Pull out the response code as a CurlCode.
105 let code = respCurlCode resp
109 CurlOK -> Right (respBody resp)
110 error_code -> Left $ "HTTP Error: " ++ (show error_code)
111 -- If an error occurred, we want to dump as much information as
112 -- possible. If this becomes a problem, we can use respGetInfo to
113 -- query the response object for more information
115 post_submit :: String
116 post_submit = submit_field ++ "=Log+In"
118 post_username :: String
119 post_username = username_field ++ "=" ++ username
121 post_password :: String
122 post_password = password_field ++ "=" ++ password
124 post_data :: [String]
125 post_data = [post_username, post_password, post_submit]
127 post_opts :: [CurlOption]
129 [ CurlCookieSession True,
130 CurlCookieJar cookie_jar,
132 CurlPostFields post_data ]
134 curl_opts :: [CurlOption]
135 curl_opts = default_curl_opts ++ post_opts
138 -- | Save the image at 'url'. Saves to a temporary file, and
139 -- returns the path to that file if successful. Otherwise,
140 -- returns 'Nothing'.
142 -- We need to be able to parse the filename out of the URL
143 -- so that when we stick our image in the document, the reader
144 -- knows that type (jpg, png, etc.) it is.
145 save_image :: URL -> IO (Maybe FilePath)
147 it_exists <- doesFileExist url
149 -- It's local, just use it.
152 let fn = filename url
154 Nothing -> return Nothing
156 temp_dir <- getTemporaryDirectory
157 (out_path, out_handle) <- openBinaryTempFile temp_dir file
158 result <- openURI url
161 hPutStrLn stderr ("HTTP Error: " ++ err)
165 return $ Just out_path
170 -- | Map absolute image URLs to local system file paths where the
171 -- image referenced by the URL is stored.
172 type ImageMap = Map.Map URL FilePath
174 download_image_urls :: [URL] -> IO ImageMap
175 download_image_urls image_urls = do
176 files <- mapM save_image image_urls
177 let pairs = zip image_urls files
178 return $ foldl my_insert empty_map pairs
180 empty_map = Map.empty :: ImageMap
182 my_insert :: ImageMap -> (URL, Maybe FilePath) -> ImageMap
183 my_insert dict (_, Nothing) = dict
184 my_insert dict (k, Just v) = Map.insert k v dict