diff --git a/hoauth.cabal b/hoauth.cabal --- a/hoauth.cabal +++ b/hoauth.cabal @@ -1,5 +1,5 @@ name: hoauth -version: 0.3.0 +version: 0.3.1 category: Network,Protocol,OAuth license: BSD3 license-file: LICENSE @@ -18,23 +18,24 @@ library build-depends: base<5 - ,bytestring>=0.9.1.5 - ,binary>=0.5.0.2 - ,SHA>=1.4.1.1 - ,dataenc>=0.13.0.2 - ,utf8-string>=0.3.4 - ,time>=1.1.4 - ,old-locale>=1.0.0.2 - ,random>=1.0.0.2 - ,curl>=1.3.5 - ,mtl>=1.1.0.2 + , bytestring>=0.9.1.5 + , binary>=0.5.0.2 + , SHA>=1.4.1.1 + , dataenc>=0.13.0.2 + , utf8-string>=0.3.4 + , time>=1.1.4 + , old-locale>=1.0.0.2 + , random>=1.0.0.2 + , curl>=1.3.5 + , mtl>=1.1.0.2 + , RSA>=1.0.5 exposed-modules: Network.OAuth.Http.Request - , Network.OAuth.Http.Response - , Network.OAuth.Http.HttpClient - , Network.OAuth.Http.CurlHttpClient - , Network.OAuth.Http.PercentEncoding - , Network.OAuth.Http.Util - , Network.OAuth.Consumer + , Network.OAuth.Http.Response + , Network.OAuth.Http.HttpClient + , Network.OAuth.Http.CurlHttpClient + , Network.OAuth.Http.PercentEncoding + , Network.OAuth.Http.Util + , Network.OAuth.Consumer hs-source-dirs: src/main/haskell ghc-options: -W -Wall diff --git a/src/main/haskell/Network/OAuth/Consumer.hs b/src/main/haskell/Network/OAuth/Consumer.hs --- a/src/main/haskell/Network/OAuth/Consumer.hs +++ b/src/main/haskell/Network/OAuth/Consumer.hs @@ -40,12 +40,11 @@ -- > srvUrl = fromJust . parseURL $ "http://service/path/to/resource/" -- > authUrl = ("http://service.provider/authorize?oauth_token="++) . findWithDefault ("oauth_token","ERROR") . oauthParams -- > app = Application "consumerKey" "consumerSec" OOB --- > response = runOAuthM_ $ do { ignite app --- > ; signRq2 PLAINTEXT Nothing reqUrl >>= oauthRequest CurlHttpClient --- > ; cliAskAuthorization authUrl --- > ; signRq2 PLAINTEXT Nothing accUrl >>= oauthRequest CurlHttpClient --- > ; signRq2 HMACSHA1 (Just $ Realm "realm") srvUrl >>= serviceRequest CurlHttpClient --- > } +-- > response = runOAuthM (fromApplication app) $ do { signRq2 PLAINTEXT Nothing reqUrl >>= oauthRequest CurlHttpClient +-- > ; cliAskAuthorization authUrl +-- > ; signRq2 PLAINTEXT Nothing accUrl >>= oauthRequest CurlHttpClient +-- > ; signRq2 HMACSHA1 (Just $ Realm "realm") srvUrl >>= serviceRequest CurlHttpClient +-- > } -- module Network.OAuth.Consumer ( -- * Types @@ -62,7 +61,6 @@ -- * OAuthMonadT related functions , runOAuth , runOAuthM - , runOAuthM_ , oauthRequest , packRq , signRq @@ -76,7 +74,6 @@ -- * Token related functions , twoLegged , threeLegged - , notoken , signature , injectOAuthVerifier , fromApplication @@ -101,6 +98,7 @@ import qualified Data.Digest.Pure.SHA as S import qualified Codec.Binary.Base64 as B64 import qualified Data.ByteString.Lazy as B +import qualified Codec.Crypto.RSA as R -- | A request that is ready to be performed, i.e., that contains authorization headers. newtype OAuthRequest = OAuthRequest { unpackRq :: Request } @@ -151,9 +149,6 @@ | AccessToken { application :: Application , oauthParams :: FieldList } - {-| Use this when there is no oauth token present. The request goes unauthenticated. - -} - | NoToken deriving (Eq) -- | Available signature methods. @@ -171,7 +166,14 @@ by an /&/ character (ASCII code 38) even if empty. -} | HMACSHA1 - deriving (Eq) + {-| The "RSA-SHA1" signature method uses the RSASSA-PKCS1-v1_5 signature + algorithm as defined in [RFC3447], Section 8.2 (also known as + PKCS#1), using SHA-1 as the hash function for EMSA-PKCS1-v1_5. To + use this method, the client MUST have established client credentials + with the server that included its RSA public key (in a manner that is + beyond the scope of this specification). + -} + | RSASHA1 R.PrivateKey data OAuthMonadT m a = OAuthMonadT (Token -> m (Either String (Token,a))) @@ -181,6 +183,8 @@ signature m token req = case m of PLAINTEXT -> key HMACSHA1 -> b64encode $ S.bytestringDigest (S.hmacSha1 (bsencode key) (bsencode text)) + RSASHA1 k -> b64encode $ R.rsassa_pkcs1_v1_5_sign R.ha_SHA1 k (bsencode text) + where bsencode = B.pack . map (fromIntegral.ord) b64encode = B64.encode . B.unpack @@ -213,11 +217,6 @@ threeLegged (AccessToken _ _) = True threeLegged _ = False --- | Tests whether or not the current token is NoToken. -notoken :: Token -> Bool -notoken NoToken = True -notoken _ = False - -- | Transforms an application into a token. ignite :: (MonadIO m) => Application -> OAuthMonadT m () ignite = putToken . fromApplication @@ -239,10 +238,6 @@ runOAuthM :: (Monad m) => Token -> OAuthMonadT m a -> m a runOAuthM = runOAuth fail --- | Invokes runOAuthM with NoToken using fail as the error handler. -runOAuthM_ :: (Monad m) => OAuthMonadT m a -> m a -runOAuthM_ = runOAuthM NoToken - -- | Executes an oauth request which is intended to upgrade/refresh the current -- token. oauthRequest :: (HttpClient c, MonadIO m) => c -> OAuthRequest -> OAuthMonadT m Token @@ -267,13 +262,12 @@ signRq2 :: (MonadIO m) => SigMethod -> Maybe Realm -> Request -> OAuthMonadT m OAuthRequest signRq2 sigm realm req = getToken >>= \t -> lift $ signRq t sigm realm req --- | Simply create the OAuthRequest but adds no Authorization header. This is the same as using signRq with NoToken. +-- | Simply create the OAuthRequest but adds no Authorization header. packRq :: Request -> OAuthRequest packRq = OAuthRequest -- | Complete the request with authorization headers. signRq :: (MonadIO m) => Token -> SigMethod -> Maybe Realm -> Request -> m OAuthRequest -signRq NoToken _ _ req = return (packRq req) signRq token sigm realm req0 = do { nonce <- _nonce ; timestamp <- _timestamp ; let authValue = authorization sigm realm nonce timestamp token req0 @@ -316,7 +310,6 @@ of TwoLegg app params -> Right $ ReqToken app (payload `union` params) ReqToken app params -> Right $ AccessToken app (payload `union` params) AccessToken app params -> Right $ AccessToken app (payload `union` params) - NoToken -> Right $ NoToken | otherwise = Left errorMessage where payload = parseQString . map (chr.fromIntegral) . B.unpack . rspPayload $ rsp @@ -331,7 +324,6 @@ , "oauth_token_secret" , "oauth_callback_confirmed" ] - | notoken token = [] | otherwise = [ "oauth_token" , "oauth_token_secret" ] @@ -350,9 +342,13 @@ where oauthFields = [ ("oauth_consumer_key", consKey.application $ token) , ("oauth_nonce", unNonce nonce) , ("oauth_timestamp", unTimestamp time) - , ("oauth_signature_method", show m) + , ("oauth_signature_method", showMethod m) , ("oauth_version", "1.0") ] ++ extra + + showMethod HMACSHA1 = "HMAC-SHA1" + showMethod (RSASHA1 _) = "RSA-SHA1" + showMethod PLAINTEXT = "PLAINTEXT" oauthPrefix = case realm of Nothing -> "OAuth " @@ -366,7 +362,6 @@ AccessToken _ params -> filter (not.null.snd) [ ("oauth_token", findWithDefault ("oauth_token","") params) , ("oauth_session_handle", findWithDefault ("oauth_session_handle","") params) ] - NoToken -> [] oauthSignature = signature m token (req {qString = (qString req) `union` (fromList oauthFields)}) @@ -406,10 +401,6 @@ where left = return . Left right (t1,a) = return (Right (t1, f a)) -instance Show SigMethod where - showsPrec _ PLAINTEXT = showString "PLAINTEXT" - showsPrec _ HMACSHA1 = showString "HMAC-SHA1" - instance Show OAuthCallback where showsPrec _ OOB = showString "oob" showsPrec _ (URL u) = showString u @@ -452,7 +443,6 @@ ; Bi.put app ; Bi.put params } - put NoToken = Bi.put (3 :: Word8) get = do { t <- Bi.get :: Bi.Get Word8 ; case t of 0 -> do { app <- Bi.get @@ -467,7 +457,6 @@ ; params <- Bi.get ; return (AccessToken app params) } - 3 -> return NoToken _ -> fail "Consumer#get: parse error" }