hoauth 0.1.5 → 0.1.6
raw patch · 2 files changed
+40/−41 lines, 2 files
Files
hoauth.cabal view
@@ -1,5 +1,5 @@ name: hoauth-version: 0.1.5+version: 0.1.6 category: Network,Protocol,OAuth license: BSD3 license-file: LICENSE
src/main/haskell/Network/Protocol/OAuth/Request.hs view
@@ -27,9 +27,8 @@ module Network.Protocol.OAuth.Request (Request(..),HTTPMethod(..),Parameter,PercentEncoding(encode,encodes,decode,decodes),append_param,show_url,show_oauthurl,show_oauthheader,show_urlencoded,read_urlencoded,(>>+)) where import Data.Bits as B-import qualified Data.ByteString.Lazy as B1-import qualified Data.ByteString.Lazy.UTF8 as B2-import qualified Data.ByteString.Lazy.Char8 as B3+import qualified Data.ByteString.Lazy as B+import qualified Codec.Binary.UTF8.String as S import qualified Data.Word as W import qualified Data.Char as C import qualified Data.List as L@@ -47,21 +46,21 @@ -- | Refer to <http://en.wikipedia.org/wiki/Percent-encoding> for more information class PercentEncoding a where -- | Encodes an /a/ type to bytestring.- encode :: a -> B1.ByteString+ encode :: a -> B.ByteString -- | Encodes a list of /a/ types into bytestring.- encodes :: [a] -> B1.ByteString- encodes = B1.concat . map encode+ encodes :: [a] -> B.ByteString+ encodes = B.concat . map encode -- | Decodes a single /a/ type out of an encoded string.- decode :: B1.ByteString -> (a,B1.ByteString)+ decode :: B.ByteString -> (a,B.ByteString) -- | Decodes the whole string into a list of /a/ types.- decodes :: B1.ByteString -> [a]+ decodes :: B.ByteString -> [a] decodes = L.unfoldr decode' where- decode' bs | B1.null bs = Nothing- | otherwise = (Just . decode) bs+ decode' bs | B.null bs = Nothing+ | otherwise = (Just . decode) bs -- | The HTTP request which must be properly authenticated with oauth. It is not meant to represent the full HTTP request, instead the data which matters for oauth authentication. data Request = HTTP { ssl :: Bool, -- ^ True means /HTTPS/ and false means /HTTP/@@ -80,32 +79,32 @@ in r { params = n_params } -- | Parses a urlencoded string.-read_urlencoded :: B1.ByteString -> [Parameter]-read_urlencoded u | B1.null u = []- | otherwise = (map param' . map keyval' . B1.split 0x26) u+read_urlencoded :: B.ByteString -> [Parameter]+read_urlencoded u | B.null u = []+ | otherwise = (map param' . map keyval' . B.split 0x26) u where- keyval' s = let (k,v) = B1.break (==0x3d) s- in (k, B1.drop 1 v)+ keyval' s = let (k,v) = B.break (==0x3d) s+ in (k, B.drop 1 v) - param' (k,v) | B1.null v = (decodes k,Nothing)+ param' (k,v) | B.null v = (decodes k,Nothing) | otherwise = (decodes k,(Just . decodes) v) -- | Show the entire url, including possibly any oauth parameter which may be present.-show_url :: Request -> B1.ByteString-show_url (HTTP s m h p0 p1 ps) = B1.concat [endpoint', path', query']+show_url :: Request -> B.ByteString+show_url (HTTP s m h p0 p1 ps) = B.concat [endpoint', path', query'] where- endpoint' | s && p0==443 = B3.pack $ "https://" ++ h- | s = B3.pack $ "https://" ++ h ++ (':':(show p0))- | not s && p0==80 = B3.pack $ "http://" ++ h- | otherwise = B3.pack $ "http://" ++ h ++ (':':(show p0))+ endpoint' | s && p0==443 = B.pack $ S.encode $ "https://" ++ h+ | s = B.pack $ S.encode $ "https://" ++ h ++ (':':(show p0))+ | not s && p0==80 = B.pack $ S.encode $ "http://" ++ h+ | otherwise = B.pack $ S.encode $ "http://" ++ h ++ (':':(show p0)) - path' = (B1.cons 0x2f . B1.concat . L.intersperse (B1.singleton 0x2f) . map encodes . _path_comp) p1+ path' = (B.cons 0x2f . B.concat . L.intersperse (B.singleton 0x2f) . map encodes . _path_comp) p1 - query' | m/=GET || null ps = B1.empty- | otherwise = (B1.cons 0x3f . show_urlencoded) ps+ query' | m/=GET || null ps = B.empty+ | otherwise = (B.cons 0x3f . show_urlencoded) ps -- | The URL to perform the oauth request-show_oauthurl :: Request -> B1.ByteString+show_oauthurl :: Request -> B.ByteString show_oauthurl req = let params' = params req req' = req { params = filter (not . L.isPrefixOf "oauth_" . fst) params' } in show_url req'@@ -113,19 +112,19 @@ -- | The Authorization or WWW-Authenticated headers to perform oauth authentication. show_oauthheader :: String -- ^ The realm -> Request- -> B1.ByteString -- ^ The Authorization\/WWW-Authenticate header-show_oauthheader realm (HTTP _ _ _ _ _ p) | B1.null params' = realm'- | otherwise = B1.concat [realm', B1.singleton 0x2c, params']+ -> B.ByteString -- ^ The Authorization\/WWW-Authenticate header+show_oauthheader realm (HTTP _ _ _ _ _ p) | B.null params' = realm'+ | otherwise = B.concat [realm', B.singleton 0x2c, params'] where- encodes' s = B1.concat [B1.singleton 0x22, encodes s, B1.singleton 0x22]+ encodes' s = B.concat [B.singleton 0x22, encodes s, B.singleton 0x22] params' = (_urlencode encodes' 0x2c . filter (L.isPrefixOf "oauth_" . fst)) p - realm' = B3.pack ("OAuth realm=\"" ++ realm ++ "\"")+ realm' = B.pack $ S.encode ("OAuth realm=\"" ++ realm ++ "\"") -- | Produces a urlencoded string. -- For convenience, it sorts the parameters first, as demands the oauth protocol.-show_urlencoded :: [Parameter] -> B1.ByteString+show_urlencoded :: [Parameter] -> B.ByteString show_urlencoded = _urlencode encodes 0x26 -- | Convenience operator to append an item in request's parameters list@@ -133,7 +132,7 @@ (>>+) = append_param instance PercentEncoding Char where- encode = B1.pack . concat . map enc' . B1.unpack . B2.fromString . (:[])+ encode = B.pack . concat . map enc' . S.encode . (:[]) where enc' b | elem b whitelist' = [b] | otherwise = let b0 = b .&. 0x0F@@ -143,9 +142,9 @@ decode bytes = let c0 = (head . decodes) bytes b0 = encode c0- in (c0, B1.drop (B1.length b0) bytes)+ in (c0, B.drop (B.length b0) bytes) - decodes = B2.toString . B1.pack . fold' . B1.unpack+ decodes = S.decode . fold' . B.unpack where fold' (37:b1:b0:bs) = let b1' = (fromIntegral . C.digitToInt . C.chr . fromIntegral) b1 b0' = (fromIntegral . C.digitToInt . C.chr . fromIntegral) b0@@ -155,12 +154,12 @@ fold' (b:bs) = b : fold' bs fold' [] = [] -_urlencode :: (String -> B1.ByteString) -> W.Word8 -> [Parameter] -> B1.ByteString-_urlencode ve s p | null p = B1.empty- | otherwise = (B1.init . foldr fold' B1.empty . L.sort) p+_urlencode :: (String -> B.ByteString) -> W.Word8 -> [Parameter] -> B.ByteString+_urlencode ve s p | null p = B.empty+ | otherwise = (B.init . foldr fold' B.empty . L.sort) p where - fold' (k,Nothing) = B1.append (B1.concat [encodes k, B1.singleton 0x3d, B1.singleton s])- fold' (k,Just v) = B1.append (B1.concat [encodes k, B1.singleton 0x3d, ve v, B1.singleton s])+ fold' (k,Nothing) = B.append (B.concat [encodes k, B.singleton 0x3d, B.singleton s])+ fold' (k,Just v) = B.append (B.concat [encodes k, B.singleton 0x3d, ve v, B.singleton s]) _path_comp :: String -> [String] _path_comp p = (filter (not . null) . L.unfoldr unfold') p ++ trailing'