hoauth 0.2.1 → 0.2.2

raw patch · 4 files changed

+48/−41 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hoauth.cabal +3/−4
• src/main/haskell/Network/OAuth/Consumer.hs +6/−5
• src/main/haskell/Network/OAuth/Http/HttpClient.hs +7/−1
• src/main/haskell/Network/OAuth/Http/PercentEncoding.hs +32/−31

@@ -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

@@ -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

@@ -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

@@ -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