{-# LANGUAGE CPP, QuasiQuotes #-}
module Yesod.Helpers.Auth.OAuth
    ( authOAuth
    , oauthUrl
    , authTwitter
    ) where
import Yesod
import Yesod.Helpers.Auth
import Network.OAuth.Consumer
import Network.OAuth.Http.Request hiding (replace)
import qualified Network.OAuth.Http.Request as OA
import Network.OAuth.Http.CurlHttpClient
import Data.Maybe

oauthUrl :: AuthRoute
oauthUrl = PluginR "oauth" ["forward"]

authOAuth :: YesodAuth m =>
             String -- ^ Service Name
          -> String -- ^ OAuth Parameter Name to use for identify
          -> String -- ^ Request URL
          -> String -- ^ Access Token URL
          -> String -- ^ Authorize URL
          -> String -- ^ Consumer Key
          -> String -- ^ Consumer Secret
          -> AuthPlugin m
authOAuth name ident reqUrl accUrl authUrl key sec = AuthPlugin name dispatch login
  where
    url = PluginR name []
    dispatch "GET" ["forward"] = do
        render <- getUrlRender
        tm <- getRouteToMaster
        let app = Application key sec (URL $ render $ tm url)
        tok <- runOAuthM (fromApplication app) $ do
          signRq2 HMACSHA1 Nothing (fromJust . parseURL $ reqUrl) >>= oauthRequest CurlClient
        let oaUrl = concat
                    [authUrl
                    , "?oauth_token="
                    , findWithDefault ("oauth_token", "ERR") $ oauthParams tok
                    ]
        redirectString RedirectTemporary oaUrl
    dispatch "GET" [] = do
        render <- getUrlRender
        tm <- getRouteToMaster
        let app = Application key sec (URL $ render $ tm url)
        verifier <- runFormGet' $ stringInput "oauth_verifier"
        oaTok    <- runFormGet' $ stringInput "oauth_token"
        let appTok = fromApplication app
            params = OA.replace ("oauth_token", oaTok) $ oauthParams appTok
            reqTok = injectOAuthVerifier verifier $ ReqToken app params
        accTok <- runOAuthM reqTok $ do
          signRq2 HMACSHA1 Nothing (fromJust . parseURL $ accUrl) >>= oauthRequest CurlClient
        let crId = findWithDefault (ident, error "oops!") $ oauthParams accTok
            creds = Creds name crId $ toList $ oauthParams accTok
        setCreds True creds
    dispatch _ _ = notFound
    login tm = do
        render <- liftHandler getUrlRender
        let app = Application key sec (URL $ render $ tm url)
        tok <- runOAuthM (fromApplication app) $ do
          signRq2 HMACSHA1 Nothing (fromJust . parseURL $ reqUrl) >>= oauthRequest CurlClient
        let oaUrl = concat
                    [authUrl
                    , "?oauth_token="
                    , findWithDefault ("oauth_token", "ERR") $ oauthParams tok
                    ]
        addHtml
#if GHC7
          [hamlet|
#else
          [$hamlet|
#endif
             %a!href=$oaUrl$ Login with $name$
          |]

authTwitter :: YesodAuth m =>
               String -- ^ Consumer Key
            -> String -- ^ Consumer Secret
            -> AuthPlugin m
authTwitter = authOAuth "twitter"
                        "screen_name"
                        "http://twitter.com/oauth/request_token"
                        "http://twitter.com/oauth/access_token"
                        "http://twitter.com/oauth/authorize"