wai-app-file-cgi 0.7.1 → 0.7.2

raw patch · 4 files changed

+72/−5 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Network/Wai/Application/Classic/EventSource.hs +58/−0
• Network/Wai/Application/Classic/File.hs +3/−3
• Network/Wai/Application/Classic/RevProxy.hs +9/−1
• wai-app-file-cgi.cabal +2/−1

@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.Application.Classic.EventSource (+  toResponseEventSource+) where++import Blaze.ByteString.Builder+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Conduit+import qualified Data.Conduit.List as CL++lineBreak :: ByteString -> Int -> Maybe Int+lineBreak bs n = go+  where+    len = BS.length bs+    go | n >= len = Nothing+       | otherwise = case bs `BS.index` n of+                         13 -> go' (n+1)+                         10 -> Just (n+1)+                         _ -> Nothing+    go' n' | n' >= len = Just n'+           | otherwise = case bs `BS.index` n' of+                             10 -> Just (n'+1)+                             _ -> Just n'++-- splitDoubleLineBreak "aaa\n\nbbb" == ["aaa\n\n", "bbb"]+-- splitDoubleLineBreak "aaa\n\nbbb\n\n" == ["aaa\n\n", "bbb\n\n", ""]+-- splitDoubleLineBreak "aaa\r\n\rbbb\n\r\n" == ["aaa\r\n\r", "bbb\n\r\n", ""]+-- splitDoubleLineBreak "aaa" == ["aaa"]+-- splitDoubleLineBreak "" == [""]+splitDoubleLineBreak :: ByteString -> [ByteString]+splitDoubleLineBreak str = go str 0+  where+    go bs n | n < BS.length str =+                    case lineBreak bs n of+                        Nothing -> go bs (n+1)+                        Just n' ->+                            case lineBreak bs n' of+                                Nothing -> go bs (n+1)+                                Just n'' ->+                                    let (xs,ys) = BS.splitAt n'' bs+                                    in xs:go ys 0+            | otherwise = [bs]++eventSourceConduit :: Conduit ByteString (ResourceT IO) (Flush Builder)+eventSourceConduit = CL.concatMapAccum f ""+  where+    f input rest = (last xs, concatMap addFlush $ init xs)+      where+        addFlush x = [Chunk (fromByteString x), Flush]+        xs = splitDoubleLineBreak (rest `BS.append` input)++-- insert Flush if exists a double line-break+toResponseEventSource :: ResumableSource (ResourceT IO) ByteString+                      -> (ResourceT IO) (Source (ResourceT IO) (Flush Builder))+toResponseEventSource rsrc = do+    (src,_) <- unwrapResumable rsrc+    return $ src $= eventSourceConduit

@@ -120,7 +120,7 @@  tryGetFile :: HandlerInfo -> Bool -> Lang -> Rsp tryGetFile (HandlerInfo spec req file _) ishtml lang = do-    finfo <- liftIO $ (getFileInfo spec) (lang file)+    finfo <- liftIO $ getFileInfo spec (lang file)     let mtime = fileInfoTime finfo         size = fileInfoSize finfo         sfile = fileInfoName finfo@@ -150,7 +150,7 @@  tryHeadFile :: HandlerInfo -> Bool -> Lang -> Rsp tryHeadFile (HandlerInfo spec req file _) ishtml lang = do-    finfo <- liftIO $ (getFileInfo spec) (lang file)+    finfo <- liftIO $ getFileInfo spec (lang file)     let mtime = fileInfoTime finfo         size = fileInfoSize finfo         date = fileInfoDate finfo@@ -172,7 +172,7 @@  tryRedirectFile :: HandlerInfo -> Lang -> Rsp tryRedirectFile (HandlerInfo spec req file _) lang = do-    _ <- liftIO $ (getFileInfo spec) (lang file)+    _ <- liftIO $ getFileInfo spec (lang file)     return $ RspSpec movedPermanently301 (BodyFileNoBody hdr)   where     hdr = redirectHeader req

@@ -16,9 +16,11 @@ import Network.HTTP.Types import Network.Wai import Network.Wai.Application.Classic.Conduit+import Network.Wai.Application.Classic.EventSource import Network.Wai.Application.Classic.Field import Network.Wai.Application.Classic.Path import Network.Wai.Application.Classic.Types+import Blaze.ByteString.Builder (Builder) import Prelude hiding (catch)  toHTTPRequest :: Request -> RevProxyRoute -> Int64 -> H.Request (ResourceT IO)@@ -75,7 +77,7 @@     H.Response status _ hdr rdownbody <- http httpReq mgr     let hdr' = fixHeader hdr     liftIO $ logger cspec req status (fromIntegral <$> mlen)-    ResponseSource status hdr' <$> toResponseSource rdownbody+    ResponseSource status hdr' <$> toSource (lookup hContentType hdr') rdownbody   where     mgr = revProxyManager spec     fixHeader = addVia cspec req . filter p@@ -83,6 +85,12 @@       | k == hContentEncoding = False       | k == hContentLength   = False       | otherwise              = True++toSource :: Maybe BS.ByteString+         -> ResumableSource (ResourceT IO) BS.ByteString+         -> (ResourceT IO) (Source (ResourceT IO) (Flush Builder))+toSource (Just "text/event-stream") = toResponseEventSource+toSource _                          = toResponseSource  type Resp = ResourceT IO (H.Response (ResumableSource (ResourceT IO) BS.ByteString)) 

@@ -1,5 +1,5 @@ Name:                   wai-app-file-cgi-Version:                0.7.1+Version:                0.7.2 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -17,6 +17,7 @@   Exposed-Modules:      Network.Wai.Application.Classic   Other-Modules:        Network.Wai.Application.Classic.CGI                         Network.Wai.Application.Classic.Conduit+                        Network.Wai.Application.Classic.EventSource                         Network.Wai.Application.Classic.Field                         Network.Wai.Application.Classic.File                         Network.Wai.Application.Classic.FileInfo