![](https://seccdn.libravatar.org/avatar/e2145bc5cf53dda95c308a3c75e8fef3.jpg?s=120&d=mm&r=g)
Hello community, here is the log from the commit of package ghc-wai for openSUSE:Factory checked in at 2016-01-28 17:24:10 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-wai (Old) and /work/SRC/openSUSE:Factory/.ghc-wai.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-wai" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-wai/ghc-wai.changes 2015-12-23 08:49:27.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-wai.new/ghc-wai.changes 2016-01-28 17:25:02.000000000 +0100 @@ -1,0 +2,12 @@ +Wed Jan 20 12:01:48 UTC 2016 - mimi.vx@gmail.com + +- update to 3.2.0 +* Major version up due to breaking changes. We chose 3.2.0, not 3.1.0 for + consistency with Warp 3.2.0. +* The Network.Wai.HTTP2 module was removed. +* tryGetFileSize, hContentRange, hAcceptRanges, contentRangeHeader and + chooseFilePart, adjustForFilePart and parseByteRanges were removed from + the Network.Wai.Internal module. +* New fields for Request: requestHeaderReferer and requestHeaderUserAgent. + +------------------------------------------------------------------- Old: ---- wai-3.0.5.0.tar.gz New: ---- wai-3.2.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-wai.spec ++++++ --- /var/tmp/diff_new_pack.aeeLVy/_old 2016-01-28 17:25:03.000000000 +0100 +++ /var/tmp/diff_new_pack.aeeLVy/_new 2016-01-28 17:25:03.000000000 +0100 @@ -21,7 +21,7 @@ %bcond_with tests Name: ghc-wai -Version: 3.0.5.0 +Version: 3.2.0 Release: 0 Summary: Web Application Interface License: MIT ++++++ wai-3.0.5.0.tar.gz -> wai-3.2.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-3.0.5.0/Network/Wai/HTTP2.hs new/wai-3.2.0/Network/Wai/HTTP2.hs --- old/wai-3.0.5.0/Network/Wai/HTTP2.hs 2015-12-07 10:08:37.000000000 +0100 +++ new/wai-3.2.0/Network/Wai/HTTP2.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,272 +0,0 @@ -{-# LANGUAGE OverloadedStrings, RankNTypes #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} - --- | An HTTP\/2-aware variant of the 'Network.Wai.Application' type. Compared --- to the original, this exposes the new functionality of server push and --- trailers, allows stream fragments to be sent in the form of file ranges, and --- allows the stream body to produce a value to be used in constructing the --- trailers. Existing @Applications@ can be faithfully upgraded to HTTP\/2 --- with 'promoteApplication' or served transparently over both protocols with --- the normal Warp 'Network.Wai.Handler.Warp.run' family of functions. --- --- An 'HTTP2Application' takes a 'Request' and a 'PushFunc' and produces a --- 'Responder' that will push any associated resources and send the response --- body. The response is always a stream of 'Builder's and file chunks. --- Equivalents of the 'Network.Wai.responseBuilder' family of functions are --- provided for creating 'Responder's conveniently. --- --- Pushed streams are handled by an IO action that triggers a server push. It --- returns @True@ if the @PUSH_PROMISE@ frame was sent, @False@ if not. Note --- this means it will still return @True@ if the client reset or ignored the --- stream. This gives handlers the freedom to implement their own heuristics --- for whether to actually push a resource, while also allowing middleware and --- frameworks to trigger server pushes automatically. - -module Network.Wai.HTTP2 - ( - -- * Applications - HTTP2Application - -- * Responder - , Responder(..) - , RespondFunc - , Body - , Chunk(..) - , Trailers - -- * Server push - , PushFunc - , PushPromise(..) - , promiseHeaders - -- * Conveniences - , promoteApplication - -- ** Responders - , respond - , respondCont - , respondIO - , respondFile - , respondFilePart - , respondNotFound - , respondWith - -- ** Stream Bodies - , streamFilePart - , streamBuilder - , streamSimple - ) where - -import Blaze.ByteString.Builder (Builder) -import Blaze.ByteString.Builder.ByteString (fromByteString) -import Control.Exception (Exception, throwIO) -import Control.Monad.Trans.Cont (ContT(..)) -import Data.ByteString (ByteString) -#if __GLASGOW_HASKELL__ < 709 -import Data.Functor ((<$>)) -#endif -import Data.IORef (newIORef, readIORef, writeIORef) -#if __GLASGOW_HASKELL__ < 709 -import Data.Monoid (mempty) -#endif -import Data.Typeable (Typeable) -import qualified Network.HTTP.Types as H - -import Network.Wai (Application) -import Network.Wai.Internal - ( FilePart(..) - , Request(requestHeaders) - , Response(..) - , ResponseReceived(..) - , StreamingBody - , adjustForFilePart - , chooseFilePart - , tryGetFileSize - ) - --- | Headers sent after the end of a data stream, as defined by section 4.1.2 of --- the HTTP\/1.1 spec (RFC 7230), and section 8.1 of the HTTP\/2 spec. -type Trailers = [H.Header] - --- | The synthesized request and headers of a pushed stream. -data PushPromise = PushPromise - { promisedMethod :: H.Method - , promisedPath :: ByteString - , promisedAuthority :: ByteString - , promisedScheme :: ByteString - , promisedHeader :: H.RequestHeaders - } - --- | The HTTP\/2-aware equivalent of 'Network.Wai.Application'. -type HTTP2Application = Request -> PushFunc -> Responder - --- | Part of a streaming response -- either a 'Builder' or a range of a file. -data Chunk = FileChunk FilePath FilePart | BuilderChunk Builder - --- | The streaming body of a response. Equivalent to --- 'Network.Wai.StreamingBody' except that it can also write file ranges and --- return the stream's trailers. -type Body = (Chunk -> IO ()) -> IO () -> IO Trailers - --- | Given to 'Responders'; provide a status, headers, and a stream body, and --- we'll give you a token proving you called the 'RespondFunc'. -type RespondFunc s = H.Status -> H.ResponseHeaders -> Body -> IO s - --- | The result of an 'HTTP2Application'; or, alternately, an application --- that's independent of the request. This is a continuation-passing style --- function that first provides a response by calling the given respond --- function, then returns the request's 'Trailers'. --- --- The respond function is similar to the one in 'Network.Wai.Application', but --- it only takes a streaming body, the status and headers are curried, and it --- also produces trailers for the stream. -newtype Responder = Responder - { runResponder :: forall s. RespondFunc s -> IO s } - --- | A function given to an 'HTTP2Application' to initiate a server-pushed --- stream. Its argument is the same as the result of an 'HTTP2Application', so --- you can either implement the response inline, or call your own application --- to create the response. --- --- The result is 'True' if the @PUSH_PROMISE@ frame will be sent, or 'False' if --- it will not. This can happen if server push is disabled, the concurrency --- limit of server-initiated streams is reached, or the associated stream has --- already been closed. --- --- This function shall ensure that stream data provided after it returns will --- be sent after the @PUSH_PROMISE@ frame, so that servers can implement the --- requirement that any pushed stream for a resource be initiated before --- sending DATA frames that reference it. -type PushFunc = PushPromise -> Responder -> IO Bool - --- | Create the 'H.RequestHeaders' corresponding to the given 'PushPromise'. --- --- This is primarily useful for WAI handlers like Warp, and application --- implementers are unlikely to use it directly. -promiseHeaders :: PushPromise -> H.RequestHeaders -promiseHeaders p = - [ (":method", promisedMethod p) - , (":path", promisedPath p) - , (":authority", promisedAuthority p) - , (":scheme", promisedScheme p) - ] ++ promisedHeader p - --- | Create a response body consisting of a single range of a file. Does not --- set Content-Length or Content-Range headers. For that, use --- 'respondFilePart' or 'respondFile'. -streamFilePart :: FilePath -> FilePart -> Body -streamFilePart path part write _ = write (FileChunk path part) >> return [] - --- | Respond with a single range of a file, adding the Accept-Ranges, --- Content-Length and Content-Range headers and changing the status to 206 as --- appropriate. --- --- If you want the range to be inferred automatically from the Range header, --- use 'respondFile' instead. On the other hand, if you want to avoid the --- automatic header and status adjustments, use 'respond' and 'streamFilePart' --- directly. -respondFilePart :: H.Status -> H.ResponseHeaders -> FilePath -> FilePart -> Responder -respondFilePart s h path part = Responder $ \k -> do - let (s', h') = adjustForFilePart s h part - k s' h' $ streamFilePart path part - --- | Serve the requested range of the specified file (based on the Range --- header), using the given 'H.Status' and 'H.ResponseHeaders' as a base. If --- the file is not accessible, the status will be replaced with 404 and a --- default not-found message will be served. If a partial file is requested, --- the status will be replaced with 206 and the Content-Range header will be --- added. The Content-Length header will always be added. -respondFile :: H.Status -> H.ResponseHeaders -> FilePath -> H.RequestHeaders -> Responder -respondFile s h path reqHdrs = Responder $ \k -> do - fileSize <- tryGetFileSize path - case fileSize of - Left _ -> runResponder (respondNotFound h) k - Right size -> runResponder (respondFileExists s h path size reqHdrs) k - --- As 'respondFile', but with prior knowledge of the file's existence and size. -respondFileExists :: H.Status -> H.ResponseHeaders -> FilePath -> Integer -> H.RequestHeaders -> Responder -respondFileExists s h path size reqHdrs = - respondFilePart s h path $ chooseFilePart size $ lookup H.hRange reqHdrs - --- | Respond with a minimal 404 page with the given headers. -respondNotFound :: H.ResponseHeaders -> Responder -respondNotFound h = Responder $ \k -> k H.notFound404 h' $ - streamBuilder $ fromByteString "File not found." - where - contentType = (H.hContentType, "text/plain; charset=utf-8") - h' = contentType:filter ((/=H.hContentType) . fst) h - --- | Construct a 'Responder' that will just call the 'RespondFunc' with the --- given arguments. -respond :: H.Status -> H.ResponseHeaders -> Body -> Responder -respond s h b = Responder $ \k -> k s h b - --- | Fold the given bracketing action into a 'Responder'. Note the first --- argument is isomorphic to @Codensity IO a@ or @forall s. ContT s IO a@, and --- is the type of a partially-applied 'Control.Exception.bracket' or --- @with@-style function. --- --- > respondWith (bracket acquire release) $ --- > \x -> respondNotFound [("x", show x)] --- --- is equivalent to --- --- > Responder $ \k -> bracket acquire release $ --- > \x -> runResponder (respondNotFound [("x", show x)] k --- --- This is morally equivalent to ('>>=') on 'Codensity' 'IO'. -respondWith :: (forall s. (a -> IO s) -> IO s) -> (a -> Responder) -> Responder -respondWith with f = respondCont $ f <$> ContT with - --- | Fold the 'ContT' into the contained 'Responder'. -respondCont :: (forall r. ContT r IO Responder) -> Responder -respondCont cont = Responder $ \k -> runContT cont $ \r -> runResponder r k - --- | Fold the 'IO' into the contained 'Responder'. -respondIO :: IO Responder -> Responder -respondIO io = Responder $ \k -> io >>= \r -> runResponder r k - --- | Create a response body consisting of a single builder. -streamBuilder :: Builder -> Body -streamBuilder builder write _ = write (BuilderChunk builder) >> return [] - --- | Create a response body of a stream of 'Builder's. -streamSimple :: StreamingBody -> Body -streamSimple body write flush = body (write . BuilderChunk) flush >> return [] - --- | Use a normal WAI 'Response' to send the response. Useful if you're --- sharing code between HTTP\/2 applications and HTTP\/1 applications. --- --- The 'Request' is used to determine the right file range to serve for --- 'ResponseFile'. -promoteResponse :: Request -> Response -> Responder -promoteResponse req response = case response of - (ResponseBuilder s h b) -> - Responder $ \k -> k s h (streamBuilder b) - (ResponseStream s h body) -> - Responder $ \k -> k s h (streamSimple body) - (ResponseRaw _ fallback) -> promoteResponse req fallback - (ResponseFile s h path mpart) -> maybe - (respondFile s h path $ requestHeaders req) - (respondFilePart s h path) - mpart - --- | An 'Network.Wai.Application' we tried to promote neither called its --- respond action nor raised; this is only possible if it imported the --- 'ResponseReceived' constructor and used it to lie about having called the --- action. -data RespondNeverCalled = RespondNeverCalled deriving (Show, Typeable) - -instance Exception RespondNeverCalled - --- | Promote a normal WAI 'Application' to an 'HTTP2Application' by ignoring --- the HTTP/2-specific features. -promoteApplication :: Application -> HTTP2Application -promoteApplication app req _ = Responder $ \k -> do - -- In HTTP2Applications, the Responder is required to ferry a value of - -- arbitrary type from the RespondFunc back to the caller of the - -- application, but in Application the type is fixed to ResponseReceived. - -- To add this extra power to an Application, we have to squirrel it away - -- in an IORef as a hack. - ref <- newIORef Nothing - let k' r = do - writeIORef ref . Just =<< runResponder (promoteResponse req r) k - return ResponseReceived - ResponseReceived <- app req k' - readIORef ref >>= maybe (throwIO RespondNeverCalled) return diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-3.0.5.0/Network/Wai/Internal.hs new/wai-3.2.0/Network/Wai/Internal.hs --- old/wai-3.0.5.0/Network/Wai/Internal.hs 2015-12-07 10:08:37.000000000 +0100 +++ new/wai-3.2.0/Network/Wai/Internal.hs 2015-12-30 01:24:47.000000000 +0100 @@ -1,7 +1,6 @@ {-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} -- | Internal constructors and helper functions. Note that no guarantees are @@ -9,25 +8,17 @@ module Network.Wai.Internal where import Blaze.ByteString.Builder (Builder) -import Control.Exception (IOException, try) import qualified Data.ByteString as B hiding (pack) -import qualified Data.ByteString.Builder as B -import qualified Data.ByteString.Char8 as B (pack, readInteger) -import qualified Data.ByteString.Lazy as L #if __GLASGOW_HASKELL__ < 709 import Data.Functor ((<$>)) #endif -import Data.Maybe (listToMaybe) import Data.Text (Text) import Data.Typeable (Typeable) import Data.Vault.Lazy (Vault) import Data.Word (Word64) import qualified Network.HTTP.Types as H -import qualified Network.HTTP.Types.Header as HH import Network.Socket (SockAddr) -import Numeric (showInt) import Data.List (intercalate) -import qualified System.PosixCompat.Files as P -- | Information on the request sent by the client. This abstracts away the -- details of the underlying implementation. @@ -93,6 +84,14 @@ -- -- Since 2.0.0 , requestHeaderRange :: Maybe B.ByteString + -- | The value of the Referer header in a HTTP request. + -- + -- Since 3.2.0 + , requestHeaderReferer :: Maybe B.ByteString + -- | The value of the User-Agent header in a HTTP request. + -- + -- Since 3.2.0 + , requestHeaderUserAgent :: Maybe B.ByteString } deriving (Typeable) @@ -157,91 +156,3 @@ -- Since 3.0.0 data ResponseReceived = ResponseReceived deriving Typeable - --- | Look up the size of a file in 'Right' or the 'IOException' in 'Left'. -tryGetFileSize :: FilePath -> IO (Either IOException Integer) -tryGetFileSize path = - fmap (fromIntegral . P.fileSize) <$> try (P.getFileStatus path) - --- | \"Content-Range\". -hContentRange :: H.HeaderName -hContentRange = "Content-Range" - --- | \"Accept-Ranges\". -hAcceptRanges :: H.HeaderName -hAcceptRanges = "Accept-Ranges" - --- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header' --- for the range specified. -contentRangeHeader :: Integer -> Integer -> Integer -> H.Header -contentRangeHeader beg end total = (hContentRange, range) - where - range = B.pack - -- building with ShowS - $ 'b' : 'y': 't' : 'e' : 's' : ' ' - : (if beg > end then ('*':) else - showInt beg - . ('-' :) - . showInt end) - ( '/' - : showInt total "") - --- | Given the full size of a file and optionally a Range header value, --- determine the range to serve by parsing the range header and obeying it, or --- serving the whole file if it's absent or malformed. -chooseFilePart :: Integer -> Maybe B.ByteString -> FilePart -chooseFilePart size Nothing = FilePart 0 size size -chooseFilePart size (Just range) = case parseByteRanges range >>= listToMaybe of - -- Range is broken - Nothing -> FilePart 0 size size - Just hrange -> checkRange hrange - where - checkRange (H.ByteRangeFrom beg) = fromRange beg (size - 1) - checkRange (H.ByteRangeFromTo beg end) = fromRange beg (min (size - 1) end) - checkRange (H.ByteRangeSuffix count) = fromRange (max 0 (size - count)) (size - 1) - - fromRange beg end = FilePart beg (end - beg + 1) size - --- | Adjust the given 'H.Status' and 'H.ResponseHeaders' based on the given --- 'FilePart'. This means replacing the status with 206 if the response is --- partial, and adding the Content-Length and Accept-Ranges (always) and --- Content-Range (if appropriate) headers. -adjustForFilePart :: H.Status -> H.ResponseHeaders -> FilePart -> (H.Status, H.ResponseHeaders) -adjustForFilePart s h part = (s', h'') - where - off = filePartOffset part - len = filePartByteCount part - size = filePartFileSize part - - contentRange = contentRangeHeader off (off + len - 1) size - lengthBS = L.toStrict $ B.toLazyByteString $ B.integerDec len - s' = if filePartByteCount part /= size then H.partialContent206 else s - h' = (H.hContentLength, lengthBS):(hAcceptRanges, "bytes"):h - h'' = (if len == size then id else (contentRange:)) h' - --- | Parse the value of a Range header into a 'HH.ByteRanges'. -parseByteRanges :: B.ByteString -> Maybe HH.ByteRanges -parseByteRanges bs1 = do - bs2 <- stripPrefix "bytes=" bs1 - (r, bs3) <- range bs2 - ranges (r:) bs3 - where - range bs2 = do - (i, bs3) <- B.readInteger bs2 - if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-") - then Just (HH.ByteRangeSuffix (negate i), bs3) - else do - bs4 <- stripPrefix "-" bs3 - case B.readInteger bs4 of - Just (j, bs5) | j >= i -> Just (HH.ByteRangeFromTo i j, bs5) - _ -> Just (HH.ByteRangeFrom i, bs4) - ranges front bs3 - | B.null bs3 = Just (front []) - | otherwise = do - bs4 <- stripPrefix "," bs3 - (r, bs5) <- range bs4 - ranges (front . (r:)) bs5 - - stripPrefix x y - | x `B.isPrefixOf` y = Just (B.drop (B.length x) y) - | otherwise = Nothing diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-3.0.5.0/Network/Wai.hs new/wai-3.2.0/Network/Wai.hs --- old/wai-3.0.5.0/Network/Wai.hs 2015-12-07 10:08:37.000000000 +0100 +++ new/wai-3.2.0/Network/Wai.hs 2015-12-30 01:24:47.000000000 +0100 @@ -59,6 +59,8 @@ , requestBodyLength , requestHeaderHost , requestHeaderRange + , requestHeaderReferer + , requestHeaderUserAgent , strictRequestBody , lazyRequestBody -- * Response @@ -274,6 +276,8 @@ , requestBodyLength = KnownLength 0 , requestHeaderHost = Nothing , requestHeaderRange = Nothing + , requestHeaderReferer = Nothing + , requestHeaderUserAgent = Nothing } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-3.0.5.0/wai.cabal new/wai-3.2.0/wai.cabal --- old/wai-3.0.5.0/wai.cabal 2015-12-07 10:08:37.000000000 +0100 +++ new/wai-3.2.0/wai.cabal 2015-12-30 01:24:47.000000000 +0100 @@ -1,5 +1,5 @@ Name: wai -Version: 3.0.5.0 +Version: 3.2.0 Synopsis: Web Application Interface. Description: Provides a common protocol for communication between web applications and web servers. description: API docs and the README are available at http://www.stackage.org/package/wai. @@ -27,10 +27,8 @@ , http-types >= 0.7 , text >= 0.7 , transformers >= 0.0 - , unix-compat >= 0.2 , vault >= 0.3 && < 0.4 Exposed-modules: Network.Wai - Network.Wai.HTTP2 Network.Wai.Internal ghc-options: -Wall