f6bec21 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Migrated to WAI 0.2.0

f6bec21Michael Snoyman16 years ago

Network/Wai/Handler/FastCGI.hsc+17−15

compare with master

unifiedsplit

@@ -1,5 +1,6 @@

1{-# LANGUAGE ForeignFunctionInterface #-}

2{-# LANGUAGE EmptyDataDecls #-}

3+{-# LANGUAGE OverloadedStrings #-}

3-----------------------------------------------------------------------------

4-----------------------------------------------------------------------------

4-- |

5-- |

5-- Module : Network.Wai.Handler.FastCGI

6-- Module : Network.Wai.Handler.FastCGI

@@ -180,7 +181,7 @@ run' :: [(String, String)] -- ^ all variables

180 -> W.Application

181 -> W.Application

181 -> IO ()

182 -> IO ()

182run' vars inputH hPut app = do

183run' vars inputH hPut app = do

183− let rmethod = safeRead W.GET $ lookup' "REQUEST_METHOD" vars

184+ let rmethod = safeRead "GET" $ lookup' "REQUEST_METHOD" vars

184 pinfo = lookup' "PATH_INFO" vars

185 pinfo = lookup' "PATH_INFO" vars

185 qstring = lookup' "QUERY_STRING" vars

186 qstring = lookup' "QUERY_STRING" vars

186 servername = lookup' "SERVER_NAME" vars

187 servername = lookup' "SERVER_NAME" vars

@@ -193,10 +194,10 @@ run' vars inputH hPut app = do

193 case lookup "REMOTE_ADDR" vars of

194 case lookup "REMOTE_ADDR" vars of

194 Just x -> x

195 Just x -> x

195 Nothing -> ""

196 Nothing -> ""

196− urlScheme' =

197+ isSecure' =

197 case map toLower $ lookup' "SERVER_PROTOCOL" vars of

198 case map toLower $ lookup' "SERVER_PROTOCOL" vars of

198− "https" -> W.HTTPS

199+ "https" -> True

199− _ -> W.HTTP

200+ _ -> False

200 let env = W.Request

201 let env = W.Request

201 { W.requestMethod = rmethod

202 { W.requestMethod = rmethod

202 , W.pathInfo = B8.pack pinfo

203 , W.pathInfo = B8.pack pinfo

@@ -204,16 +205,16 @@ run' vars inputH hPut app = do

204 , W.serverName = B8.pack servername

205 , W.serverName = B8.pack servername

205 , W.serverPort = serverport

206 , W.serverPort = serverport

206 , W.requestHeaders = map (cleanupVarName *** B8.pack) vars

207 , W.requestHeaders = map (cleanupVarName *** B8.pack) vars

207− , W.urlScheme = urlScheme'

208+ , W.isSecure = isSecure'

208 , W.requestBody = requestBodyLBS inputH contentLength

209 , W.requestBody = requestBodyLBS inputH contentLength

209 , W.errorHandler = System.IO.hPutStr System.IO.stderr

210 , W.errorHandler = System.IO.hPutStr System.IO.stderr

210 , W.remoteHost = B8.pack remoteHost'

211 , W.remoteHost = B8.pack remoteHost'

211− , W.httpVersion = W.HttpVersion BS.empty

212+ , W.httpVersion = "" -- FIXME

212 }

213 }

213 res <- app env

214 res <- app env

214 let h = W.responseHeaders res

215 let h = W.responseHeaders res

215− let h' = case lookup W.ContentType h of

216+ let h' = case lookup "Content-Type" h of

216− Nothing -> (W.ContentType, B8.pack "text/html; charset=utf-8")

217+ Nothing -> ("Content-Type", "text/html; charset=utf-8")

217 : h

218 : h

218 Just _ -> h

219 Just _ -> h

219 hPut $ B8.pack $ "Status: " ++ (show $ W.statusCode $ W.status res) ++ " "

220 hPut $ B8.pack $ "Status: " ++ (show $ W.statusCode $ W.status res) ++ " "

@@ -221,7 +222,8 @@ run' vars inputH hPut app = do

221 hPut $ B8.singleton '\n'

222 hPut $ B8.singleton '\n'

222 mapM_ (printHeader hPut) h'

223 mapM_ (printHeader hPut) h'

223 hPut $ B8.singleton '\n'

224 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) ()

225 return ()

227 return ()

226

228

227myPut :: (BS.ByteString -> IO ()) -> () -> BS.ByteString -> IO (Either () ())

229myPut :: (BS.ByteString -> IO ()) -> () -> BS.ByteString -> IO (Either () ())

@@ -231,21 +233,21 @@ printHeader :: (BS.ByteString -> IO ())

231 -> (W.ResponseHeader, BS.ByteString)

233 -> (W.ResponseHeader, BS.ByteString)

232 -> IO ()

234 -> IO ()

233printHeader f (x, y) = do

235printHeader f (x, y) = do

234− f $ W.responseHeaderToBS x

236+ f $ W.ciOriginal x

235 f $ B8.pack ": "

237 f $ B8.pack ": "

236 f y

238 f y

237 f $ B8.singleton '\n'

239 f $ B8.singleton '\n'

238

240

239cleanupVarName :: String -> W.RequestHeader

241cleanupVarName :: String -> W.RequestHeader

240cleanupVarName ('H':'T':'T':'P':'_':a:as) =

242cleanupVarName ('H':'T':'T':'P':'_':a:as) =

241− W.requestHeaderFromBS $ B8.pack $ a : helper' as where

243+ W.mkCIByteString $ B8.pack $ a : helper' as where

242 helper' ('_':x:rest) = '-' : x : helper' rest

244 helper' ('_':x:rest) = '-' : x : helper' rest

243 helper' (x:rest) = toLower x : helper' rest

245 helper' (x:rest) = toLower x : helper' rest

244 helper' [] = []

246 helper' [] = []

245−cleanupVarName "CONTENT_TYPE" = W.ReqContentType

247+cleanupVarName "CONTENT_TYPE" = "Content-Type"

246−cleanupVarName "CONTENT_LENGTH" = W.ReqContentLength

248+cleanupVarName "CONTENT_LENGTH" = "Content-Length"

247−cleanupVarName "SCRIPT_NAME" = W.requestHeaderFromBS $ B8.pack "CGI-Script-Name"

249+cleanupVarName "SCRIPT_NAME" = "CGI-Script-Name"

248−cleanupVarName x = W.requestHeaderFromBS $ B8.pack x -- FIXME remove?

250+cleanupVarName x = W.mkCIByteString $ B8.pack x -- FIXME remove?

249

251

250requestBodyLBS :: Lazy.ByteString -> Int -> W.Source

252requestBodyLBS :: Lazy.ByteString -> Int -> W.Source

251requestBodyLBS = go . Lazy.toChunks

253requestBodyLBS = go . Lazy.toChunks

wai-handler-fastcgi.cabal+3−3

@@ -1,5 +1,5 @@

1name: wai-handler-fastcgi

2−version: 0.1.0

2+version: 0.2.0

3license: BSD3

4license-file: LICENSE

5author: Michael Snoyman <michael@snoyman.com>

@@ -14,8 +14,8 @@ homepage: http://github.com/snoyberg/hack-handler-fastcgi/tree/master

15library

16 build-depends: base >= 4 && < 5,

17− wai >= 0.0.0 && < 0.2.0,

17+ wai >= 0.2.0 && < 0.3.0,

18− wai-extra >= 0.1.0 && < 0.2.0,

18+ wai-extra >= 0.2.0 && < 0.3.0,

19 bytestring >= 0.9.1.4 && < 0.10

20 exposed-modules: Network.Wai.Handler.FastCGI

21 ghc-options: -Wall