{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}
module Network.HTTP.Client.Body
( makeChunkedReader
, makeLengthReader
, makeGzipReader
, makeUnlimitedReader
, brConsume
, brEmpty
, constBodyReader
, brReadSome
, brRead
) where
import Network.HTTP.Client.Connection
import Network.HTTP.Client.Types
import Control.Exception (assert)
import Data.ByteString (empty, uncons)
import Data.IORef
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Control.Monad (unless, when)
import qualified Data.Streaming.Zlib as Z
brRead :: BodyReader -> IO S.ByteString
brRead :: BodyReader -> BodyReader
brRead = BodyReader -> BodyReader
forall a. a -> a
id
brReadSome :: BodyReader -> Int -> IO L.ByteString
brReadSome :: BodyReader -> Int -> IO ByteString
brReadSome BodyReader
brRead' =
([ByteString] -> [ByteString]) -> Int -> IO ByteString
loop [ByteString] -> [ByteString]
forall a. a -> a
id
where
loop :: ([ByteString] -> [ByteString]) -> Int -> IO ByteString
loop [ByteString] -> [ByteString]
front Int
rem'
| Int
rem' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front []
| Bool
otherwise = do
ByteString
bs <- BodyReader
brRead'
if ByteString -> Bool
S.null ByteString
bs
then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front []
else ([ByteString] -> [ByteString]) -> Int -> IO ByteString
loop ([ByteString] -> [ByteString]
front ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
bsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)) (Int
rem' Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
bs)
brEmpty :: BodyReader
brEmpty :: BodyReader
brEmpty = ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
S.empty
constBodyReader :: [S.ByteString] -> IO BodyReader
constBodyReader :: [ByteString] -> IO BodyReader
constBodyReader [ByteString]
input = do
IORef [ByteString]
iinput <- [ByteString] -> IO (IORef [ByteString])
forall a. a -> IO (IORef a)
newIORef [ByteString]
input
BodyReader -> IO BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyReader -> IO BodyReader) -> BodyReader -> IO BodyReader
forall a b. (a -> b) -> a -> b
$ IORef [ByteString]
-> ([ByteString] -> ([ByteString], ByteString)) -> BodyReader
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [ByteString]
iinput (([ByteString] -> ([ByteString], ByteString)) -> BodyReader)
-> ([ByteString] -> ([ByteString], ByteString)) -> BodyReader
forall a b. (a -> b) -> a -> b
$ \[ByteString]
input' ->
case [ByteString]
input' of
[] -> ([], ByteString
S.empty)
ByteString
x:[ByteString]
xs -> ([ByteString]
xs, ByteString
x)
brConsume :: BodyReader -> IO [S.ByteString]
brConsume :: BodyReader -> IO [ByteString]
brConsume BodyReader
brRead' =
([ByteString] -> [ByteString]) -> IO [ByteString]
forall c. ([ByteString] -> c) -> IO c
go [ByteString] -> [ByteString]
forall a. a -> a
id
where
go :: ([ByteString] -> c) -> IO c
go [ByteString] -> c
front = do
ByteString
x <- BodyReader
brRead'
if ByteString -> Bool
S.null ByteString
x
then c -> IO c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> IO c) -> c -> IO c
forall a b. (a -> b) -> a -> b
$ [ByteString] -> c
front []
else ([ByteString] -> c) -> IO c
go ([ByteString] -> c
front ([ByteString] -> c)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
xByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:))
makeGzipReader :: BodyReader -> IO BodyReader
makeGzipReader :: BodyReader -> IO BodyReader
makeGzipReader BodyReader
brRead' = do
Inflate
inf <- WindowBits -> IO Inflate
Z.initInflate (WindowBits -> IO Inflate) -> WindowBits -> IO Inflate
forall a b. (a -> b) -> a -> b
$ Int -> WindowBits
Z.WindowBits Int
31
IORef (Maybe (IO PopperRes))
istate <- Maybe (IO PopperRes) -> IO (IORef (Maybe (IO PopperRes)))
forall a. a -> IO (IORef a)
newIORef Maybe (IO PopperRes)
forall a. Maybe a
Nothing
let goPopper :: IO PopperRes -> BodyReader
goPopper IO PopperRes
popper = do
PopperRes
res <- IO PopperRes
popper
case PopperRes
res of
Z.PRNext ByteString
bs -> do
IORef (Maybe (IO PopperRes)) -> Maybe (IO PopperRes) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (IO PopperRes))
istate (Maybe (IO PopperRes) -> IO ()) -> Maybe (IO PopperRes) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO PopperRes -> Maybe (IO PopperRes)
forall a. a -> Maybe a
Just IO PopperRes
popper
ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
PopperRes
Z.PRDone -> do
ByteString
bs <- Inflate -> BodyReader
Z.flushInflate Inflate
inf
if ByteString -> Bool
S.null ByteString
bs
then BodyReader
start
else do
IORef (Maybe (IO PopperRes)) -> Maybe (IO PopperRes) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (IO PopperRes))
istate Maybe (IO PopperRes)
forall a. Maybe a
Nothing
ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
Z.PRError ZlibException
e -> HttpExceptionContent -> BodyReader
forall a. HttpExceptionContent -> IO a
throwHttp (HttpExceptionContent -> BodyReader)
-> HttpExceptionContent -> BodyReader
forall a b. (a -> b) -> a -> b
$ ZlibException -> HttpExceptionContent
HttpZlibException ZlibException
e
start :: BodyReader
start = do
ByteString
bs <- BodyReader
brRead'
if ByteString -> Bool
S.null ByteString
bs
then ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
S.empty
else do
IO PopperRes
popper <- Inflate -> ByteString -> IO (IO PopperRes)
Z.feedInflate Inflate
inf ByteString
bs
IO PopperRes -> BodyReader
goPopper IO PopperRes
popper
BodyReader -> IO BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyReader -> IO BodyReader) -> BodyReader -> IO BodyReader
forall a b. (a -> b) -> a -> b
$ do
Maybe (IO PopperRes)
state <- IORef (Maybe (IO PopperRes)) -> IO (Maybe (IO PopperRes))
forall a. IORef a -> IO a
readIORef IORef (Maybe (IO PopperRes))
istate
case Maybe (IO PopperRes)
state of
Maybe (IO PopperRes)
Nothing -> BodyReader
start
Just IO PopperRes
popper -> IO PopperRes -> BodyReader
goPopper IO PopperRes
popper
makeUnlimitedReader
:: IO ()
-> Connection
-> IO BodyReader
makeUnlimitedReader :: IO () -> Connection -> IO BodyReader
makeUnlimitedReader IO ()
cleanup Connection {IO ()
BodyReader
ByteString -> IO ()
connectionClose :: Connection -> IO ()
connectionWrite :: Connection -> ByteString -> IO ()
connectionUnread :: Connection -> ByteString -> IO ()
connectionRead :: Connection -> BodyReader
connectionClose :: IO ()
connectionWrite :: ByteString -> IO ()
connectionUnread :: ByteString -> IO ()
connectionRead :: BodyReader
..} = do
IORef Bool
icomplete <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
BodyReader -> IO BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyReader -> IO BodyReader) -> BodyReader -> IO BodyReader
forall a b. (a -> b) -> a -> b
$ do
ByteString
bs <- BodyReader
connectionRead
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
S.null ByteString
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
icomplete Bool
True
IO ()
cleanup
ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
makeLengthReader
:: IO ()
-> Int
-> Connection
-> IO BodyReader
makeLengthReader :: IO () -> Int -> Connection -> IO BodyReader
makeLengthReader IO ()
cleanup Int
count0 Connection {IO ()
BodyReader
ByteString -> IO ()
connectionClose :: IO ()
connectionWrite :: ByteString -> IO ()
connectionUnread :: ByteString -> IO ()
connectionRead :: BodyReader
connectionClose :: Connection -> IO ()
connectionWrite :: Connection -> ByteString -> IO ()
connectionUnread :: Connection -> ByteString -> IO ()
connectionRead :: Connection -> BodyReader
..} = do
IORef Int
icount <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
count0
BodyReader -> IO BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyReader -> IO BodyReader) -> BodyReader -> IO BodyReader
forall a b. (a -> b) -> a -> b
$ do
Int
count <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
icount
if Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
empty
else do
ByteString
bs <- BodyReader
connectionRead
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
S.null ByteString
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HttpExceptionContent -> IO ()
forall a. HttpExceptionContent -> IO a
throwHttp (HttpExceptionContent -> IO ()) -> HttpExceptionContent -> IO ()
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> HttpExceptionContent
ResponseBodyTooShort (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count0) (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Int
count0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
count)
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
count (Int -> Ordering) -> Int -> Ordering
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs of
Ordering
LT -> do
let (ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
count ByteString
bs
ByteString -> IO ()
connectionUnread ByteString
y
IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
icount (-Int
1)
IO ()
cleanup
ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
x
Ordering
EQ -> do
IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
icount (-Int
1)
IO ()
cleanup
ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
Ordering
GT -> do
IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
icount (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
bs)
ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
makeChunkedReader
:: IO ()
-> Bool
-> Connection
-> IO BodyReader
makeChunkedReader :: IO () -> Bool -> Connection -> IO BodyReader
makeChunkedReader IO ()
cleanup Bool
raw conn :: Connection
conn@Connection {IO ()
BodyReader
ByteString -> IO ()
connectionClose :: IO ()
connectionWrite :: ByteString -> IO ()
connectionUnread :: ByteString -> IO ()
connectionRead :: BodyReader
connectionClose :: Connection -> IO ()
connectionWrite :: Connection -> ByteString -> IO ()
connectionUnread :: Connection -> ByteString -> IO ()
connectionRead :: Connection -> BodyReader
..} = do
IORef Int
icount <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
BodyReader -> IO BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyReader -> IO BodyReader) -> BodyReader -> IO BodyReader
forall a b. (a -> b) -> a -> b
$ do
ByteString
bs <- IORef Int -> BodyReader
go IORef Int
icount
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
S.null ByteString
bs) IO ()
cleanup
ByteString -> BodyReader
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
where
go :: IORef Int -> BodyReader
go IORef Int
icount = do
Int
count0 <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
icount
(ByteString
rawCount, Int
count) <-
if Int
count0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then IO (ByteString, Int)
readHeader
else (ByteString, Int) -> IO (ByteString, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
empty, Int
count0)
if Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
then do
IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
icount (-Int
1)
if | Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1 Bool -> Bool -> Bool
&& Bool
raw -> ByteString -> ByteString -> ByteString
S.append ByteString
rawCount (ByteString -> ByteString) -> BodyReader -> BodyReader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BodyReader
readTrailersRaw
| Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1 -> IO ()
consumeTrailers IO () -> BodyReader -> BodyReader
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> BodyReader
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
empty
| Bool
otherwise -> ByteString -> BodyReader
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
empty
else do
(ByteString
bs, Int
count') <- Int -> IO (ByteString, Int)
readChunk Int
count
IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
icount Int
count'
ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> BodyReader) -> ByteString -> BodyReader
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
appendHeader ByteString
rawCount ByteString
bs
appendHeader :: ByteString -> ByteString -> ByteString
appendHeader
| Bool
raw = ByteString -> ByteString -> ByteString
S.append
| Bool
otherwise = (ByteString -> ByteString -> ByteString)
-> ByteString -> ByteString -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> ByteString -> ByteString
forall a b. a -> b -> a
const
readChunk :: Int -> IO (ByteString, Int)
readChunk Int
0 = (ByteString, Int) -> IO (ByteString, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
empty, Int
0)
readChunk Int
remainder = do
ByteString
bs <- BodyReader
connectionRead
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
S.null ByteString
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HttpExceptionContent -> IO ()
forall a. HttpExceptionContent -> IO a
throwHttp HttpExceptionContent
InvalidChunkHeaders
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
remainder (Int -> Ordering) -> Int -> Ordering
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs of
Ordering
LT -> do
let (ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
remainder ByteString
bs
Bool -> IO () -> IO ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
y) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
connectionUnread ByteString
y
IO ()
requireNewline
ByteString -> IO (ByteString, Int)
forall (m :: * -> *) b.
(Monad m, Num b) =>
ByteString -> m (ByteString, b)
done ByteString
x
Ordering
EQ -> do
IO ()
requireNewline
ByteString -> IO (ByteString, Int)
forall (m :: * -> *) b.
(Monad m, Num b) =>
ByteString -> m (ByteString, b)
done ByteString
bs
Ordering
GT -> (ByteString, Int) -> IO (ByteString, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs, Int
remainder Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
bs)
where
done :: ByteString -> m (ByteString, b)
done ByteString
x
| Bool
raw = (ByteString, b) -> m (ByteString, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
x ByteString -> ByteString -> ByteString
`S.append` ByteString
"\r\n", b
0)
| Bool
otherwise = (ByteString, b) -> m (ByteString, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
x, b
0)
requireNewline :: IO ()
requireNewline = do
ByteString
bs <- Connection -> BodyReader
connectionReadLine Connection
conn
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
S.null ByteString
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HttpExceptionContent -> IO ()
forall a. HttpExceptionContent -> IO a
throwHttp HttpExceptionContent
InvalidChunkHeaders
readHeader :: IO (ByteString, Int)
readHeader = do
ByteString
bs <- Connection -> BodyReader
connectionReadLine Connection
conn
case ByteString -> Maybe Int
forall a. Num a => ByteString -> Maybe a
parseHex ByteString
bs of
Maybe Int
Nothing -> HttpExceptionContent -> IO (ByteString, Int)
forall a. HttpExceptionContent -> IO a
throwHttp HttpExceptionContent
InvalidChunkHeaders
Just Int
hex -> (ByteString, Int) -> IO (ByteString, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs ByteString -> ByteString -> ByteString
`S.append` ByteString
"\r\n", Int
hex)
parseHex :: ByteString -> Maybe a
parseHex ByteString
bs0 =
case ByteString -> Maybe (Word8, ByteString)
uncons ByteString
bs0 of
Just (Word8
w0, ByteString
bs')
| Just a
i0 <- Word8 -> Maybe a
forall a a. (Num a, Integral a) => a -> Maybe a
toI Word8
w0 -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> ByteString -> a
forall p. Num p => p -> ByteString -> p
parseHex' a
i0 ByteString
bs'
Maybe (Word8, ByteString)
_ -> Maybe a
forall a. Maybe a
Nothing
parseHex' :: p -> ByteString -> p
parseHex' p
i ByteString
bs =
case ByteString -> Maybe (Word8, ByteString)
uncons ByteString
bs of
Just (Word8
w, ByteString
bs')
| Just p
i' <- Word8 -> Maybe p
forall a a. (Num a, Integral a) => a -> Maybe a
toI Word8
w -> p -> ByteString -> p
parseHex' (p
i p -> p -> p
forall a. Num a => a -> a -> a
* p
16 p -> p -> p
forall a. Num a => a -> a -> a
+ p
i') ByteString
bs'
Maybe (Word8, ByteString)
_ -> p
i
toI :: a -> Maybe a
toI a
w
| a
48 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
57 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
48
| a
65 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
70 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
55
| a
97 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
w Bool -> Bool -> Bool
&& a
w a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
102 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
87
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
readTrailersRaw :: BodyReader
readTrailersRaw = do
ByteString
bs <- Connection -> BodyReader
connectionReadLine Connection
conn
if ByteString -> Bool
S.null ByteString
bs
then ByteString -> BodyReader
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
"\r\n"
else (ByteString
bs ByteString -> ByteString -> ByteString
`S.append` ByteString
"\r\n" ByteString -> ByteString -> ByteString
`S.append`) (ByteString -> ByteString) -> BodyReader -> BodyReader
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BodyReader
readTrailersRaw
consumeTrailers :: IO ()
consumeTrailers = Connection -> IO ()
connectionDropTillBlankLine Connection
conn