module Network.Protocol.OAuth.Signature (Method(..),Signer,sign) where
import qualified Network.Protocol.OAuth.Request as R
import qualified Data.Digest.Pure.SHA as S
import qualified Data.Char as C
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as B1
import qualified Codec.Binary.Base64.String as B2
data Method =
PLAINTEXT
| HMAC_SHA1
deriving (Eq)
class Signer a where
sign :: a
-> String
-> Maybe String
-> R.Request
-> String
instance Signer Method where
sign PLAINTEXT k (Just s) _ = k ++ "&" ++ s
sign PLAINTEXT k Nothing _ = k ++ "&"
sign HMAC_SHA1 k Nothing r = let secret = B.concat [R.encodes k, _froms "&"]
in (B2.encode . B1.unpack . S.bytestringDigest . S.hmacSha1 secret . _basestr) r
sign HMAC_SHA1 k (Just s) r = let secret = B.concat [R.encodes k, _froms "&", R.encodes s]
in (B2.encode . B1.unpack . S.bytestringDigest . S.hmacSha1 secret . _basestr) r
instance Show Method where
showsPrec _ PLAINTEXT = showString "PLAINTEXT"
showsPrec _ HMAC_SHA1 = showString "HMAC-SHA1"
instance Read Method where
readsPrec _ ('P':'L':'A':'I':'N':'T':'E':'X':'T':r) = (PLAINTEXT,r) : []
readsPrec _ ('H':'M':'A':'C':'-':'S':'H':'A':'1':r) = (HMAC_SHA1,r) : []
readsPrec _ _ = []
_basestr :: R.Request -> B.ByteString
_basestr r = let endpoint' = (R.encodes . _endpoint) r
params' = (R.encodes . _params) r
method' = (R.encodes . show . R.method) r
in B.concat [method', _froms "&", endpoint', _froms "&", params']
_endpoint :: R.Request -> String
_endpoint r | R.ssl r = ssl_endpoint'
| otherwise = endpoint'
where
host' = (map C.toLower . R.host) r
port' = ((':':) . show . R.port) r
ssl_endpoint' | R.port r == 443 = "https://" ++ host' ++ (R.path r)
| otherwise = "https://" ++ host' ++ port' ++ (R.path r)
endpoint' | R.port r == 80 = "http://" ++ host' ++ (R.path r)
| otherwise = "http://" ++ host' ++ port' ++ (R.path r)
_params :: R.Request -> String
_params = map (C.chr . fromIntegral) . B.unpack . R.show_urlencoded . R.params
_froms :: String -> B.ByteString
_froms = B.pack . map (fromIntegral . C.ord)