web-encodings 0.3.0 → 0.3.0.1
raw patch · 2 files changed
+5/−118 lines, 2 filesdep ~textPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: text
API changes (from Hackage documentation)
Files
- Web/Encodings.hs +3/−116
- web-encodings.cabal +2/−2
Web/Encodings.hs view
@@ -74,7 +74,6 @@ import Data.Either (partitionEithers) import System.Directory (getTemporaryDirectory, removeFile) import System.IO-import Control.Monad (foldM) -- | Encode all but unreserved characters with percentage encoding. --@@ -474,125 +473,13 @@ , sinkFinalize = \fp -> removeFile fp } -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 (PSBegin x) = show ("PSBegin" :: String, B8.unpack $ B8.concat $ x [])+ show (PSParam x y) = show ("PSParam" :: String, x, y)+ show (PSFile x y z _ _) = show ("PSFile" :: String, 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)--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)
web-encodings.cabal view
@@ -1,5 +1,5 @@ name: web-encodings-version: 0.3.0+version: 0.3.0.1 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -21,7 +21,7 @@ time >= 1.1.2.4 && < 1.3, old-locale >= 1.0.0.1 && < 1.1, bytestring >= 0.9.1.4 && < 0.10,- text >= 0.5 && < 0.8,+ text >= 0.5 && < 0.9, failure >= 0.0.0 && < 0.2, directory >= 1 && < 1.1 exposed-modules: Web.Encodings