diff --git a/hoauth.cabal b/hoauth.cabal --- a/hoauth.cabal +++ b/hoauth.cabal @@ -1,5 +1,5 @@ name: hoauth -version: 0.2.1 +version: 0.2.2 category: Network,Protocol,OAuth license: BSD3 license-file: LICENSE @@ -8,7 +8,6 @@ stability: experimental build-type: Simple cabal-version: >= 1.6 -tested-with: GHC==6.12.1 synopsis: A Haskell implementation of OAuth 1.0a protocol. description: This library implements all PLAINTEXT, HMAC-SHA1 and RSA-SHA1 signatures as defined in the specification 1.0. Currently it @@ -40,5 +39,5 @@ ghc-options: -W -Wall -fwarn-tabs source-repository head - type: darcs - location: http://projects.bitforest.org/hoauth/ + type: git + location: git@github.com:dsouza/hoauth.git 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 @@ -110,7 +110,7 @@ , consSec :: String , callback :: OAuthCallback } - deriving (Show,Eq) + deriving (Eq) -- | The OAuth Token. data Token = @@ -119,8 +119,9 @@ TwoLegg {application :: Application ,oauthParams :: FieldList } - {-| The request token is a 2 legged OAuth. At this point, the service - provider has validated your application. + {-| The service provider has granted you the request token but the user has + not yet authorized your application. If you use this token it will goes + as 2 legged OAuth. -} | ReqToken {application :: Application ,oauthParams :: FieldList @@ -325,7 +326,7 @@ case t of 0 -> return OOB 1 -> fmap URL Bi.get - _ -> error "Consumer: parse error" + _ -> fail "Consumer: parse error" instance Bi.Binary Application where put app = do Bi.put (consKey app) @@ -358,6 +359,6 @@ 2 -> do app <- Bi.get params <- Bi.get return (AccessToken app params) - _ -> error "Consumer: parse error" + _ -> fail "Consumer: parse error" -- vim:sts=2:sw=2:ts=2:et diff --git a/src/main/haskell/Network/OAuth/Http/HttpClient.hs b/src/main/haskell/Network/OAuth/Http/HttpClient.hs --- a/src/main/haskell/Network/OAuth/Http/HttpClient.hs +++ b/src/main/haskell/Network/OAuth/Http/HttpClient.hs @@ -33,9 +33,9 @@ import Network.Curl import Control.Monad.Fix -import Control.Monad.Trans import Network.OAuth.Http.Request import Network.OAuth.Http.Response +import Control.Monad.Trans import Data.Char (chr,ord) import qualified Data.ByteString.Lazy as B @@ -44,10 +44,16 @@ -- | Performs the request and returns the response wrapped into a given monad. request :: Request -> m Response + -- | Unpacks the monad and returns the inner IO monad. + unlift :: m a -> IO a + -- | The libcurl backend newtype CurlM a = CurlM { unCurlM :: IO a } deriving (Monad,MonadIO,MonadFix,Functor) + instance HttpClient CurlM where + unlift = unCurlM + request req = CurlM $ withCurlDo $ do c <- initialize setopts c opts rsp <- perform_with_response_ c diff --git a/src/main/haskell/Network/OAuth/Http/PercentEncoding.hs b/src/main/haskell/Network/OAuth/Http/PercentEncoding.hs --- a/src/main/haskell/Network/OAuth/Http/PercentEncoding.hs +++ b/src/main/haskell/Network/OAuth/Http/PercentEncoding.hs @@ -30,11 +30,11 @@ ,decodeWithDefault ) where -import Data.Monoid (mappend) -import Data.List (splitAt) +import Data.List (unfoldr) import qualified Codec.Binary.UTF8.String as U -import Data.Char (intToDigit,digitToInt,toUpper,ord) +import Data.Char (intToDigit,digitToInt,toUpper,ord,chr) import Data.Bits +import Data.Word (Word8) class PercentEncoding a where -- | Encodes a type into its percent encoding representation. @@ -45,37 +45,38 @@ -- | Encodes Char types using UTF\-8 charset. instance PercentEncoding Char where - encode c | c `elem` whitelist = [c] - | otherwise = concatMap (run.fromIntegral) (U.encode [c]) - where whitelist = ['a'..'z'] - ++ ['A'..'Z'] - ++ ['0'..'9'] - ++ "-._~" - run b = '%' : map (toUpper.intToDigit) [shiftR (b .&. 0xF0) 4,b .&. 0x0F] + encode c = concatMap encode (U.encode [c]) - decode xs = case (U.decode . tobytes $ xs) - of [] -> Nothing - (y:_) -> let sizeof = if ("%"==take 1 xs) - then length (encode y) - else 1 - in Just (y,drop sizeof xs) - where tobytes (b:bs) = case b - of '%' -> let ([c0,c1],bs') = splitAt 2 bs - b0 = (shiftL (digitToInt c0) 4) .&. 0xF0 - b1 = (digitToInt c1) .&. 0x0F - byte = fromIntegral (b0 .|. b1) - in byte : tobytes bs' - _ -> fromIntegral (ord b) : tobytes bs - tobytes [] = [] + decode [] = Nothing + decode (x:xs) = case (fmap (U.decode.fst) (decode (x:xs))) + of Nothing -> Nothing + Just [] -> Nothing + Just (y:_) | x=='%' -> let sizeof = length (encode y) - 1 + in Just (y,drop sizeof xs) + | otherwise -> Just (y,xs) --- | Add support for encoding strings +instance PercentEncoding Word8 where + encode b | b `elem` whitelist = [chr.fromIntegral $ b] + | otherwise = '%' : map (toUpper.intToDigit.fromIntegral) + [shiftR (b .&. 0xF0) 4,b .&. 0x0F] + where whitelist = [97..122] + ++ [65..90] + ++ [48..57] + ++ [45,46,95,126] + + decode [] = Nothing + decode (b:bs) = case b + of '%' -> let ([c0,c1],bs') = splitAt 2 bs + b0 = (shiftL (digitToInt c0) 4) .&. 0xF0 + b1 = (digitToInt c1) .&. 0x0F + byte = fromIntegral (b0 .|. b1) + in Just (byte,bs') + _ -> Just (fromIntegral (ord b),bs) + instance (PercentEncoding a) => PercentEncoding [a] where - encode (x:xs) = encode x ++ encode xs - encode [] = [] - - decode xs = do (c,ys) <- (decode xs) - cs <- fmap (fst) (decode ys `mappend` Just ([],"")) - return (c:cs,"") + encode = concatMap encode + decode = pack . unfoldr decode + where pack xs = Just (xs,"") -- | Decodes a percent encoded string. In case of failure returns a default value, instead of Nothing. decodeWithDefault :: (PercentEncoding a) => a -> String -> a