Hello community,
here is the log from the commit of package ghc-authenticate-oauth for
openSUSE:Factory checked in at 2017-03-03 17:48:01
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-authenticate-oauth (Old)
and /work/SRC/openSUSE:Factory/.ghc-authenticate-oauth.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-authenticate-oauth"
Fri Mar 3 17:48:01 2017 rev:4 rq:461603 version:1.6
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-authenticate-oauth/ghc-authenticate-oauth.changes
2016-07-21 08:07:04.000000000 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-authenticate-oauth.new/ghc-authenticate-oauth.changes
2017-03-03 17:48:09.818366684 +0100
@@ -1,0 +2,5 @@
+Sun Feb 12 14:19:10 UTC 2017 - [email protected]
+
+- Update to version 1.6 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
authenticate-oauth-1.5.1.2.tar.gz
New:
----
authenticate-oauth-1.6.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-authenticate-oauth.spec ++++++
--- /var/tmp/diff_new_pack.1HyFni/_old 2017-03-03 17:48:10.510268969 +0100
+++ /var/tmp/diff_new_pack.1HyFni/_new 2017-03-03 17:48:10.514268404 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-authenticate-oauth
#
-# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -18,15 +18,14 @@
%global pkg_name authenticate-oauth
Name: ghc-%{pkg_name}
-Version: 1.5.1.2
+Version: 1.6
Release: 0
Summary: Library to authenticate with OAuth for Haskell web applications
License: BSD-2-Clause
-Group: System/Libraries
+Group: Development/Languages/Other
Url: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
BuildRequires: ghc-Cabal-devel
-# Begin cabal-rpm deps:
BuildRequires: ghc-RSA-devel
BuildRequires: ghc-SHA-devel
BuildRequires: ghc-base64-bytestring-devel
@@ -39,9 +38,9 @@
BuildRequires: ghc-random-devel
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-time-devel
+BuildRequires: ghc-transformers-compat-devel
BuildRequires: ghc-transformers-devel
BuildRoot: %{_tmppath}/%{name}-%{version}-build
-# End cabal-rpm deps
%description
API docs and the README are available at
@@ -62,15 +61,12 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-
%build
%ghc_lib_build
-
%install
%ghc_lib_install
-
%post devel
%ghc_pkg_recache
++++++ authenticate-oauth-1.5.1.2.tar.gz -> authenticate-oauth-1.6.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/authenticate-oauth-1.5.1.2/ChangeLog.md
new/authenticate-oauth-1.6/ChangeLog.md
--- old/authenticate-oauth-1.5.1.2/ChangeLog.md 2016-05-24 09:55:05.000000000
+0200
+++ new/authenticate-oauth-1.6/ChangeLog.md 2016-06-04 12:34:32.000000000
+0200
@@ -1,3 +1,9 @@
+## 1.6
+
+* Add checkOAuth
+* Add support for [oauth_body_hash
extension](https://oauth.googlecode.com/svn/spec/ext/body_hash/1.0/oauth-bodyhash.html)
+ in `checkOAuth` and `signOAuth`; this might have slightly changed
`checkOAuth` behavior.
+
## 1.5.1.2
* Allow newest transformers
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/authenticate-oauth-1.5.1.2/Web/Authenticate/OAuth.hs
new/authenticate-oauth-1.6/Web/Authenticate/OAuth.hs
--- old/authenticate-oauth-1.5.1.2/Web/Authenticate/OAuth.hs 2016-05-24
09:55:05.000000000 +0200
+++ new/authenticate-oauth-1.6/Web/Authenticate/OAuth.hs 2016-06-04
12:34:32.000000000 +0200
@@ -17,7 +17,7 @@
-- * Operations for credentials
newCredential, emptyCredential, insert, delete, inserts, injectVerifier,
-- * Signature
- signOAuth, genSign,
+ signOAuth, genSign, checkOAuth,
-- * Url & operation for authentication
-- ** Temporary credentials
getTemporaryCredential, getTemporaryCredentialWithScope,
@@ -39,9 +39,11 @@
import Blaze.ByteString.Builder (toByteString)
import Control.Exception
+import Control.Arrow (second)
import Control.Monad
import Control.Monad.IO.Class (MonadIO, liftIO)
-import Crypto.Types.PubKey.RSA (PrivateKey (..), PublicKey (..))
+import Control.Monad.Trans.Except
+import Crypto.Types.PubKey.RSA (PrivateKey (..)) -- , PublicKey
(..)
import Data.ByteString.Base64
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
@@ -49,7 +51,7 @@
import Data.Default
import Data.Digest.Pure.SHA
import qualified Data.IORef as I
-import Data.List (sort)
+import Data.List as List (sort, find)
import Data.Maybe
import Data.Time
import Network.HTTP.Client
@@ -135,7 +137,7 @@
deriving (Show, Eq, Read, Data, Typeable)
-data OAuthException = OAuthException String
+newtype OAuthException = OAuthException String
deriving (Show, Eq, Data, Typeable)
instance Exception OAuthException
@@ -193,8 +195,9 @@
-- | Data type for redential.
-data Credential = Credential { unCredential :: [(BS.ByteString,
BS.ByteString)] }
- deriving (Show, Eq, Ord, Read, Data, Typeable)
+newtype Credential = Credential -- we can easily change it back to "data"
later if needed, right?
+ { unCredential :: [(BS.ByteString, BS.ByteString)] }
+ deriving (Show, Eq, Ord, Read, Data, Typeable)
-- | Convenient function to create 'Credential' with OAuth Token and Token
Secret.
@@ -243,24 +246,40 @@
-> Credential -- ^ Credential
-> Request -- ^ Original Request
-> m Request -- ^ Signed OAuth Request
-signOAuth oa crd req = signOAuth' oa crd addAuthHeader req
+signOAuth oa crd req = signOAuth' oa crd True addAuthHeader req
-- | More flexible signOAuth
signOAuth' :: MonadIO m
=> OAuth -- ^ OAuth Application
-> Credential -- ^ Credential
+ -> Bool -- ^ whether to insert oauth_body_hash or not
-> (BS.ByteString -> Credential -> Request -> Request) -- ^
signature style
-> Request -- ^ Original Request
-> m Request -- ^ Signed OAuth Request
-signOAuth' oa crd add_auth req = do
+signOAuth' oa crd withHash add_auth req = do
crd' <- addTimeStamp =<< addNonce crd
- let tok = injectOAuthToCred oa crd'
+ mhash <- moauth_body_hash
+ let tok = addHashToCred mhash $ injectOAuthToCred oa crd'
sign <- genSign oa tok req
- return $ add_auth prefix (insert "oauth_signature" sign tok) req
- where
- prefix = case oauthRealm oa of
- Nothing -> "OAuth "
- Just v -> "OAuth realm=\"" `BS.append` v `BS.append` "\","
+ let prefix = case oauthRealm oa of
+ Nothing -> "OAuth "
+ Just v -> "OAuth realm=\"" `BS.append` v `BS.append` "\","
+ return $ add_auth prefix
+ (insert "oauth_signature" sign tok)
+ req
+ where -- adding extension
https://oauth.googlecode.com/svn/spec/ext/body_hash/1.0/oauth-bodyhash.html
+ moauth_body_hash = if not withHash || isBodyFormEncoded (requestHeaders
req)
+ then return Nothing
+ else (Just
+ . encode
+ . BSL.toStrict
+ . bytestringDigest
+ . sha1
+ . BSL.fromStrict) `liftM` loadBodyBS req
+ -- encodeHash (Just h) = "oauth_body_hash=\"" `BS.append` paramEncode h
`BS.append` "\","
+ -- encodeHash Nothing = ""
+ addHashToCred (Just h) = insert "oauth_body_hash" h
+ addHashToCred Nothing = id
-- | Generate OAuth signature. Used by 'signOAuth'.
@@ -276,6 +295,70 @@
RSASHA1 pr ->
liftM (encode . toStrict . rsassa_pkcs1_v1_5_sign hashSHA1 pr)
(getBaseString tok req)
+-- | Test existing OAuth signature.
+-- Since 1.5.2
+checkOAuth :: MonadIO m
+ => OAuth -> Credential -> Request
+ -> ExceptT OAuthException m Request
+checkOAuth oa crd req = if isBodyFormEncoded origHeaders then checkOAuthB oa
crd req else do
+ case mosig of
+ Nothing -> throwE $ OAuthException "oauth_signature parameter not found"
+ Just osig -> do
+ mhash <- moauth_body_hash
+ case (\oh nh -> oh == paramEncode nh) `liftM` moauth_body_hash_orig `ap`
mhash of
+ Just False -> throwE $ OAuthException "Failed test of oauth_body_hash"
+ _ -> let tok = addHashToCred mhash . injectOAuthToCred oa $ inserts
(remParams authParams) crd
+ in genSign oa tok req
+ {requestHeaders = catMaybes [mtypeHeader]}
+ >>= \nsig -> if osig == paramEncode nsig
+ then return req
+ else throwE $ OAuthException "Failed test of
oauth_signature"
+ where
+ origHeaders = requestHeaders req
+ mauthHeader = List.find ( ("Authorization" ==) . fst) $ origHeaders
+ mtypeHeader = List.find ( ("Content-Type" ==) . fst) $ origHeaders
+ authParams = (map parseParam . BS.split ',' . BS.drop 6 . snd) `liftM`
mauthHeader
+ remParams Nothing = []
+ remParams (Just ms) = filter ( not . flip elem
+ ("realm" : "oauth_signature" : map
fst (unCredential crd))
+ . fst) ms
+ mosig = fmap snd . join $ List.find (("oauth_signature" ==) . fst) `liftM`
authParams
+ parseParam = second (BS.takeWhile ('"' /=) . BS.drop 1 . BS.dropWhile ('"'
/=))
+ . splitEq . BS.dropWhile (' ' ==)
+ splitEq s = case BS.elemIndex '=' s of
+ Nothing -> (s,"")
+ Just i -> BS.splitAt i s
+ moauth_body_hash_orig = join $ (fmap snd . List.find ( ("oauth_body_hash"
==) . fst)) `liftM` authParams
+ moauth_body_hash = if moauth_body_hash_orig == Nothing
+ then return Nothing
+ else (Just
+ . encode
+ . BSL.toStrict
+ . bytestringDigest
+ . sha1
+ . BSL.fromStrict) `liftM` loadBodyBS req
+ addHashToCred (Just h) = insert "oauth_body_hash" h
+ addHashToCred Nothing = id
+
+checkOAuthB :: MonadIO m
+ => OAuth -> Credential -> Request
+ -> ExceptT OAuthException m Request
+checkOAuthB oa crd req0 = do
+ (mosig, reqBody) <- getSig `liftM` loadBodyBS req0
+ let req = req0 {requestBody = RequestBodyBS reqBody}
+ case mosig of
+ "" -> throwE $ OAuthException "oauth_signature parameter not found"
+ osig -> do
+ nsig <- genSign oa crd req
+ if osig == paramEncode nsig
+ then return req0
+ else throwE $ OAuthException "Failed test of oauth_signature"
+ where
+ getSig b = let (h1 , r ) = BS.breakSubstring "&oauth_signature=" b
+ (sig, h2) = BS.breakSubstring "&" $ BS.drop 17 r
+ in (sig, h1 `BS.append` h2)
+
+
----------------------------------------------------------------------
-- Temporary credentails
@@ -315,13 +398,14 @@
getTemporaryCredential' hook oa manager = do
let req = fromJust $ parseUrl $ oauthRequestUri oa
crd = maybe id (insert "oauth_callback") (oauthCallback oa) $
emptyCredential
- req' <- signOAuth oa crd $ hook (req { method = "POST" })
+ req' <- signOAuth' oa crd False addAuthHeader $ hook (req { method = "POST"
})
rsp <- liftIO $ httpLbs req' manager
if responseStatus rsp == status200
then do
let dic = parseSimpleQuery . toStrict . responseBody $ rsp
return $ Credential dic
- else liftIO . throwIO . OAuthException $ "Gaining OAuth Temporary
Credential Failed: " ++ BSL.unpack (responseBody rsp)
+ else liftIO . throwIO . OAuthException
+ $ "Gaining OAuth Temporary Credential Failed: " ++ BSL.unpack
(responseBody rsp)
----------------------------------------------------------------------
@@ -381,17 +465,29 @@
-> Manager
-> m Credential -- ^ Token Credential (Access Token &
Secret)
getAccessToken' hook oauth cr manager = do
- maybe_access_token <- getAccessTokenWith AccessTokenRequest {
accessTokenAddAuth = addAuthHeader, accessTokenRequestHook = hook,
accessTokenOAuth = oauth, accessTokenTemporaryCredential = cr,
accessTokenManager = manager }
- case maybe_access_token of
- Left error_response -> liftIO . throwIO . OAuthException $ "Gaining
OAuth Token Credential Failed: " ++ BSL.unpack (responseBody error_response)
+ maybe_access_token <- getAccessTokenWith AccessTokenRequest
+ { accessTokenAddAuth = addAuthHeader
+ , accessTokenRequestHook = hook
+ , accessTokenOAuth = oauth
+ , accessTokenTemporaryCredential = cr
+ , accessTokenManager = manager
+ }
+ case maybe_access_token of
+ Left error_response -> liftIO . throwIO . OAuthException
+ $ "Gaining OAuth Token Credential Failed: "
+ ++ BSL.unpack (responseBody error_response)
Right access_token -> return access_token
getAccessTokenWith :: MonadIO m
=> AccessTokenRequest -- ^ extensible parameters
- -> m (Either (Response BSL.ByteString) Credential) -- ^
Token Credential (Access Token & Secret) or the conduit response on failures
+ -> m (Either (Response BSL.ByteString) Credential
+ ) -- ^ Token Credential (Access Token & Secret) or the
conduit response on failures
getAccessTokenWith params = do
let req = hook (fromJust $ parseUrl $ oauthAccessTokenUri oa) { method =
"POST" }
- rsp <- liftIO $ flip httpLbs manager =<< signOAuth' oa (if oauthVersion
oa == OAuth10 then delete "oauth_verifier" cr else cr) add_auth req
+ rsp <- liftIO $ flip httpLbs manager
+ =<< signOAuth' oa (if oauthVersion oa == OAuth10
+ then delete "oauth_verifier" cr
+ else cr) False add_auth req
if responseStatus rsp == status200
then do
let dic = parseSimpleQuery . toStrict . responseBody $ rsp
@@ -451,10 +547,28 @@
req { requestHeaders = insertMap "Authorization" (renderAuthHeader prefix
cred) $ requestHeaders req }
renderAuthHeader :: BS.ByteString -> [(BS.ByteString, BS.ByteString)] ->
BS.ByteString
-renderAuthHeader prefix = (prefix `BS.append`). BS.intercalate "," . map
(\(a,b) -> BS.concat [paramEncode a, "=\"", paramEncode b, "\""]) . filterCreds
+renderAuthHeader prefix = (prefix `BS.append`)
+ . BS.intercalate ","
+ . map (\(a,b) -> BS.concat [paramEncode a, "=\"",
paramEncode b, "\""])
+ . filterCreds
filterCreds :: [(BS.ByteString, BS.ByteString)] -> [(BS.ByteString,
BS.ByteString)]
-filterCreds = filter ((`elem` ["oauth_token", "oauth_verifier",
"oauth_consumer_key", "oauth_signature_method", "oauth_timestamp",
"oauth_nonce", "oauth_version", "oauth_callback", "oauth_signature"]) . fst)
+-- as per http://oauth.net/core/1.0a -- 9.1.1. Normalize Request Parameters
+-- everything except "realm" parameter should be encoded
+-- 6.1.1, 6.1.2, 6.2.1, 6.3.2 and 7 allow encoding anything in the
authorization parameters
+-- 6.2.3 is only limited to oauth_token and oauth_verifier (although query
params are allowed)
+-- 6.3.1 does not allow specifing other params, so no need to filter them (it
is an error anyway)
+filterCreds = filter (not . flip elem ["realm", "oauth_token_secret"] . fst )
+--filterCreds = filter ((`elem` [ "oauth_consumer_key"
+-- , "oauth_token"
+-- , "oauth_signature"
+-- , "oauth_signature_method"
+-- , "oauth_timestamp"
+-- , "oauth_nonce"
+-- , "oauth_verifier"
+-- , "oauth_version"
+-- , "oauth_callback"
+-- ] ) . fst )
getBaseString :: MonadIO m => Credential -> Request -> m BSL.ByteString
@@ -467,15 +581,15 @@
bsURI = BS.concat [scheme, "://", host req, bsPort, path req]
bsQuery = parseSimpleQuery $ queryString req
bsBodyQ <- if isBodyFormEncoded $ requestHeaders req
- then liftM parseSimpleQuery $ toBS (requestBody req)
+ then liftM parseSimpleQuery $ loadBodyBS req
else return []
- let bsAuthParams = filter ((`elem`["oauth_consumer_key","oauth_token",
"oauth_version","oauth_signature_method","oauth_timestamp", "oauth_nonce",
"oauth_verifier", "oauth_version","oauth_callback"]).fst) $ unCredential tok
+ let bsAuthParams = filterCreds $ unCredential tok
allParams = bsQuery++bsBodyQ++bsAuthParams
bsParams = BS.intercalate "&" $ map (\(a,b)->BS.concat[a,"=",b]) $ sort
$ map (\(a,b) -> (paramEncode a,paramEncode b)) allParams
-- parameter encoding method in OAuth is slight different from ordinary one.
-- So this is OK.
- return $ BSL.intercalate "&" $ map (fromStrict.paramEncode) [bsMtd, bsURI,
bsParams]
+ return . BSL.fromStrict $ BS.intercalate "&" $ map paramEncode [bsMtd,
bsURI, bsParams]
----------------------------------------------------------------------
@@ -519,12 +633,19 @@
fromStrict = BSL.fromChunks . return
+loadBodyBS :: MonadIO m => Request -> m BS.ByteString
+loadBodyBS = toBS . requestBody
+
toBS :: MonadIO m => RequestBody -> m BS.ByteString
toBS (RequestBodyLBS l) = return $ toStrict l
toBS (RequestBodyBS s) = return s
toBS (RequestBodyBuilder _ b) = return $ toByteString b
toBS (RequestBodyStream _ givesPopper) = toBS' givesPopper
toBS (RequestBodyStreamChunked givesPopper) = toBS' givesPopper
+#if MIN_VERSION_http_client(0, 4, 28)
+toBS (RequestBodyIO op) = liftIO op >>= toBS
+#else
+#endif
toBS' :: MonadIO m => GivesPopper () -> m BS.ByteString
toBS' gp = liftIO $ do
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/authenticate-oauth-1.5.1.2/authenticate-oauth.cabal
new/authenticate-oauth-1.6/authenticate-oauth.cabal
--- old/authenticate-oauth-1.5.1.2/authenticate-oauth.cabal 2016-05-24
09:55:05.000000000 +0200
+++ new/authenticate-oauth-1.6/authenticate-oauth.cabal 2016-06-04
12:34:32.000000000 +0200
@@ -1,9 +1,9 @@
name: authenticate-oauth
-version: 1.5.1.2
+version: 1.6
license: BSD3
license-file: LICENSE
author: Hiromi Ishii
-maintainer: Hiromi Ishii
+maintainer: Hiromi Ishii, Artem Chirkin
synopsis: Library to authenticate with OAuth for Haskell web
applications.
description: API docs and the README are available at
<http://www.stackage.org/package/authenticate-oauth>.
category: Web
@@ -27,6 +27,7 @@
, random
, http-types >= 0.6
, blaze-builder
+ , transformers-compat >= 0.3
exposed-modules: Web.Authenticate.OAuth, Web.Authenticate.OAuth.IO
ghc-options: -Wall
