gistfile1.hs

-- OAuth Request 生成
oauthRequest :: OAuth -> String -> String -> [Parameter] -> IO String
oauthRequest oauth url token parameter = do
  timestamp <- show . (\(TOD i _) -> i) <$> getClockTime -- タイムスタンプ取得
  nonce <- show <$> randomRIO (0, maxBound::Int) -- 乱数取得
  let authorizationParameters_ = parameter ++ [
                                          ("oauth_consumer_key", consumerKey oauth),
                                          ("oauth_nonce", nonce),
                                          ("oauth_timestamp", timestamp),
                                          ("oauth_signature_method", "HMAC-SHA1"),
                                          ("oauth_version", "1.0")
                                         ] -- 各種基本パラメータをセット
      signature = genSignature (consumerSecret oauth) token POST url authorizationParameters_ -- 署名生成
      authorizationParameters = authorizationParameters_++[("oauth_signature", signature)] -- 署名をパラメータに加える
      authorizationHeader = ("Authorization: OAuth "++) . urlEncodeParams $ authorizationParameters -- Authorizationヘッダ生成
      contentLengthHeader = "Content-Length: 0"
  -- Curlインスタンス初期化
  curl <- initialize
  -- Requestを送信
  setopts curl [CurlHttpHeaders [authorizationHeader, contentLengthHeader],
                CurlPostFieldSize 0,
                CurlPost True]
  respBody <$> (do_curl_ curl url [] :: IO (CurlResponse_ [(String, String)] String))

-- APIリクエスト
apiRequest :: OAuth -> String -> RequestMethod -> [Parameter] -> IO String
apiRequest oauth api method args = do
  let url = apiRequestURL api
      accessurl = if method == POST then url else url ++ "?" ++ urlEncodeVars args  -- URI
  timestamp <- show . (\(TOD i _) -> i) <$> getClockTime -- タイムスタンプ取得
  nonce <- show <$> randomRIO (0, maxBound::Int) -- 乱数取得
  let authorizationParameters_ = [
       ("oauth_token", accessToken oauth),
       ("oauth_consumer_key", consumerKey oauth),
       ("oauth_nonce", nonce),
       ("oauth_timestamp", timestamp),
       ("oauth_signature_method", "HMAC-SHA1"),
       ("oauth_version", "1.0")] -- 各種基本パラメータをセット
      signature = genSignature (consumerSecret oauth) (accessTokenSecret oauth) method url (args ++ authorizationParameters_) -- 署名生成
      authorizationParameters = authorizationParameters_++[("oauth_signature", signature)] -- 署名をパラメータに加える
      authorizationHeader = ("Authorization: OAuth "++) . urlEncodeParams $ authorizationParameters -- Authorizationヘッダ生成
      postFields = map (\(x, y) -> urlEncode x ++ "=" ++ urlEncode y) args
      contentLengthHeader = "Content-Length: " ++ (show . length . urlEncodeVars $ args)
      headers = if method==POST then [authorizationHeader, contentLengthHeader] else [authorizationHeader]
  -- Curlインスタンス初期化
  curl <- initialize
  -- Requestを送信
  setopts curl [CurlHttpHeaders headers]
  when (method == POST) $ setopts curl [CurlPostFieldSize (fromIntegral . length . urlEncodeVars $ args),
                                        CurlPost True,
                                        CurlPostFields postFields]
  respBody <$> (do_curl_ curl accessurl [] :: IO (CurlResponse_ [(String, String)] String))