1 {-# LANGUAGE DoAndIfThenElse #-}
6 import qualified Data.ByteString as B (hPut)
19 import Network.Curl.Download (openURI)
20 import System.Directory (doesFileExist, getTemporaryDirectory)
21 import System.IO (hClose, hPutStrLn, stderr)
22 import System.IO.Temp (openBinaryTempFile, openTempFile)
24 import LWN.URI (filename)
26 login_url :: URLString
27 login_url = "https://lwn.net/login"
29 username_field :: String
30 username_field = "Username"
32 password_field :: String
33 password_field = "Password"
35 submit_field :: String
36 submit_field = "submit"
39 default_curl_opts :: [CurlOption]
41 [ -- The Global cache is not thread-friendly.
42 CurlDNSUseGlobalCache False,
44 -- And we don't want to use a DNS cache anyway.
45 CurlDNSCacheTimeout 0,
48 CurlFollowLocation True,
50 -- Give it a little time...
57 make_cookie_jar :: IO FilePath
59 temp_dir <- getTemporaryDirectory
60 let file_name_template = "lwn-epub-cookies.txt"
61 (out_path, out_handle) <- openTempFile temp_dir file_name_template
62 hClose out_handle -- We just want to create it for now.
65 get_page :: Maybe FilePath -> URLString -> IO (Either String String)
66 get_page cookie_file url =
68 -- Create a curl instance.
71 -- Perform the request, and get back a CurlResponse object.
72 -- The cast is needed to specify how we would like our headers
73 -- and body returned (Strings).
74 resp <- do_curl_ curl url curl_opts :: IO CurlResponse
76 -- Pull out the response code as a CurlCode.
77 let code = respCurlCode resp
81 CurlOK -> Right (respBody resp)
82 error_code -> Left ("HTTP Error: " ++ (show error_code))
83 -- If an error occurred, we want to dump as much information as
84 -- possible. If this becomes a problem, we can use respGetInfo to
85 -- query the response object for more information
90 Just cookies -> [ CurlCookieFile cookies ]
92 curl_opts = default_curl_opts ++ get_opts
95 -- | Log in using curl. Store the resulting session cookies in the
96 -- supplied file.Warning: This returns an error if the function
98 log_in :: FilePath -> String -> String -> IO (Maybe String)
99 log_in cookie_jar username password =
101 -- Create a curl instance.
104 -- Perform the request, and get back a CurlResponse object.
105 -- The cast is needed to specify how we would like our headers
106 -- and body returned (Strings).
107 resp <- do_curl_ curl login_url curl_opts :: IO CurlResponse
109 -- Pull out the response code as a CurlCode.
110 let code = respCurlCode resp
115 error_code -> Just $ "HTTP Error: " ++ (show error_code)
116 -- If an error occurred, we want to dump as much information as
117 -- possible. If this becomes a problem, we can use respGetInfo to
118 -- query the response object for more information
120 post_submit :: String
121 post_submit = submit_field ++ "=Log+In"
123 post_username :: String
124 post_username = username_field ++ "=" ++ username
126 post_password :: String
127 post_password = password_field ++ "=" ++ password
129 post_data :: [String]
130 post_data = [post_username, post_password, post_submit]
132 post_opts :: [CurlOption]
134 [ CurlCookieSession True,
135 CurlCookieJar cookie_jar,
137 CurlPostFields post_data ]
139 curl_opts :: [CurlOption]
140 curl_opts = default_curl_opts ++ post_opts
143 -- | Save the image at 'url'. Saves to a temporary file, and
144 -- returns the path to that file if successful. Otherwise,
145 -- returns 'Nothing'.
147 -- We need to be able to parse the filename out of the URL
148 -- so that when we stick our image in the document, the reader
149 -- knows that type (jpg, png, etc.) it is.
150 save_image :: URLString -> IO (Maybe FilePath)
152 it_exists <- doesFileExist url
154 -- It's local, just use it.
157 let fn = filename url
159 Nothing -> return Nothing
161 temp_dir <- getTemporaryDirectory
162 (out_path, out_handle) <- openBinaryTempFile temp_dir file
163 result <- openURI url
166 hPutStrLn stderr ("HTTP Error: " ++ err)
170 return $ Just out_path