fWjaRGry

1module Whiteye.OAuth.Consumer (
2    Consumer (..),
3    oAuthRequest
4    ) where
5
6import Data.List
7import Control.Applicative
8import Network.URI
9import Network.HTTP
10import qualified System.Time as Time
11import qualified System.Random as Rand
12import qualified Data.ByteString.Lazy as B
13import qualified Data.ByteString.Lazy.Char8 as B8
14import qualified Data.Digest.Pure.SHA as SHA
15import qualified Codec.Binary.Base64 as Base64
16
17data Consumer = Consumer {
18    consumerKey :: String,
19    consumerSecret :: String,
20    accessToken :: String,
21    accessTokenSecret :: String
22} deriving (Show, Eq)
23
24mkTimestamp :: IO String
25mkTimestamp = showSec <$> Time.getClockTime
26    where showSec (Time.TOD sec _) = show sec
27
28mkNonce :: IO String
29mkNonce = sequence $ replicate 32 $ Rand.randomRIO ('a', 'z')
30
31mkSignature :: String -> String -> RequestMethod -> URI -> [(String, String)] -> String
32mkSignature consumerSecret accessTokenSecret method uri params =
33  base64encode $ SHA.hmacSha1 (B8.pack key) (B8.pack msg)
34    where key = consumerSecret ++ "&" ++ accessTokenSecret
35          msg = intercalate "&" $
36            map urlEncode [show method, show uri, urlEncodeVars (sort params)]
37          base64encode = Base64.encode . B.unpack . SHA.bytestringDigest
38
39oAuthHeaderContent :: [(String, String)] -> String
40oAuthHeaderContent params =
41  "OAuth " ++ (intercalate ", " $ map encodeParam params)
42    where encodeParam (k, v) = urlEncode k ++ "=\"" ++ urlEncode v ++ "\""
43
44mkOAuthHeader :: Consumer -> RequestMethod -> URI -> [(String, String)] ->
45                 String -> String -> Header
46mkOAuthHeader consumer method uri params timestamp nonce =
47  mkHeader HdrAuthorization $
48           oAuthHeaderContent $ ("oauth_signature", sig) : oauthParams
49    where oauthParams = [ ("oauth_consumer_key", consumerKey consumer),
50                          ("oauth_token", accessToken consumer),
51                          ("oauth_signature_method", "HMAC-SHA1"),
52                          ("oauth_timestamp", timestamp),
53                          ("oauth_nonce", nonce),
54                          ("oauth_version", "1.0") ]
55          sig = mkSignature (consumerSecret consumer)
56                            (accessTokenSecret consumer)
57                            method uri (oauthParams ++ params)
58
59mkOAuthRequest :: RequestMethod -> URI -> [(String, String)] ->
60                  Header -> Request_String
61mkOAuthRequest GET uri params authHeader =
62  Request {
63      rqMethod = GET,
64      rqURI = uri { uriQuery = '?' : urlEncodeVars params },
65      rqHeaders = [authHeader],
66      rqBody = ""
67  }
68mkOAuthRequest POST uri params authHeader =
69  Request {
70      rqMethod = POST,
71      rqURI = uri,
72      rqHeaders = [authHeader, ctypeHeader, clenHeader],
73      rqBody = body
74  }
75    where
76      body = urlEncodeVars params
77      ctypeHeader = mkHeader HdrContentType "application/x-www-form-urlencoded"
78      clenHeader = mkHeader HdrContentType (show $ length body)
79
80oAuthRequest :: Consumer -> RequestMethod -> URI -> [(String, String)] ->
81                IO Request_String
82oAuthRequest consumer method uri params =
83  mkOAuthRequest method uri params <$>
84    (mkOAuthHeader consumer method uri params <$> mkTimestamp <*> mkNonce)