test.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

-- | Github API: http://developer.github.com/v3/oauth/

module Main where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Maybe (fromJust)
import qualified Data.Text as T
import  Data.Text (Text)
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Types as HT
import Network.HTTP.Conduit
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Conduit (MonadResource)
import           Control.Applicative
import           Control.Monad                     (mzero)
import           Data.Aeson

import Network.OAuth.OAuth2.HttpClient
import Network.OAuth.OAuth2

import Keys


main :: IO ()
main = do
    let state = "testGithubApi"
    print $ (authorizationUrl githubKey) `appendQueryParam` [("state", state)]
    putStrLn "visit the url and paste code here: "
    code <- getLine
    let (url, body) = accessTokenUrl githubKey (sToBS code)
    token <- doJSONPostRequest (url, body ++ [("state", state)])
    print (token :: Maybe AccessToken)
    case token of
      Just (AccessToken t _) -> userInfo (githubKey {oauthAccessToken = Just t}) >>= print
      _      -> print "no access token found yet"

sToBS :: String -> BS.ByteString
sToBS = T.encodeUtf8 . T.pack

-- | Test API: user
--
userInfo :: OAuth2 -> IO (Maybe GithubUser)
userInfo oauth = doJSONGetRequest (appendAccessToken
                                     "https://api.github.com/user"
                                     oauth)

data GithubUser = GithubUser { gid    :: Integer
                             , gname  :: Text
                             } deriving (Show, Eq)

instance FromJSON GithubUser where
    parseJSON (Object o) = GithubUser
                           <$> o .: "id"
                           <*> o .: "name"
    parseJSON _ = mzero