suztomoの日記

型をあわせると動く

23:10

そういう不思議な言語です。

httpLbsは2XXなステータスコードじゃないとエラーになるので、それをControl.Exception.Liftedのcatchで拾ってやるのがこつです。

帰ってきたJSONはData.Aesonで処理してあげます。

http://d.hatena.ne.jp/melpon/20111026/1319602571

    getAccessToken :: String -> IO (Maybe Text)
    getAccessToken code = do
      let payload = [("code", C8.pack code), ("client_id", C8.pack key),
                     ("client_secret", C8.pack sec),
                    ("redirect_uri", "http://localhost:3000/auth/page/GooglePlus"),
                    ("grant_type", "authorization_code")]
      parsedUrl <- parseUrl accUrl
      let req = urlEncodedBody payload $ parsedUrl
          errHandler :: ResourceIO m => HttpException
                     -> ResourceT m (Response LBS.ByteString)
          errHandler (StatusCodeException status hdrs) = return $ Response status hdrs LBS.empty
      (status, content) <- withManager $ \manager -> do
                                 Response status _ bsrc <- (httpLbs req manager) `L.catch` errHandler
                                 return (status, bsrc)
      putStrLn $ "Got status: " ++ (show status)
      case status of
        (Status 200 _) -> do
                    let r = AP.eitherResult $ AP.parse json content
                    case r of
                      Left msg -> do
                             putStrLn $ "Json error" ++ msg
                             return Nothing
                      Right d -> do
                             putStrLn "json ok"
                             let Object obj = d
                                 t = do
                                   String txt <- M.lookup "access_token" obj
                                   return txt
                             return t
        _ -> do
          putStrLn "invalid status"
          return Nothing

Haskellの難しいところはいろいろなライブラリが依存関係がいっぱいあるということな気がします。