{-# language DeriveAnyClass #-}
{-# language DerivingStrategies #-}
{-# language DuplicateRecordFields #-}
{-# language LambdaCase #-}
{-# language OverloadedStrings #-}

module Exchange
  ( Exception(..)
  , HttpException(..)
  , exchange
  ) where

import Channel (M,Resource,SendException,ReceiveException,send,receive)
import Control.Monad (when)
import Data.Char (ord)
import Data.Bytes (Bytes)
import Data.Bytes.Chunks (Chunks(ChunksCons,ChunksNil))
import Data.Word (Word64)
import Http.Bodied (Bodied(Bodied))
import Http.Exchange.Types (HttpException)
import Http.Header (Header(Header))
import Http.Types (Request,Response,Headers,LookupException(Duplicate,Missing))
import Text.Read (readMaybe)
import Data.Bytes.Parser (Parser)

import qualified Data.Bytes.Parser as Parser
import qualified Data.Bytes.Parser.Latin as Latin
import qualified Http.Exchange.Types as E
import qualified Data.Bytes as Bytes
import qualified Data.Bytes.Chunks as Chunks
import qualified Data.Text as T
import qualified Http.Header
import qualified Http.Headers as Headers
import qualified Http.Request as Request
import qualified Http.Response as Response
import qualified Http.Bodied
import qualified Control.Exception
import qualified Channel

data Continuation = Continuation
  !Instruction
  !Chunks -- these chunks are in reverse order

-- Not exported
data Instruction
  = More -- we are in the middle of a chunk
      !Int -- how much input was requested (zero is special)
      !Int -- how much more input do we need to consume
  | MorePostCr
      !Int -- how much input was requested for the last chunk
  | ChunkLength
      -- We are in the middle (or at the beginning) of chunk length,
      -- the leading CRLF has already been consumed
      !Word64 -- chunk length accumulator
  | PostCr -- We already got the CR after the chunk length
      !Int -- how much input we need to consume, but we need to consume the LF first
  | Done
    -- ^ We got all the chunks, and we got the zero-length chunk
    -- at the end, and we got the trailing CRLF. We are done.

data TransferEncoding
  = Nonchunked
  | Chunked

-- | An exception that occurs during an HTTP exchange.
data Exception
  = Http -- ^ The response was not a valid HTTP response
      !HttpException
  | Send
      -- ^ Transport exception while sending. When backed by stream sockets,
      -- exceptions like @ECONNRESET@ show up here.
      !SendException
  | Receive
      -- ^ Transport exception while receiving. Depending on the backend,
      -- this may or may not include an end-of-input exception. For stream
      -- sockets, end-of-input is not presented as an exception. It is
      -- presented as a zero-length result.
      !ReceiveException
  deriving anyclass (Show Exception
Typeable Exception
SomeException -> Maybe Exception
Exception -> String
Exception -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: Exception -> String
$cdisplayException :: Exception -> String
fromException :: SomeException -> Maybe Exception
$cfromException :: SomeException -> Maybe Exception
toException :: Exception -> SomeException
$ctoException :: Exception -> SomeException
Control.Exception.Exception)

instance Show Exception where
  showsPrec :: Int -> Exception -> ShowS
showsPrec Int
d (Http HttpException
e) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
    (String -> ShowS
showString String
"Http " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 HttpException
e)
  showsPrec Int
d (Send SendException
e) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
    (String -> ShowS
showString String
"Send " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SendException -> ShowS
Channel.showsPrecSendException Int
11 SendException
e)
  showsPrec Int
d (Receive ReceiveException
e) = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
    (String -> ShowS
showString String
"Receive " forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReceiveException -> ShowS
Channel.showsPrecReceiveException Int
11 ReceiveException
e)

-- | Send an HTTP request and await a response. This function takes
-- responsibility for encoding the request and decoding the response.
-- It deals with the @Transfer-Encoding@ of the response and supports
-- both chunked and nonchunked responses.
exchange ::
     Resource
  -> Bodied Request -- http request line and headers
  -> M (Either Exception (Bodied Response))
exchange :: Resource
-> Bodied Request -> M (Either Exception (Bodied Response))
exchange Resource
ctx Bodied Request
req = do
  let enc :: Chunks
enc = Bodied Request -> Chunks
Request.bodiedToChunks Bodied Request
req
  Resource -> Chunks -> M (Either SendException ())
send Resource
ctx Chunks
enc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left SendException
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (SendException -> Exception
Send SendException
err))
    Right () -> Resource -> M (Either Exception (Bodied Response))
receiveResponse Resource
ctx

receiveResponse ::
     Resource
  -> M (Either Exception (Bodied Response))
receiveResponse :: Resource -> M (Either Exception (Bodied Response))
receiveResponse !Resource
ctx = do
  let go :: Bytes -> M (Either Exception (Bodied Response))
go !Bytes
oldOutput = Resource -> M (Either ReceiveException Bytes)
receive Resource
ctx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left ReceiveException
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (ReceiveException -> Exception
Receive ReceiveException
err))
        Right Bytes
newOutput -> case Bytes -> Int
Bytes.length Bytes
newOutput of
          Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (HttpException -> Exception
Http HttpException
E.HeadersEndOfInput))
          Int
_ -> do
            let output :: Bytes
output = Bytes
oldOutput forall a. Semigroup a => a -> a -> a
<> Bytes
newOutput
            case Bytes -> Maybe (Bytes, Bytes)
splitEndOfHeaders Bytes
output of
              Maybe (Bytes, Bytes)
Nothing -> if Bytes -> Int
Bytes.length Bytes
output forall a. Ord a => a -> a -> Bool
> Int
16000
                then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (HttpException -> Exception
Http HttpException
E.HeadersTooLarge))
                else Bytes -> M (Either Exception (Bodied Response))
go Bytes
output
              Just (Bytes
pre,Bytes
post) -> case Int -> Bytes -> Maybe Response
Response.decode Int
128 Bytes
pre of
                Maybe Response
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (HttpException -> Exception
Http HttpException
E.HeadersMalformed))
                Just resp :: Response
resp@Response.Response{Headers
$sel:headers:Response :: Response -> Headers
headers :: Headers
headers} -> case Headers -> Either HttpException TransferEncoding
lookupTransferEncoding Headers
headers of
                  Left HttpException
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (HttpException -> Exception
Http HttpException
err))
                  Right TransferEncoding
enc -> case TransferEncoding
enc of
                    TransferEncoding
Nonchunked -> Resource
-> Response
-> Bytes
-> Headers
-> M (Either Exception (Bodied Response))
handleNonchunkedBody Resource
ctx Response
resp Bytes
post Headers
headers
                    TransferEncoding
Chunked -> Resource
-> Response -> Bytes -> M (Either Exception (Bodied Response))
handleChunkedBody Resource
ctx Response
resp Bytes
post
  Bytes -> M (Either Exception (Bodied Response))
go forall a. Monoid a => a
mempty

handleChunkedBody ::
     Resource
  -> Response
  -> Bytes
  -> M (Either Exception (Bodied Response))
handleChunkedBody :: Resource
-> Response -> Bytes -> M (Either Exception (Bodied Response))
handleChunkedBody !Resource
ctx Response
resp !Bytes
input0 = do
  let go :: Continuation -> Bytes -> M (Either Exception (Bodied Response))
go Continuation
contA !Bytes
inputA = case forall e a. (forall s. Parser e s a) -> Bytes -> Result e a
Parser.parseBytes (forall s. Continuation -> Parser HttpException s Continuation
parserChunked Continuation
contA) Bytes
inputA of
        Parser.Failure HttpException
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (HttpException -> Exception
Http HttpException
e))
        Parser.Success (Parser.Slice Int
_ Int
leftoverLen Continuation
contB) -> case Int
leftoverLen of
          -- We expect that parserChunked consumes all input, so we check
          -- here to be certain that it actually does.
          Int
0 -> case Continuation
contB of
            Continuation Instruction
Done Chunks
revChunks -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bodied
              { metadata :: Response
metadata = Response
resp
              , body :: Chunks
body = Chunks -> Chunks
Chunks.reverse Chunks
revChunks
              }
            Continuation
_ -> Resource -> M (Either ReceiveException Bytes)
receive Resource
ctx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Right Bytes
inputB -> case Bytes -> Int
Bytes.length Bytes
inputB of
                Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (HttpException -> Exception
Http HttpException
E.ChunkedBodyEndOfInput))
                Int
_ -> Continuation -> Bytes -> M (Either Exception (Bodied Response))
go Continuation
contB Bytes
inputB
              Left ReceiveException
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (ReceiveException -> Exception
Receive ReceiveException
err))
          Int
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (HttpException -> Exception
Http HttpException
E.ImplementationMistake))
  let cont0 :: Continuation
cont0 = Instruction -> Chunks -> Continuation
Continuation (Word64 -> Instruction
ChunkLength Word64
0) Chunks
ChunksNil
  Continuation -> Bytes -> M (Either Exception (Bodied Response))
go Continuation
cont0 Bytes
input0

parserChunked :: Continuation -> Parser HttpException s Continuation
parserChunked :: forall s. Continuation -> Parser HttpException s Continuation
parserChunked (Continuation Instruction
instr Chunks
chunks0) = case Instruction
instr of
  Instruction
Done -> forall e s a. e -> Parser e s a
Parser.fail HttpException
E.ImplementationMistake
  More Int
total Int
n -> forall s.
Int -> Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMore Int
total Int
n Chunks
chunks0
  MorePostCr Int
total -> forall s. Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMorePostCr Int
total Chunks
chunks0
  ChunkLength Word64
acc -> forall s. Word64 -> Chunks -> Parser HttpException s Continuation
parserChunkedChunkLength Word64
acc Chunks
chunks0
  PostCr Int
n -> forall s. Int -> Chunks -> Parser HttpException s Continuation
parserChunkedChunkLengthPostCr Int
n Chunks
chunks0

parserChunkedMore :: Int -> Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMore :: forall s.
Int -> Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMore !Int
total !Int
n !Chunks
chunks0 = case Int
n of
  -- If there are no more bytes left in the chunk, we start
  -- on the next decimal-encoded chunk length.
  Int
0 -> forall s. Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMorePost Int
total Chunks
chunks0
  Int
_ -> do
    Bytes
b <- forall e s. Int -> Parser e s Bytes
Parser.takeUpTo Int
n
    case Bytes -> Int
Bytes.length Bytes
b of
      -- If there was no input left, we return to request more input.
      -- If we didn't check for this, we would go into a loop.
      Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instruction -> Chunks -> Continuation
Continuation (Int -> Int -> Instruction
More Int
total Int
n) Chunks
chunks0)
      Int
m -> do
        let chunks1 :: Chunks
chunks1 = Bytes -> Chunks -> Chunks
ChunksCons Bytes
b Chunks
chunks0
        forall s.
Int -> Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMore Int
total (Int
n forall a. Num a => a -> a -> a
- Int
m) Chunks
chunks1

parserChunkedMorePost :: Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMorePost :: forall s. Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMorePost !Int
total !Chunks
chunks0 = forall e s. Parser e s (Maybe Char)
Latin.opt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Just Char
'\r' -> forall s. Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMorePostCr Int
total Chunks
chunks0
  Just Char
_ -> forall e s a. e -> Parser e s a
Parser.fail HttpException
E.ExpectedCrlfAfterChunk
  Maybe Char
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instruction -> Chunks -> Continuation
Continuation (Int -> Int -> Instruction
More Int
total Int
0) Chunks
chunks0)

parserChunkedMorePostCr :: Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMorePostCr :: forall s. Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMorePostCr !Int
total !Chunks
chunks0 = forall e s. Parser e s (Maybe Char)
Latin.opt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Just Char
'\n' -> case Int
total of
    Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instruction -> Chunks -> Continuation
Continuation Instruction
Done Chunks
chunks0)
    Int
_ -> forall s. Word64 -> Chunks -> Parser HttpException s Continuation
parserChunkedChunkLength Word64
0 Chunks
chunks0
  Just Char
_ -> forall e s a. e -> Parser e s a
Parser.fail HttpException
E.ExpectedCrlfAfterChunk
  Maybe Char
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instruction -> Chunks -> Continuation
Continuation (Int -> Instruction
MorePostCr Int
total) Chunks
chunks0)

parserChunkedChunkLength :: Word64 -> Chunks -> Parser HttpException s Continuation
parserChunkedChunkLength :: forall s. Word64 -> Chunks -> Parser HttpException s Continuation
parserChunkedChunkLength !Word64
acc !Chunks
chunks0 = if Word64
acc forall a. Ord a => a -> a -> Bool
> Word64
100_000_000
  then forall e s a. e -> Parser e s a
Parser.fail HttpException
E.ChunkTooLarge
  else forall e s. Parser e s (Maybe Char)
Latin.opt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Char
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instruction -> Chunks -> Continuation
Continuation (Word64 -> Instruction
ChunkLength Word64
acc) Chunks
chunks0)
    Just Char
c -> case Char
c of
      Char
'\r' -> forall e s. Parser e s (Maybe Char)
Latin.opt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Char
d -> case Char
d of
          Char
'\n' -> do
            let !acc' :: Int
acc' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
acc :: Int
            forall s.
Int -> Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMore Int
acc' Int
acc' Chunks
chunks0
          Char
_ -> forall e s a. e -> Parser e s a
Parser.fail HttpException
E.ExpectedCrlfAfterChunkLength
        Maybe Char
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instruction -> Chunks -> Continuation
Continuation (Int -> Instruction
PostCr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
acc)) Chunks
chunks0)
      Char
_ | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0', Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9' -> forall s. Word64 -> Chunks -> Parser HttpException s Continuation
parserChunkedChunkLength (Word64
acc forall a. Num a => a -> a -> a
* Word64
16 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Int
0x30)) Chunks
chunks0
      Char
_ | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'a', Char
c forall a. Ord a => a -> a -> Bool
<= Char
'f' -> forall s. Word64 -> Chunks -> Parser HttpException s Continuation
parserChunkedChunkLength (Word64
acc forall a. Num a => a -> a -> a
* Word64
16 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- (Int
0x61 forall a. Num a => a -> a -> a
- Int
10))) Chunks
chunks0
      Char
_ | Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A', Char
c forall a. Ord a => a -> a -> Bool
<= Char
'F' -> forall s. Word64 -> Chunks -> Parser HttpException s Continuation
parserChunkedChunkLength (Word64
acc forall a. Num a => a -> a -> a
* Word64
16 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- (Int
0x41 forall a. Num a => a -> a -> a
- Int
10))) Chunks
chunks0
      Char
_ -> forall e s a. e -> Parser e s a
Parser.fail HttpException
E.NonNumericChunkLength

parserChunkedChunkLengthPostCr :: Int -> Chunks -> Parser HttpException s Continuation
parserChunkedChunkLengthPostCr :: forall s. Int -> Chunks -> Parser HttpException s Continuation
parserChunkedChunkLengthPostCr !Int
n !Chunks
chunks0 = forall e s. Parser e s (Maybe Char)
Latin.opt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Just Char
d -> case Char
d of
    Char
'\n' -> forall s.
Int -> Int -> Chunks -> Parser HttpException s Continuation
parserChunkedMore Int
n Int
n Chunks
chunks0
    Char
_ -> forall e s a. e -> Parser e s a
Parser.fail HttpException
E.ExpectedCrlfAfterChunkLength
  Maybe Char
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Instruction -> Chunks -> Continuation
Continuation (Int -> Instruction
PostCr Int
n) Chunks
chunks0)

handleNonchunkedBody :: Resource -> Response -> Bytes -> Headers -> M (Either Exception (Bodied Response))
handleNonchunkedBody :: Resource
-> Response
-> Bytes
-> Headers
-> M (Either Exception (Bodied Response))
handleNonchunkedBody Resource
ctx Response
resp !Bytes
post !Headers
headers = case Headers -> Either HttpException Int
lookupContentLength Headers
headers of
  Left HttpException
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (HttpException -> Exception
Http HttpException
err))
  Right Int
len -> do
    let finish :: Chunks -> Int -> M (Either Exception (Bodied Response))
finish Chunks
reversedChunks Int
n = case forall a. Ord a => a -> a -> Ordering
compare Int
n Int
0 of
          Ordering
LT -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (HttpException -> Exception
Http HttpException
E.PipelinedResponses))
          Ordering
EQ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bodied
            { metadata :: Response
metadata = Response
resp
            , body :: Chunks
body = Chunks -> Chunks
Chunks.reverse Chunks
reversedChunks
            }
          Ordering
GT -> Resource -> M (Either ReceiveException Bytes)
receive Resource
ctx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Right Bytes
chunk -> case Bytes -> Int
Bytes.length Bytes
chunk of
              Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (HttpException -> Exception
Http HttpException
E.NonchunkedBodyEndOfInput))
              Int
_ -> Chunks -> Int -> M (Either Exception (Bodied Response))
finish (Bytes -> Chunks -> Chunks
ChunksCons Bytes
chunk Chunks
reversedChunks) (Int
n forall a. Num a => a -> a -> a
- Bytes -> Int
Bytes.length Bytes
chunk)
            Left ReceiveException
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (ReceiveException -> Exception
Receive ReceiveException
err))
    Chunks -> Int -> M (Either Exception (Bodied Response))
finish (Bytes -> Chunks -> Chunks
ChunksCons Bytes
post Chunks
ChunksNil) (Int
len forall a. Num a => a -> a -> a
- Bytes -> Int
Bytes.length Bytes
post)

splitEndOfHeaders :: Bytes -> Maybe (Bytes, Bytes)
splitEndOfHeaders :: Bytes -> Maybe (Bytes, Bytes)
splitEndOfHeaders !Bytes
b = case Word8 -> Word8 -> Word8 -> Word8 -> Bytes -> Maybe Int
Bytes.findTetragramIndex Word8
0x0D Word8
0x0A Word8
0x0D Word8
0x0A Bytes
b of
  Maybe Int
Nothing -> forall a. Maybe a
Nothing
  Just Int
n -> forall a. a -> Maybe a
Just (Int -> Bytes -> Bytes
Bytes.unsafeTake (Int
n forall a. Num a => a -> a -> a
+ Int
4) Bytes
b, Int -> Bytes -> Bytes
Bytes.unsafeDrop (Int
n forall a. Num a => a -> a -> a
+ Int
4) Bytes
b)

lookupTransferEncoding :: Headers -> Either HttpException TransferEncoding
lookupTransferEncoding :: Headers -> Either HttpException TransferEncoding
lookupTransferEncoding !Headers
hdrs =
  case Headers -> Either LookupException Header
Headers.lookupTransferEncoding Headers
hdrs of
    Right Header{Text
value :: Header -> Text
value :: Text
value} -> case Text
value of
      Text
"chunked" -> forall a b. b -> Either a b
Right TransferEncoding
Chunked
      Text
_ -> forall a b. a -> Either a b
Left HttpException
E.TransferEncodingUnrecognized
    Left LookupException
Missing -> forall a b. b -> Either a b
Right TransferEncoding
Nonchunked
    Left LookupException
Duplicate -> forall a b. a -> Either a b
Left HttpException
E.TransferEncodingDuplicated

lookupContentLength :: Headers -> Either HttpException Int
lookupContentLength :: Headers -> Either HttpException Int
lookupContentLength !Headers
hdrs =
  case Headers -> Either LookupException Header
Headers.lookupContentLength Headers
hdrs of
    Left LookupException
Missing -> forall a b. b -> Either a b
Right Int
0
    Left LookupException
Duplicate -> forall a b. a -> Either a b
Left HttpException
E.ContentLengthDuplicated
    Right Header{Text
value :: Text
value :: Header -> Text
value} -> case forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
value) of
      Maybe Int
Nothing -> forall a b. a -> Either a b
Left HttpException
E.ContentLengthMalformed
      Just Int
i -> do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Ord a => a -> a -> Bool
> Int
8_000_000_000) (forall a b. a -> Either a b
Left HttpException
E.ContentLengthTooLarge)
        forall a b. b -> Either a b
Right Int
i