diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2016 + +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 Author name here nor the names of other + 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 +OWNER 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/oauth10a.cabal b/oauth10a.cabal new file mode 100644 --- /dev/null +++ b/oauth10a.cabal @@ -0,0 +1,49 @@ +name: oauth10a +version: 0.1.0.0 +synopsis: Simple utilities to create OAuth 1.0a headers +description: + Provides simple functions and types for generating OAuth 1.0a headers as + simply and straightforwardly as possible. If you have credentials, a request + method, a url, and extra parameters, you'll get back a compliant + 'ByteString' to put in your @Authorization@ header. + + See the README.md for more details! + +homepage: https://github.com/gatlin/oauth10a#readme +license: GPL-3 +license-file: LICENSE +author: Gatlin Johnson +maintainer: gatlin@niltag.net +copyright: 2016 Gatlin Johnson +category: Web +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Net.OAuth.OAuth10a + build-depends: base >= 4.7 && < 5, + base64-bytestring, + bytestring, + aeson, + entropy, + time, + transformers, + cryptohash, + http-types + default-language: Haskell2010 + +test-suite oauth10a-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , oauth10a + , bytestring + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/gatlin/oauth10a diff --git a/src/Net/OAuth/OAuth10a.hs b/src/Net/OAuth/OAuth10a.hs new file mode 100644 --- /dev/null +++ b/src/Net/OAuth/OAuth10a.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE OverloadedStrings #-} + +{- | +Module : Net.OAuth.OAuth10a +Description : OAuth 1.0a implementation +Copyright : 2016 +License : GPLv3 + +Maintainer : Gatlin Johnson +Stability : experimental +Portability : non-portable + +Defines functions necessary for generating OAuth 1.0a Authorization headers. +-} + +module Net.OAuth.OAuth10a + ( auth_header + , param_string + , Param(..) + , Credentials(..) + , PercentEncode(..) + , filterNonAlphanumeric + , gen_nonce + , timestamp + , sig_base_string + , signing_key + , sign + , create_header_string + , oauth_sig + ) where + +import Network.HTTP.Types.Status (statusCode) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as B64 +import Data.ByteString.Char8 (pack, unpack) +import Data.ByteString.Builder (Builder) +import qualified Data.ByteString.Builder as BB +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad (forM, mapM) +import System.Entropy (getEntropy) +import Data.Time.Clock.POSIX (getPOSIXTime) +import Data.List (sort, intersperse) +import Data.Monoid ((<>)) +import Crypto.MAC.HMAC (hmac) +import Crypto.Hash.SHA1 (hash) + +-- | HTTP request parameters +data Param = Param + { paramKey :: ByteString + , paramValue :: ByteString + } deriving (Show, Eq, Ord) + +-- | Request credentials +data Credentials = Credentials + { consumerKey :: ByteString + , consumerSecret :: ByteString + , token :: Maybe ByteString + , tokenSecret :: Maybe ByteString + } deriving (Show) + +-- * Helpers +bs = BB.byteString +build = BL.toStrict . BB.toLazyByteString + +-- | Filter all non-alphanumeric (by English standards) from a 'ByteString' +filterNonAlphanumeric :: ByteString -> ByteString +filterNonAlphanumeric = BS.pack . trunc . filter f . BS.unpack where + f ch | ch >= 97 && ch <= 122 = True + | ch >= 48 && ch <= 57 = True + | otherwise = False + trunc it | length it > 32 = take 32 it + | otherwise = it + +-- | Generate the request nonce +gen_nonce :: MonadIO m => m ByteString +gen_nonce = do + random_bytes <- liftIO $ getEntropy 32 + return $ filterNonAlphanumeric $ B64.encode random_bytes + +-- | Rounded integer number of seconds since the UNIX epoch +timestamp :: MonadIO m => m Integer +timestamp = liftIO $ round <$> getPOSIXTime + +-- | Types which may be percent encoded +class PercentEncode t where + percent_encode :: t -> t + +instance PercentEncode ByteString where + percent_encode = build . mconcat . map encodeChar . BS.unpack where + encodeChar ch | unreserved' ch = BB.word8 ch + | otherwise = h2 ch + unreserved' ch | ch >= 65 && ch <= 90 = True -- A-Z + | ch >= 97 && ch <= 122 = True -- a-z + | ch >= 48 && ch <= 57 = True -- 0-9 + | ch == 95 = True -- _ + | ch == 46 = True -- . + | ch == 126 = True -- ~ + | ch == 45 = True -- - + | otherwise = False + h2 v = let (a, b) = v `divMod` 16 in bs $ BS.pack [37, h a, h b] + h i | i < 10 = 48 + i -- zero (0) + | otherwise = 65 + i - 10 -- 65: A + +instance PercentEncode Param where + percent_encode (Param a b) = Param (percent_encode a) (percent_encode b) + +-- | Generate a parameter string from a list of 'Param' +param_string :: [Param] -> ByteString +param_string = build . + foldl (<>) mempty . intersperse (bs "&") . + map (\(Param k v) -> (bs k) <> (bs "=") <> (bs v)) . + sort . map percent_encode + +-- | Create the base string which will be signed +sig_base_string :: ByteString -> ByteString -> ByteString -> ByteString +sig_base_string ps method url = build $ (bs method) <> amp <> url' <> amp <> ps' + where + amp = bs "&" + url' = bs $ percent_encode url + ps' = bs $ percent_encode ps + +-- | Create the OAuth signing key from the various access secrets +signing_key :: ByteString -> Maybe ByteString -> ByteString +signing_key secret token = build $ (bs secret) <> (bs "&") <> token' where + token' = bs $ maybe "" id token + +sign + :: ByteString -- ^ Signing key + -> ByteString -- ^ Message to sign + -> ByteString -- ^ Resulting base64-encoded signature +sign key msg = B64.encode $ hmac hash 64 key msg + +-- | Generate the Authorization header given a list of 'Param' +create_header_string :: [Param] -> ByteString +create_header_string params = build $ (bs "OAuth ") <> str where + q = bs $ pack ['"'] + encoded = sort $ map percent_encode params + stringified = map (\(Param k v) -> (bs k) <> (bs "=") <> q <> (bs v) <> q) + encoded + comma'd = intersperse (bs ", ") stringified + str = foldl (<>) mempty comma'd + +-- | Generates the signature for a given request, not the full header +oauth_sig + :: MonadIO m + => Credentials + -> ByteString -- ^ method + -> ByteString -- ^ url + -> [Param] -- ^ any extra parameters + -> m [Param] +oauth_sig creds method url extras = do + nonce <- gen_nonce + ts <- timestamp >>= return . pack . show + let params = [ Param "oauth_consumer_key" (consumerKey creds) + , Param "oauth_nonce" nonce + , Param "oauth_timestamp" ts + , Param "oauth_token" (maybe "" id (token creds)) + , Param "oauth_signature_method" "HMAC-SHA1" + , Param "oauth_version" "1.0" + ] + let sk = signing_key (consumerSecret creds) (tokenSecret creds) + let params' = param_string $ extras ++ params + let base_string = sig_base_string params' method url + let signature = sign sk base_string + return $ (Param "oauth_signature" signature) : (params ++ extras) + +-- | From start to finish creates the OAuth 1.0a header string +-- (what you would put as the value for the 'Authorization' header) +auth_header + :: MonadIO m + => Credentials + -> ByteString -- ^ method + -> ByteString -- ^ url + -> [Param] -- ^ Any extra parameters + -> m ByteString +auth_header (Credentials key secret token token_secret) method url extras = do + nonce <- gen_nonce + ts <- timestamp >>= return . pack . show + let params = [ Param "oauth_consumer_key" key + , Param "oauth_nonce" nonce + , Param "oauth_timestamp" ts + , Param "oauth_token" (maybe "" id token) + , Param "oauth_signature_method" "HMAC-SHA1" + , Param "oauth_version" "1.0" + ] + let sk = signing_key secret token_secret + let params' = param_string $ extras ++ params + let base_string = sig_base_string params' method url + let signature = sign sk base_string + let with_signature = (Param "oauth_signature" signature) : params + return $ create_header_string with_signature diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Data.ByteString (ByteString) +import Data.ByteString (ByteString, append, empty) +import Data.ByteString.Char8 (pack, unpack) +import Control.Monad (mapM_) + +import Net.OAuth.OAuth10a + +{- Test data -} + +ts :: ByteString +ts = "1318622958" + +nonce :: ByteString +nonce = "kYjzVBB8Y0ZFabxSWbWovY3uYSQ2pTgmZeNu2VS4cg" + +method :: ByteString +method = "POST" + +url :: ByteString +url = "https://api.twitter.com/1/statuses/update.json" + +creds :: Credentials +creds = Credentials { + consumerKey = "xvz1evFS4wEEPTGEFPHBog", + consumerSecret = "kAcSOqF21Fu85e7zjz7ZN2U4ZRhfV3WpwPAoE3Z7kBw", + token = Just "370773112-GmHxMAgYyLbNEtIKZeRNFsMKPR9EyMZeS9weJAEb", + tokenSecret = Just "LswwdoUaIvS8ltyTt5jkRh4J50vUPVVHtR2YPi5kE" + } + +{- Tests + +For the most part the tests consist of `actual_*` functions with the correct +values and `gen_*` functions which attempt to create them. + +-} + +gen_param_string :: ByteString +gen_param_string = + let params = [ Param "oauth_consumer_key" (consumerKey creds) + , Param "oauth_nonce" nonce + , Param "oauth_signature_method" "HMAC-SHA1" + , Param "oauth_timestamp" ts + , Param "oauth_version" "1.0" + , Param "oauth_token" (maybe "" id (token creds)) + , Param "status" + "Hello Ladies + Gentlemen, a signed OAuth request!" + , Param "include_entities" "true" + ] + in param_string params + +actual_param_string :: ByteString +actual_param_string = "include_entities=true&oauth_consumer_key=xvz1evFS4wEEPTGEFPHBog&oauth_nonce=kYjzVBB8Y0ZFabxSWbWovY3uYSQ2pTgmZeNu2VS4cg&oauth_signature_method=HMAC-SHA1&oauth_timestamp=1318622958&oauth_token=370773112-GmHxMAgYyLbNEtIKZeRNFsMKPR9EyMZeS9weJAEb&oauth_version=1.0&status=Hello%20Ladies%20%2B%20Gentlemen%2C%20a%20signed%20OAuth%20request%21" + +actual_base_string :: ByteString +actual_base_string = "POST&https%3A%2F%2Fapi.twitter.com%2F1%2Fstatuses%2Fupdate.json&include_entities%3Dtrue%26oauth_consumer_key%3Dxvz1evFS4wEEPTGEFPHBog%26oauth_nonce%3DkYjzVBB8Y0ZFabxSWbWovY3uYSQ2pTgmZeNu2VS4cg%26oauth_signature_method%3DHMAC-SHA1%26oauth_timestamp%3D1318622958%26oauth_token%3D370773112-GmHxMAgYyLbNEtIKZeRNFsMKPR9EyMZeS9weJAEb%26oauth_version%3D1.0%26status%3DHello%2520Ladies%2520%252B%2520Gentlemen%252C%2520a%2520signed%2520OAuth%2520request%2521" + +gen_base_string :: ByteString +gen_base_string = + let params = [ Param "oauth_consumer_key" (consumerKey creds) + , Param "oauth_nonce" nonce + , Param "oauth_signature_method" "HMAC-SHA1" + , Param "oauth_timestamp" ts + , Param "oauth_version" "1.0" + , Param "oauth_token" (maybe "" id (token creds)) + , Param "status" + "Hello Ladies + Gentlemen, a signed OAuth request!" + , Param "include_entities" "true" + ] + in sig_base_string (param_string params) method url + +actual_signing_key :: ByteString +actual_signing_key = "kAcSOqF21Fu85e7zjz7ZN2U4ZRhfV3WpwPAoE3Z7kBw&LswwdoUaIvS8ltyTt5jkRh4J50vUPVVHtR2YPi5kE" + +gen_signing_key :: ByteString +gen_signing_key = signing_key (consumerSecret creds) (tokenSecret creds) + +actual_signature :: ByteString +actual_signature = "tnnArxj06cWHq44gCs1OSKk/jLY=" + +gen_signature :: ByteString +gen_signature = + let params = [ Param "oauth_consumer_key" (consumerKey creds) + , Param "oauth_nonce" nonce + , Param "oauth_timestamp" ts + , Param "oauth_signature_method" "HMAC-SHA1" + , Param "oauth_version" "1.0" + , Param "include_entities" "true" + , Param "oauth_token" (maybe "" id (token creds)) + , Param "status" + "Hello Ladies + Gentlemen, a signed OAuth request!" + ] + sk = signing_key (consumerSecret creds) (tokenSecret creds) + base_string = sig_base_string (param_string params) method url + in sign sk base_string + +test_percent_encoding :: Bool +test_percent_encoding = + "%2Fuser%2F123456%2Fcourses" == + percent_encode( "/user/123456/courses" :: ByteString) + +main :: IO () +main = do + mapM_ putStrLn [ + "", + "Tests", + "[test_percent_encoding] " ++ (show test_percent_encoding), + "[test_param_string] " ++ + (show $ actual_param_string == gen_param_string), + "[test_base_string] " ++ (show $ + actual_base_string == gen_base_string), + "[test_signing_key] " ++ + (show $ actual_signing_key == gen_signing_key), + "[test_signature] " ++ + (show $ actual_signature == gen_signature) + ]