Consumer.hs

-- Copyright (c) 2009, Diego Souza
-- All rights reserved.
-- 
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
-- 
--   * Redistributions of source code must retain the above copyright notice,
--     this list of conditions and the following disclaimer.
--   * Redistributions in binary form must reproduce the above copyright notice,
--     this list of conditions and the following disclaimer in the documentation
--     and/or other materials provided with the distribution.
--   * Neither the name of the <ORGANIZATION> nor the names of its contributors
--     may be used to endorse or promote products derived from this software
--     without specific prior written permission.
-- 
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
-- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-- | A pure library that implements oauth authentication protocol as defined in <http://oauth.net/core/1.0a>.
--
-- Refer to <http://oauth.net/> for more information about the oauth protocol.
module Network.Protocol.OAuth.Consumer (Token(),Consumer(..),request,response,nonce_and_timestamp,oauth_token,oauth_token_secret,oauth_extra,plaintext_signature,hmacsha1_signature) where

import Network.Protocol.OAuth.Request as R
import qualified Data.ByteString.Lazy as B
import qualified Network.Protocol.OAuth.Signature as S
import qualified Data.Time.Clock as T
import qualified Data.Time.Format as F
import qualified System.Locale as L
import qualified System.UUID.V1 as U
import qualified Text.Printf as P
import qualified Data.Binary as Bn
import qualified Data.List as L
import qualified Control.Monad as M

-- | OAuth uses Tokens generated by the Service Provider instead of the User's credentials in Protected Resources requests.
data Token = Token { oauth_token        :: String,
                     oauth_token_secret :: String,
                     oauth_extra        :: [R.Parameter]
                   }
  deriving (Show,Read,Eq)

-- | The application which needs to authenticate using oauth.
data Consumer =   
    -- | Creates a consumer with /consumer_key/ and /consumer_secret/
    Unauthenticated String String
    -- | A consumer with /consumer_key/, /consumer_secret/ and a 'Token'
  | Authenticated String String Token
  deriving (Show,Read,Eq)

-- | The PLAINTEXT signature for a given consumer
plaintext_signature :: Consumer -> S.Method
plaintext_signature (Authenticated _ s t) = S.PLAINTEXT s ((Just . oauth_token_secret) t)
plaintext_signature (Unauthenticated _ s) = S.PLAINTEXT s Nothing

-- | The HMAC-SHA1 signature for a given consumer 
hmacsha1_signature :: Consumer -> S.Method
hmacsha1_signature (Authenticated _ s t) = S.HMAC_SHA1 s ((Just . oauth_token_secret) t)
hmacsha1_signature (Unauthenticated _ s) = S.HMAC_SHA1 s Nothing

-- | Sign a request for oauth request. Use this either to sign requests with a proper Access token or to use the oauth protocol to get a token from service provider.
--
-- The request you provide /must/ contain /oauth_nonce/ and /oauth_timestamp/ parameters properly defined.
request :: (S.Signer s,Show s) => Consumer -> s -> R.Request -> R.Request
request (Unauthenticated ckey _)  s r = _oauth ckey s r
request (Authenticated ckey _ tk) s r = let req = r >>+ ("oauth_token", (Just . oauth_token) tk) 
                                        in _oauth ckey s req

-- | Process the response of the service provider. The response should be an urlencoded string.
response :: Consumer -> B.ByteString -> Maybe Consumer
response c u = let postdata    = R.read_urlencoded u
                   o_token     = (M.join . lookup "oauth_token") postdata
                   o_token_sec = (M.join . lookup "oauth_token_secret") postdata
                   o_token_ext = return $ filter (not . flip elem ["oauth_token","oauth_token_secret"] . fst) postdata
                   token       = M.liftM3 Token o_token o_token_sec o_token_ext
               in case c
                  of (Unauthenticated ckey csec) -> M.liftM3 Authenticated (return ckey) (return csec) token
                     (Authenticated ckey csec _) -> M.liftM3 Authenticated (return ckey) (return csec) token

-- | Generates the oauth_nonce and oauth_timestamp parameters.
nonce_and_timestamp :: Request -> IO Request
nonce_and_timestamp r = do
  timestamp <- fmap (F.formatTime L.defaultTimeLocale "%s") T.getCurrentTime
  nonce     <- fmap (concatMap (P.printf "%02x") . B.unpack . Bn.encode) U.uuid
  return (r >>+ ("oauth_nonce",Just nonce) >>+ ("oauth_timestamp",Just timestamp))

_oauth :: (S.Signer s,Show s) => String -> s -> R.Request -> R.Request
_oauth ckey met req = _sign met $ req >>+ ("oauth_consumer_key",Just ckey)
                                      >>+ ("oauth_version",Just "1.0")
                                      >>+ ("oauth_signature_method",(Just . show) met)

_sign :: (S.Signer s,Show s) => s -> R.Request -> R.Request
_sign met req = let sig = S.sign met req
                in req >>+ ("oauth_signature",Just sig)