15 import System.IO (hPutStrLn, stderr)
17 login_url :: URLString
18 login_url = "https://lwn.net/login"
20 username_field :: String
21 username_field = "Username"
23 password_field :: String
24 password_field = "Password"
26 submit_field :: String
27 submit_field = "submit"
30 default_curl_opts :: [CurlOption]
32 [ -- The Global cache is not thread-friendly.
33 CurlDNSUseGlobalCache False,
35 -- And we don't want to use a DNS cache anyway.
36 CurlDNSCacheTimeout 0,
38 -- Give it a little time...
41 -- And let us know when things go wrong.
46 get_page :: Maybe FilePath -> URLString -> IO (Maybe String)
47 get_page cookie_jar url =
49 -- Create a curl instance.
52 -- Perform the request, and get back a CurlResponse object.
53 -- The cast is needed to specify how we would like our headers
54 -- and body returned (Strings).
55 resp <- do_curl_ curl login_url curl_opts :: IO CurlResponse
57 -- Pull out the response code as a CurlCode.
58 let code = respCurlCode resp
61 CurlOK -> return $ Just (respBody resp)
63 hPutStrLn stderr ("HTTP Error: " ++ (show error_code))
64 -- If an error occurred, we want to dump as much information as
65 -- possible. If this becomes a problem, we can use respGetInfo to
66 -- query the response object for more information
72 Just cookies -> [ CurlCookieJar cookies ]
74 curl_opts = default_curl_opts ++ get_opts
77 log_in :: FilePath -> String -> String -> IO Bool
78 log_in cookie_jar username password =
80 -- Create a curl instance.
83 -- Perform the request, and get back a CurlResponse object.
84 -- The cast is needed to specify how we would like our headers
85 -- and body returned (Strings).
86 resp <- do_curl_ curl login_url curl_opts :: IO CurlResponse
88 -- Pull out the response code as a CurlCode.
89 let code = respCurlCode resp
94 hPutStrLn stderr ("HTTP Error: " ++ (show error_code))
95 -- If an error occurred, we want to dump as much information as
96 -- possible. If this becomes a problem, we can use respGetInfo to
97 -- query the response object for more information
100 post_submit :: String
101 post_submit = submit_field ++ "=Log+In"
103 post_username :: String
104 post_username = username_field ++ "=" ++ username
106 post_password :: String
107 post_password = password_field ++ "=" ++ password
109 post_data :: [String]
110 post_data = [post_username, post_password]
112 post_opts :: [CurlOption]
114 [ CurlCookieSession True,
115 CurlCookieJar cookie_jar,
117 CurlPostFields post_data ]
119 curl_opts :: [CurlOption]
120 curl_opts = default_curl_opts ++ post_opts