@@ -1,5 +1,6 @@
11{-# LANGUAGE ForeignFunctionInterface #-}
22{-# LANGUAGE EmptyDataDecls #-}
3+{-# LANGUAGE OverloadedStrings #-}
34-----------------------------------------------------------------------------
45-- |
56-- Module : Network.Wai.Handler.FastCGI
@@ -180,7 +181,7 @@ run' :: [(String, String)] -- ^ all variables
180181 -> W.Application
181182 -> IO ()
182183run' vars inputH hPut app = do
183− let rmethod = safeRead W.GET $ lookup' "REQUEST_METHOD" vars
184+ let rmethod = safeRead "GET" $ lookup' "REQUEST_METHOD" vars
184185 pinfo = lookup' "PATH_INFO" vars
185186 qstring = lookup' "QUERY_STRING" vars
186187 servername = lookup' "SERVER_NAME" vars
@@ -193,10 +194,10 @@ run' vars inputH hPut app = do
193194 case lookup "REMOTE_ADDR" vars of
194195 Just x -> x
195196 Nothing -> ""
196− urlScheme' =
197+ isSecure' =
197198 case map toLower $ lookup' "SERVER_PROTOCOL" vars of
198− "https" -> W.HTTPS
199− _ -> W.HTTP
199+ "https" -> True
200+ _ -> False
200201 let env = W.Request
201202 { W.requestMethod = rmethod
202203 , W.pathInfo = B8.pack pinfo
@@ -204,16 +205,16 @@ run' vars inputH hPut app = do
204205 , W.serverName = B8.pack servername
205206 , W.serverPort = serverport
206207 , W.requestHeaders = map (cleanupVarName *** B8.pack) vars
207− , W.urlScheme = urlScheme'
208+ , W.isSecure = isSecure'
208209 , W.requestBody = requestBodyLBS inputH contentLength
209210 , W.errorHandler = System.IO.hPutStr System.IO.stderr
210211 , W.remoteHost = B8.pack remoteHost'
211− , W.httpVersion = W.HttpVersion BS.empty
212+ , W.httpVersion = "" -- FIXME
212213 }
213214 res <- app env
214215 let h = W.responseHeaders res
215− let h' = case lookup W.ContentType h of
216− Nothing -> (W.ContentType, B8.pack "text/html; charset=utf-8")
216+ let h' = case lookup "Content-Type" h of
217+ Nothing -> ("Content-Type", "text/html; charset=utf-8")
217218 : h
218219 Just _ -> h
219220 hPut $ B8.pack $ "Status: " ++ (show $ W.statusCode $ W.status res) ++ " "
@@ -221,7 +222,8 @@ run' vars inputH hPut app = do
221222 hPut $ B8.singleton '\n'
222223 mapM_ (printHeader hPut) h'
223224 hPut $ B8.singleton '\n'
224− _ <- W.runEnumerator (WE.fromEitherFile (W.responseBody res)) (myPut hPut) ()
225+ _ <- W.runEnumerator (WE.fromResponseBody (W.responseBody res))
226+ (myPut hPut) ()
225227 return ()
226228
227229myPut :: (BS.ByteString -> IO ()) -> () -> BS.ByteString -> IO (Either () ())
@@ -231,21 +233,21 @@ printHeader :: (BS.ByteString -> IO ())
231233 -> (W.ResponseHeader, BS.ByteString)
232234 -> IO ()
233235printHeader f (x, y) = do
234− f $ W.responseHeaderToBS x
236+ f $ W.ciOriginal x
235237 f $ B8.pack ": "
236238 f y
237239 f $ B8.singleton '\n'
238240
239241cleanupVarName :: String -> W.RequestHeader
240242cleanupVarName ('H':'T':'T':'P':'_':a:as) =
241− W.requestHeaderFromBS $ B8.pack $ a : helper' as where
243+ W.mkCIByteString $ B8.pack $ a : helper' as where
242244 helper' ('_':x:rest) = '-' : x : helper' rest
243245 helper' (x:rest) = toLower x : helper' rest
244246 helper' [] = []
245−cleanupVarName "CONTENT_TYPE" = W.ReqContentType
246−cleanupVarName "CONTENT_LENGTH" = W.ReqContentLength
247−cleanupVarName "SCRIPT_NAME" = W.requestHeaderFromBS $ B8.pack "CGI-Script-Name"
248−cleanupVarName x = W.requestHeaderFromBS $ B8.pack x -- FIXME remove?
247+cleanupVarName "CONTENT_TYPE" = "Content-Type"
248+cleanupVarName "CONTENT_LENGTH" = "Content-Length"
249+cleanupVarName "SCRIPT_NAME" = "CGI-Script-Name"
250+cleanupVarName x = W.mkCIByteString $ B8.pack x -- FIXME remove?
249251
250252requestBodyLBS :: Lazy.ByteString -> Int -> W.Source
251253requestBodyLBS = go . Lazy.toChunks