{-# LANGUAGE OverloadedStrings, CPP #-}
module Network.Wai.Application.Classic.Conduit (
byteStringToBuilder
, toResponseSource
, parseHeader
) where
import Control.Applicative
import Data.Attoparsec.ByteString
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BB (byteString)
import Data.CaseInsensitive (CI(..), mk)
import Data.Conduit
import Data.Conduit.Attoparsec
import qualified Data.Conduit.List as CL
import Data.Word
import Network.HTTP.Types
byteStringToBuilder :: ByteString -> Builder
byteStringToBuilder :: ByteString -> Builder
byteStringToBuilder = ByteString -> Builder
BB.byteString
#if MIN_VERSION_conduit(1,3,0)
toResponseSource :: SealedConduitT () ByteString IO ()
-> IO (ConduitT () (Flush Builder) IO ())
toResponseSource :: SealedConduitT () ByteString IO ()
-> IO (ConduitT () (Flush Builder) IO ())
toResponseSource SealedConduitT () ByteString IO ()
rsrc = do
let src :: ConduitT () ByteString IO ()
src = SealedConduitT () ByteString IO () -> ConduitT () ByteString IO ()
forall (m :: * -> *) i o r.
Monad m =>
SealedConduitT i o m r -> ConduitT i o m r
unsealConduitT SealedConduitT () ByteString IO ()
rsrc
ConduitT () (Flush Builder) IO ()
-> IO (ConduitT () (Flush Builder) IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConduitT () (Flush Builder) IO ()
-> IO (ConduitT () (Flush Builder) IO ()))
-> ConduitT () (Flush Builder) IO ()
-> IO (ConduitT () (Flush Builder) IO ())
forall a b. (a -> b) -> a -> b
$ ConduitT () ByteString IO ()
src ConduitT () ByteString IO ()
-> ConduitT ByteString (Flush Builder) IO ()
-> ConduitT () (Flush Builder) IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (ByteString -> Flush Builder)
-> ConduitT ByteString (Flush Builder) IO ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map (Builder -> Flush Builder
forall a. a -> Flush a
Chunk (Builder -> Flush Builder)
-> (ByteString -> Builder) -> ByteString -> Flush Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
byteStringToBuilder)
#else
toResponseSource :: ResumableSource IO ByteString
-> IO (Source IO (Flush Builder))
toResponseSource rsrc = do
(src,_) <- unwrapResumable rsrc
return $ src $= CL.map (Chunk . byteStringToBuilder)
#endif
parseHeader :: ConduitM ByteString o IO RequestHeaders
= Parser ByteString RequestHeaders
-> ConduitT ByteString o IO RequestHeaders
forall a (m :: * -> *) b o.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a o m b
sinkParser Parser ByteString RequestHeaders
parseHeader'
parseHeader' :: Parser RequestHeaders
= Parser ByteString RequestHeaders
forall {a}. Parser ByteString [a]
stop Parser ByteString RequestHeaders
-> Parser ByteString RequestHeaders
-> Parser ByteString RequestHeaders
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString RequestHeaders
loop
where
stop :: Parser ByteString [a]
stop = [] [a] -> Parser ByteString () -> Parser ByteString [a]
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Parser ByteString ()
crlf Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput)
loop :: Parser ByteString RequestHeaders
loop = (:) (RequestHeader -> RequestHeaders -> RequestHeaders)
-> Parser ByteString RequestHeader
-> Parser ByteString (RequestHeaders -> RequestHeaders)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString RequestHeader
keyVal Parser ByteString (RequestHeaders -> RequestHeaders)
-> Parser ByteString RequestHeaders
-> Parser ByteString RequestHeaders
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString RequestHeaders
parseHeader'
type = (CI ByteString, ByteString)
keyVal :: Parser RequestHeader
keyVal :: Parser ByteString RequestHeader
keyVal = do
ByteString
key <- (Word8 -> Bool) -> Parser ByteString
takeTill (Word8
wcollonWord8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==)
Word8
_ <- Word8 -> Parser Word8
word8 Word8
wcollon
(Word8 -> Bool) -> Parser ByteString ()
skipWhile (Word8
wspace Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==)
ByteString
val <- (Word8 -> Bool) -> Parser ByteString
takeTill (Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8
wlf,Word8
wcr])
Parser ByteString ()
crlf
RequestHeader -> Parser ByteString RequestHeader
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
mk ByteString
key, ByteString
val)
crlf :: Parser ()
crlf :: Parser ByteString ()
crlf = (Parser ByteString ()
cr Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Parser ByteString ()
lf Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Parser ByteString ()
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ())) Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString ()
lf
cr :: Parser ()
cr :: Parser ByteString ()
cr = () () -> Parser Word8 -> Parser ByteString ()
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser Word8
word8 Word8
wcr
lf :: Parser ()
lf :: Parser ByteString ()
lf = () () -> Parser Word8 -> Parser ByteString ()
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser Word8
word8 Word8
wlf
wcollon :: Word8
wcollon :: Word8
wcollon = Word8
58
wcr :: Word8
wcr :: Word8
wcr = Word8
13
wlf :: Word8
wlf :: Word8
wlf = Word8
10
wspace :: Word8
wspace :: Word8
wspace = Word8
32