http-encodings (empty) → 0.9
raw patch · 7 files changed
+361/−0 lines, 7 filesdep +HTTPdep +basedep +bytestringsetup-changed
Dependencies added: HTTP, base, bytestring, iconv, mime, mtl, parsec, utf8-string, zlib
Files
- LICENSE +31/−0
- Network/HTTP/Encoding.hs +133/−0
- Network/HTTP/Encoding/Character.hs +61/−0
- Network/HTTP/Encoding/Content.hs +63/−0
- Network/HTTP/Encoding/Error.hs +30/−0
- Setup.hs +2/−0
- http-encodings.cabal +41/−0
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2012-2013 Stevens Institute of Technology++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Stevens Institute of Technology nor the+ names of the authors and other contributors may be used to+ endorse or promote products derived from this software without+ specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/HTTP/Encoding.hs view
@@ -0,0 +1,133 @@+-- | Encoding and decoding of bodies and complete HTTP messages. See+-- package 'jespresso' for an example of usage.+module Network.HTTP.Encoding (-- * Operations on HTTP messages+ decode+ ,encode+ -- * Operations on the bodies of HTTP messages+ ,withDecodedBody+ ,withDecodedBodyM + ,decodeBody+ ,encodeBody+ -- * Types+ ,HasBody(..)+ ,EncodingError+ ,DecodingResult(..)) where++import Network.HTTP.Encoding.Content+import Network.HTTP.Encoding.Character+import Network.HTTP.Encoding.Error+import Network.HTTP+import Data.ByteString.Lazy+import Codec.Text.IConv+import Control.Applicative+import Data.ByteString.Lazy.UTF8 (fromString, toString)++targetEncoding = "UTF-8"++class HasBody a where+ getBody :: a b -> b+ setBody :: c -> a b -> a c++instance HasBody Request where+ getBody = rqBody+ setBody body rq = rq {rqBody = body}++instance HasBody Response where+ getBody = rspBody+ setBody body rsp = rsp {rspBody = body}++-- | The result of decoding a message body+data DecodingResult = DecodingResult {decodedBody :: String+ ,originalEncoding :: EncodingName+ }++-- | Decodes and decompresses the response or request body using the+-- information in the headers and content and possibly returns the+-- body in UTF8+decodeBody :: (HasHeaders (r ByteString), HasBody r)+ => r ByteString + -> Either EncodingError DecodingResult+decodeBody r =+ let headers = getHeaders r+ body = getBody r+ contentEnc = getContentEncoding headers+ decodeBody2 :: String -> Either EncodingError DecodingResult+ decodeBody2 enc =+ do dbody <- decompress contentEnc body+ x <- either (Right) (Left . IConvError)+ (convertStrictly enc targetEncoding dbody)++ return $ DecodingResult {decodedBody = toString x+ ,originalEncoding = enc}+ in case snd $ getContentTypeAndCharacterEncoding headers of+ Nothing -> decodeBody2 "utf-8"+ Just charEnc -> decodeBody2 charEnc+ +flipEither :: Either a b -> Either b a+flipEither (Left x) = Right x+flipEither (Right x) = Left x++-- | Decode the body of an HTTP message and return the original+-- encoding name and the same message with decoded body (as+-- UTF8-encoded string) and updated character and content encoding+-- headers.+decode :: (HasHeaders (m ByteString), HasHeaders (m String), HasBody m) + => m ByteString+ -> Either EncodingError (String, m String)+decode r = do res <- decodeBody r+ let hdrs = updateContentEncoding IdentityCompression (getHeaders r)+ hdrs2= setCharacterEncoding (originalEncoding res) hdrs + return (originalEncoding res+ ,flip setHeaders hdrs $ setBody (decodedBody res) r)+ +-- |Takes a haskell UTF8-encoded string and produces a stream, encoded+-- and compressed+encodeBody :: EncodingName + -> ContentEncoding+ -> String+ -> Either EncodingError ByteString+encodeBody source_enc ce str =+ do body <- either Right+ (Left . IConvError)+ (convertStrictly targetEncoding source_enc (fromString str))+ compress ce body++-- | Encode the UTF8-encoded body of an HTTP message with the provided+-- encoding.+encode :: (HasHeaders (m String), HasBody m)+ => EncodingName -> m String -> Either EncodingError (m ByteString)+encode ch_enc r = + let headers = getHeaders r+ body = getBody r+ in let ce = getContentEncoding headers in+ do ebody <- encodeBody ch_enc ce body+ return $ setBody ebody r++either2Maybe (Left x) = Just x+either2Maybe (Right _) = Nothing++-- | Allows to lift a transformation function operating on decoded+-- (UTF-8) bodies to bodies of requests with encoded (and compressed)+-- bodies.+withDecodedBody :: (HasHeaders (r String), HasHeaders (r ByteString), HasBody r) + => (String -> String)+ -> r ByteString+ -> Either EncodingError (r ByteString)+withDecodedBody f r = + do (enc, dr) <- decode r+ let mdr = setBody (f $ getBody dr) dr+ encode enc mdr+ +-- | A monadic version of 'withDecodeBody'+withDecodedBodyM :: (Monad m, HasHeaders (r String), HasHeaders (r ByteString), + HasBody r)+ => (String -> m String)+ -> r ByteString+ -> m (Either EncodingError (r ByteString))+withDecodedBodyM f r =+ case decode r of+ Left err -> return $ Left err+ Right (enc, dr) -> f (getBody dr) >>= \mbody ->+ case encode enc $ setBody mbody dr of+ Left err -> return $ Left err+ Right mr -> return $ Right mr
+ Network/HTTP/Encoding/Character.hs view
@@ -0,0 +1,61 @@+-- | Detection and of character encodings of HTTP message bodies+module Network.HTTP.Encoding.Character + (getContentTypeAndCharacterEncoding+ ,setCharacterEncoding+ ,tryAsUTF8) where++import Network.HTTP+import Codec.Text.IConv+import Codec.MIME.Parse+import Codec.MIME.Type+import Control.Applicative hiding (many, (<|>))+import Data.Char (toLower, ord)+import Data.ByteString.Lazy.UTF8 (uncons)+import Data.ByteString.Lazy (ByteString)+import Control.Monad++-- | Looks for and parses the ContentType header. Returns the+-- (optional) content-type and (optional) the character encoding name.+getContentTypeAndCharacterEncoding :: [Header] -> + (Maybe Type, Maybe EncodingName)+getContentTypeAndCharacterEncoding [] = (Nothing, Nothing)+getContentTypeAndCharacterEncoding (Header HdrContentType str:_) = + parseContentTypeHdr str+getContentTypeAndCharacterEncoding (_:hs) = getContentTypeAndCharacterEncoding hs++-- | Sets the given character encoding name in the given header. If+-- there is no content type header in the header list, it defaults to+-- the text/plain content type+setCharacterEncoding :: EncodingName -> [Header] -> [Header]+setCharacterEncoding enc [] = [plainText enc]+setCharacterEncoding enc ((Header HdrContentType str):rest) =+ let (mtype, _) = parseContentTypeHdr str+ newhdr = case mtype of+ Nothing -> plainText enc+ Just ty -> Header HdrContentType $ showType $ setMIMEEncoding ty enc+ in newhdr:rest++plainText :: EncodingName -> Header+plainText enc = Header HdrContentType $ showType $+ Type {mimeType = (Text "plain")+ ,mimeParams = [("charset", enc)]}++setMIMEEncoding :: Type -> EncodingName -> Type+setMIMEEncoding ty enc = ty {mimeParams = map replaceEnc $ mimeParams ty}+ where replaceEnc (pname, _) | pname == "charset" = (pname, enc)+ replaceEnc x = x++parseContentTypeHdr :: String -> (Maybe Type, Maybe EncodingName)+parseContentTypeHdr str = + case parseContentType str of+ Nothing -> (Nothing, Nothing)+ Just ctype -> (Just ctype, + (map toLower) <$> lookup "charset" (mimeParams ctype))++-- | Tries to decode a bytestring as UTF-8. Returns nothing if any+-- illegal characters are encountered+tryAsUTF8 :: ByteString -> Maybe String+tryAsUTF8 bs = uncons bs >>= \(c, bs') ->+ if (ord c == 0xFFFD) then mzero+ else tryAsUTF8 bs' >>= \s -> return (c:s)+
+ Network/HTTP/Encoding/Content.hs view
@@ -0,0 +1,63 @@+-- | Deals with content encoding (compression) of message bodies:+-- detection, update and compression/decompression+module Network.HTTP.Encoding.Content(ContentEncoding(..)+ ,getContentEncoding+ ,updateContentEncoding+ ,decompress+ ,compress+ ) where++import Network.HTTP+import Network.HTTP.Encoding.Error+import qualified Codec.Compression.GZip as GZip+import qualified Codec.Compression.Zlib as Zlib+import Data.ByteString.Lazy+import Data.Maybe++-- | Represents the content encoding, per the HTTP/1.1 standard.+data ContentEncoding = GZip | Compress | Deflate | IdentityCompression++instance Show ContentEncoding where+ show GZip = "gzip"+ show Compress = "compress"+ show Deflate = "deflate"+ show IdentityCompression = ""++-- | Determines the content encoding from a list of headers. Defaults+-- to 'IdentityCompression'+getContentEncoding :: [Header] -> ContentEncoding+getContentEncoding [] = IdentityCompression+getContentEncoding (Header HdrContentEncoding "gzip":hs) = GZip+getContentEncoding (Header HdrContentEncoding "x-gzip":hs) = GZip+getContentEncoding (Header HdrContentEncoding "compress":hs) = Compress+getContentEncoding (Header HdrContentEncoding "x-compress":hs) = Compress+getContentEncoding (Header HdrContentEncoding "deflate":hs) = Deflate+getContentEncoding (h:hs) = getContentEncoding hs++-- | Given the list of headers, updates content encoding to the+-- specified.+updateContentEncoding :: ContentEncoding -> [Header] -> [Header]+updateContentEncoding ce [] = maybeToList $ contentEncodingHeader ce+updateContentEncoding ce (Header HdrContentEncoding _:hs) = + hs ++ maybeToList (contentEncodingHeader ce)+updateContentEncoding ce (h:hs) = h:updateContentEncoding ce hs++contentEncodingHeader :: ContentEncoding -> Maybe Header+contentEncodingHeader IdentityCompression = Nothing+contentEncodingHeader ce = Just $ Header HdrContentEncoding (show ce)++-- | Decompresses a 'Bytestring' assuming a given content encoding. The+-- Compress encoding (LZW algorithm) is not supported at this time.+decompress :: ContentEncoding -> ByteString -> Either EncodingError ByteString+decompress GZip bs = Right $ GZip.decompress bs+decompress Compress body = Left UnsupportedCompressionAlgorithm+decompress Deflate bs = Right $ Zlib.decompress bs+decompress IdentityCompression bs = Right bs++-- | Compresses a 'Bytestring' assuming a given content encoding. The+-- Compress encoding (LZW algorithm) is not supported at this time.+compress :: ContentEncoding -> ByteString -> Either EncodingError ByteString+compress GZip body = Right $ GZip.compress body+compress Compress body = Left UnsupportedCompressionAlgorithm+compress Deflate body = Right $ Zlib.compress body+compress IdentityCompression rsp = Right rsp
+ Network/HTTP/Encoding/Error.hs view
@@ -0,0 +1,30 @@+-- | Errors that may occur during decoding/encoding of HTTP message bodies+module Network.HTTP.Encoding.Error (EncodingError (..)+ ,ConversionError (..)) where++import Codec.Text.IConv (ConversionError+ ,reportConversionError)++-- | Encoding/Decoding error message+data EncodingError = CannotDetermineCharacterEncoding+ -- ^ Character decoding is not specified and+ -- cannot be guessed+ | UnsupportedCompressionAlgorithm+ -- ^ A compression algorithm is not supported (LZW)+ | IConvError ConversionError+ -- ^ IConv conversion error+ | GenericError String+ -- ^ Other error+ +instance Show EncodingError where+ show err = case err of + CannotDetermineCharacterEncoding ->+ "No character encoding was specified in message headers \+ \and the body character encoding cannot be determined"+ UnsupportedCompressionAlgorithm -> + "Sorry, the 'compress' algorithm is not supported at this time"+ IConvError conv_err -> + "Charset conversion error in iconv: " ++ + show (reportConversionError conv_err)+ GenericError err -> "Generic error: " ++ err+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ http-encodings.cabal view
@@ -0,0 +1,41 @@+Name: http-encodings+Version: 0.9+Synopsis: A library for encoding and decoding bodies of HTTP messages+Description: A library for encoding and decoding bodies of HTTP messages, designed to work with the HTTP and http-server libraries. No heuristic encoding detection at this time. WANTED: a library implementing the Unix "compress" command encoding/decoding (or the LZW algorithm).++License: BSD3+License-file: LICENSE+Author: Andrey Chudnov+Maintainer: Andrey Chudnov <oss@chudnov.com>+Homepage: http://github.com/achudnov/http-encodings+Bug-reports: http://github.com/achudnov/http-encodings/issues+Copyright: (c) 2012-2013 Stevens Institute of Technology+Category: Web+Build-type: Simple+Stability: Experimental+Cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/achudnov/http-encodings.git++source-repository this+ type: git+ location: git://github.com/achudnov/http-encodings.git+ tag: 0.9++Library+ Exposed-modules: Network.HTTP.Encoding, + Network.HTTP.Encoding.Character, + Network.HTTP.Encoding.Content,+ Network.HTTP.Encoding.Error + Build-depends: base == 4.*+ , HTTP == 4000.*+ , bytestring >= 0.9 && < 0.10+ , parsec == 3.*+ , utf8-string == 0.3.*+ , iconv == 0.4.*+ , zlib == 0.5.*+ , mtl == 2.*+ , mime == 0.3.*+ Default-language: Haskell2010