packages feed

web-encodings 0.2.3 → 0.2.4

raw patch · 4 files changed

+402/−47 lines, 4 filesdep +convertible-textdep +directorydep +test-framework-quickcheck2dep −test-framework-quickcheckdep ~QuickCheckPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: convertible-text, directory, test-framework-quickcheck2, wai

Dependencies removed: test-framework-quickcheck

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

- Web.Encodings: instance (Show s) => Show (FileInfo s a)
+ Web.Encodings: Sink :: IO x -> (x -> ByteString -> IO x) -> (x -> IO y) -> (y -> IO ()) -> Sink x y
+ Web.Encodings: data Sink x y
+ Web.Encodings: instance (Eq s, Eq c) => Eq (FileInfo s c)
+ Web.Encodings: instance (Show s, Show c) => Show (FileInfo s c)
+ Web.Encodings: instance Show (ParseState x)
+ Web.Encodings: lbsSink :: Sink ([ByteString] -> [ByteString]) ByteString
+ Web.Encodings: parseRequestBody :: Sink x y -> Request -> IO ([(ByteString, ByteString)], [(ByteString, FileInfo ByteString y)])
+ Web.Encodings: sinkAppend :: Sink x y -> x -> ByteString -> IO x
+ Web.Encodings: sinkClose :: Sink x y -> x -> IO y
+ Web.Encodings: sinkFinalize :: Sink x y -> y -> IO ()
+ Web.Encodings: sinkInit :: Sink x y -> IO x
+ Web.Encodings: tempFileSink :: Sink (FilePath, Handle) FilePath
+ Web.Encodings.StringLike: chompStart :: (StringLike a) => a -> a
+ Web.Encodings.StringLike: takeLineMaybe :: (StringLike a) => a -> Maybe (a, a)
+ Web.Encodings.StringLike: takeUntilBlankMaybe :: (StringLike a) => a -> Maybe ([a], a)

Files

Web/Encodings.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TypeFamilies #-} --------------------------------------------------------- -- | -- Module        : Web.Encodings@@ -42,6 +44,11 @@     , parseHttpAccept       -- * Date/time encoding     , formatW3+      -- * WAI-specific decodings+    , parseRequestBody+    , Sink (..)+    , lbsSink+    , tempFileSink     ) where  import Numeric (showHex)@@ -62,6 +69,14 @@ import Data.Typeable (Typeable) import Control.Exception (Exception) import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL+import Data.Maybe (catMaybes)+import Data.Either (partitionEithers)+import Network.Wai+import System.Directory (getTemporaryDirectory, removeFile)+import System.IO+import Control.Monad (foldM)  -- | Encode all but unreserved characters with percentage encoding. --@@ -295,28 +310,15 @@     , fileContentType :: s     , fileContent :: c     }-instance Show s => Show (FileInfo s a) where-    show (FileInfo fn ct _) =-        "FileInfo: " ++ show fn ++ " (" ++ show ct ++ ")"+    deriving (Eq, Show)  -- | Parse a multipart form into parameters and files. parseMultipart :: StringLike s                => String -- ^ boundary                -> s -- ^ content                -> ([(s, s)], [(s, FileInfo s s)])-parseMultipart boundary content =-    let pieces = getPieces boundary content-        getJusts [] = []-        getJusts (Nothing:rest) = getJusts rest-        getJusts ((Just x):rest) = x : getJusts rest-        getLefts [] = []-        getLefts (Left x:rest) = x : getLefts rest-        getLefts (Right _:rest) = getLefts rest-        getRights [] = []-        getRights (Left _:rest) = getRights rest-        getRights (Right x:rest) = x : getRights rest-        pieces' = getJusts $ map parsePiece pieces-     in (getLefts pieces', getRights pieces')+parseMultipart boundary =+    partitionEithers . catMaybes . map parsePiece . getPieces boundary  -- | Parse a single segment of a multipart/form-data POST. parsePiece :: (StringLike s, MonadFailure (AttributeNotFound s) m)@@ -343,14 +345,6 @@           => String -- ^ boundary           -> s -- ^ content           -> [s]-{- FIXME this would be nice...-getPieces b c =-    let fullBound = ord '-' `BS.cons'` (ord '-' `BS.cons'` b)-        pieces = fullBound `BS.split` c-     in filter (/= toLazyByteString "--") $-        filter (not . BS.null) $-        map chompBS pieces--} getPieces _ c | SL.null c = [] getPieces b c =         let fullBound = SL.pack $ '-' `SL.cons` ('-' `SL.cons` b)@@ -386,10 +380,14 @@             ((x, _):_) -> x             [] -> 0         content = SL.take len body-        urlenc = "application/x-www-form-urlencoded"-        formBound = "multipart/form-data; boundary="         boundProcessed = drop (length formBound) ctype +urlenc :: String+urlenc = "application/x-www-form-urlencoded"++formBound :: String+formBound = "multipart/form-data; boundary="+ {-# DEPRECATED decodeCookies "Please use parseCookies instead" #-} -- | Deprecate alias for 'parseCookies'. decodeCookies :: StringLike s => s -> [(s, s)]@@ -441,3 +439,235 @@ -- | Format a 'UTCTime' in W3 format; useful for setting cookies. formatW3 :: UTCTime -> String formatW3 = formatTime defaultTimeLocale "%FT%X-00:00"++-- | A destination for data, the opposite of a 'Source'.+data Sink x y = Sink+    { sinkInit :: IO x+    , sinkAppend :: x -> BS.ByteString -> IO x+    , sinkClose :: x -> IO y+    , sinkFinalize :: y -> IO ()+    }++lbsSink :: Sink ([BS.ByteString] -> [BS.ByteString]) BL.ByteString+lbsSink = Sink+    { sinkInit = return id+    , sinkAppend = \front bs -> return $ front . (:) bs+    , sinkClose = \front -> return $ BL.fromChunks $ front []+    , sinkFinalize = \_ -> return ()+    }++tempFileSink :: Sink (FilePath, Handle) FilePath+tempFileSink = Sink+    { sinkInit = do+        tempDir <- getTemporaryDirectory+        openBinaryTempFile tempDir "webenc.buf"+    , sinkAppend = \(fp, h) bs -> BS.hPut h bs >> return (fp, h)+    , sinkClose = \(fp, h) -> do+        hClose h+        return fp+    , sinkFinalize = \fp -> removeFile fp+    }++-- | This function works just like 'parsePost', which two important distinctions:+--+-- * It runs on a 'Source', which is the datatype used by the WAI for feeding a+-- request body.+--+-- * It allows you to specify a 'Sink' for receiving each individual file+-- parameter, so that you can avoid allocating large amounts of memory if+-- desired.+--+-- Remember that it is your obligation to call 'sinkFinalize' on the returned+-- values.+parseRequestBody :: Sink x y+                 -> Request+                 -> IO ([(BL.ByteString, BL.ByteString)],+                        [(BS.ByteString, FileInfo BS.ByteString y)])+parseRequestBody sink req = do+    let ctype = do+    {- NOTE: Ignoring length, WAI must handle it+        clen' <- lookup ReqContentLength $ requestHeaders req+        clen'' <- readMay $ B8.unpack clen'+    -}+        ctype' <- lookup ReqContentType $ requestHeaders req+        if B8.pack urlenc `BS.isPrefixOf` ctype'+            then Just Nothing+            else if B8.pack formBound `BS.isPrefixOf` ctype'+                    then Just $ Just (BS.drop (length formBound) ctype')+                    else Nothing+    case ctype of+        Nothing -> return ([], [])+        Just Nothing -> do+            lbs <- sourceToLbsStrict $ requestBody req+            return (decodeUrlPairs lbs, [])+        Just (Just bound) ->+            parsePieces sink (PSBegin id) bound BS.empty (requestBody req) id id++type PieceReturn sink =+    Either+              (BL.ByteString, BL.ByteString)+              (BS.ByteString, FileInfo BS.ByteString sink)++data ParseState seed+    = PSBegin ([BS.ByteString] -> [BS.ByteString])+    | PSParam BL.ByteString BL.ByteString+    | PSFile BL.ByteString BL.ByteString BL.ByteString seed BS.ByteString+    | PSNothing+instance Show (ParseState x) where+    show (PSBegin x) = show ("PSBegin", B8.unpack $ B8.concat $ x [])+    show (PSParam x y) = show ("PSParam", x, y)+    show (PSFile x y z _ _) = show ("PSFile", x, y, z)+    show PSNothing = "PSNothing"++-- | Parse a single segment of a multipart/form-data POST.+parsePiece' :: Sink x y+            -> ParseState x+            -> BS.ByteString+            -> IO (ParseState x)+parsePiece' sink (PSBegin front) bs =+    case SL.takeUntilBlankMaybe $ BL.fromChunks $ front [bs] of+        Nothing -> return $ PSBegin $ front . (:) bs+        Just (headers', content) ->+            let headers = map parseHeader headers'+                name = lookupHeaderAttr+                        (SL.pack "Content-Disposition")+                        (SL.pack "name")+                        headers+                fname = lookupHeaderAttr+                            (SL.pack "Content-Disposition")+                            (SL.pack "filename")+                            headers+                ctype = lookupHeader (SL.pack "Content-Type") headers+             in case (name, fname, ctype) of+                    (Just name', Nothing, _) ->+                        return $ PSParam name' content+                    (Just name', Just fname', Just ctype') -> do+                        seed <- sinkInit sink+                        (seed', hasNewLine)+                            <- foldM (sinkAppendNL sink) (seed, BS.empty)+                             $ BL.toChunks content+                        return $ PSFile name' fname' ctype' seed' hasNewLine+                    _ -> return PSNothing+parsePiece' _ PSNothing _ = return PSNothing+parsePiece' _ (PSParam name content) bs =+    return $ PSParam name $ BL.append content $ BL.fromChunks [bs]+parsePiece' sink (PSFile name fname ctype seed newLine) bs = do+    let (bs', newLine') = mychomp bs+    seed' <- sinkAppend sink seed newLine+    seed'' <- sinkAppend sink seed' bs'+    return $ PSFile name fname ctype seed'' newLine'++mychomp :: BS.ByteString -> (BS.ByteString, BS.ByteString)+mychomp bs+    | BS.null bs = (bs, BS.empty)+    | B8.last bs == '\n' && BS.null (BS.init bs) = (BS.empty, bs)+    | B8.last bs == '\n' && B8.last (BS.init bs) == '\r' =+        (BS.init $ BS.init bs, B8.pack "\r\n")+    | B8.last bs == '\n' = (BS.init bs, B8.pack "\n")+    | otherwise = (bs, BS.empty)++-- | Removes one new line from end.+sinkAppendNL :: Sink x y -> (x, BS.ByteString) -> BS.ByteString+             -> IO (x, BS.ByteString)+sinkAppendNL sink (seed, prev) bs = do+    seed' <- sinkAppend sink seed prev+    let (bs', prev') = mychomp bs+    seed'' <- sinkAppend sink seed' bs'+    return (seed'', prev')++type Param = (BL.ByteString, BL.ByteString)+type File y = (BS.ByteString, FileInfo BS.ByteString y)++parsePieces :: Sink x y+            -> ParseState x+            -> BS.ByteString+            -> BS.ByteString+            -> Source+            -> ([Param] -> [Param])+            -> ([File y] -> [File y])+            -> IO ([Param], [File y])+parsePieces sink pstate boundary prev (Source source) frontp frontf = do+    res <- source+    case res of+        Nothing -> do+            (pstate', prev', frontp', frontf') <- go prev+            if BS.null prev' || prev == prev' -- second clause ensures termination+                then return (frontp' [], frontf' [])+                else parsePieces sink pstate' boundary prev' (Source $ return Nothing) frontp' frontf'+        Just (bs', source') -> do+            let bs = BS.append prev bs'+            (pstate', prev', frontp', frontf') <- go bs+            parsePieces sink pstate' boundary prev' source' frontp' frontf'+    where+        go bs =+            case hasBound boundary bs of+                NoBound -> do+                    pstate' <- parsePiece' sink pstate bs+                    return (pstate', BS.empty, frontp, frontf)+                MaybeBound -> return (pstate, bs, frontp, frontf)+                HasBound before after -> do+                    pstate' <- parsePiece' sink pstate before+                    es <- extractState sink pstate'+                    let (frontp', frontf') =+                            case es of+                                Nothing -> (frontp, frontf)+                                Just (Left p) -> (frontp . (:) p, frontf)+                                Just (Right f) -> (frontp, frontf . (:) f)+                    return (PSBegin id, after, frontp', frontf')++extractState :: Sink x y+             -> ParseState x+             -> IO (Maybe (PieceReturn y))+extractState _ (PSBegin _) = return Nothing+extractState _ PSNothing = return Nothing+extractState _ (PSParam name val) =+    return $ Just $ Left (name, SL.chomp val)+extractState sink (PSFile name fname ctype seed _newLine) = do+    output <- sinkClose sink seed+    return $ Just $ Right (BS.concat $ BL.toChunks name, FileInfo+        { fileName = BS.concat $ BL.toChunks fname+        , fileContentType = BS.concat $ BL.toChunks ctype+        , fileContent = output+        })++data HasBound = NoBound | MaybeBound | HasBound BS.ByteString BS.ByteString+hasBound :: BS.ByteString -> BS.ByteString -> HasBound+hasBound bound content =+    case notEmpty $ BS.breakSubstring fullBound1 content of+        Just (before, after) ->+            let after' = BS.drop (BS.length fullBound1) after+             in HasBound before $ SL.chompStart after'+        Nothing ->+          case notEmpty $ BS.breakSubstring fullBound2 content of+            Just (before, after) ->+                let after' = BS.drop (BS.length fullBound2) after+                 in HasBound before $ SL.chompStart after'+            Nothing ->+              case notEmpty $ BS.breakSubstring fullBound3 content of+                Just (before, after) ->+                  let after' = BS.drop (BS.length fullBound3) after+                   in HasBound before $ SL.chompStart after'+                Nothing ->+                    if endsWithBound+                        then MaybeBound+                        else NoBound+      where+        fullBound' = B8.cons '-' $ B8.cons '-' bound+        fullBound1 = fullBound' `B8.snoc` '\n'+        fullBound2 = fullBound' `B8.snoc` '\r' `B8.snoc` '\n'+        fullBound3 = fullBound' `B8.snoc` '-' `B8.snoc` '-'+        endsWithBound =+            or $ map (\x -> x `BS.isSuffixOf` content)+               $ (BS.inits fullBound2 ++ BS.inits fullBound3)+        notEmpty (x, y)+            | BS.null y = Nothing+            | otherwise = Just (x, y)++sourceToLbsStrict :: Source -> IO BL.ByteString+sourceToLbsStrict source0 = go source0 id+  where+    go (Source source) front = do+        res <- source+        case res of+            Nothing -> return $ BL.fromChunks $ front []+            Just (bs, source') -> go source' $ front . (:) bs
Web/Encodings/StringLike.hs view
@@ -65,6 +65,14 @@                 '\n' -> chomp $ init s                 '\r' -> chomp $ init s                 _ -> s+    chompStart :: a -> a+    chompStart s = case uncons s of+                    Just ('\r', rest) ->+                        case uncons rest of+                            Just ('\n', rest') -> rest'+                            _ -> s+                    Just ('\n', rest) -> rest+                    _ -> s     split :: Char -> a -> [a]     split c s =         let (next, rest) = breakChar c s@@ -109,6 +117,10 @@         let (x, y) = breakChar '\n' a             x' = chomp x          in (x', y)+    takeLineMaybe :: a -> Maybe (a, a)+    takeLineMaybe a = do+        (x, y) <- breakCharMaybe '\n' a+        Just (chomp x, y)     takeUntilBlank :: a -> ([a], a)     takeUntilBlank a =         let (next, rest) = takeLine a@@ -116,6 +128,14 @@                 then ([], rest)                 else let (nexts, rest') = takeUntilBlank rest                       in (next : nexts, rest')+    takeUntilBlankMaybe :: a -> Maybe ([a], a)+    takeUntilBlankMaybe a = do+        (next, rest) <- takeLineMaybe a+        if null next+                then Just ([], rest)+                else do+                        (nexts, rest') <- takeUntilBlankMaybe rest+                        Just (next : nexts, rest')      lengthLT :: Int -> a -> Bool     lengthLT i _ | i <= 0 = False
runtests.hs view
@@ -8,7 +8,7 @@ import Test.QuickCheck  import Web.Encodings-import Data.Char (chr, ord)+import Data.Convertible.Text (cs)  import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BL@@ -19,6 +19,8 @@ import qualified Web.Encodings.StringLike as SL import Web.Encodings.StringLike (StringLike) import Control.Arrow ((***))+import qualified Data.ByteString as B+import Network.Wai  main :: IO () main = defaultMain [tests]@@ -36,7 +38,6 @@     , testCase "decode URL pairs" $ caseDecodeUrlPairs s     , testCase "parse cookies" $ caseParseCookies s     , testCase "parse http accept" $ caseParseHttpAccept s-    -- FIXME , testCase "parse post" huParsePost     , testCase "hebrew query string encode" $ caseHebrewQueryStringEncode s     , testCase "hebrew query string decode" $ caseHebrewQueryStringDecode s     , testCase "bad query string decode" $ caseBadQueryStringDecode s@@ -49,6 +50,8 @@     , allTests "Lazy ByteString" (undefined :: BL.ByteString)     , allTests "Strict Text" (undefined :: TS.Text)     , allTests "Lazy Text" (undefined :: TL.Text)+    , testCase "parse post" huParsePost+    , testCase "parse request body" huParseRequestBody     ]  qcEncodeDecodeUrl :: StringLike a => a -> a -> Bool@@ -113,48 +116,47 @@ instance Arbitrary TL.Text where     arbitrary = fmap SL.pack arbitrary -{- FIXME+huParsePost :: Assertion huParsePost = t where-    content2 = BSLU.fromString $+    content2 = cs $         "--AaB03x\n" ++         "Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n" ++-        "Content-Type: text/plain; charset=iso-8859-1\n" +++        "Content-Type: text/plain; charset=iso-8859-1\n\n" ++         "This is a file.\n" ++         "It has two lines.\n" ++         "--AaB03x\n" ++         "Content-Disposition: form-data; name=\"title\"\n" ++-        "Content-Type: text/plain; charset=iso-8859-1\n" +++        "Content-Type: text/plain; charset=iso-8859-1\n\n" ++         "A File\n" ++         "--AaB03x\n" ++         "Content-Disposition: form-data; name=\"summary\"\n" ++-        "Content-Type: text/plain; charset=iso-8859-1\n" +++        "Content-Type: text/plain; charset=iso-8859-1\n\n" ++         "This is my file\n" ++         "file test\n" ++         "--AaB03x--\n"     t = do-        let content1 = BSLU.fromString "foo=bar&baz=bin"-        let len1 = BSLU.fromString $ show $ BS.length content1-        let ctype1 = BSLU.fromString "application/x-www-form-urlencoded"+        let content1 = cs "foo=bar&baz=bin"+        let len1 = cs $ show $ BS.length content1+        let ctype1 = cs "application/x-www-form-urlencoded"         let result1 = parsePost ctype1 len1 content1         assertEqual "parsing post x-www-form-urlencoded"-                    ([("foo", "bar"), ("baz", "bin")], [])+                    (map (cs *** cs) [("foo", "bar"), ("baz", "bin")], [])                     result1 -        let ctype2 = BSLU.fromString "multipart/form-data; boundary=AaB03x"-        let len2 = BSLU.fromString $ show $ BS.length content2+        let ctype2 = cs "multipart/form-data; boundary=AaB03x"+        let len2 = cs $ show $ BS.length content2         let result2 = parsePost ctype2 len2 content2         let expectedsmap2 =               [ ("title", "A File")               , ("summary", "This is my file\nfile test")               ]         let expectedfile2 =-              [ ("document", "b.txt", "text/plain", BSLU.fromString $-                 "This is a file.\nIt has two lines.\n") ]-        let expected2 = (expectedsmap2, expectedfile2)+              [(cs "document", FileInfo (cs "b.txt") (cs "text/plain") $ cs+                 "This is a file.\nIt has two lines.")]+        let expected2 = (map (cs *** cs) expectedsmap2, expectedfile2)         assertEqual "parsing post multipart/form-data"                     expected2                     result2--}  caseDecodeUrlPairs :: StringLike a => a -> IO () caseDecodeUrlPairs dummy = do@@ -196,3 +198,103 @@         encoded = SL.pack raw `asTypeOf` dummy         expected = SL.unpackUtf8 bs     expected @=? decodeUrlFailure encoded++huParseRequestBody :: Assertion+huParseRequestBody = t where+    content2 = cs $+        "--AaB03x\n" +++        "Content-Disposition: form-data; name=\"document\"; filename=\"b.txt\"\n" +++        "Content-Type: text/plain; charset=iso-8859-1\n\n" +++        "This is a file.\n" +++        "It has two lines.\n" +++        "--AaB03x\n" +++        "Content-Disposition: form-data; name=\"title\"\n" +++        "Content-Type: text/plain; charset=iso-8859-1\n\n" +++        "A File\n" +++        "--AaB03x\n" +++        "Content-Disposition: form-data; name=\"summary\"\n" +++        "Content-Type: text/plain; charset=iso-8859-1\n\n" +++        "This is my file\n" +++        "file test\n" +++        "--AaB03x--"+    content3 = cs "------WebKitFormBoundaryB1pWXPZ6lNr8RiLh\r\nContent-Disposition: form-data; name=\"yaml\"; filename=\"README\"\r\nContent-Type: application/octet-stream\r\n\r\nPhoto blog using Hack.\n\r\n------WebKitFormBoundaryB1pWXPZ6lNr8RiLh--\r\n"+    t = do+        let content1 = cs "foo=bar&baz=bin"+        let ctype1 = cs "application/x-www-form-urlencoded"+        result1 <- parseRequestBody lbsSink $ toRequest ctype1 content1+        assertEqual "parsing post x-www-form-urlencoded"+                    (map (cs *** cs) [("foo", "bar"), ("baz", "bin")], [])+                    result1++        let ctype2 = cs "multipart/form-data; boundary=AaB03x"+        result2 <- parseRequestBody lbsSink $ toRequest ctype2 content2+        let expectedsmap2 =+              [ ("title", "A File")+              , ("summary", "This is my file\nfile test")+              ]+        let expectedfile2 =+              [(cs "document", FileInfo (cs "b.txt") (cs "text/plain") $ cs+                 "This is a file.\nIt has two lines.")]+        let expected2 = (map (cs *** cs) expectedsmap2, expectedfile2)+        assertEqual "parsing post multipart/form-data"+                    expected2+                    result2++        let ctype3 = cs "multipart/form-data; boundary=----WebKitFormBoundaryB1pWXPZ6lNr8RiLh"+        result3 <- parseRequestBody lbsSink $ toRequest ctype3 content3+        let expectedsmap3 = []+        let expectedfile3 = [(cs "yaml", FileInfo (cs "README") (cs "application/octet-stream") $+                                cs "Photo blog using Hack.\n")]+        let expected3 = (expectedsmap3, expectedfile3)+        assertEqual "parsing actual post multipart/form-data"+                    expected3+                    result3++        result2' <- parseRequestBody lbsSink $ toRequest' ctype2 content2+        assertEqual "parsing post multipart/form-data 2"+                    expected2+                    result2+        putStrLn "\n\n\n\n\n"+        result3' <- parseRequestBody lbsSink $ toRequest' ctype3 content3+        assertEqual "parsing actual post multipart/form-data 2"+                    expected3+                    result3'++toRequest :: BS.ByteString -> BS.ByteString -> Request+toRequest ctype content = Request+    { requestHeaders = [(ReqContentType, ctype)]+    , requestBody = toSource content+    , requestMethod = undefined+    , httpVersion = undefined+    , pathInfo = undefined+    , queryString = undefined+    , serverName = undefined+    , serverPort = undefined+    , urlScheme = undefined+    , errorHandler = undefined+    , remoteHost = undefined+    }++toRequest' :: BS.ByteString -> BS.ByteString -> Request+toRequest' ctype content = Request+    { requestHeaders = [(ReqContentType, ctype)]+    , requestBody = toSource' content+    , requestMethod = undefined+    , httpVersion = undefined+    , pathInfo = undefined+    , queryString = undefined+    , serverName = undefined+    , serverPort = undefined+    , urlScheme = undefined+    , errorHandler = undefined+    , remoteHost = undefined+    }++toSource :: BS.ByteString -> Source+toSource bs = Source $+    case B.uncons bs of+        Nothing -> return Nothing+        Just (x, xs) -> return $ Just (B.singleton x, toSource xs)++toSource' :: BS.ByteString -> Source+toSource' bs = Source $ return $ Just (bs, Source $ return Nothing)
web-encodings.cabal view
@@ -1,5 +1,5 @@ name:            web-encodings-version:         0.2.3+version:         0.2.4 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -23,7 +23,9 @@                      bytestring >= 0.9.1.4 && < 0.10,                      text >= 0.5 && < 0.8,                      failure >= 0.0.0 && < 0.1,-                     safe >= 0.2 && < 0.3+                     safe >= 0.2 && < 0.3,+                     wai >= 0.0.0 && < 0.1,+                     directory >= 1 && < 1.1     exposed-modules: Web.Encodings                      Web.Encodings.MimeHeader,                      Web.Encodings.StringLike,@@ -34,10 +36,11 @@     if flag(buildtests)         Buildable: True         build-depends:   test-framework,-                         test-framework-quickcheck,+                         test-framework-quickcheck2,                          test-framework-hunit,                          HUnit,-                         QuickCheck >= 1 && < 2+                         QuickCheck >= 2 && < 3,+                         convertible-text >= 0.2.0 && < 0.3     else         Buildable: False     ghc-options:     -Wall