@@ -193,35 +193,35 @@ staticApp :: StaticSettings -> W.Application
193193staticApp set req = staticAppPieces set (W.pathInfo req) req
194194
195195staticAppPieces :: StaticSettings -> [Text] -> W.Application
196−staticAppPieces _ _ req
197− | W.requestMethod req /= "GET" = return $ W.responseLBS
196+staticAppPieces _ _ req sendResponse
197+ | W.requestMethod req /= "GET" = sendResponse $ W.responseLBS
198198 H.status405
199199 [("Content-Type", "text/plain")]
200200 "Only GET is supported"
201−staticAppPieces _ [".hidden", "folder.png"] _ = return $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/folder.png")]
202−staticAppPieces _ [".hidden", "haskell.png"] _ = return $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/haskell.png")]
203−staticAppPieces ss rawPieces req = liftIO $ do
201+staticAppPieces _ [".hidden", "folder.png"] _ sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/folder.png")]
202+staticAppPieces _ [".hidden", "haskell.png"] _ sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] $ L.fromChunks [$(embedFile "images/haskell.png")]
203+staticAppPieces ss rawPieces req sendResponse = liftIO $ do
204204 case toPieces rawPieces of
205205 Just pieces -> checkPieces ss pieces req >>= response
206− Nothing -> return $ W.responseLBS H.status403
206+ Nothing -> sendResponse $ W.responseLBS H.status403
207207 [ ("Content-Type", "text/plain")
208208 ] "Forbidden"
209209 where
210− response :: StaticResponse -> IO W.Response
210+ response :: StaticResponse -> IO W.ResponseReceived
211211 response (FileResponse file ch) = do
212212 mimetype <- ssGetMimeType ss file
213213 let filesize = fileGetSize file
214214 let headers = ("Content-Type", mimetype)
215215 : ("Content-Length", S8.pack $ show filesize)
216216 : ch
217− return $ fileToResponse file H.status200 headers
217+ sendResponse $ fileToResponse file H.status200 headers
218218
219219 response NotModified =
220− return $ W.responseLBS H.status304 [] ""
220+ sendResponse $ W.responseLBS H.status304 [] ""
221221
222222 response (SendContent mt lbs) = do
223223 -- TODO: set caching headers
224− return $ W.responseLBS H.status200
224+ sendResponse $ W.responseLBS H.status200
225225 [ ("Content-Type", mt)
226226 -- TODO: set Content-Length
227227 ] lbs
@@ -232,13 +232,13 @@ staticAppPieces ss rawPieces req = liftIO $ do
232232 Just hash -> replace "etag" (Just hash) (W.queryString req)
233233 Nothing -> remove "etag" (W.queryString req)
234234
235− return $ W.responseLBS H.status301
235+ sendResponse $ W.responseLBS H.status301
236236 [ ("Content-Type", "text/plain")
237237 , ("Location", S8.append loc $ H.renderQuery True qString)
238238 ] "Redirect"
239239
240− response NotFound = return $ W.responseLBS H.status404
240+ response NotFound = sendResponse $ W.responseLBS H.status404
241241 [ ("Content-Type", "text/plain")
242242 ] "File not found"
243243
244− response (WaiResponse r) = return r
244+ response (WaiResponse r) = sendResponse r