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
data Token = Token { oauth_token :: String,
oauth_token_secret :: String,
oauth_extra :: [R.Parameter]
}
deriving (Show,Read,Eq)
data Consumer =
Unauthenticated String String
| Authenticated String String Token
deriving (Show,Read,Eq)
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
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
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
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
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)