oauth10a (empty) → 0.1.0.0
raw patch · 5 files changed
+391/−0 lines, 5 filesdep +aesondep +basedep +base64-bytestringsetup-changed
Dependencies added: aeson, base, base64-bytestring, bytestring, cryptohash, entropy, http-types, oauth10a, time, transformers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- oauth10a.cabal +49/−0
- src/Net/OAuth/OAuth10a.hs +193/−0
- test/Spec.hs +117/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ oauth10a.cabal view
@@ -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
+ src/Net/OAuth/OAuth10a.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Net.OAuth.OAuth10a+Description : OAuth 1.0a implementation+Copyright : 2016+License : GPLv3++Maintainer : Gatlin Johnson <gatlin@niltag.net>+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
+ test/Spec.hs view
@@ -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)+ ]