test.hs

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

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

module Main where

import           Control.Applicative
import           Control.Monad        (mzero)
import           Data.Aeson
import           Data.Aeson.TH                 (defaultOptions, deriveJSON)
import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy.Char8    as BSL
import           Data.Text            (Text)
import qualified Data.Text            as T
import qualified Data.Text.Encoding   as T
import           Network.HTTP.Conduit

import           Network.OAuth.OAuth2

import           Keys

data SiteInfo = SiteInfo { items   :: [SiteItem]
                         , has_more :: Bool
                         , quota_max :: Integer
                         , quota_remaining :: Integer
                         } deriving (Show, Eq)

data SiteItem = SiteItem { new_active_users :: Integer
                           , total_users :: Integer
                           , badges_per_minute :: Double
                           , total_badges :: Integer
                           , total_votes :: Integer
                           , total_comments :: Integer
                           , answers_per_minute :: Double
                           , questions_per_minute :: Double
                           , total_answers :: Integer
                           , total_accepted :: Integer
                           , total_unanswered :: Integer
                           , total_questions :: Integer
                           , api_revision :: Text
                         } deriving (Show, Eq)

$(deriveJSON defaultOptions ''SiteInfo)
$(deriveJSON defaultOptions ''SiteItem)


main :: IO ()
main = do
    print $ authorizationUrl stackexchangeKey
    putStrLn "visit the url and paste code here: "
    code <- getLine
    mgr <- newManager tlsManagerSettings
    let (url, body) = accessTokenUrl stackexchangeKey (sToBS code)
    token <- doSimplePostRequest mgr stackexchangeKey url (body)
    print (token :: OAuth2Result BSL.ByteString)
    case token of
      Right at  -> siteInfo mgr (getAccessToken at) >>= print
      Left _    -> putStrLn "no access token found yet"



-- stackexchange access token api does not respond json but an string
-- https://api.stackexchange.com/docs/authentication
getAccessToken :: BSL.ByteString -> AccessToken
getAccessToken str = let xs = BSL.split '&' str
                         ys = BSL.split '=' (xs !! 0)
                     in
                       AccessToken { accessToken = BSL.toStrict (ys !! 1)
                                   , refreshToken = Nothing
                                   , expiresIn = Nothing
                                   , tokenType = Nothing
                                   }

-- | Test API: info
siteInfo :: Manager -> AccessToken -> IO (OAuth2Result SiteInfo)
siteInfo mgr token = authGetJSON mgr token "https://api.stackexchange.com/2.2/info?site=stackoverflow"

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