-username_field :: String
-username_field = "Username"
-
-password_field :: String
-password_field = "Password"
-
-submit_field :: String
-submit_field = "submit"
-
-
-default_curl_opts :: [CurlOption]
-default_curl_opts =
- [ -- The Global cache is not thread-friendly.
- CurlDNSUseGlobalCache False,
-
- -- And we don't want to use a DNS cache anyway.
- CurlDNSCacheTimeout 0,
-
- -- Give it a little time...
- CurlTimeout 45,
-
- -- And let us know when things go wrong.
- CurlVerbose True ]
-
-
-make_cookie_jar :: IO FilePath
-make_cookie_jar = do
- temp_dir <- getTemporaryDirectory
- let file_name_template = "lwn-epub-cookies.txt"
- (out_path, out_handle) <- openTempFile temp_dir file_name_template
- hClose out_handle -- We just want to create it for now.
- return out_path
-
-get_page :: Maybe FilePath -> URLString -> IO (Maybe String)
-get_page cookie_jar url =
- withCurlDo $ do
- -- Create a curl instance.
- curl <- initialize
-
- -- Perform the request, and get back a CurlResponse object.
- -- The cast is needed to specify how we would like our headers
- -- and body returned (Strings).
- resp <- do_curl_ curl url curl_opts :: IO CurlResponse
-
- -- Pull out the response code as a CurlCode.
- let code = respCurlCode resp
-
- case code of
- CurlOK -> return $ Just (respBody resp)
- error_code -> do
- hPutStrLn stderr ("HTTP Error: " ++ (show error_code))
- -- If an error occurred, we want to dump as much information as
- -- possible. If this becomes a problem, we can use respGetInfo to
- -- query the response object for more information
- return Nothing
- where
- get_opts =
- case cookie_jar of
- Nothing -> []
- Just cookies -> [ CurlCookieJar cookies ]
-
- curl_opts = default_curl_opts ++ get_opts
-
-
-log_in :: FilePath -> String -> String -> IO Bool
-log_in cookie_jar username password =
- withCurlDo $ do
- -- Create a curl instance.
- curl <- initialize
-
- -- Perform the request, and get back a CurlResponse object.
- -- The cast is needed to specify how we would like our headers
- -- and body returned (Strings).
- resp <- do_curl_ curl login_url curl_opts :: IO CurlResponse
-
- -- Pull out the response code as a CurlCode.
- let code = respCurlCode resp
-
- case code of
- CurlOK -> return True
- error_code -> do
- hPutStrLn stderr ("HTTP Error: " ++ (show error_code))
- -- If an error occurred, we want to dump as much information as
- -- possible. If this becomes a problem, we can use respGetInfo to
- -- query the response object for more information
- return False
+username_field :: C.ByteString
+username_field = C.pack "Username"
+
+password_field :: C.ByteString
+password_field = C.pack "Password"
+
+submit_field :: C.ByteString
+submit_field = C.pack "submit"
+
+
+-- | Get the requested URL as a L.ByteString, or return the response
+-- as an error. Use the given cookie jar for the request.
+get_page :: CookieJar -> URL -> IO (Either LBSResponse L.ByteString)
+get_page cj url = do
+ init_req <- parseUrl url
+ let req' = init_req { checkStatus = \_ _ -> Nothing }
+ now <- getCurrentTime
+ let (req, _) = insertCookiesIntoRequest req' cj now
+ resp <- withManager $ httpLbs req
+
+ return $ if (responseStatus resp) == status200 then
+ Right (responseBody resp)
+ else
+ Left resp
+
+
+-- | Log in using curl. Store the resulting session cookies in the
+-- supplied file.
+log_in :: String -> String -> IO (Either LBSResponse CookieJar)
+log_in username password = do
+ init_req <- parseUrl login_url
+ let req' = init_req { method = methodPost,
+ checkStatus = \_ _ -> Nothing,
+ redirectCount = 0 }
+ let req = urlEncodedBody post_data req'
+
+ resp <- withManager $ httpLbs req
+
+ -- The login page redirects. If we follow it, we lose our cookies.
+ if (responseStatus resp) == status302 then do
+ now <- getCurrentTime
+ let (cj,_) = updateCookieJar resp req now C.cj_empty
+ return $ Right cj
+ else do
+ return $ Left resp
+