http-enumerator 0.0.0 → 0.0.1
raw patch · 4 files changed
+140/−8 lines, 4 filesdep +AESdep +mtldep +tlsdep ~networknew-component:exe:http-enumeratorPVP ok
version bump matches the API change (PVP)
Dependencies added: AES, mtl, tls
Dependency ranges changed: network
API changes (from Hackage documentation)
Files
- Network/HTTP/Enumerator.hs +81/−5
- Network/HTTP/Enumerator/HttpParser.hs +1/−0
- http-enumerator.cabal +23/−3
- test.hs +35/−0
Network/HTTP/Enumerator.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-} module Network.HTTP.Enumerator ( Request (..) , Response (..)@@ -12,7 +13,22 @@ , withHttpEnumerator ) where +#if OPENSSL+import OpenSSL import qualified OpenSSL.Session as SSL+#else+import System.IO (hClose, hSetBuffering, BufferMode (NoBuffering))+import qualified Network.TLS.Client as TLS+import qualified Network.TLS.Struct as TLS+import qualified Network.TLS.Cipher as TLS+import qualified Network.TLS.SRandom as TLS+import qualified Control.Monad.State as MTL+import Data.IORef+import Network (connectTo, PortID (PortNumber))+import qualified Codec.Crypto.AES.Random as AESRand+import Control.Applicative ((<$>))+#endif+ import Network.Socket import qualified Network.Socket.ByteString as B import qualified Data.ByteString as S@@ -31,7 +47,6 @@ import Data.Word (Word8) import Data.Bits import Data.Maybe (fromMaybe)-import OpenSSL -- | The OpenSSL library requires some initialization of variables to be used, -- and therefore you must call 'withOpenSSL' before using any of its functions.@@ -44,7 +59,11 @@ -- early as you like; in fact, simply wrapping the do block of your main -- function is probably best. withHttpEnumerator :: IO a -> IO a+#if OPENSSL withHttpEnumerator = withOpenSSL+#else+withHttpEnumerator = id+#endif getSocket :: String -> Int -> IO Socket getSocket host' port' = do@@ -64,8 +83,10 @@ sClose sock return a -withOpenSslConn :: String -> Int -> (HttpConn -> IO a) -> IO a-withOpenSslConn host' port' f = do+withSslConn :: String -> Int -> (HttpConn -> IO a) -> IO a+withSslConn host' port' f = do++#if OPENSSL ctx <- SSL.context sock <- getSocket host' port' ssl <- SSL.connection ctx sock@@ -76,7 +97,62 @@ } SSL.shutdown ssl SSL.Unidirectional return a+#else+ ranByte <- S.head <$> AESRand.randBytes 1+ _ <- AESRand.randBytes (fromIntegral ranByte)+ Just clientRandom <- TLS.clientRandom . S.unpack <$> AESRand.randBytes 32+ premasterRandom <- (TLS.ClientKeyData . S.unpack) <$> AESRand.randBytes 46+ seqInit <- conv . S.unpack <$> AESRand.randBytes 4+ handle <- connectTo host' (PortNumber $ fromIntegral port')+ hSetBuffering handle NoBuffering+ let params = TLS.TLSClientParams+ TLS.TLS10+ [TLS.TLS10]+ Nothing+ [ TLS.cipher_AES128_SHA1+ , TLS.cipher_AES256_SHA1+ , TLS.cipher_RC4_128_MD5+ , TLS.cipher_RC4_128_SHA1+ ]+ Nothing+ (TLS.TLSClientCallbacks Nothing) + (a, _) <- TLS.runTLSClient (do+ TLS.connect handle clientRandom premasterRandom+ state <- TLS.TLSClient MTL.get+ istate <- TLS.TLSClient $ MTL.liftIO $ newIORef state+ a <- TLS.TLSClient $ MTL.liftIO $ f HttpConn+ { hcRead = \_len -> do+ state1 <- readIORef istate+ (a, state2) <-+ flip MTL.runStateT state1+ $ TLS.runTLSC+ $ TLS.recvData handle+ writeIORef istate state2+ return $ S.concat $ L.toChunks a+ , hcWrite = \bs -> do+ state1 <- readIORef istate+ state2 <-+ flip MTL.execStateT state1+ $ TLS.runTLSC+ $ TLS.sendData handle+ $ L.fromChunks [bs]+ writeIORef istate state2+ }+ state' <- TLS.TLSClient $ MTL.liftIO $ readIORef istate+ TLS.TLSClient $ MTL.put state'+ TLS.close handle+ return a+ ) params $ TLS.makeSRandomGen seqInit+ hClose handle+ return a++conv :: [Word8] -> Int+conv l = (a `shiftL` 24) .|. (b `shiftL` 16) .|. (c `shiftL` 8) .|. d+ where+ [a,b,c,d] = map fromIntegral l+#endif+ data HttpConn = HttpConn { hcRead :: Int -> IO S.ByteString , hcWrite :: S.ByteString -> IO ()@@ -113,9 +189,9 @@ } http :: Request -> Iteratee S.ByteString IO a -> IO (Response a)-http req@(Request {..}) bodyIter = do+http Request {..} bodyIter = do let h' = S8.unpack host- res <- (if secure then withOpenSslConn else withSocketConn) h' port go+ res <- (if secure then withSslConn else withSocketConn) h' port go case res of Left e -> throwIO e Right x -> return x
Network/HTTP/Enumerator/HttpParser.hs view
@@ -86,6 +86,7 @@ parseChunk :: Parser S.ByteString parseChunk = do len <- hexs+ skipWhile isSpace newline <|> attribs bs <- take len newline
http-enumerator.cabal view
@@ -1,5 +1,5 @@ name: http-enumerator-version: 0.0.0+version: 0.0.1 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -13,20 +13,40 @@ build-type: Simple homepage: http://github.com/snoyberg/http-enumerator +flag openssl+ description: Build using the HSOpenSSL library.+ default: False+flag test+ description: Build the test executable.+ default: False+ library build-depends: base >= 4 && < 5 , bytestring >= 0.9.1.4 && < 0.10 , transformers >= 0.2 && < 0.3- , HsOpenSSL >= 0.8 && < 0.9 , failure >= 0.1 && < 0.2 , enumerator >= 0.4 && < 0.5- , network >= 2.2.1.7 && < 2.3+ , network >= 2.2.1 && < 2.3 , network-bytestring >= 0.1.3 && < 0.2 , attoparsec >= 0.8.0.2 && < 0.9 , attoparsec-enumerator >= 0.2 && < 0.3+ if flag(openssl)+ build-depends: HsOpenSSL >= 0.8 && < 0.9+ cpp-options: -DOPENSSL+ else+ build-depends: tls >= 0.1.2 && < 0.2+ , mtl >= 1.1 && < 1.2+ , AES >= 0.2.7 && < 0.3 exposed-modules: Network.HTTP.Enumerator other-modules: Network.HTTP.Enumerator.HttpParser ghc-options: -Wall++executable http-enumerator+ main-is: test.hs+ if flag(test)+ Buildable: True+ else+ Buildable: False source-repository head type: git
+ test.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+import Network.HTTP.Enumerator+import Network+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as L8+import Data.Enumerator (consume, Iteratee)+import System.Environment (getArgs)++main :: IO ()+main = withSocketsDo $ withHttpEnumerator $ do+ let _req1 = Request+ { host = "localhost"+ , port = 80+ , secure = False+ , requestHeaders = []+ , path = "/"+ , queryString = [("foo", "bar")]+ , requestBody = L8.pack "baz=bin"+ , method = "POST"+ }+ [url] <- getArgs+ _req2 <- parseUrl url+ Response sc hs b <- http _req2 toLBS+ print sc+ mapM_ (\(x, y) -> do+ S.putStr x+ putStr ": "+ S.putStr y+ putStrLn "") hs+ putStrLn ""+ L.putStr b++toLBS :: Monad m => Iteratee S.ByteString m L.ByteString+toLBS = L.fromChunks `fmap` consume