Source

astrosearch / Common.hs.in

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

module Common 
       ( credentialFile
       , getTwitterAuthorization
       , authorizeTwitterRequest
       , authorizeAction
       , streamSearch
       ) where

import qualified Control.Exception as C
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as LB8
import qualified Data.Aeson as A
import qualified Data.Conduit.Internal as CI
import qualified Data.Conduit.Text as CT
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Network.HTTP.Types as HT
import qualified Web.Authenticate.OAuth as OA

import Control.Applicative ((<$>))

--import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.IO.Class (MonadIO, liftIO)
-- import Control.Monad.Trans.Resource (MonadThrow, MonadUnsafeIO)

import Data.Conduit

import Network.HTTP.Conduit

import System.Directory (getHomeDirectory, createDirectoryIfMissing)
import System.FilePath ((</>))
import System.IO (hFlush, stdout)

import Web.Authenticate.OAuth (Credential(..), OAuth(..))

{-
The consumer key and secret need filling in with the
values you get for your applciation from Twitter.
-}

twitterOauth :: OAuth
twitterOauth = def { oauthServerName = "twitter"
                   , oauthRequestUri = "http://twitter.com/oauth/request_token"
                   , oauthAccessTokenUri = "http://twitter.com/oauth/access_token"
                   , oauthAuthorizeUri = "http://twitter.com/oauth/authorize"
                   , oauthConsumerKey = "@@KEY@@"
                   , oauthConsumerSecret = "@@SECRET@@"
                   , oauthSignatureMethod = OA.HMACSHA1
                   , oauthCallback = Nothing
                   }
  

-- | Where should credentials be searched for/stored (directory);
--   the directory is created if it does not exist.
credentialPath :: IO FilePath
credentialPath = do
  hdir <- getHomeDirectory
  let dname = hdir </> ".astrosearch"
  createDirectoryIfMissing True dname
  return dname

-- | The full path to the credential (the directory will be created
--   if required, but not the file itself).
credentialFile :: IO FilePath
credentialFile = (</> "credential.json") <$> credentialPath

-- | Return the credential, if it exists.
getCredential :: FilePath -> IO (Maybe Credential)
getCredential credFile = 
    let getCred = do
          cts <- LB8.readFile credFile
          return $ Credential <$> A.decode cts
    in C.catch getCred
           ((return . const Nothing) :: C.IOException -> IO (Maybe Credential))

-- | Save the credential to disk.
putCredential :: FilePath -> Credential -> IO ()
putCredential credFile cred = 
  LB8.writeFile credFile $ A.encode . unCredential $ cred

-- | Ask Twitter for authorization, save the credential to the file, and
--   return it.
getAuthorization :: String -> IO Credential
getAuthorization credFile = 
    withManager $ \mgr -> do
      tCred <- OA.getTemporaryCredential twitterOauth mgr
      let url = OA.authorizeUrl twitterOauth tCred
      pin <- liftIO $ getTwitterPIN url
      let tCred2 = OA.insert "oauth_verifier" (B8.pack pin) tCred
      cred <- OA.getAccessToken twitterOauth tCred2 mgr
      liftIO $ putCredential credFile cred
      return cred

-- | Ask the user for the PIN from Twitter.
getTwitterPIN :: String -> IO String
getTwitterPIN url = do
  putStrLn $ "Please go to " ++ show url
  putStrLn "and enter below the PIN that Twitter gave you:"
  hFlush stdout
  getLine

-- | Get the credential for calling the Twitter API. This may
--   require interacting with Twitter or just reading the
--   data from disk.
getTwitterAuthorization :: FilePath -> IO Credential
getTwitterAuthorization credFile = maybe (getAuthorization credFile) return =<< getCredential credFile

-- | Given an action, authorize it and perform the action. Thie auhorization
--   will be taken from the given file if it exists, otherwise you will be
--   prompted for a PIN from Twitter, and this will be saved to the file
--   for later use.
--
authorizeAction :: 
    FilePath
    -> (Manager -> Credential -> ResourceT IO a) 
    -> IO a
authorizeAction credFile act = do
  cred <- getTwitterAuthorization credFile
  runAction cred act

-- | Run the action given the credential.
runAction :: 
    (MonadIO m, MonadBaseControl IO m, MonadThrow m, MonadUnsafeIO m) =>
    Credential -> (Manager -> Credential -> ResourceT m a) -> m a
runAction cred act = withManager $ \mgr -> act mgr cred

-- | Pass the contents of a resumable conduit to a
--   conduit, ensuring the whole thing is resumable.
passTo :: 
    MonadIO m =>
    CI.ResumableSource m a ->
    CI.Conduit a m o ->
    m (CI.ResumableSource m o)
passTo input output = do
  (src, finalizer) <- unwrapResumable input
  return $ CI.ResumableSource (src $= output) finalizer

-- | Use the streaming API to search for the given terms.
streamSearch ::
    (MonadBaseControl IO m, MonadResource m)
    => S.Set T.Text
    -> Manager
    -> Credential
    -> m (ResumableSource m T.Text)
streamSearch terms mgr cred = do
  req <- liftIO $ parseUrl "https://stream.twitter.com/1.1/statuses/filter.json"
  let qry = [("track", 
              TE.encodeUtf8 (T.intercalate "," (S.toList terms)))
            ]
      sreq = req { method = "POST"
                 , queryString = HT.renderSimpleQuery False qry
                 }
  s2req <- OA.signOAuth twitterOauth cred sreq
  res <- http s2req mgr
  -- access the search results and decode to text
  responseBody res `passTo` CT.decode CT.utf8 

-- | Authorize the Twitter request given the credentials.
authorizeTwitterRequest :: 
  MonadUnsafeIO m => Credential -> Request m -> m (Request m)
authorizeTwitterRequest = OA.signOAuth twitterOauth
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.