cc5ce73 · typeable/wai

27 , withSocketsDo)

28import Control.Exception (bracket, finally, Exception)

29import System.IO (Handle, hClose)

30−import Control.Concurrent

30+import Control.Concurrent (forkIO)

31import Control.Monad (unless)

32import Data.Maybe (isJust, fromJust, fromMaybe)

33

118 bs <- lookup ReqContentLength heads

119 let str = SL.unpack bs

120 Safe.readMay str

121− mlen <- newMVar len

122 let (serverName', _) = SL.breakChar ':' host

121 let (serverName', _) = SL.breakChar ':' host

123 return $ Request

122 return $ Request

124 { requestMethod = method

123 { requestMethod = method

129 , serverPort = port

128 , serverPort = port

130 , requestHeaders = heads

129 , requestHeaders = heads

131 , urlScheme = HTTP

130 , urlScheme = HTTP

132− , requestBody = requestBodyHandle handle mlen

131+ , requestBody = requestBodyHandle handle len

133 , errorHandler = System.IO.hPutStr System.IO.stderr

132 , errorHandler = System.IO.hPutStr System.IO.stderr

134 , remoteHost = B8.pack remoteHost'

133 , remoteHost = B8.pack remoteHost'

135 }

134 }

136

135

137−requestBodyHandle :: Handle -> MVar Int -> Enumerator

136+requestBodyHandle :: Handle -> Int -> Enumerator

138−requestBodyHandle h mlen = Enumerator $ \iter accum ->

137+requestBodyHandle h len0 = Enumerator $ helper len0 where

139− modifyMVar mlen (helper iter accum) where

140− helper _ a 0 = return (0, Right a)

138+ helper 0 _ a = return $ Right a

141− helper iter a len = do

139+ helper len iter a = do

142 let maxChunkSize = 1024

140 let maxChunkSize = 1024

143 bs <- BS.hGet h $ min len maxChunkSize

141 bs <- BS.hGet h $ min len maxChunkSize

144 let newLen = len - BS.length bs

142 let newLen = len - BS.length bs

145 putStrLn $ "reading a chunk of size " ++ show (BS.length bs)

143 putStrLn $ "reading a chunk of size " ++ show (BS.length bs)

146 ea' <- iter a bs

144 ea' <- iter a bs

147 case ea' of

145 case ea' of

148− Left a' -> return (newLen, Left a')

146+ Left a' -> return $ Left a'

149− Right a' -> helper iter a' newLen

147+ Right a' -> helper newLen iter a'

150

148

151parseFirst :: (StringLike s, MonadFailure InvalidRequest m) =>

149parseFirst :: (StringLike s, MonadFailure InvalidRequest m) =>

152 s

150 s