    {-# LANGUAGE CPP,NoMonomorphismRestriction, FlexibleContexts #-}
    -- | Filter for compressing the 'Response' body.
    module Happstack.Server.Internal.Compression
        ( compressedResponseFilter
        , compressedResponseFilter'
        , compressWithFilter
        , gzipFilter
        , deflateFilter
        , identityFilter
        , starFilter
        , encodings
        , standardEncodingHandlers
        ) where
    import Happstack.Server.SimpleHTTP
    import Text.ParserCombinators.Parsec
    import Control.Monad
    #if !MIN_VERSION_base(4,13,0)
    import Control.Monad.Fail (MonadFail)
    #endif
    import Data.Maybe
    import Data.List
    import qualified Data.ByteString.Char8 as BS
    import qualified Data.ByteString.Lazy.Char8 as L
    import qualified Codec.Compression.GZip as GZ
    import qualified Codec.Compression.Zlib as Z

    -- | reads the @Accept-Encoding@ header.  Then, if possible
    -- will compress the response body with methods @gzip@ or @deflate@.
    --
    -- This function uses 'standardEncodingHandlers'. If you want to
    -- provide alternative handers (perhaps to change compression levels),
    -- see 'compressedResponseFilter''
    --
    -- > main =
    -- >   simpleHTTP nullConf $
    -- >      do str <- compressedResponseFilter
    -- >         return $ toResponse ("This response compressed using: " ++ str)
    compressedResponseFilter :: (FilterMonad Response m, MonadPlus m, WebMonad Response m, ServerMonad m, MonadFail m) =>
                                m String -- ^ name of the encoding chosen
    compressedResponseFilter :: forall (m :: * -> *).
    (FilterMonad Response m, MonadPlus m, WebMonad Response m,
     ServerMonad m, MonadFail m) =>
    m String
    compressedResponseFilter = [(String, String -> Bool -> m ())] -> m String
    forall (m :: * -> *).
    (FilterMonad Response m, MonadPlus m, WebMonad Response m,
     ServerMonad m, MonadFail m) =>
    [(String, String -> Bool -> m ())] -> m String
    compressedResponseFilter' [(String, String -> Bool -> m ())]
    forall (m :: * -> *).
    (FilterMonad Response m, MonadFail m) =>
    [(String, String -> Bool -> m ())]
    standardEncodingHandlers

    -- | reads the @Accept-Encoding@ header.  Then, if possible
    -- will compress the response body using one of the supplied filters.
    --
    -- A filter function takes two arguments. The first is a 'String' with
    -- the value to be used as the 'Content-Encoding' header. The second
    -- is 'Bool' which indicates if the compression filter is allowed to
    -- fallback to @identity@.
    --
    -- This is important if the resource being sent using sendfile, since
    -- sendfile does not provide a compression option. If @identity@ is
    -- allowed, then the file can be sent uncompressed using sendfile. But
    -- if @identity@ is not allowed, then the filter will need to return
    -- error 406.
    --
    -- You should probably always include the @identity@ and @*@ encodings
    -- as acceptable.
    --
    -- > myFilters :: (FilterMonad Response m) => [(String, String -> Bool -> m ()]
    -- > myFilters = [ ("gzip"    , gzipFilter)
    -- >             , ("identity", identityFilter)
    -- >             , ("*"       , starFilter)
    -- >             ]
    -- >
    -- > main =
    -- >   simpleHTTP nullConf $
    -- >      do let filters =
    -- > str <- compressedResponseFilter'
    -- >         return $ toResponse ("This response compressed using: " ++ str)
    compressedResponseFilter' ::
        (FilterMonad Response m, MonadPlus m, WebMonad Response m, ServerMonad m, MonadFail m)
        => [(String, String -> Bool -> m ())]  -- ^ compression filter assoc list
        -> m String                            -- ^ name of the encoding chosen
    compressedResponseFilter' :: forall (m :: * -> *).
    (FilterMonad Response m, MonadPlus m, WebMonad Response m,
     ServerMonad m, MonadFail m) =>
    [(String, String -> Bool -> m ())] -> m String
    compressedResponseFilter' [(String, String -> Bool -> m ())]
    encodingHandlers = do
        String -> m (Maybe ByteString)
    forall (m :: * -> *).
    ServerMonad m =>
    String -> m (Maybe ByteString)
    getHeaderM String
    "Accept-Encoding" m (Maybe ByteString) -> (Maybe ByteString -> m String) -> m String
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
            (m String
    -> (ByteString -> m String) -> Maybe ByteString -> m String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> m String
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "identity") ByteString -> m String
    installHandler)

      where
        badEncoding :: String
    badEncoding = String
    "Encoding returned not in the list of known encodings"

        installHandler :: ByteString -> m String
    installHandler ByteString
    accept = do
          let eEncoding :: Either String [String]
    eEncoding = [String] -> String -> Either String [String]
    bestEncoding (((String, String -> Bool -> m ()) -> String)
    -> [(String, String -> Bool -> m ())] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String -> Bool -> m ()) -> String
    forall a b. (a, b) -> a
    fst [(String, String -> Bool -> m ())]
    encodingHandlers) (String -> Either String [String])
    -> String -> Either String [String]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> String
    BS.unpack ByteString
    accept
          (coding, identityAllowed, action) <- case Either String [String]
    eEncoding of
              Left String
    _ -> do
                Int -> m ()
    forall (m :: * -> *). FilterMonad Response m => Int -> m ()
    setResponseCode Int
    406
                Response -> m (String, Bool, String -> Bool -> m ())
    forall b. Response -> m b
    forall a (m :: * -> *) b. WebMonad a m => a -> m b
    finishWith (Response -> m (String, Bool, String -> Bool -> m ()))
    -> Response -> m (String, Bool, String -> Bool -> m ())
    forall a b. (a -> b) -> a -> b
    $ String -> Response
    forall a. ToMessage a => a -> Response
    toResponse String
    ""

              Right encs :: [String]
    encs@(String
    a:[String]
    _) -> (String, Bool, String -> Bool -> m ())
    -> m (String, Bool, String -> Bool -> m ())
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    a
                                         , String
    "identity" String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    encs
                                         , (String -> Bool -> m ())
    -> Maybe (String -> Bool -> m ()) -> String -> Bool -> m ()
    forall a. a -> Maybe a -> a
    fromMaybe (\ String
    _ Bool
    _ -> String -> m ()
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    badEncoding)
                                              (String
    -> [(String, String -> Bool -> m ())]
    -> Maybe (String -> Bool -> m ())
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    a [(String, String -> Bool -> m ())]
    encodingHandlers)
                                         )
              Right [] -> String -> m (String, Bool, String -> Bool -> m ())
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    badEncoding
          action coding identityAllowed
          return coding

    -- | Ignore the @Accept-Encoding@ header in the 'Request' and attempt to compress the body of the response with @gzip@.
    --
    -- calls 'compressWithFilter' using 'GZ.compress'.
    --
    -- see also: 'compressedResponseFilter'
    gzipFilter::(FilterMonad Response m) =>
                String -- ^ encoding to use for Content-Encoding header
              -> Bool   -- ^ fallback to identity for SendFile
              -> m ()
    gzipFilter :: forall (m :: * -> *).
    FilterMonad Response m =>
    String -> Bool -> m ()
    gzipFilter = (ByteString -> ByteString) -> String -> Bool -> m ()
    forall (m :: * -> *).
    FilterMonad Response m =>
    (ByteString -> ByteString) -> String -> Bool -> m ()
    compressWithFilter ByteString -> ByteString
    GZ.compress

    -- | Ignore the @Accept-Encoding@ header in the 'Request' and attempt compress the body of the response with zlib's
    -- @deflate@ method
    --
    -- calls 'compressWithFilter' using 'Z.compress'.
    --
    -- see also: 'compressedResponseFilter'
    deflateFilter::(FilterMonad Response m) =>
                   String -- ^ encoding to use for Content-Encoding header
                 -> Bool   -- ^ fallback to identity for SendFile
                 -> m ()
    deflateFilter :: forall (m :: * -> *).
    FilterMonad Response m =>
    String -> Bool -> m ()
    deflateFilter = (ByteString -> ByteString) -> String -> Bool -> m ()
    forall (m :: * -> *).
    FilterMonad Response m =>
    (ByteString -> ByteString) -> String -> Bool -> m ()
    compressWithFilter ByteString -> ByteString
    Z.compress

    -- | compression filter for the identity encoding (aka, do nothing)
    --
    -- see also: 'compressedResponseFilter'
    identityFilter :: (FilterMonad Response m) =>
                      String  -- ^ encoding to use for Content-Encoding header
                   -> Bool    -- ^ fallback to identity for SendFile (irrelavant for this filter)
                   -> m ()
    identityFilter :: forall (m :: * -> *).
    FilterMonad Response m =>
    String -> Bool -> m ()
    identityFilter = (ByteString -> ByteString) -> String -> Bool -> m ()
    forall (m :: * -> *).
    FilterMonad Response m =>
    (ByteString -> ByteString) -> String -> Bool -> m ()
    compressWithFilter ByteString -> ByteString
    forall a. a -> a
    id

    -- | compression filter for the * encoding
    --
    -- This filter always fails.
    starFilter :: (FilterMonad Response m, MonadFail m) =>
                  String  -- ^ encoding to use for Content-Encoding header
               -> Bool    -- ^ fallback to identity for SendFile (irrelavant for this filter)
               -> m ()
    starFilter :: forall (m :: * -> *).
    (FilterMonad Response m, MonadFail m) =>
    String -> Bool -> m ()
    starFilter String
    _ Bool
    _ = String -> m ()
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "chose * as content encoding"

    -- | Ignore the @Accept-Encoding@ header in the 'Request' and attempt to compress the body of the response using the supplied compressor.
    --
    -- We can not compress files being transfered using 'SendFile'. If
    -- @identity@ is an allowed encoding, then just return the 'Response'
    -- unmodified. Otherwise we return @406 Not Acceptable@.
    --
    -- see also: 'gzipFilter', 'deflateFilter', 'identityFilter', 'starFilter', 'compressedResponseFilter''
    compressWithFilter :: (FilterMonad Response m) =>
                          (L.ByteString -> L.ByteString) -- ^ function to compress the body
                       -> String -- ^ encoding to use for Content-Encoding header
                       -> Bool   -- ^ fallback to identity for SendFile
                       -> m ()
    compressWithFilter :: forall (m :: * -> *).
    FilterMonad Response m =>
    (ByteString -> ByteString) -> String -> Bool -> m ()
    compressWithFilter ByteString -> ByteString
    compressor String
    encoding Bool
    identityAllowed =
        (Response -> Response) -> m ()
    forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
    composeFilter ((Response -> Response) -> m ()) -> (Response -> Response) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Response
    r ->
            case Response
    r of
              Response{} -> String -> String -> Response -> Response
    forall r. HasHeaders r => String -> String -> r -> r
    setHeader String
    "Content-Encoding" String
    encoding          (Response -> Response) -> Response -> Response
    forall a b. (a -> b) -> a -> b
    $
                            String -> String -> Response -> Response
    forall r. HasHeaders r => String -> String -> r -> r
    setHeader String
    "Vary"             String
    "Accept-Encoding" (Response -> Response) -> Response -> Response
    forall a b. (a -> b) -> a -> b
    $
                             Response
    r {rsBody = compressor $ rsBody r}
              Response
    _ | Bool
    identityAllowed -> Response
    r
                | Bool
    otherwise       -> (String -> Response
    forall a. ToMessage a => a -> Response
    toResponse String
    "") { rsCode = 406 }

    -- | based on the rules describe in rfc2616 sec. 14.3
    bestEncoding :: [String] -> String -> Either String [String]
    bestEncoding :: [String] -> String -> Either String [String]
    bestEncoding [String]
    availableEncodings String
    encs = do
            encList<-(ParseError -> Either String [(String, Maybe Double)])
    -> ([(String, Maybe Double)]
        -> Either String [(String, Maybe Double)])
    -> Either ParseError [(String, Maybe Double)]
    -> Either String [(String, Maybe Double)]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (String -> Either String [(String, Maybe Double)]
    forall a b. a -> Either a b
    Left (String -> Either String [(String, Maybe Double)])
    -> (ParseError -> String)
    -> ParseError
    -> Either String [(String, Maybe Double)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseError -> String
    forall a. Show a => a -> String
    show) ([(String, Maybe Double)] -> Either String [(String, Maybe Double)]
    forall a b. b -> Either a b
    Right) (Either ParseError [(String, Maybe Double)]
     -> Either String [(String, Maybe Double)])
    -> Either ParseError [(String, Maybe Double)]
    -> Either String [(String, Maybe Double)]
    forall a b. (a -> b) -> a -> b
    $ Parsec String () [(String, Maybe Double)]
    -> String -> String -> Either ParseError [(String, Maybe Double)]
    forall s t a.
    Stream s Identity t =>
    Parsec s () a -> String -> s -> Either ParseError a
    parse Parsec String () [(String, Maybe Double)]
    forall st. GenParser Char st [(String, Maybe Double)]
    encodings String
    "" String
    encs
            case acceptable encList of
                [] -> String -> Either String [String]
    forall a b. a -> Either a b
    Left String
    "no encoding found"
                [String]
    a -> [String] -> Either String [String]
    forall a b. b -> Either a b
    Right ([String] -> Either String [String])
    -> [String] -> Either String [String]
    forall a b. (a -> b) -> a -> b
    $ [String]
    a
        where
            -- first intersect with the list of encodings we know how to deal with at all
            knownEncodings:: [(String,Maybe Double)] -> [(String, Maybe Double)]
            knownEncodings :: [(String, Maybe Double)] -> [(String, Maybe Double)]
    knownEncodings [(String, Maybe Double)]
    m = ((String, Maybe Double) -> (String, Maybe Double) -> Bool)
    -> [(String, Maybe Double)]
    -> [(String, Maybe Double)]
    -> [(String, Maybe Double)]
    forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
    intersectBy (\(String, Maybe Double)
    x (String, Maybe Double)
    y->(String, Maybe Double) -> String
    forall a b. (a, b) -> a
    fst (String, Maybe Double)
    x String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == (String, Maybe Double) -> String
    forall a b. (a, b) -> a
    fst (String, Maybe Double)
    y) [(String, Maybe Double)]
    m ((String -> (String, Maybe Double))
    -> [String] -> [(String, Maybe Double)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    x -> (String
    x,Maybe Double
    forall a. Maybe a
    Nothing)) [String]
    availableEncodings)
            -- this expands the wildcard, by figuring out if we need to include "identity" in the list
            -- Then it deletes the wildcard entry, drops all the "q=0" entries (which aren't allowed).
            --
            -- note this implementation is a little conservative.  if someone were to specify "*"
            -- without a "q" value, it would be this server is willing to accept any format at all.
            -- We pretty much assume we can't send them /any/ format and that they really
            -- meant just "identity" this seems safe to me.
            knownEncodings':: [(String,Maybe Double)] -> [(String, Maybe Double)]
            knownEncodings' :: [(String, Maybe Double)] -> [(String, Maybe Double)]
    knownEncodings' [(String, Maybe Double)]
    m = ((String, Maybe Double) -> Bool)
    -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String, Maybe Double) -> Bool
    forall {a} {a}. (Eq a, Num a) => (a, Maybe a) -> Bool
    dropZero ([(String, Maybe Double)] -> [(String, Maybe Double)])
    -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    forall a b. (a -> b) -> a -> b
    $ ((String, Maybe Double) -> (String, Maybe Double) -> Bool)
    -> (String, Maybe Double)
    -> [(String, Maybe Double)]
    -> [(String, Maybe Double)]
    forall a. (a -> a -> Bool) -> a -> [a] -> [a]
    deleteBy (\(String
    a,Maybe Double
    _) (String
    b,Maybe Double
    _)->String
    aString -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==String
    b) (String
    "*",Maybe Double
    forall a. Maybe a
    Nothing) ([(String, Maybe Double)] -> [(String, Maybe Double)])
    -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    forall a b. (a -> b) -> a -> b
    $
                case String -> [(String, Maybe Double)] -> Maybe (Maybe Double)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "*" ([(String, Maybe Double)] -> [(String, Maybe Double)]
    knownEncodings [(String, Maybe Double)]
    m) of
                    Maybe (Maybe Double)
    Nothing -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    addIdent ([(String, Maybe Double)] -> [(String, Maybe Double)])
    -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    forall a b. (a -> b) -> a -> b
    $ [(String, Maybe Double)] -> [(String, Maybe Double)]
    knownEncodings [(String, Maybe Double)]
    m
                    Just (Just Double
    a) | Double
    aDouble -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    >Double
    0 -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    addIdent ([(String, Maybe Double)] -> [(String, Maybe Double)])
    -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    forall a b. (a -> b) -> a -> b
    $ [(String, Maybe Double)] -> [(String, Maybe Double)]
    knownEncodings [(String, Maybe Double)]
    m
                                  | Bool
    otherwise -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    knownEncodings [(String, Maybe Double)]
    m
                    Just (Maybe Double
    Nothing) -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    addIdent ([(String, Maybe Double)] -> [(String, Maybe Double)])
    -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    forall a b. (a -> b) -> a -> b
    $ [(String, Maybe Double)] -> [(String, Maybe Double)]
    knownEncodings [(String, Maybe Double)]
    m
            dropZero :: (a, Maybe a) -> Bool
    dropZero (a
    _, Just a
    a) | a
    aa -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==a
    0      = Bool
    False
                                 | Bool
    otherwise = Bool
    True
            dropZero (a
    _, Maybe a
    Nothing) = Bool
    True
            addIdent:: [(String,Maybe Double)] -> [(String, Maybe Double)]
            addIdent :: [(String, Maybe Double)] -> [(String, Maybe Double)]
    addIdent [(String, Maybe Double)]
    m = if Maybe (Maybe Double) -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe (Maybe Double) -> Bool) -> Maybe (Maybe Double) -> Bool
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, Maybe Double)] -> Maybe (Maybe Double)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "identity" [(String, Maybe Double)]
    m
                then [(String, Maybe Double)]
    m [(String, Maybe Double)]
    -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    forall a. [a] -> [a] -> [a]
    ++ [(String
    "identity",Maybe Double
    forall a. Maybe a
    Nothing)]
                else [(String, Maybe Double)]
    m
            -- finally we sort the list of available encodings.
            acceptable:: [(String,Maybe Double)] -> [String]
            acceptable :: [(String, Maybe Double)] -> [String]
    acceptable [(String, Maybe Double)]
    l = ((String, Maybe Double) -> String)
    -> [(String, Maybe Double)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Maybe Double) -> String
    forall a b. (a, b) -> a
    fst ([(String, Maybe Double)] -> [String])
    -> [(String, Maybe Double)] -> [String]
    forall a b. (a -> b) -> a -> b
    $ ((String, Maybe Double) -> (String, Maybe Double) -> Ordering)
    -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (((String, Maybe Double) -> (String, Maybe Double) -> Ordering)
    -> (String, Maybe Double) -> (String, Maybe Double) -> Ordering
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (String, Maybe Double) -> (String, Maybe Double) -> Ordering
    cmp) ([(String, Maybe Double)] -> [(String, Maybe Double)])
    -> [(String, Maybe Double)] -> [(String, Maybe Double)]
    forall a b. (a -> b) -> a -> b
    $  [(String, Maybe Double)] -> [(String, Maybe Double)]
    knownEncodings'  [(String, Maybe Double)]
    l
            -- let the client choose but break ties with gzip
            encOrder :: [(String, b)]
    encOrder = [(String, b)] -> [(String, b)]
    forall a. [a] -> [a]
    reverse ([(String, b)] -> [(String, b)]) -> [(String, b)] -> [(String, b)]
    forall a b. (a -> b) -> a -> b
    $ [String] -> [b] -> [(String, b)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip ([String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    availableEncodings) [b
    1..]
            m0 :: Maybe Double -> Double
    m0 = Double -> (Double -> Double) -> Maybe Double -> Double
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Double
    0.0::Double) Double -> Double
    forall a. a -> a
    id
            cmp :: (String, Maybe Double) -> (String, Maybe Double) -> Ordering
    cmp (String
    s,Maybe Double
    mI) (String
    t,Maybe Double
    mJ) | Maybe Double -> Double
    m0 Maybe Double
    mI Double -> Double -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Double -> Double
    m0 Maybe Double
    mJ
                = Double -> Double -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Maybe Double -> Double
    m0 (Maybe Double -> Double) -> Maybe Double -> Double
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, Double)] -> Maybe Double
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    s [(String, Double)]
    forall {b}. (Num b, Enum b) => [(String, b)]
    encOrder) (Maybe Double -> Double
    m0 (Maybe Double -> Double) -> Maybe Double -> Double
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, Double)] -> Maybe Double
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    t [(String, Double)]
    forall {b}. (Num b, Enum b) => [(String, b)]
    encOrder)
                              | Bool
    otherwise = Double -> Double -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Maybe Double -> Double
    m0 Maybe Double
    mI) (Maybe Double -> Double
    m0 Maybe Double
    mJ)

    -- | an assoc list of encodings and their corresponding compression
    -- functions.
    --
    -- e.g.
    --
    -- > [("gzip", gzipFilter), ("identity", identityFilter), ("*",starFilter)]
    standardEncodingHandlers :: (FilterMonad Response m, MonadFail m) =>
                                [(String, String -> Bool -> m ())]
    standardEncodingHandlers :: forall (m :: * -> *).
    (FilterMonad Response m, MonadFail m) =>
    [(String, String -> Bool -> m ())]
    standardEncodingHandlers = [String]
    -> [String -> Bool -> m ()] -> [(String, String -> Bool -> m ())]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [String]
    standardEncodings [String -> Bool -> m ()]
    forall (m :: * -> *).
    (FilterMonad Response m, MonadFail m) =>
    [String -> Bool -> m ()]
    handlers

    standardEncodings :: [String]
    standardEncodings :: [String]
    standardEncodings =
        [String
    "gzip"
        ,String
    "x-gzip"
    --    ,"compress" -- as far as I can tell there is no haskell library that supports this
    --    ,"x-compress" -- as far as I can tell, there is no haskell library that supports this
        ,String
    "deflate"
        ,String
    "identity"
        ,String
    "*"
        ]

    handlers::(FilterMonad Response m, MonadFail m) => [String -> Bool -> m ()]
    handlers :: forall (m :: * -> *).
    (FilterMonad Response m, MonadFail m) =>
    [String -> Bool -> m ()]
    handlers =
        [ String -> Bool -> m ()
    forall (m :: * -> *).
    FilterMonad Response m =>
    String -> Bool -> m ()
    gzipFilter
        , String -> Bool -> m ()
    forall (m :: * -> *).
    FilterMonad Response m =>
    String -> Bool -> m ()
    gzipFilter
    --    ,compressFilter
    --    ,compressFilter
        , String -> Bool -> m ()
    forall (m :: * -> *).
    FilterMonad Response m =>
    String -> Bool -> m ()
    deflateFilter
        , String -> Bool -> m ()
    forall (m :: * -> *).
    FilterMonad Response m =>
    String -> Bool -> m ()
    identityFilter
        , String -> Bool -> m ()
    forall (m :: * -> *).
    (FilterMonad Response m, MonadFail m) =>
    String -> Bool -> m ()
    starFilter
        ]

    -- | a parser for the Accept-Encoding header
    encodings :: GenParser Char st [(String, Maybe Double)]
    encodings :: forall st. GenParser Char st [(String, Maybe Double)]
    encodings = GenParser Char st ()
    forall st. GenParser Char st ()
    ws GenParser Char st ()
    -> ParsecT String st Identity [(String, Maybe Double)]
    -> ParsecT String st Identity [(String, Maybe Double)]
    forall a b.
    ParsecT String st Identity a
    -> ParsecT String st Identity b -> ParsecT String st Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (GenParser Char st (String, Maybe Double)
    forall st. GenParser Char st (String, Maybe Double)
    encoding1 GenParser Char st (String, Maybe Double)
    -> GenParser Char st ()
    -> ParsecT String st Identity [(String, Maybe Double)]
    forall s (m :: * -> *) t u a sep.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
    `sepBy` GenParser Char st () -> GenParser Char st ()
    forall tok st a. GenParser tok st a -> GenParser tok st a
    try GenParser Char st ()
    forall st. GenParser Char st ()
    sep) ParsecT String st Identity [(String, Maybe Double)]
    -> ([(String, Maybe Double)]
        -> ParsecT String st Identity [(String, Maybe Double)])
    -> ParsecT String st Identity [(String, Maybe Double)]
    forall a b.
    ParsecT String st Identity a
    -> (a -> ParsecT String st Identity b)
    -> ParsecT String st Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (\[(String, Maybe Double)]
    x -> GenParser Char st ()
    forall st. GenParser Char st ()
    ws GenParser Char st ()
    -> GenParser Char st () -> GenParser Char st ()
    forall a b.
    ParsecT String st Identity a
    -> ParsecT String st Identity b -> ParsecT String st Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> GenParser Char st ()
    forall s (m :: * -> *) t u.
    (Stream s m t, Show t) =>
    ParsecT s u m ()
    eof GenParser Char st ()
    -> ParsecT String st Identity [(String, Maybe Double)]
    -> ParsecT String st Identity [(String, Maybe Double)]
    forall a b.
    ParsecT String st Identity a
    -> ParsecT String st Identity b -> ParsecT String st Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [(String, Maybe Double)]
    -> ParsecT String st Identity [(String, Maybe Double)]
    forall a. a -> ParsecT String st Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(String, Maybe Double)]
    x)
        where
            ws :: GenParser Char st ()
            ws :: forall st. GenParser Char st ()
    ws = ParsecT String st Identity Char
    -> ParsecT String st Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ParsecT String st Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    space ParsecT String st Identity String
    -> ParsecT String st Identity () -> ParsecT String st Identity ()
    forall a b.
    ParsecT String st Identity a
    -> ParsecT String st Identity b -> ParsecT String st Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> ParsecT String st Identity ()
    forall a. a -> ParsecT String st Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

            sep :: GenParser Char st ()
            sep :: forall st. GenParser Char st ()
    sep = do
                GenParser Char st ()
    forall st. GenParser Char st ()
    ws
                _ <- Char -> ParsecT String st Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ','
                ws

            encoding1 :: GenParser Char st ([Char], Maybe Double)
            encoding1 :: forall st. GenParser Char st (String, Maybe Double)
    encoding1 = do
                encoding <- ParsecT String st Identity Char
    -> ParsecT String st Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 (ParsecT String st Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    alphaNum ParsecT String st Identity Char
    -> ParsecT String st Identity Char
    -> ParsecT String st Identity Char
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> Char -> ParsecT String st Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '-') ParsecT String st Identity String
    -> ParsecT String st Identity String
    -> ParsecT String st Identity String
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> String -> ParsecT String st Identity String
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m String
    string String
    "*"
                ws
                quality<-optionMaybe qual
                return (encoding, fmap read quality)

            qual :: GenParser Char st String
            qual :: forall st. GenParser Char st String
    qual = do
                Char -> ParsecT String st Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    ';' ParsecT String st Identity Char
    -> ParsecT String st Identity () -> ParsecT String st Identity ()
    forall a b.
    ParsecT String st Identity a
    -> ParsecT String st Identity b -> ParsecT String st Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ParsecT String st Identity ()
    forall st. GenParser Char st ()
    ws ParsecT String st Identity ()
    -> ParsecT String st Identity Char
    -> ParsecT String st Identity Char
    forall a b.
    ParsecT String st Identity a
    -> ParsecT String st Identity b -> ParsecT String st Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Char -> ParsecT String st Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    'q' ParsecT String st Identity Char
    -> ParsecT String st Identity () -> ParsecT String st Identity ()
    forall a b.
    ParsecT String st Identity a
    -> ParsecT String st Identity b -> ParsecT String st Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ParsecT String st Identity ()
    forall st. GenParser Char st ()
    ws ParsecT String st Identity ()
    -> ParsecT String st Identity Char
    -> ParsecT String st Identity Char
    forall a b.
    ParsecT String st Identity a
    -> ParsecT String st Identity b -> ParsecT String st Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Char -> ParsecT String st Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '=' ParsecT String st Identity Char
    -> ParsecT String st Identity () -> ParsecT String st Identity ()
    forall a b.
    ParsecT String st Identity a
    -> ParsecT String st Identity b -> ParsecT String st Identity b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ParsecT String st Identity ()
    forall st. GenParser Char st ()
    ws
                q<-GenParser Char st String
    forall st. GenParser Char st String
    float
                return q

            int :: GenParser Char st String
            int :: forall st. GenParser Char st String
    int = ParsecT String st Identity Char
    -> ParsecT String st Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 ParsecT String st Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    digit

            float :: GenParser Char st String
            float :: forall st. GenParser Char st String
    float = do
                    wholePart<-ParsecT String st Identity Char
    -> ParsecT String st Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many1 ParsecT String st Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    digit
                    fractionalPart<-option "" fraction
                    return $ wholePart ++ fractionalPart
                ParsecT String st Identity String
    -> ParsecT String st Identity String
    -> ParsecT String st Identity String
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|>
                    do
                    fractionalPart<-ParsecT String st Identity String
    forall st. GenParser Char st String
    fraction
                    return fractionalPart
            fraction :: GenParser Char st String
            fraction :: forall st. GenParser Char st String
    fraction = do
                _ <- Char -> ParsecT String st Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    Char -> ParsecT s u m Char
    char Char
    '.'
                fractionalPart<-option "" int
                return $ '.':fractionalPart