    {-# LANGUAGE BangPatterns       #-}
    {-# LANGUAGE CPP                #-}
    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE MagicHash          #-}
    {-# LANGUAGE OverloadedStrings  #-}
    {-# LANGUAGE Rank2Types         #-}
    {-# LANGUAGE Trustworthy        #-}
    {-# LANGUAGE UnboxedTuples      #-}

    module Snap.Internal.Http.Server.Parser
      ( IRequest(..)
      , HttpParseException(..)
      , readChunkedTransferEncoding
      , writeChunkedTransferEncoding
      , parseRequest
      , parseFromStream
      , parseCookie
      , parseUrlEncoded
      , getStdContentLength
      , getStdHost
      , getStdTransferEncoding
      , getStdCookie
      , getStdContentType
      , getStdConnection
      ) where

    ------------------------------------------------------------------------------
    #if !MIN_VERSION_base(4,8,0)
    import           Control.Applicative              ((<$>))
    #endif
    import           Control.Exception                (Exception, throwIO)
    import           Control.Monad                    (void, when)
    import           Control.Monad.IO.Class           (MonadIO (liftIO))
    import           Data.Attoparsec.ByteString.Char8 (Parser, hexadecimal, takeTill)
    import qualified Data.ByteString.Char8            as S
    import           Data.ByteString.Internal         (ByteString (..), c2w, memchr, w2c)
    #if MIN_VERSION_bytestring(0, 10, 6)
    import           Data.ByteString.Internal         (accursedUnutterablePerformIO)
    #else
    import           Data.ByteString.Internal         (inlinePerformIO)
    #endif
    import qualified Data.ByteString.Unsafe           as S
    import           Data.List                        (sort)
    import           Data.Typeable                    (Typeable)
    import qualified Data.Vector                      as V
    import qualified Data.Vector.Mutable              as MV
    import           Foreign.ForeignPtr               (withForeignPtr)
    import           Foreign.Ptr                      (minusPtr, nullPtr, plusPtr)
    import           Prelude                          hiding (take)
    ------------------------------------------------------------------------------
    import           Blaze.ByteString.Builder.HTTP    (chunkedTransferEncoding, chunkedTransferTerminator)
    import           Data.ByteString.Builder          (Builder)
    import           System.IO.Streams                (InputStream, OutputStream, Generator)
    import qualified System.IO.Streams                as Streams
    import           System.IO.Streams.Attoparsec     (parseFromStream)
    ------------------------------------------------------------------------------
    import           Snap.Internal.Http.Types         (Method (..))
    import           Snap.Internal.Parsing            (crlf, parseCookie, parseUrlEncoded, unsafeFromNat)
    import           Snap.Types.Headers               (Headers)
    import qualified Snap.Types.Headers               as H

    ------------------------------------------------------------------------------
    newtype StandardHeaders = StandardHeaders (V.Vector (Maybe ByteString))
    type MStandardHeaders = MV.IOVector (Maybe ByteString)

    ------------------------------------------------------------------------------
    contentLengthTag, hostTag, transferEncodingTag, cookieTag, contentTypeTag,
      connectionTag, nStandardHeaders :: Int
    contentLengthTag :: Int
    contentLengthTag    = Int
    0
    hostTag :: Int
    hostTag             = Int
    1
    transferEncodingTag :: Int
    transferEncodingTag = Int
    2
    cookieTag :: Int
    cookieTag           = Int
    3
    contentTypeTag :: Int
    contentTypeTag      = Int
    4
    connectionTag :: Int
    connectionTag       = Int
    5
    nStandardHeaders :: Int
    nStandardHeaders    = Int
    6

    ------------------------------------------------------------------------------
    findStdHeaderIndex :: ByteString -> Int
    findStdHeaderIndex :: ByteString -> Int
    findStdHeaderIndex ByteString
    "content-length"    = Int
    contentLengthTag
    findStdHeaderIndex ByteString
    "host"              = Int
    hostTag
    findStdHeaderIndex ByteString
    "transfer-encoding" = Int
    transferEncodingTag
    findStdHeaderIndex ByteString
    "cookie"            = Int
    cookieTag
    findStdHeaderIndex ByteString
    "content-type"      = Int
    contentTypeTag
    findStdHeaderIndex ByteString
    "connection"        = Int
    connectionTag
    findStdHeaderIndex ByteString
    _                   = -Int
    1

    ------------------------------------------------------------------------------
    getStdContentLength, getStdHost, getStdTransferEncoding, getStdCookie,
        getStdConnection, getStdContentType :: StandardHeaders -> Maybe ByteString
    getStdContentLength :: StandardHeaders -> Maybe ByteString
    getStdContentLength    (StandardHeaders Vector (Maybe ByteString)
    v) = Vector (Maybe ByteString) -> Int -> Maybe ByteString
    forall a. Vector a -> Int -> a
    V.unsafeIndex Vector (Maybe ByteString)
    v Int
    contentLengthTag
    getStdHost :: StandardHeaders -> Maybe ByteString
    getStdHost             (StandardHeaders Vector (Maybe ByteString)
    v) = Vector (Maybe ByteString) -> Int -> Maybe ByteString
    forall a. Vector a -> Int -> a
    V.unsafeIndex Vector (Maybe ByteString)
    v Int
    hostTag
    getStdTransferEncoding :: StandardHeaders -> Maybe ByteString
    getStdTransferEncoding (StandardHeaders Vector (Maybe ByteString)
    v) = Vector (Maybe ByteString) -> Int -> Maybe ByteString
    forall a. Vector a -> Int -> a
    V.unsafeIndex Vector (Maybe ByteString)
    v Int
    transferEncodingTag
    getStdCookie :: StandardHeaders -> Maybe ByteString
    getStdCookie           (StandardHeaders Vector (Maybe ByteString)
    v) = Vector (Maybe ByteString) -> Int -> Maybe ByteString
    forall a. Vector a -> Int -> a
    V.unsafeIndex Vector (Maybe ByteString)
    v Int
    cookieTag
    getStdContentType :: StandardHeaders -> Maybe ByteString
    getStdContentType      (StandardHeaders Vector (Maybe ByteString)
    v) = Vector (Maybe ByteString) -> Int -> Maybe ByteString
    forall a. Vector a -> Int -> a
    V.unsafeIndex Vector (Maybe ByteString)
    v Int
    contentTypeTag
    getStdConnection :: StandardHeaders -> Maybe ByteString
    getStdConnection       (StandardHeaders Vector (Maybe ByteString)
    v) = Vector (Maybe ByteString) -> Int -> Maybe ByteString
    forall a. Vector a -> Int -> a
    V.unsafeIndex Vector (Maybe ByteString)
    v Int
    connectionTag

    ------------------------------------------------------------------------------
    newMStandardHeaders :: IO MStandardHeaders
    newMStandardHeaders :: IO MStandardHeaders
    newMStandardHeaders = Int
    -> Maybe ByteString
    -> IO (MVector (PrimState IO) (Maybe ByteString))
    forall (m :: * -> *) a.
    PrimMonad m =>
    Int -> a -> m (MVector (PrimState m) a)
    MV.replicate Int
    nStandardHeaders Maybe ByteString
    forall a. Maybe a
    Nothing

    ------------------------------------------------------------------------------
    -- | an internal version of the headers part of an HTTP request
    data IRequest = IRequest
        { IRequest -> Method
    iMethod         :: !Method
        , IRequest -> ByteString
    iRequestUri     :: !ByteString
        , IRequest -> (Int, Int)
    iHttpVersion    :: (Int, Int)
        , IRequest -> Headers
    iRequestHeaders :: Headers
        , IRequest -> StandardHeaders
    iStdHeaders     :: StandardHeaders
        }

    ------------------------------------------------------------------------------
    instance Eq IRequest where
        IRequest
    a == :: IRequest -> IRequest -> Bool
    == IRequest
    b =
            [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [ IRequest -> Method
    iMethod IRequest
    a      Method -> Method -> Bool
    forall a. Eq a => a -> a -> Bool
    == IRequest -> Method
    iMethod IRequest
    b
                , IRequest -> ByteString
    iRequestUri IRequest
    a  ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == IRequest -> ByteString
    iRequestUri IRequest
    b
                , IRequest -> (Int, Int)
    iHttpVersion IRequest
    a (Int, Int) -> (Int, Int) -> Bool
    forall a. Eq a => a -> a -> Bool
    == IRequest -> (Int, Int)
    iHttpVersion IRequest
    b
                , [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
    forall a. Ord a => [a] -> [a]
    sort (Headers -> [(CI ByteString, ByteString)]
    H.toList (IRequest -> Headers
    iRequestHeaders IRequest
    a))
                      [(CI ByteString, ByteString)]
    -> [(CI ByteString, ByteString)] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
    forall a. Ord a => [a] -> [a]
    sort (Headers -> [(CI ByteString, ByteString)]
    H.toList (IRequest -> Headers
    iRequestHeaders IRequest
    b))
                ]

    ------------------------------------------------------------------------------
    instance Show IRequest where
        show :: IRequest -> String
    show (IRequest Method
    m ByteString
    u (Int
    major, Int
    minor) Headers
    hdrs StandardHeaders
    _) =
            [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ Method -> String
    forall a. Show a => a -> String
    show Method
    m
                   , String
    " "
                   , ByteString -> String
    forall a. Show a => a -> String
    show ByteString
    u
                   , String
    " "
                   , Int -> String
    forall a. Show a => a -> String
    show Int
    major
                   , String
    "."
                   , Int -> String
    forall a. Show a => a -> String
    show Int
    minor
                   , String
    " "
                   , Headers -> String
    forall a. Show a => a -> String
    show Headers
    hdrs
                   ]

    ------------------------------------------------------------------------------
    data HttpParseException = HttpParseException String deriving (Typeable, Int -> HttpParseException -> ShowS
    [HttpParseException] -> ShowS
    HttpParseException -> String
    (Int -> HttpParseException -> ShowS)
    -> (HttpParseException -> String)
    -> ([HttpParseException] -> ShowS)
    -> Show HttpParseException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HttpParseException -> ShowS
    showsPrec :: Int -> HttpParseException -> ShowS
    $cshow :: HttpParseException -> String
    show :: HttpParseException -> String
    $cshowList :: [HttpParseException] -> ShowS
    showList :: [HttpParseException] -> ShowS
    Show)
    instance Exception HttpParseException

    ------------------------------------------------------------------------------
    {-# INLINE parseRequest #-}
    parseRequest :: InputStream ByteString -> IO IRequest
    parseRequest :: InputStream ByteString -> IO IRequest
    parseRequest InputStream ByteString
    input = do
        line <- InputStream ByteString -> IO ByteString
    pLine InputStream ByteString
    input
        let (!mStr, !s)     = bSp line
        let (!uri, !vStr)   = bSp s
        let method          = ByteString -> Method
    methodFromString ByteString
    mStr
        let !version        = ByteString -> (Int, Int)
    forall {a} {b}.
    (Enum a, Enum b, Num a, Num b, Bits a, Bits b) =>
    ByteString -> (a, b)
    pVer ByteString
    vStr
        let (host, uri')    = getHost uri
        let uri''           = if ByteString -> Bool
    S.null ByteString
    uri' then ByteString
    "/" else ByteString
    uri'

        stdHdrs <- newMStandardHeaders
        MV.unsafeWrite stdHdrs hostTag host
        hdrs    <- pHeaders stdHdrs input
        outStd  <- StandardHeaders <$> V.unsafeFreeze stdHdrs
        return $! IRequest method uri'' version hdrs outStd

      where
        getHost :: ByteString -> (Maybe ByteString, ByteString)
    getHost ByteString
    s | ByteString
    "http://" ByteString -> ByteString -> Bool
    `S.isPrefixOf` ByteString
    s
                      = let s' :: ByteString
    s'            = Int -> ByteString -> ByteString
    S.unsafeDrop Int
    7 ByteString
    s
                            (!ByteString
    host, !ByteString
    uri) = Char -> ByteString -> (ByteString, ByteString)
    breakCh Char
    '/' ByteString
    s'
                        in (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $! ByteString
    host, ByteString
    uri)
                  | ByteString
    "https://" ByteString -> ByteString -> Bool
    `S.isPrefixOf` ByteString
    s
                      = let s' :: ByteString
    s'            = Int -> ByteString -> ByteString
    S.unsafeDrop Int
    8 ByteString
    s
                            (!ByteString
    host, !ByteString
    uri) = Char -> ByteString -> (ByteString, ByteString)
    breakCh Char
    '/' ByteString
    s'
                        in (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $! ByteString
    host, ByteString
    uri)
                  | Bool
    otherwise = (Maybe ByteString
    forall a. Maybe a
    Nothing, ByteString
    s)

        pVer :: ByteString -> (a, b)
    pVer ByteString
    s = if ByteString
    "HTTP/" ByteString -> ByteString -> Bool
    `S.isPrefixOf` ByteString
    s
                   then ByteString -> (a, b)
    forall {a} {b}.
    (Enum a, Enum b, Num a, Num b, Bits a, Bits b) =>
    ByteString -> (a, b)
    pVers (Int -> ByteString -> ByteString
    S.unsafeDrop Int
    5 ByteString
    s)
                   else (a
    1, b
    0)

        bSp :: ByteString -> (ByteString, ByteString)
    bSp   = Char -> ByteString -> (ByteString, ByteString)
    splitCh Char
    ' '

        pVers :: ByteString -> (a, b)
    pVers ByteString
    s = (a
    c, b
    d)
          where
            (!ByteString
    a, !ByteString
    b)   = Char -> ByteString -> (ByteString, ByteString)
    splitCh Char
    '.' ByteString
    s
            !c :: a
    c         = ByteString -> a
    forall a. (Enum a, Num a, Bits a) => ByteString -> a
    unsafeFromNat ByteString
    a
            !d :: b
    d         = ByteString -> b
    forall a. (Enum a, Num a, Bits a) => ByteString -> a
    unsafeFromNat ByteString
    b

    ------------------------------------------------------------------------------
    pLine :: InputStream ByteString -> IO ByteString
    pLine :: InputStream ByteString -> IO ByteString
    pLine InputStream ByteString
    input = [ByteString] -> IO ByteString
    go []
      where
        throwNoCRLF :: IO a
    throwNoCRLF =
            HttpParseException -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (HttpParseException -> IO a) -> HttpParseException -> IO a
    forall a b. (a -> b) -> a -> b
    $
            String -> HttpParseException
    HttpParseException String
    "parse error: expected line ending in crlf"

        throwBadCRLF :: IO a
    throwBadCRLF =
            HttpParseException -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (HttpParseException -> IO a) -> HttpParseException -> IO a
    forall a b. (a -> b) -> a -> b
    $
            String -> HttpParseException
    HttpParseException String
    "parse error: got cr without subsequent lf"

        go :: [ByteString] -> IO ByteString
    go ![ByteString]
    l = do
            !mb <- InputStream ByteString -> IO (Maybe ByteString)
    forall a. InputStream a -> IO (Maybe a)
    Streams.read InputStream ByteString
    input
            !s  <- maybe throwNoCRLF return mb

            let !i = Char -> ByteString -> Int
    elemIndex Char
    '\r' ByteString
    s
            if i < 0
              then noCRLF l s
              else case () of
                     !()
    _ | Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= ByteString -> Int
    S.length ByteString
    s           -> [ByteString] -> ByteString -> Int -> IO ByteString
    lastIsCR [ByteString]
    l ByteString
    s Int
    i
                        | ByteString -> Int -> Word8
    S.unsafeIndex ByteString
    s (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    10 -> [ByteString] -> ByteString -> Int -> IO ByteString
    foundCRLF [ByteString]
    l ByteString
    s Int
    i
                        | Bool
    otherwise                   -> IO ByteString
    forall {a}. IO a
    throwBadCRLF

        foundCRLF :: [ByteString] -> ByteString -> Int -> IO ByteString
    foundCRLF [ByteString]
    l ByteString
    s !Int
    i1 = do
            let !i2 :: Int
    i2 = Int
    i1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2
            let !a :: ByteString
    a = Int -> ByteString -> ByteString
    S.unsafeTake Int
    i1 ByteString
    s
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    i2 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < ByteString -> Int
    S.length ByteString
    s) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                let !b :: ByteString
    b = Int -> ByteString -> ByteString
    S.unsafeDrop Int
    i2 ByteString
    s
                ByteString -> InputStream ByteString -> IO ()
    forall a. a -> InputStream a -> IO ()
    Streams.unRead ByteString
    b InputStream ByteString
    input

            -- Optimize for the common case: dl is almost always "id"
            let !out :: ByteString
    out = if [ByteString] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ByteString]
    l then ByteString
    a else [ByteString] -> ByteString
    S.concat ([ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse (ByteString
    aByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    l))
            ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    out

        noCRLF :: [ByteString] -> ByteString -> IO ByteString
    noCRLF [ByteString]
    l ByteString
    s = [ByteString] -> IO ByteString
    go (ByteString
    sByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    l)

        lastIsCR :: [ByteString] -> ByteString -> Int -> IO ByteString
    lastIsCR [ByteString]
    l ByteString
    s !Int
    idx = do
            !t <- InputStream ByteString -> IO (Maybe ByteString)
    forall a. InputStream a -> IO (Maybe a)
    Streams.read InputStream ByteString
    input IO (Maybe ByteString)
    -> (Maybe ByteString -> IO ByteString) -> IO ByteString
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO ByteString
    -> (ByteString -> IO ByteString)
    -> Maybe ByteString
    -> IO ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IO ByteString
    forall {a}. IO a
    throwNoCRLF ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
            if S.null t
              then lastIsCR l s idx
              else do
                let !c = ByteString -> Word8
    S.unsafeHead ByteString
    t
                if c /= 10
                  then throwBadCRLF
                  else do
                      let !a = Int -> ByteString -> ByteString
    S.unsafeTake Int
    idx ByteString
    s
                      let !b = Int -> ByteString -> ByteString
    S.unsafeDrop Int
    1 ByteString
    t
                      when (not $ S.null b) $ Streams.unRead b input
                      let !out = if [ByteString] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ByteString]
    l then ByteString
    a else [ByteString] -> ByteString
    S.concat ([ByteString] -> [ByteString]
    forall a. [a] -> [a]
    reverse (ByteString
    aByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    l))
                      return out

    ------------------------------------------------------------------------------
    splitCh :: Char -> ByteString -> (ByteString, ByteString)
    splitCh :: Char -> ByteString -> (ByteString, ByteString)
    splitCh !Char
    c !ByteString
    s = if Int
    idx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0
                      then (ByteString
    s, ByteString
    S.empty)
                      else let !a :: ByteString
    a = Int -> ByteString -> ByteString
    S.unsafeTake Int
    idx ByteString
    s
                               !b :: ByteString
    b = Int -> ByteString -> ByteString
    S.unsafeDrop (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) ByteString
    s
                           in (ByteString
    a, ByteString
    b)
      where
        !idx :: Int
    idx = Char -> ByteString -> Int
    elemIndex Char
    c ByteString
    s
    {-# INLINE splitCh #-}

    ------------------------------------------------------------------------------
    breakCh :: Char -> ByteString -> (ByteString, ByteString)
    breakCh :: Char -> ByteString -> (ByteString, ByteString)
    breakCh !Char
    c !ByteString
    s = if Int
    idx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0
                      then (ByteString
    s, ByteString
    S.empty)
                      else let !a :: ByteString
    a = Int -> ByteString -> ByteString
    S.unsafeTake Int
    idx ByteString
    s
                               !b :: ByteString
    b = Int -> ByteString -> ByteString
    S.unsafeDrop Int
    idx ByteString
    s
                           in (ByteString
    a, ByteString
    b)
      where
        !idx :: Int
    idx = Char -> ByteString -> Int
    elemIndex Char
    c ByteString
    s
    {-# INLINE breakCh #-}

    ------------------------------------------------------------------------------
    splitHeader :: ByteString -> (ByteString, ByteString)
    splitHeader :: ByteString -> (ByteString, ByteString)
    splitHeader !ByteString
    s = if Int
    idx Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0
                       then (ByteString
    s, ByteString
    S.empty)
                       else let !a :: ByteString
    a = Int -> ByteString -> ByteString
    S.unsafeTake Int
    idx ByteString
    s
                            in (ByteString
    a, Int -> ByteString
    skipSp (Int
    idx Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1))
      where
        !idx :: Int
    idx = Char -> ByteString -> Int
    elemIndex Char
    ':' ByteString
    s
        l :: Int
    l    = ByteString -> Int
    S.length ByteString
    s

        skipSp :: Int -> ByteString
    skipSp !Int
    i | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    l    = ByteString
    S.empty
                  | Bool
    otherwise = let c :: Word8
    c = ByteString -> Int -> Word8
    S.unsafeIndex ByteString
    s Int
    i
                                in if Char -> Bool
    isLWS (Char -> Bool) -> Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Char
    w2c Word8
    c
                                     then Int -> ByteString
    skipSp (Int -> ByteString) -> Int -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
                                     else Int -> ByteString -> ByteString
    S.unsafeDrop Int
    i ByteString
    s

    {-# INLINE splitHeader #-}

    ------------------------------------------------------------------------------
    isLWS :: Char -> Bool
    isLWS :: Char -> Bool
    isLWS Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\t'
    {-# INLINE isLWS #-}

    ------------------------------------------------------------------------------
    pHeaders :: MStandardHeaders -> InputStream ByteString -> IO Headers
    pHeaders :: MStandardHeaders -> InputStream ByteString -> IO Headers
    pHeaders MStandardHeaders
    stdHdrs InputStream ByteString
    input = do
        hdrs    <- [(ByteString, ByteString)] -> Headers
    H.unsafeFromCaseFoldedList ([(ByteString, ByteString)] -> Headers)
    -> IO [(ByteString, ByteString)] -> IO Headers
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(ByteString, ByteString)] -> IO [(ByteString, ByteString)]
    go []
        return hdrs

      where
        go :: [(ByteString, ByteString)] -> IO [(ByteString, ByteString)]
    go ![(ByteString, ByteString)]
    list = do
            line <- InputStream ByteString -> IO ByteString
    pLine InputStream ByteString
    input
            if S.null line
              then return list
              else do
                let (!k0,!v) = splitHeader line
                let !k = ByteString -> ByteString
    toLower ByteString
    k0
                vf <- pCont id
                let vs = [ByteString] -> [ByteString]
    vf []
                let !v' = [ByteString] -> ByteString
    S.concat (ByteString
    vByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    vs)
                let idx = ByteString -> Int
    findStdHeaderIndex ByteString
    k
                when (idx >= 0) $ MV.unsafeWrite stdHdrs idx $! Just v'

                let l' = ((ByteString
    k, ByteString
    v')(ByteString, ByteString)
    -> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
    forall a. a -> [a] -> [a]
    :[(ByteString, ByteString)]
    list)
                go l'

        trimBegin :: ByteString -> ByteString
    trimBegin = (Char -> Bool) -> ByteString -> ByteString
    S.dropWhile Char -> Bool
    isLWS

        pCont :: ([ByteString] -> c) -> IO ([ByteString] -> c)
    pCont ![ByteString] -> c
    dlist = do
            mbS  <- InputStream ByteString -> IO (Maybe ByteString)
    forall a. InputStream a -> IO (Maybe a)
    Streams.peek InputStream ByteString
    input
            maybe (return dlist)
                  (\ByteString
    s -> if Bool -> Bool
    not (ByteString -> Bool
    S.null ByteString
    s)
                           then if Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Char -> Bool
    isLWS (Char -> Bool) -> Char -> Bool
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Char
    w2c (Word8 -> Char) -> Word8 -> Char
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Word8
    S.unsafeHead ByteString
    s
                                  then ([ByteString] -> c) -> IO ([ByteString] -> c)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ByteString] -> c
    dlist
                                  else ([ByteString] -> c) -> IO ([ByteString] -> c)
    procCont [ByteString] -> c
    dlist
                           else InputStream ByteString -> IO (Maybe ByteString)
    forall a. InputStream a -> IO (Maybe a)
    Streams.read InputStream ByteString
    input IO (Maybe ByteString)
    -> IO ([ByteString] -> c) -> IO ([ByteString] -> c)
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ([ByteString] -> c) -> IO ([ByteString] -> c)
    pCont [ByteString] -> c
    dlist)
                  mbS

        procCont :: ([ByteString] -> c) -> IO ([ByteString] -> c)
    procCont ![ByteString] -> c
    dlist = do
            line <- InputStream ByteString -> IO ByteString
    pLine InputStream ByteString
    input
            let !t = ByteString -> ByteString
    trimBegin ByteString
    line
            pCont (dlist . (" ":) . (t:))

    ------------------------------------------------------------------------------
    methodFromString :: ByteString -> Method
    methodFromString :: ByteString -> Method
    methodFromString ByteString
    "GET"     = Method
    GET
    methodFromString ByteString
    "POST"    = Method
    POST
    methodFromString ByteString
    "HEAD"    = Method
    HEAD
    methodFromString ByteString
    "PUT"     = Method
    PUT
    methodFromString ByteString
    "DELETE"  = Method
    DELETE
    methodFromString ByteString
    "TRACE"   = Method
    TRACE
    methodFromString ByteString
    "OPTIONS" = Method
    OPTIONS
    methodFromString ByteString
    "CONNECT" = Method
    CONNECT
    methodFromString ByteString
    "PATCH"   = Method
    PATCH
    methodFromString ByteString
    s         = ByteString -> Method
    Method ByteString
    s

    ------------------------------------------------------------------------------
    readChunkedTransferEncoding :: InputStream ByteString
                                -> IO (InputStream ByteString)
    readChunkedTransferEncoding :: InputStream ByteString -> IO (InputStream ByteString)
    readChunkedTransferEncoding InputStream ByteString
    input =
        Generator ByteString () -> IO (InputStream ByteString)
    forall r a. Generator r a -> IO (InputStream r)
    Streams.fromGenerator (InputStream ByteString -> Generator ByteString ()
    consumeChunks InputStream ByteString
    input)

    ------------------------------------------------------------------------------
    writeChunkedTransferEncoding :: OutputStream Builder
                                 -> IO (OutputStream Builder)
    writeChunkedTransferEncoding :: OutputStream Builder -> IO (OutputStream Builder)
    writeChunkedTransferEncoding OutputStream Builder
    os = (Maybe Builder -> IO ()) -> IO (OutputStream Builder)
    forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
    Streams.makeOutputStream Maybe Builder -> IO ()
    f
      where
        f :: Maybe Builder -> IO ()
    f Maybe Builder
    Nothing = do
            Maybe Builder -> OutputStream Builder -> IO ()
    forall a. Maybe a -> OutputStream a -> IO ()
    Streams.write (Builder -> Maybe Builder
    forall a. a -> Maybe a
    Just Builder
    chunkedTransferTerminator) OutputStream Builder
    os
            Maybe Builder -> OutputStream Builder -> IO ()
    forall a. Maybe a -> OutputStream a -> IO ()
    Streams.write Maybe Builder
    forall a. Maybe a
    Nothing OutputStream Builder
    os
        f Maybe Builder
    x = Maybe Builder -> OutputStream Builder -> IO ()
    forall a. Maybe a -> OutputStream a -> IO ()
    Streams.write (Builder -> Builder
    chunkedTransferEncoding (Builder -> Builder) -> Maybe Builder -> Maybe Builder
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Maybe Builder
    x) OutputStream Builder
    os

                                 ---------------------
                                 -- parse functions --
                                 ---------------------

    ------------------------------------------------------------------------------
    {-
        For a response body in chunked transfer encoding, iterate over
        the individual chunks, reading the size parameter, then
        looping over that chunk in bites of at most bUFSIZ,
        yielding them to the receiveResponse InputStream accordingly.
    -}
    consumeChunks :: InputStream ByteString -> Generator ByteString ()
    consumeChunks :: InputStream ByteString -> Generator ByteString ()
    consumeChunks InputStream ByteString
    i1 = do
        !n <- Generator ByteString Int
    parseSize
        if n > 0
            then do
                -- read one or more bytes, then loop to next chunk
                go n
                skipCRLF
                consumeChunks i1
            else do
                -- NB: snap-server doesn't yet support chunked trailer parts
                -- (see RFC7230#sec4.1.2)

                -- consume final CRLF
                skipCRLF

      where
        go :: Int -> Generator ByteString ()
    go Int
    0 = () -> Generator ByteString ()
    forall a. a -> Generator ByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go !Int
    n = do
            (!x',!r) <- IO (ByteString, Int) -> Generator ByteString (ByteString, Int)
    forall a. IO a -> Generator ByteString a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ByteString, Int) -> Generator ByteString (ByteString, Int))
    -> IO (ByteString, Int) -> Generator ByteString (ByteString, Int)
    forall a b. (a -> b) -> a -> b
    $ Int -> InputStream ByteString -> IO (ByteString, Int)
    readN Int
    n InputStream ByteString
    i1
            Streams.yield x'
            go r

        parseSize :: Generator ByteString Int
    parseSize = do
            IO Int -> Generator ByteString Int
    forall a. IO a -> Generator ByteString a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Int -> Generator ByteString Int)
    -> IO Int -> Generator ByteString Int
    forall a b. (a -> b) -> a -> b
    $ Parser Int -> InputStream ByteString -> IO Int
    forall r. Parser r -> InputStream ByteString -> IO r
    parseFromStream Parser Int
    transferChunkSize InputStream ByteString
    i1

        skipCRLF :: Generator ByteString ()
    skipCRLF = do
            IO () -> Generator ByteString ()
    forall a. IO a -> Generator ByteString a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Generator ByteString ())
    -> IO () -> Generator ByteString ()
    forall a b. (a -> b) -> a -> b
    $ IO ByteString -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Parser ByteString -> InputStream ByteString -> IO ByteString
    forall r. Parser r -> InputStream ByteString -> IO r
    parseFromStream Parser ByteString
    crlf InputStream ByteString
    i1)

        transferChunkSize :: Parser (Int)
        transferChunkSize :: Parser Int
    transferChunkSize = do
            !n <- Parser Int
    forall a. (Integral a, Bits a) => Parser a
    hexadecimal
            -- skip over any chunk extensions (see RFC7230#sec4.1.1)
            void (takeTill (== '\r'))
            void crlf
            return n

        {-
            The chunk size coming down from the client is somewhat arbitrary;
            it's really just an indication of how many bytes need to be read
            before the next size marker or end marker - neither of which has
            anything to do with streaming on our side. Instead, we'll feed
            bytes into our InputStream at an appropriate intermediate size.
        -}
        bUFSIZ :: Int
        bUFSIZ :: Int
    bUFSIZ = Int
    32752

        {-
            Read the specified number of bytes up to a maximum of bUFSIZ,
            returning a resultant ByteString and the number of bytes remaining.
        -}
        readN :: Int -> InputStream ByteString -> IO (ByteString, Int)
        readN :: Int -> InputStream ByteString -> IO (ByteString, Int)
    readN Int
    n InputStream ByteString
    input = do
            !x' <- Int -> InputStream ByteString -> IO ByteString
    Streams.readExactly Int
    p InputStream ByteString
    input
            return (x', r)
          where
            !d :: Int
    d = Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    bUFSIZ
            !p :: Int
    p = if Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then Int
    bUFSIZ else Int
    n
            !r :: Int
    r = if Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then Int
    d else Int
    0

    ------------------------------------------------------------------------------
    toLower :: ByteString -> ByteString
    toLower :: ByteString -> ByteString
    toLower = (Char -> Char) -> ByteString -> ByteString
    S.map Char -> Char
    lower
      where
        lower :: Char -> Char
    lower Char
    c0 = let !c :: Word8
    c = Char -> Word8
    c2w Char
    c0
                   in if Word8
    65 Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    c Bool -> Bool -> Bool
    && Word8
    c Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    90
                        then Word8 -> Char
    w2c (Word8 -> Char) -> Word8 -> Char
    forall a b. (a -> b) -> a -> b
    $! Word8
    c Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Word8
    32
                        else Char
    c0

    ------------------------------------------------------------------------------
    -- | A version of elemIndex that doesn't allocate a Maybe. (It returns -1 on
    -- not found.)
    elemIndex :: Char -> ByteString -> Int
    #if MIN_VERSION_bytestring(0, 10, 6)
    elemIndex :: Char -> ByteString -> Int
    elemIndex Char
    c (PS !ForeignPtr Word8
    fp !Int
    start !Int
    len) = IO Int -> Int
    forall a. IO a -> a
    accursedUnutterablePerformIO (IO Int -> Int) -> IO Int -> Int
    forall a b. (a -> b) -> a -> b
    $
    #else
    elemIndex c (PS !fp !start !len) = inlinePerformIO $
    #endif
                                       ForeignPtr Word8 -> (Ptr Word8 -> IO Int) -> IO Int
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    fp ((Ptr Word8 -> IO Int) -> IO Int)
    -> (Ptr Word8 -> IO Int) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    p0 -> do
        let !p :: Ptr b
    p = Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    plusPtr Ptr Word8
    p0 Int
    start
        q <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
    memchr Ptr Word8
    forall {b}. Ptr b
    p Word8
    w8 (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    len)
        return $! if q == nullPtr then (-1) else q `minusPtr` p
      where
        !w8 :: Word8
    w8 = Char -> Word8
    c2w Char
    c
    {-# INLINE elemIndex #-}