-- Copyright (C) 2009 Diego Souza <dsouza at bitforest dot org>
-- 
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESha  S FOR A PARTICULAR PURPOSE.  See the
-- GNU Lesser General Public License for more details.
-- 
-- You should have received a copy of the GNU Lesser General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

-- | 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,oauth_token,oauth_token_secret,oauth_extra) 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.List as L

-- | 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)

-- | 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 csec)  s r = _oauth ckey csec Nothing s r
request (Authenticated ckey csec tk) s r = let req = r >>+ ("oauth_token", (Just . oauth_token) tk) 
                                           in _oauth ckey csec ((Just . oauth_token_secret) tk) s req

-- | Process the response of the service provider. The response should be an urlencoded string.
response :: Consumer -> B.ByteString -> Maybe Consumer
response cons u = let postdata  = R.read_urlencoded u
                      otken0    = lookup "oauth_token" postdata
                      otkensec0 = lookup "oauth_token_secret" postdata
                      otkextra0 = Just $ filter (\(k,_) -> k/="oauth_token"&&k/="oauth_token_secret") postdata
                  in otken0    >>= \otken1 -> 
                     otken1    >>= \otken -> 
                     otkensec0 >>= \otkensec1 ->
                     otkensec1 >>= \otkensec ->
                     otkextra0 >>= \otkextra ->
                     case cons
                     of (Unauthenticated ckey csec) -> Just $ Authenticated ckey csec (Token otken otkensec otkextra)
                        (Authenticated ckey csec _) -> Just $ Authenticated ckey csec (Token otken otkensec otkextra)

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

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