Hello community, here is the log from the commit of package ghc-wai for openSUSE:Factory checked in at 2015-12-23 08:49:26 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 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-07-08 06:59:52.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-wai.new/ghc-wai.changes 2015-12-23 08:49:27.000000000 +0100 @@ -1,0 +2,9 @@ +Sun Dec 13 17:10:41 UTC 2015 - mimi...@gmail.com + +- update to 3.0.5.0 +* Avoid using the IsString Builder instance +* A new module Network.Wai.HTTP2 is exported. +* mapResponseHeaders, ifRequest and modifyResponse are exported. +- add remove-dep.patch mimi...@gmail.com -- remove bytestring-builder dep + +------------------------------------------------------------------- Old: ---- wai-3.0.3.0.tar.gz New: ---- remove-dep.patch wai-3.0.5.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-wai.spec ++++++ --- /var/tmp/diff_new_pack.XUTPAV/_old 2015-12-23 08:49:28.000000000 +0100 +++ /var/tmp/diff_new_pack.XUTPAV/_new 2015-12-23 08:49:28.000000000 +0100 @@ -21,7 +21,7 @@ %bcond_with tests Name: ghc-wai -Version: 3.0.3.0 +Version: 3.0.5.0 Release: 0 Summary: Web Application Interface License: MIT @@ -29,6 +29,9 @@ Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz +# PATCH-FIX-OPENSUSE remove-dep.path -- mimi...@gmail.com remove unused dependency +Patch0: remove-dep.patch + BuildRoot: %{_tmppath}/%{name}-%{version}-build BuildRequires: ghc-Cabal-devel @@ -39,6 +42,8 @@ BuildRequires: ghc-http-types-devel BuildRequires: ghc-network-devel BuildRequires: ghc-text-devel +BuildRequires: ghc-transformers-devel +BuildRequires: ghc-unix-compat-devel BuildRequires: ghc-vault-devel %if %{with tests} BuildRequires: ghc-hspec-devel @@ -63,6 +68,7 @@ %prep %setup -q -n %{pkg_name}-%{version} +%patch0 -p1 %build %ghc_lib_build ++++++ remove-dep.patch ++++++ Index: wai-3.0.5.0/wai.cabal =================================================================== --- wai-3.0.5.0.orig/wai.cabal +++ wai-3.0.5.0/wai.cabal @@ -21,7 +21,6 @@ Source-repository head Library Build-Depends: base >= 4 && < 5 , bytestring >= 0.10 - , bytestring-builder >= 0.10.4.0 && < 0.10.7 , blaze-builder >= 0.2.1.4 && < 0.5 , network >= 2.2.1.5 , http-types >= 0.7 ++++++ wai-3.0.3.0.tar.gz -> wai-3.0.5.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-3.0.3.0/ChangeLog.md new/wai-3.0.5.0/ChangeLog.md --- old/wai-3.0.3.0/ChangeLog.md 2015-07-05 07:08:07.000000000 +0200 +++ new/wai-3.0.5.0/ChangeLog.md 2015-12-07 10:08:37.000000000 +0100 @@ -1,6 +1,18 @@ +## 3.0.5.0 + +* Avoid using the IsString Builder instance + +## 3.0.4.0 + +* A new module Network.Wai.HTTP2 is exported. + +## 3.0.3.0 + +* mapResponseHeaders, ifRequest and modifyResponse are exported. + ## 3.0.2.3 -Allow blaze-builder 0.4 +* Allow blaze-builder 0.4 ## 3.0.2.2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/wai-3.0.3.0/Network/Wai/HTTP2.hs new/wai-3.0.5.0/Network/Wai/HTTP2.hs --- old/wai-3.0.3.0/Network/Wai/HTTP2.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/wai-3.0.5.0/Network/Wai/HTTP2.hs 2015-12-07 10:08:37.000000000 +0100 @@ -0,0 +1,272 @@ +{-# 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.3.0/Network/Wai/Internal.hs new/wai-3.0.5.0/Network/Wai/Internal.hs --- old/wai-3.0.3.0/Network/Wai/Internal.hs 2015-07-05 07:08:07.000000000 +0200 +++ new/wai-3.0.5.0/Network/Wai/Internal.hs 2015-12-07 10:08:37.000000000 +0100 @@ -1,6 +1,7 @@ {-# OPTIONS_HADDOCK not-home #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} -- | Internal constructors and helper functions. Note that no guarantees are @@ -8,14 +9,25 @@ module Network.Wai.Internal where import Blaze.ByteString.Builder (Builder) -import qualified Data.ByteString as B +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.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. @@ -145,3 +157,91 @@ -- 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.3.0/wai.cabal new/wai-3.0.5.0/wai.cabal --- old/wai-3.0.3.0/wai.cabal 2015-07-05 07:08:07.000000000 +0200 +++ new/wai-3.0.5.0/wai.cabal 2015-12-07 10:08:37.000000000 +0100 @@ -1,5 +1,5 @@ Name: wai -Version: 3.0.3.0 +Version: 3.0.5.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>. @@ -20,13 +20,17 @@ Library Build-Depends: base >= 4 && < 5 - , bytestring >= 0.9.1.4 + , bytestring >= 0.10 + , bytestring-builder >= 0.10.4.0 && < 0.10.7 , blaze-builder >= 0.2.1.4 && < 0.5 , network >= 2.2.1.5 , 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
