KCLDwST7

1-- OAuth Request 生成
2oauthRequest :: OAuth -> String -> String -> [Parameter] -> IO String
3oauthRequest oauth url token parameter = do
4  timestamp <- show . (\(TOD i _) -> i) <$> getClockTime -- タイムスタンプ取得
5  nonce <- show <$> randomRIO (0, maxBound::Int) -- 乱数取得
6  let authorizationParameters_ = parameter ++ [
7                                          ("oauth_consumer_key", consumerKey oauth),
8                                          ("oauth_nonce", nonce),
9                                          ("oauth_timestamp", timestamp),
10                                          ("oauth_signature_method", "HMAC-SHA1"),
11                                          ("oauth_version", "1.0")
12                                         ] -- 各種基本パラメータをセット
13      signature = genSignature (consumerSecret oauth) token POST url authorizationParameters_ -- 署名生成
14      authorizationParameters = authorizationParameters_++[("oauth_signature", signature)] -- 署名をパラメータに加える
15      authorizationHeader = ("Authorization: OAuth "++) . urlEncodeParams $ authorizationParameters -- Authorizationヘッダ生成
16      contentLengthHeader = "Content-Length: 0"
17  -- Curlインスタンス初期化
18  curl <- initialize
19  -- Requestを送信
20  setopts curl [CurlHttpHeaders [authorizationHeader, contentLengthHeader],
21                CurlPostFieldSize 0,
22                CurlPost True]
23  respBody <$> (do_curl_ curl url [] :: IO (CurlResponse_ [(String, String)] String))
24
25-- APIリクエスト
26apiRequest :: OAuth -> String -> RequestMethod -> [Parameter] -> IO String
27apiRequest oauth api method args = do
28  let url = apiRequestURL api
29      accessurl = if method == POST then url else url ++ "?" ++ urlEncodeVars args  -- URI
30  timestamp <- show . (\(TOD i _) -> i) <$> getClockTime -- タイムスタンプ取得
31  nonce <- show <$> randomRIO (0, maxBound::Int) -- 乱数取得
32  let authorizationParameters_ = [
33       ("oauth_token", accessToken oauth),
34       ("oauth_consumer_key", consumerKey oauth),
35       ("oauth_nonce", nonce),
36       ("oauth_timestamp", timestamp),
37       ("oauth_signature_method", "HMAC-SHA1"),
38       ("oauth_version", "1.0")] -- 各種基本パラメータをセット
39      signature = genSignature (consumerSecret oauth) (accessTokenSecret oauth) method url (args ++ authorizationParameters_) -- 署名生成
40      authorizationParameters = authorizationParameters_++[("oauth_signature", signature)] -- 署名をパラメータに加える
41      authorizationHeader = ("Authorization: OAuth "++) . urlEncodeParams $ authorizationParameters -- Authorizationヘッダ生成
42      contentLengthHeader = "Content-Length: " ++ (show . length . urlEncodeVars $ args)
43      headers = if method==POST then [authorizationHeader, contentLengthHeader] else [authorizationHeader]
44  -- Curlインスタンス初期化
45  curl <- initialize
46  -- Requestを送信
47  setopts curl [CurlHttpHeaders headers]
48  when (method == POST) $ setopts curl [CurlPostFieldSize 0, CurlPost True]
49  respBody <$> (do_curl_ curl accessurl [] :: IO (CurlResponse_ [(String, String)] String))