xing-api-0.1.1: demos/cli-demo.hs

-- This demo shows how to authenticate users using OAuth and how to
-- reuse the access tokens.
-- It used the OAuth out of band (OOB) mode and can be used as a starting
-- point to write an application that does not to have a web view.
--
-- Make sure to set the environment variables XING_CONSUMER_KEY and
-- XING_CONSUMER_SECRET before trying this demo.

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

module Main where

import System.IO (hFlush, stdout)
import Data.Maybe (fromJust, isJust)

import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Resource (MonadResource)

import Data.Monoid (mappend)
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text.IO as T

import Web.XING

import System.Environment (getEnv)
import qualified System.IO.Error
import qualified Control.Exception as E

readVerifier
  :: URL
  -> IO Verifier
readVerifier url = do
  putStrLn "Please confirm the authorization at"
  putStrLn $ "  " `mappend` (BS.unpack url)
  putStr   "Please enter the PIN: " >> hFlush stdout
  BS.getLine

showAccessToken
  :: (AccessToken, BS.ByteString)
  -> IO ()
showAccessToken (accessToken, uid) = do
  putStrLn $ ""
  putStrLn $ "Hello " `mappend` (BS.unpack uid) `mappend` "!"
  putStrLn $ "You should set the access token as environment variables:"
  putStrLn $ ""
  putStrLn $ "  export XING_ACCESS_TOKEN_KEY=\""    `mappend` ((BS.unpack.token)       accessToken) `mappend` "\""
  putStrLn $ "  export XING_ACCESS_TOKEN_SECRET=\"" `mappend` ((BS.unpack.tokenSecret) accessToken) `mappend` "\""
  putStrLn $ ""

handshake
  :: (MonadResource m, MonadBaseControl IO m)
  => OAuth
  -> Manager
  -> m (AccessToken, BS.ByteString)
handshake oa manager = do
  (requestToken, url) <- getRequestToken oa manager
  verifier <- liftIO $ readVerifier url
  getAccessToken requestToken verifier oa manager

readAccessToken :: IO (Maybe Credential)
readAccessToken = do
  access_token_key    <- getEnv "XING_ACCESS_TOKEN_KEY"
  access_token_secret <- getEnv "XING_ACCESS_TOKEN_SECRET"
  return $ Just $ newCredential (BS.pack access_token_key) (BS.pack access_token_secret)

main :: IO ()
main = do
  consumer_key    <- getEnv "XING_CONSUMER_KEY"
  consumer_secret <- getEnv "XING_CONSUMER_SECRET"
  let xingConsumer = consumer (BS.pack consumer_key) (BS.pack consumer_secret)

  maybeAccessToken <- E.catch (readAccessToken) (\(_ :: System.IO.Error.IOError) -> return Nothing)

  putStrLn "XING API demo"
  user <- withManager $ \manager -> do
    accessToken <- if isJust maybeAccessToken
      then return $ fromJust maybeAccessToken
      else auth xingConsumer manager
    getIdCard xingConsumer manager accessToken
  T.putStrLn (displayName user)

auth
  :: (MonadResource m, MonadBaseControl IO m)
  => OAuth
  -> Manager
  -> m RequestToken
auth oa manager = do
  res@(accessToken, _) <- handshake oa manager
  liftIO $ showAccessToken res
  return accessToken