4 import qualified Data.ByteString as B (hPut)
16 import Network.Curl.Download (openURI)
17 import System.Directory (getTemporaryDirectory)
18 import System.IO (hPutStrLn, stderr)
19 import System.IO.Temp (openBinaryTempFile)
21 import LWN.URI (filename)
23 login_url :: URLString
24 login_url = "https://lwn.net/login"
26 username_field :: String
27 username_field = "Username"
29 password_field :: String
30 password_field = "Password"
32 submit_field :: String
33 submit_field = "submit"
36 default_curl_opts :: [CurlOption]
38 [ -- The Global cache is not thread-friendly.
39 CurlDNSUseGlobalCache False,
41 -- And we don't want to use a DNS cache anyway.
42 CurlDNSCacheTimeout 0,
44 -- Give it a little time...
47 -- And let us know when things go wrong.
52 get_page :: Maybe FilePath -> URLString -> IO (Maybe String)
53 get_page cookie_jar url =
55 -- Create a curl instance.
58 -- Perform the request, and get back a CurlResponse object.
59 -- The cast is needed to specify how we would like our headers
60 -- and body returned (Strings).
61 resp <- do_curl_ curl login_url curl_opts :: IO CurlResponse
63 -- Pull out the response code as a CurlCode.
64 let code = respCurlCode resp
67 CurlOK -> return $ Just (respBody resp)
69 hPutStrLn stderr ("HTTP Error: " ++ (show error_code))
70 -- If an error occurred, we want to dump as much information as
71 -- possible. If this becomes a problem, we can use respGetInfo to
72 -- query the response object for more information
78 Just cookies -> [ CurlCookieJar cookies ]
80 curl_opts = default_curl_opts ++ get_opts
83 log_in :: FilePath -> String -> String -> IO Bool
84 log_in cookie_jar username password =
86 -- Create a curl instance.
89 -- Perform the request, and get back a CurlResponse object.
90 -- The cast is needed to specify how we would like our headers
91 -- and body returned (Strings).
92 resp <- do_curl_ curl login_url curl_opts :: IO CurlResponse
94 -- Pull out the response code as a CurlCode.
95 let code = respCurlCode resp
100 hPutStrLn stderr ("HTTP Error: " ++ (show error_code))
101 -- If an error occurred, we want to dump as much information as
102 -- possible. If this becomes a problem, we can use respGetInfo to
103 -- query the response object for more information
106 post_submit :: String
107 post_submit = submit_field ++ "=Log+In"
109 post_username :: String
110 post_username = username_field ++ "=" ++ username
112 post_password :: String
113 post_password = password_field ++ "=" ++ password
115 post_data :: [String]
116 post_data = [post_username, post_password]
118 post_opts :: [CurlOption]
120 [ CurlCookieSession True,
121 CurlCookieJar cookie_jar,
123 CurlPostFields post_data ]
125 curl_opts :: [CurlOption]
126 curl_opts = default_curl_opts ++ post_opts
129 -- | Save the image at 'url'. Saves to a temporary file, and
130 -- returns the path to that file if successful. Otherwise,
131 -- returns 'Nothing'.
133 -- We need to be able to parse the filename out of the URL
134 -- so that when we stick our image in the document, the reader
135 -- knows that type (jpg, png, etc.) it is.
136 save_image :: URLString -> IO (Maybe FilePath)
138 let fn = filename url
140 Nothing -> return Nothing
142 temp_dir <- getTemporaryDirectory
143 (out_path, out_handle) <- openBinaryTempFile temp_dir file
144 result <- openURI url
147 hPutStrLn stderr ("HTTP Error: " ++ err)
151 return $ Just out_path