Attempt to implement article downloading.
[dead/lwn-epub.git] / src / LWN / HTTP.hs
1 {-# LANGUAGE DoAndIfThenElse #-}
2
3 module LWN.HTTP
4 where
5
6 import qualified Data.ByteString as B (hPut)
7
8 import Network.Curl (
9 CurlCode(..),
10 CurlOption(..),
11 CurlResponse,
12 URLString,
13 do_curl_,
14 initialize,
15 respBody,
16 respCurlCode,
17 withCurlDo
18 )
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)
23
24 import LWN.URI (filename)
25
26 login_url :: URLString
27 login_url = "https://lwn.net/login"
28
29 username_field :: String
30 username_field = "Username"
31
32 password_field :: String
33 password_field = "Password"
34
35 submit_field :: String
36 submit_field = "submit"
37
38
39 default_curl_opts :: [CurlOption]
40 default_curl_opts =
41 [ -- The Global cache is not thread-friendly.
42 CurlDNSUseGlobalCache False,
43
44 -- And we don't want to use a DNS cache anyway.
45 CurlDNSCacheTimeout 0,
46
47 -- Give it a little time...
48 CurlTimeout 45,
49
50 -- And let us know when things go wrong.
51 CurlVerbose True ]
52
53
54 make_cookie_jar :: IO FilePath
55 make_cookie_jar = do
56 temp_dir <- getTemporaryDirectory
57 let file_name_template = "lwn-epub-cookies.txt"
58 (out_path, out_handle) <- openTempFile temp_dir file_name_template
59 hClose out_handle -- We just want to create it for now.
60 return out_path
61
62 get_page :: Maybe FilePath -> URLString -> IO (Maybe String)
63 get_page cookie_jar url =
64 withCurlDo $ do
65 -- Create a curl instance.
66 curl <- initialize
67
68 -- Perform the request, and get back a CurlResponse object.
69 -- The cast is needed to specify how we would like our headers
70 -- and body returned (Strings).
71 resp <- do_curl_ curl url curl_opts :: IO CurlResponse
72
73 -- Pull out the response code as a CurlCode.
74 let code = respCurlCode resp
75
76 case code of
77 CurlOK -> return $ Just (respBody resp)
78 error_code -> do
79 hPutStrLn stderr ("HTTP Error: " ++ (show error_code))
80 -- If an error occurred, we want to dump as much information as
81 -- possible. If this becomes a problem, we can use respGetInfo to
82 -- query the response object for more information
83 return Nothing
84 where
85 get_opts =
86 case cookie_jar of
87 Nothing -> []
88 Just cookies -> [ CurlCookieJar cookies ]
89
90 curl_opts = default_curl_opts ++ get_opts
91
92
93 log_in :: FilePath -> String -> String -> IO Bool
94 log_in cookie_jar username password =
95 withCurlDo $ do
96 -- Create a curl instance.
97 curl <- initialize
98
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
103
104 -- Pull out the response code as a CurlCode.
105 let code = respCurlCode resp
106
107 case code of
108 CurlOK -> return True
109 error_code -> do
110 hPutStrLn stderr ("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
114 return False
115 where
116 post_submit :: String
117 post_submit = submit_field ++ "=Log+In"
118
119 post_username :: String
120 post_username = username_field ++ "=" ++ username
121
122 post_password :: String
123 post_password = password_field ++ "=" ++ password
124
125 post_data :: [String]
126 post_data = [post_username, post_password, post_submit]
127
128 post_opts :: [CurlOption]
129 post_opts =
130 [ CurlCookieSession True,
131 CurlCookieJar cookie_jar,
132 CurlPost True,
133 CurlPostFields post_data ]
134
135 curl_opts :: [CurlOption]
136 curl_opts = default_curl_opts ++ post_opts
137
138
139 -- | Save the image at 'url'. Saves to a temporary file, and
140 -- returns the path to that file if successful. Otherwise,
141 -- returns 'Nothing'.
142 --
143 -- We need to be able to parse the filename out of the URL
144 -- so that when we stick our image in the document, the reader
145 -- knows that type (jpg, png, etc.) it is.
146 save_image :: URLString -> IO (Maybe FilePath)
147 save_image url = do
148 it_exists <- doesFileExist url
149 if it_exists then do
150 -- It's local, just use it.
151 return $ Just url
152 else do
153 let fn = filename url
154 case fn of
155 Nothing -> return Nothing
156 Just file -> do
157 temp_dir <- getTemporaryDirectory
158 (out_path, out_handle) <- openBinaryTempFile temp_dir file
159 result <- openURI url
160 case result of
161 Left err -> do
162 hPutStrLn stderr ("HTTP Error: " ++ err)
163 return Nothing
164 Right bs -> do
165 B.hPut out_handle bs
166 return $ Just out_path