hoauth 0.3.3 → 0.3.4

raw patch · 4 files changed

+94/−28 lines, 4 filesdep +crypto-pubkey-typesdep +entropydep ~RSAPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: crypto-pubkey-types, entropy

Dependency ranges changed: RSA

API changes (from Hackage documentation)

Files

• hoauth.cabal +5/−3
• src/main/haskell/Network/OAuth/Consumer.hs +10/−6
• src/main/haskell/Network/OAuth/Http/CurlHttpClient.hs +23/−10
• src/main/haskell/Network/OAuth/Http/Request.hs +56/−9

@@ -1,5 +1,5 @@ name: hoauth-version: 0.3.3+version: 0.3.4 category: Network,Protocol,OAuth license: BSD3 license-file: LICENSE@@ -19,6 +19,7 @@ library   build-depends: base<5                , bytestring>=0.9.1.5+               , crypto-pubkey-types>=0.1.1                , binary>=0.5.0.2                , SHA>=1.4.1.1                , dataenc>=0.13.0.2@@ -28,7 +29,8 @@                , random>=1.0.0.2                , curl>=1.3.5                , mtl>=1.1.0.2-               , RSA>=1.0.5+               , RSA>=1.2.0.1+               , entropy>=0.2.1   exposed-modules:  Network.OAuth.Http.Request                  , Network.OAuth.Http.Response                  , Network.OAuth.Http.HttpClient@@ -42,4 +44,4 @@  source-repository head   type:     git-  location: git@github.com:dsouza/hoauth.git+  location: git://github.com/dsouza/hoauth.git

@@ -88,7 +88,7 @@ import Control.Monad import Control.Monad.Trans import System.IO-import System.Random (randomRIO)+import System.Entropy (getEntropy) import System.Locale (defaultTimeLocale) import Data.Time (getCurrentTime,formatTime) import Data.Char (chr,ord)@@ -97,12 +97,14 @@ import qualified Data.Binary as Bi import qualified Data.Digest.Pure.SHA as S import qualified Codec.Binary.Base64 as B64+import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as B-import qualified Codec.Crypto.RSA as R+import qualified Codec.Crypto.RSA        as R+import qualified Crypto.Types.PubKey.RSA as R  -- | A request that is ready to be performed, i.e., that contains authorization headers. newtype OAuthRequest = OAuthRequest { unpackRq :: Request }-                     deriving (Show,Eq)+                     deriving (Show)  -- | Random string that is unique amongst requests. Refer to <http://oauth.net/core/1.0/#nonce> for more information. newtype Nonce = Nonce { unNonce :: String }@@ -202,9 +204,13 @@                                             ]          params = if (ifindWithDefault ("content-type","") (reqHeaders req) == "application/x-www-form-urlencoded")++                 -- e.g., in the case of most Twitter API calls                  then (qString req) `unionAll` (parseQString . map (chr.fromIntegral)                                                               . B.unpack                                                               . reqPayload $ req)++                 -- e.g., in the case of a "multipart/form-data" image upload, however, the payload isn't signed                  else qString req  -- | Returns true if the token is able to perform 2-legged oauth requests.@@ -368,9 +374,7 @@         enquote = intercalate "," . map (\(k,v) -> encode k ++"=\""++ encode v ++"\"")  _nonce :: (MonadIO m) => m Nonce-_nonce = do { rand <- liftIO (randomRIO (0,maxBound::Int))-            ; return (Nonce $ show rand)-            }+_nonce = liftIO $ liftM (Nonce . B64.encode . BS.unpack) (getEntropy 32)  _timestamp :: (MonadIO m) => m Timestamp _timestamp = do { clock <- liftIO getCurrentTime

@@ -61,24 +61,37 @@           curlMethod = case (method req)                        of GET   -> [ CurlHttpGet True ]                           HEAD  -> [ CurlNoBody True,CurlCustomRequest "HEAD" ]-                          other -> if (B.null.reqPayload $ req)+                          other -> if ((B.null . reqPayload $ req) && 0 == length (multipartPayload req))                                    then [ CurlHttpGet True,CurlCustomRequest (show other) ]                                    else [ CurlPost True,CurlCustomRequest (show other) ]                                         -          curlPostData = if (B.null.reqPayload $ req)-                         then []-                         else [ CurlPostFields [map (chr.fromIntegral).B.unpack.reqPayload $ req] ]-                              +          curlPostData =+             if B.null . reqPayload $ req+             then+                case multipartPayload req+                of []    -> []                   -- i.e., no payload at all++                   parts -> [CurlHttpPost (convertMultipart parts)] -- i.e., "multipart/form-data"+                                                 -- content with a boundary and MIME stuff+                                                 -- see libcurl for HttpPost, Content+             else+                case multipartPayload req+                of []    -> let tostr = map (chr.fromIntegral).B.unpack+                                field = reqPayload req+                            in [CurlPostFields [tostr field]] -- i.e., "application/x-www-form-urlencoded"+                                                              -- strings with field sep '&'+                                                              -- although we're only giving libcurl a single field++                   _ -> error "with both CurlPostFields and CurlHttpPost, I'm not sure what libcurl would do..."+           curlHeaders = let headers = (map (\(k,v) -> k++": "++v).toList.reqHeaders $ req)-                        in [ CurlHttpHeaders $ ("Content-Length: " ++ (show.B.length.reqPayload $ req))-                                               : headers-                           ]+                        in [CurlHttpHeaders headers]            opts = [ CurlURL (showURL req)                  , CurlHttpVersion httpVersion                  , CurlHeader False-                 , CurlSSLVerifyHost 1-                 , CurlSSLVerifyPeer False+                 , CurlSSLVerifyHost 2+                 , CurlSSLVerifyPeer True                  , CurlTimeout 30                  ] ++ curlHeaders                    ++ curlMethod 

@@ -33,6 +33,10 @@        , FieldList()        , Version(..)        , Method(..)+       , FormDataPart(..)+       , Content(..)+         -- * conversion of [FormDataPart] to curl's [HttpPost]+       , convertMultipart          -- * FieldList related functions        , fromList        , singleton@@ -58,6 +62,8 @@        ) where  import Control.Monad.State+import qualified Network.Curl.Post as Curl (HttpPost(..), Content(..))+import qualified Network.Curl.Types as Curl (Long) import Network.OAuth.Http.PercentEncoding import Network.OAuth.Http.Util import Data.List (intercalate,isPrefixOf)@@ -65,6 +71,7 @@ import Data.Char (toLower) import qualified Data.ByteString.Lazy as B import qualified Data.Binary as Bi+import Foreign.C.String (CString)  -- | All known HTTP methods data Method =   GET@@ -85,18 +92,56 @@ newtype FieldList = FieldList { unFieldList :: [(String,String)] }   deriving (Eq,Ord) -data Request = ReqHttp { version    :: Version      -- ^ Protocol version-                       , ssl        :: Bool         -- ^ Wheter or not to use ssl-                       , host       :: String       -- ^ The hostname to connect to-                       , port       :: Int          -- ^ The port to connect to-                       , method     :: Method       -- ^ The HTTP method of the request.-                       , reqHeaders :: FieldList    -- ^ Request headers-                       , pathComps  :: [String]     -- ^ The path split into components -                       , qString    :: FieldList    -- ^ The query string, usually set for GET requests-                       , reqPayload :: B.ByteString -- ^ The message body+data Request = ReqHttp { version          :: Version        -- ^ Protocol version+                       , ssl              :: Bool           -- ^ Wheter or not to use ssl+                       , host             :: String         -- ^ The hostname to connect to+                       , port             :: Int            -- ^ The port to connect to+                       , method           :: Method         -- ^ The HTTP method of the request.+                       , reqHeaders       :: FieldList      -- ^ Request headers+                       , pathComps        :: [String]       -- ^ The path split into components +                       , qString          :: FieldList      -- ^ The query string, usually set for GET requests+                       , reqPayload       :: B.ByteString   -- ^ The message body (the first/only string part)+                       , multipartPayload :: [FormDataPart] -- ^ The message body (i.e., for multipart/form-data)                        }   deriving (Eq,Show) +-- one part of a multipart/form-data POST request+data FormDataPart =+   FormDataPart { postName     :: String+                , contentType  :: Maybe String+                , content      :: Content+                , extraHeaders :: [String]+                -- , extraEntries :: [FormDataPart]    -- commented out in Curl's Post.hs+                , showName     :: Maybe String+                }+   deriving (Eq, Show)++-- data for one part+-- as either a String or a FilePath (for Curl to open and include)+data Content = ContentFile FilePath+             | ContentBuffer CString Curl.Long+             | ContentString String+   deriving (Eq, Show)++-- convert one Part to Curl's HttpPost+convertMultipart :: [FormDataPart] -> [Curl.HttpPost]+convertMultipart parts =+   map convertPart parts+   where+      convertPart :: FormDataPart -> Curl.HttpPost+      convertPart part =+         Curl.HttpPost { Curl.postName     = postName     part+                       , Curl.contentType  = contentType  part+                       , Curl.content      = convertCont (content part)+                       , Curl.extraHeaders = extraHeaders part+                       , Curl.showName     = showName     part+                       }++      convertCont :: Content -> Curl.Content+      convertCont (ContentFile   z) = Curl.ContentFile   z+      convertCont (ContentString y) = Curl.ContentString y+      convertCont (ContentBuffer w x) = Curl.ContentBuffer w x+ -- | Show the protocol in use (currently either https or http) showProtocol :: Request -> String showProtocol req @@ -154,6 +199,7 @@                           , pathComps  = []                           , qString    = fromList []                           , reqPayload = B.empty+                          , multipartPayload = []                           }  -- | Parse a query string.@@ -175,6 +221,7 @@                           , pathComps  = []                           , qString    = fromList []                           , reqPayload = B.empty+                          , multipartPayload = []                           }  -- | Creates a FieldList type from a list.