{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Network.HTTP2.Arch.Sender (
    frameSender
  , fillBuilderBodyGetNext
  , fillFileBodyGetNext
  , fillStreamBodyGetNext
  , runTrailersMaker
  ) where

import Control.Concurrent.MVar (putMVar)
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder.Extra as B
import Data.IORef (readIORef, writeIORef)
import Foreign.Ptr (plusPtr, minusPtr)
import Network.ByteOrder
import qualified UnliftIO.Exception as E
import UnliftIO.STM

import Imports
import Network.HPACK (setLimitForEncoding, toHeaderTable, TokenHeaderList)
import Network.HTTP2.Arch.Config
import Network.HTTP2.Arch.Context
import Network.HTTP2.Arch.EncodeFrame
import Network.HTTP2.Arch.File
import Network.HTTP2.Arch.HPACK
import Network.HTTP2.Arch.Manager hiding (start)
import Network.HTTP2.Arch.Queue
import Network.HTTP2.Arch.Stream
import Network.HTTP2.Arch.Types
import Network.HTTP2.Arch.Window
import Network.HTTP2.Frame

----------------------------------------------------------------

data Leftover = LZero
              | LOne B.BufferWriter
              | LTwo ByteString B.BufferWriter

----------------------------------------------------------------

{-# INLINE waitStreaming #-}
waitStreaming :: TBQueue a -> IO ()
waitStreaming :: forall a. TBQueue a -> IO ()
waitStreaming TBQueue a
tbq = forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
    Bool
isEmpty <- forall a. TBQueue a -> STM Bool
isEmptyTBQueue TBQueue a
tbq
    Bool -> STM ()
checkSTM (Bool -> Bool
not Bool
isEmpty)

data Switch = C Control
            | O (Output Stream)
            | Flush

wrapException :: E.SomeException -> IO ()
wrapException :: SomeException -> IO ()
wrapException SomeException
se
  | Just (HTTP2Error
e :: HTTP2Error) <- forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
se = forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO HTTP2Error
e
  | Bool
otherwise = forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO forall a b. (a -> b) -> a -> b
$ SomeException -> HTTP2Error
BadThingHappen SomeException
se

frameSender :: Context -> Config -> Manager -> IO ()
frameSender :: Context -> Config -> Manager -> IO ()
frameSender ctx :: Context
ctx@Context{TQueue (Output Stream)
outputQ :: Context -> TQueue (Output Stream)
outputQ :: TQueue (Output Stream)
outputQ,TQueue Control
controlQ :: Context -> TQueue Control
controlQ :: TQueue Control
controlQ,DynamicTable
encodeDynamicTable :: Context -> DynamicTable
encodeDynamicTable :: DynamicTable
encodeDynamicTable,IORef Int
outputBufferLimit :: Context -> IORef Int
outputBufferLimit :: IORef Int
outputBufferLimit}
            Config{Int
Buffer
Manager
SockAddr
Int -> IO HeaderValue
PositionReadMaker
HeaderValue -> IO ()
confPeerSockAddr :: Config -> SockAddr
confMySockAddr :: Config -> SockAddr
confTimeoutManager :: Config -> Manager
confPositionReadMaker :: Config -> PositionReadMaker
confReadN :: Config -> Int -> IO HeaderValue
confSendAll :: Config -> HeaderValue -> IO ()
confBufferSize :: Config -> Int
confWriteBuffer :: Config -> Buffer
confPeerSockAddr :: SockAddr
confMySockAddr :: SockAddr
confTimeoutManager :: Manager
confPositionReadMaker :: PositionReadMaker
confReadN :: Int -> IO HeaderValue
confSendAll :: HeaderValue -> IO ()
confBufferSize :: Int
confWriteBuffer :: Buffer
..}
            Manager
mgr = Int -> IO ()
loop Int
0 forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch` SomeException -> IO ()
wrapException
  where
    ----------------------------------------------------------------
    loop :: Offset -> IO ()
    loop :: Int -> IO ()
loop Int
off = do
        Switch
x <- forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ Int -> STM Switch
dequeue Int
off
        case Switch
x of
            C Control
ctl -> Int -> IO ()
flushN Int
off forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Control -> IO ()
control Control
ctl forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
loop Int
0
            O Output Stream
out -> Output Stream -> Int -> IO Int
outputOrEnqueueAgain Output Stream
out Int
off forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> IO Int
flushIfNecessary forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> IO ()
loop
            Switch
Flush -> Int -> IO ()
flushN Int
off forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
loop Int
0

    -- Flush the connection buffer to the socket, where the first 'n' bytes of
    -- the buffer are filled.
    flushN :: Offset -> IO ()
    flushN :: Int -> IO ()
flushN Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    flushN Int
n = forall a. Buffer -> Int -> (HeaderValue -> IO a) -> IO a
bufferIO Buffer
confWriteBuffer Int
n HeaderValue -> IO ()
confSendAll

    flushIfNecessary :: Offset -> IO Offset
    flushIfNecessary :: Int -> IO Int
flushIfNecessary Int
off = do
        Int
buflim <- forall a. IORef a -> IO a
readIORef IORef Int
outputBufferLimit
        if Int
off forall a. Ord a => a -> a -> Bool
<= Int
buflim forall a. Num a => a -> a -> a
- Int
512 then
            forall (m :: * -> *) a. Monad m => a -> m a
return Int
off
          else do
            Int -> IO ()
flushN Int
off
            forall (m :: * -> *) a. Monad m => a -> m a
return Int
0

    dequeue :: Offset -> STM Switch
    dequeue :: Int -> STM Switch
dequeue Int
off = do
        Bool
isEmpty <- forall a. TQueue a -> STM Bool
isEmptyTQueue TQueue Control
controlQ
        if Bool
isEmpty then do
            Context -> STM ()
waitConnectionWindowSize Context
ctx
            Bool
emp <- forall a. TQueue a -> STM Bool
isEmptyTQueue TQueue (Output Stream)
outputQ
            if Bool
emp then
                if Int
off forall a. Eq a => a -> a -> Bool
/= Int
0 then forall (m :: * -> *) a. Monad m => a -> m a
return Switch
Flush else forall a. STM a
retrySTM
              else
                Output Stream -> Switch
O forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TQueue a -> STM a
readTQueue TQueue (Output Stream)
outputQ
          else
            Control -> Switch
C forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TQueue a -> STM a
readTQueue TQueue Control
controlQ

    ----------------------------------------------------------------
    copyAll :: [HeaderValue] -> Buffer -> IO Buffer
copyAll []     Buffer
buf = forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
buf
    copyAll (HeaderValue
x:[HeaderValue]
xs) Buffer
buf = Buffer -> HeaderValue -> IO Buffer
copy Buffer
buf HeaderValue
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [HeaderValue] -> Buffer -> IO Buffer
copyAll [HeaderValue]
xs

    -- called with off == 0
    control :: Control -> IO ()
    control :: Control -> IO ()
control (CFinish     HTTP2Error
e) = forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO HTTP2Error
e
    control (CGoaway HeaderValue
bs MVar ()
mvar) = do
        Buffer
buf <- [HeaderValue] -> Buffer -> IO Buffer
copyAll [HeaderValue
bs] Buffer
confWriteBuffer
        let off :: Int
off = Buffer
buf forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Buffer
confWriteBuffer
        Int -> IO ()
flushN Int
off
        forall a. MVar a -> a -> IO ()
putMVar MVar ()
mvar ()
        forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO HTTP2Error
GoAwayIsSent
    control (CFrames Maybe SettingsList
ms [HeaderValue]
xs) = do
        Buffer
buf <- [HeaderValue] -> Buffer -> IO Buffer
copyAll [HeaderValue]
xs Buffer
confWriteBuffer
        let off :: Int
off = Buffer
buf forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Buffer
confWriteBuffer
        Int -> IO ()
flushN Int
off
        case Maybe SettingsList
ms of
          Maybe SettingsList
Nothing    -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just SettingsList
peerAlist -> do
              -- Peer SETTINGS_INITIAL_WINDOW_SIZE
              Context -> SettingsList -> IO ()
updatePeerSettings Context
ctx SettingsList
peerAlist
              -- Peer SETTINGS_MAX_FRAME_SIZE
              case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup SettingsKey
SettingsMaxFrameSize SettingsList
peerAlist of
                Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just Int
payloadLen -> do
                    let dlim :: Int
dlim = Int
payloadLen forall a. Num a => a -> a -> a
+ Int
frameHeaderLength
                        buflim :: Int
buflim | Int
confBufferSize forall a. Ord a => a -> a -> Bool
>= Int
dlim = Int
dlim
                               | Bool
otherwise              = Int
confBufferSize
                    forall a. IORef a -> a -> IO ()
writeIORef IORef Int
outputBufferLimit Int
buflim
              -- Peer SETTINGS_HEADER_TABLE_SIZE
              case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup SettingsKey
SettingsHeaderTableSize SettingsList
peerAlist of
                Maybe Int
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just Int
siz -> Int -> DynamicTable -> IO ()
setLimitForEncoding Int
siz DynamicTable
encodeDynamicTable

    ----------------------------------------------------------------
    output :: Output Stream -> Offset -> WindowSize -> IO Offset
    output :: Output Stream -> Int -> Int -> IO Int
output out :: Output Stream
out@(Output Stream
strm OutObj{} (ONext DynaNext
curr TrailersMaker
tlrmkr) Maybe (TBQueue StreamingChunk)
_ IO ()
sentinel) Int
off0 Int
lim = do
        -- Data frame payload
        Int
buflim <- forall a. IORef a -> IO a
readIORef IORef Int
outputBufferLimit
        let payloadOff :: Int
payloadOff = Int
off0 forall a. Num a => a -> a -> a
+ Int
frameHeaderLength
            datBuf :: Ptr b
datBuf     = Buffer
confWriteBuffer forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
payloadOff
            datBufSiz :: Int
datBufSiz  = Int
buflim forall a. Num a => a -> a -> a
- Int
payloadOff
        Next Int
datPayloadLen Bool
reqflush Maybe DynaNext
mnext <- DynaNext
curr forall {b}. Ptr b
datBuf Int
datBufSiz Int
lim -- checkme
        NextTrailersMaker TrailersMaker
tlrmkr' <- TrailersMaker -> Buffer -> Int -> IO NextTrailersMaker
runTrailersMaker TrailersMaker
tlrmkr forall {b}. Ptr b
datBuf Int
datPayloadLen
        Stream
-> Int
-> Int
-> Maybe DynaNext
-> TrailersMaker
-> IO ()
-> Output Stream
-> Bool
-> IO Int
fillDataHeaderEnqueueNext Stream
strm Int
off0 Int
datPayloadLen Maybe DynaNext
mnext TrailersMaker
tlrmkr' IO ()
sentinel Output Stream
out Bool
reqflush

    output out :: Output Stream
out@(Output Stream
strm (OutObj [Header]
hdr OutBody
body TrailersMaker
tlrmkr) OutputType
OObj Maybe (TBQueue StreamingChunk)
mtbq IO ()
_) Int
off0 Int
lim = do
        -- Header frame and Continuation frame
        let sid :: Int
sid = Stream -> Int
streamNumber Stream
strm
            endOfStream :: Bool
endOfStream = case OutBody
body of
                OutBody
OutBodyNone -> Bool
True
                OutBody
_           -> Bool
False
        (TokenHeaderList
ths,ValueTable
_) <- [Header] -> IO (TokenHeaderList, ValueTable)
toHeaderTable forall a b. (a -> b) -> a -> b
$ [Header] -> [Header]
fixHeaders [Header]
hdr
        Int
off' <- Int -> TokenHeaderList -> Bool -> Int -> IO Int
headerContinue Int
sid TokenHeaderList
ths Bool
endOfStream Int
off0
        -- halfClosedLocal calls closed which removes
        -- the stream from stream table.
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
endOfStream forall a b. (a -> b) -> a -> b
$ Context -> Stream -> ClosedCode -> IO ()
halfClosedLocal Context
ctx Stream
strm ClosedCode
Finished
        Int
off <- Int -> IO Int
flushIfNecessary Int
off'
        case OutBody
body of
            OutBody
OutBodyNone -> forall (m :: * -> *) a. Monad m => a -> m a
return Int
off
            OutBodyFile (FileSpec FilePath
path Int64
fileoff Int64
bytecount) -> do
                (PositionRead
pread, Sentinel
sentinel') <- PositionReadMaker
confPositionReadMaker FilePath
path
                IO ()
refresh <- case Sentinel
sentinel' of
                             Closer IO ()
closer       -> Manager -> IO () -> IO (IO ())
timeoutClose Manager
mgr IO ()
closer
                             Refresher IO ()
refresher -> forall (m :: * -> *) a. Monad m => a -> m a
return IO ()
refresher
                let next :: DynaNext
next = PositionRead -> Int64 -> Int64 -> IO () -> DynaNext
fillFileBodyGetNext PositionRead
pread Int64
fileoff Int64
bytecount IO ()
refresh
                    out' :: Output Stream
out' = Output Stream
out { outputType :: OutputType
outputType = DynaNext -> TrailersMaker -> OutputType
ONext DynaNext
next TrailersMaker
tlrmkr }
                Output Stream -> Int -> Int -> IO Int
output Output Stream
out' Int
off Int
lim
            OutBodyBuilder Builder
builder -> do
                let next :: DynaNext
next = Builder -> DynaNext
fillBuilderBodyGetNext Builder
builder
                    out' :: Output Stream
out' = Output Stream
out { outputType :: OutputType
outputType = DynaNext -> TrailersMaker -> OutputType
ONext DynaNext
next TrailersMaker
tlrmkr }
                Output Stream -> Int -> Int -> IO Int
output Output Stream
out' Int
off Int
lim
            OutBodyStreaming (Builder -> IO ()) -> IO () -> IO ()
_ ->
                Output Stream -> Int -> Int -> IO Int
output (Maybe (TBQueue StreamingChunk)
-> TrailersMaker -> Output Stream -> Output Stream
setNextForStreaming Maybe (TBQueue StreamingChunk)
mtbq TrailersMaker
tlrmkr Output Stream
out) Int
off Int
lim
            OutBodyStreamingUnmask (forall x. IO x -> IO x) -> (Builder -> IO ()) -> IO () -> IO ()
_ ->
                Output Stream -> Int -> Int -> IO Int
output (Maybe (TBQueue StreamingChunk)
-> TrailersMaker -> Output Stream -> Output Stream
setNextForStreaming Maybe (TBQueue StreamingChunk)
mtbq TrailersMaker
tlrmkr Output Stream
out) Int
off Int
lim

    output out :: Output Stream
out@(Output Stream
strm OutObj
_ (OPush TokenHeaderList
ths Int
pid) Maybe (TBQueue StreamingChunk)
_ IO ()
_) Int
off0 Int
lim = do
        -- Creating a push promise header
        -- Frame id should be associated stream id from the client.
        let sid :: Int
sid = Stream -> Int
streamNumber Stream
strm
        Int
len <- Int -> Int -> TokenHeaderList -> Int -> IO Int
pushPromise Int
pid Int
sid TokenHeaderList
ths Int
off0
        Int
off <- Int -> IO Int
flushIfNecessary forall a b. (a -> b) -> a -> b
$ Int
off0 forall a. Num a => a -> a -> a
+ Int
frameHeaderLength forall a. Num a => a -> a -> a
+ Int
len
        Output Stream -> Int -> Int -> IO Int
output Output Stream
out{outputType :: OutputType
outputType=OutputType
OObj} Int
off Int
lim

    output Output Stream
_ Int
_ Int
_ = forall a. HasCallStack => a
undefined -- never reach

    ----------------------------------------------------------------
    setNextForStreaming :: Maybe (TBQueue StreamingChunk) -> TrailersMaker -> Output Stream -> Output Stream
    setNextForStreaming :: Maybe (TBQueue StreamingChunk)
-> TrailersMaker -> Output Stream -> Output Stream
setNextForStreaming Maybe (TBQueue StreamingChunk)
mtbq TrailersMaker
tlrmkr Output Stream
out =
        let tbq :: TBQueue StreamingChunk
tbq = forall a. HasCallStack => Maybe a -> a
fromJust Maybe (TBQueue StreamingChunk)
mtbq
            takeQ :: IO (Maybe StreamingChunk)
takeQ = forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TBQueue a -> STM (Maybe a)
tryReadTBQueue TBQueue StreamingChunk
tbq
            next :: DynaNext
next = IO (Maybe StreamingChunk) -> DynaNext
fillStreamBodyGetNext IO (Maybe StreamingChunk)
takeQ
        in Output Stream
out { outputType :: OutputType
outputType = DynaNext -> TrailersMaker -> OutputType
ONext DynaNext
next TrailersMaker
tlrmkr }

    ----------------------------------------------------------------
    outputOrEnqueueAgain :: Output Stream -> Offset -> IO Offset
    outputOrEnqueueAgain :: Output Stream -> Int -> IO Int
outputOrEnqueueAgain out :: Output Stream
out@(Output Stream
strm OutObj
_ OutputType
otyp Maybe (TBQueue StreamingChunk)
_ IO ()
_) Int
off = forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle SomeException -> IO Int
resetStream forall a b. (a -> b) -> a -> b
$ do
        StreamState
state <- Stream -> IO StreamState
readStreamState Stream
strm
        if StreamState -> Bool
isHalfClosedLocal StreamState
state then
            forall (m :: * -> *) a. Monad m => a -> m a
return Int
off
          else case OutputType
otyp of
                 OWait IO ()
wait -> do
                     -- Checking if all push are done.
                     IO ()
-> TQueue (Output Stream) -> Output Stream -> Manager -> IO ()
forkAndEnqueueWhenReady IO ()
wait TQueue (Output Stream)
outputQ Output Stream
out{outputType :: OutputType
outputType=OutputType
OObj} Manager
mgr
                     forall (m :: * -> *) a. Monad m => a -> m a
return Int
off
                 OutputType
_ -> case Maybe (TBQueue StreamingChunk)
mtbq of
                        Just TBQueue StreamingChunk
tbq -> forall {a}. TBQueue a -> IO Int
checkStreaming TBQueue StreamingChunk
tbq
                        Maybe (TBQueue StreamingChunk)
_        -> IO Int
checkStreamWindowSize
      where
        mtbq :: Maybe (TBQueue StreamingChunk)
mtbq = forall a. Output a -> Maybe (TBQueue StreamingChunk)
outputStrmQ Output Stream
out
        checkStreaming :: TBQueue a -> IO Int
checkStreaming TBQueue a
tbq = do
            Bool
isEmpty <- forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TBQueue a -> STM Bool
isEmptyTBQueue TBQueue a
tbq
            if Bool
isEmpty then do
                IO ()
-> TQueue (Output Stream) -> Output Stream -> Manager -> IO ()
forkAndEnqueueWhenReady (forall a. TBQueue a -> IO ()
waitStreaming TBQueue a
tbq) TQueue (Output Stream)
outputQ Output Stream
out Manager
mgr
                forall (m :: * -> *) a. Monad m => a -> m a
return Int
off
              else
                IO Int
checkStreamWindowSize
        checkStreamWindowSize :: IO Int
checkStreamWindowSize = do
            Int
sws <- Stream -> IO Int
getStreamWindowSize Stream
strm
            if Int
sws forall a. Eq a => a -> a -> Bool
== Int
0 then do
                IO ()
-> TQueue (Output Stream) -> Output Stream -> Manager -> IO ()
forkAndEnqueueWhenReady (Stream -> IO ()
waitStreamWindowSize Stream
strm) TQueue (Output Stream)
outputQ Output Stream
out Manager
mgr
                forall (m :: * -> *) a. Monad m => a -> m a
return Int
off
              else do
                Int
cws <- Context -> IO Int
getConnectionWindowSize Context
ctx -- not 0
                let lim :: Int
lim = forall a. Ord a => a -> a -> a
min Int
cws Int
sws
                Output Stream -> Int -> Int -> IO Int
output Output Stream
out Int
off Int
lim
        resetStream :: SomeException -> IO Int
resetStream SomeException
e = do
            Context -> Stream -> ClosedCode -> IO ()
closed Context
ctx Stream
strm (SomeException -> ClosedCode
ResetByMe SomeException
e)
            let rst :: HeaderValue
rst = ErrorCode -> Int -> HeaderValue
resetFrame ErrorCode
InternalError forall a b. (a -> b) -> a -> b
$ Stream -> Int
streamNumber Stream
strm
            TQueue Control -> Control -> IO ()
enqueueControl TQueue Control
controlQ forall a b. (a -> b) -> a -> b
$ Maybe SettingsList -> [HeaderValue] -> Control
CFrames forall a. Maybe a
Nothing [HeaderValue
rst]
            forall (m :: * -> *) a. Monad m => a -> m a
return Int
off

    ----------------------------------------------------------------
    headerContinue :: StreamId -> TokenHeaderList -> Bool -> Offset -> IO Offset
    headerContinue :: Int -> TokenHeaderList -> Bool -> Int -> IO Int
headerContinue Int
sid TokenHeaderList
ths0 Bool
endOfStream Int
off0 = do
        Int
buflim <- forall a. IORef a -> IO a
readIORef IORef Int
outputBufferLimit
        let offkv :: Int
offkv = Int
off0 forall a. Num a => a -> a -> a
+ Int
frameHeaderLength
            bufkv :: Ptr b
bufkv = Buffer
confWriteBuffer forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offkv
            limkv :: Int
limkv = Int
buflim forall a. Num a => a -> a -> a
- Int
offkv
        (TokenHeaderList
ths,Int
kvlen) <- Context
-> Buffer -> Int -> TokenHeaderList -> IO (TokenHeaderList, Int)
hpackEncodeHeader Context
ctx forall {b}. Ptr b
bufkv Int
limkv TokenHeaderList
ths0
        if Int
kvlen forall a. Eq a => a -> a -> Bool
== Int
0 then
            Int -> TokenHeaderList -> FrameType -> IO Int
continue Int
off0 TokenHeaderList
ths FrameType
FrameHeaders
          else do
            let flag :: FrameFlags
flag = forall {a}. [a] -> FrameFlags
getFlag TokenHeaderList
ths
                buf :: Ptr b
buf = Buffer
confWriteBuffer forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off0
                off :: Int
off = Int
offkv forall a. Num a => a -> a -> a
+ Int
kvlen
            FrameType -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameType
FrameHeaders Int
kvlen Int
sid FrameFlags
flag forall {b}. Ptr b
buf
            Int -> TokenHeaderList -> FrameType -> IO Int
continue Int
off TokenHeaderList
ths FrameType
FrameContinuation
      where
        eos :: FrameFlags -> FrameFlags
eos = if Bool
endOfStream then FrameFlags -> FrameFlags
setEndStream else forall a. a -> a
id
        getFlag :: [a] -> FrameFlags
getFlag [] = FrameFlags -> FrameFlags
eos forall a b. (a -> b) -> a -> b
$ FrameFlags -> FrameFlags
setEndHeader FrameFlags
defaultFlags
        getFlag [a]
_  = FrameFlags -> FrameFlags
eos forall a b. (a -> b) -> a -> b
$ FrameFlags
defaultFlags

        continue :: Offset -> TokenHeaderList -> FrameType -> IO Offset
        continue :: Int -> TokenHeaderList -> FrameType -> IO Int
continue Int
off [] FrameType
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Int
off
        continue Int
off TokenHeaderList
ths FrameType
ft = do
            Int -> IO ()
flushN Int
off
            -- Now off is 0
            Int
buflim <- forall a. IORef a -> IO a
readIORef IORef Int
outputBufferLimit
            let bufHeaderPayload :: Ptr b
bufHeaderPayload = Buffer
confWriteBuffer forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
frameHeaderLength

                headerPayloadLim :: Int
headerPayloadLim = Int
buflim forall a. Num a => a -> a -> a
- Int
frameHeaderLength
            (TokenHeaderList
ths', Int
kvlen') <- Context
-> Buffer -> Int -> TokenHeaderList -> IO (TokenHeaderList, Int)
hpackEncodeHeaderLoop Context
ctx forall {b}. Ptr b
bufHeaderPayload Int
headerPayloadLim TokenHeaderList
ths
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TokenHeaderList
ths forall a. Eq a => a -> a -> Bool
== TokenHeaderList
ths') forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO forall a b. (a -> b) -> a -> b
$ ErrorCode -> Int -> ReasonPhrase -> HTTP2Error
ConnectionErrorIsSent ErrorCode
CompressionError Int
sid ReasonPhrase
"cannot compress the header"
            let flag :: FrameFlags
flag = forall {a}. [a] -> FrameFlags
getFlag TokenHeaderList
ths'
                off' :: Int
off' = Int
frameHeaderLength forall a. Num a => a -> a -> a
+ Int
kvlen'
            FrameType -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameType
ft Int
kvlen' Int
sid FrameFlags
flag Buffer
confWriteBuffer
            Int -> TokenHeaderList -> FrameType -> IO Int
continue Int
off' TokenHeaderList
ths' FrameType
FrameContinuation

    ----------------------------------------------------------------
    fillDataHeaderEnqueueNext :: Stream
                              -> Offset
                              -> Int
                              -> Maybe DynaNext
                              -> (Maybe ByteString -> IO NextTrailersMaker)
                              -> IO ()
                              -> Output Stream
                              -> Bool
                              -> IO Offset
    fillDataHeaderEnqueueNext :: Stream
-> Int
-> Int
-> Maybe DynaNext
-> TrailersMaker
-> IO ()
-> Output Stream
-> Bool
-> IO Int
fillDataHeaderEnqueueNext strm :: Stream
strm@Stream{Int
streamNumber :: Int
streamNumber :: Stream -> Int
streamNumber}
                   Int
off Int
datPayloadLen Maybe DynaNext
Nothing TrailersMaker
tlrmkr IO ()
tell Output Stream
_ Bool
reqflush = do
        let buf :: Ptr b
buf  = Buffer
confWriteBuffer forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
            off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
frameHeaderLength forall a. Num a => a -> a -> a
+ Int
datPayloadLen
        (Maybe [Header]
mtrailers, FrameFlags
flag) <- do
              Trailers [Header]
trailers <- TrailersMaker
tlrmkr forall a. Maybe a
Nothing
              if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Header]
trailers then
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, FrameFlags -> FrameFlags
setEndStream FrameFlags
defaultFlags)
                else
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just [Header]
trailers, FrameFlags
defaultFlags)
        FrameType -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameType
FrameData Int
datPayloadLen Int
streamNumber FrameFlags
flag forall {b}. Ptr b
buf
        Int
off'' <- Maybe [Header] -> Int -> IO Int
handleTrailers Maybe [Header]
mtrailers Int
off'
        forall (f :: * -> *) a. Functor f => f a -> f ()
void IO ()
tell
        Context -> Stream -> ClosedCode -> IO ()
halfClosedLocal Context
ctx Stream
strm ClosedCode
Finished
        Context -> Stream -> Int -> IO ()
decreaseWindowSize Context
ctx Stream
strm Int
datPayloadLen
        if Bool
reqflush then do
            Int -> IO ()
flushN Int
off''
            forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
          else
            forall (m :: * -> *) a. Monad m => a -> m a
return Int
off''
      where
        handleTrailers :: Maybe [Header] -> Int -> IO Int
handleTrailers Maybe [Header]
Nothing Int
off0 = forall (m :: * -> *) a. Monad m => a -> m a
return Int
off0
        handleTrailers (Just [Header]
trailers) Int
off0 = do
            (TokenHeaderList
ths,ValueTable
_) <- [Header] -> IO (TokenHeaderList, ValueTable)
toHeaderTable [Header]
trailers
            Int -> TokenHeaderList -> Bool -> Int -> IO Int
headerContinue Int
streamNumber TokenHeaderList
ths Bool
True {- endOfStream -} Int
off0

    fillDataHeaderEnqueueNext Stream
_
                   Int
off Int
0 (Just DynaNext
next) TrailersMaker
tlrmkr IO ()
_ Output Stream
out Bool
reqflush = do
        let out' :: Output Stream
out' = Output Stream
out { outputType :: OutputType
outputType = DynaNext -> TrailersMaker -> OutputType
ONext DynaNext
next TrailersMaker
tlrmkr }
        TQueue (Output Stream) -> Output Stream -> IO ()
enqueueOutput TQueue (Output Stream)
outputQ Output Stream
out'
        if Bool
reqflush then do
            Int -> IO ()
flushN Int
off
            forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
          else
            forall (m :: * -> *) a. Monad m => a -> m a
return Int
off

    fillDataHeaderEnqueueNext strm :: Stream
strm@Stream{Int
streamNumber :: Int
streamNumber :: Stream -> Int
streamNumber}
                   Int
off Int
datPayloadLen (Just DynaNext
next) TrailersMaker
tlrmkr IO ()
_ Output Stream
out Bool
reqflush = do
        let buf :: Ptr b
buf  = Buffer
confWriteBuffer forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
            off' :: Int
off' = Int
off forall a. Num a => a -> a -> a
+ Int
frameHeaderLength forall a. Num a => a -> a -> a
+ Int
datPayloadLen
            flag :: FrameFlags
flag  = FrameFlags
defaultFlags
        FrameType -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameType
FrameData Int
datPayloadLen Int
streamNumber FrameFlags
flag forall {b}. Ptr b
buf
        Context -> Stream -> Int -> IO ()
decreaseWindowSize Context
ctx Stream
strm Int
datPayloadLen
        let out' :: Output Stream
out' = Output Stream
out { outputType :: OutputType
outputType = DynaNext -> TrailersMaker -> OutputType
ONext DynaNext
next TrailersMaker
tlrmkr }
        TQueue (Output Stream) -> Output Stream -> IO ()
enqueueOutput TQueue (Output Stream)
outputQ Output Stream
out'
        if Bool
reqflush then do
            Int -> IO ()
flushN Int
off'
            forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
          else
            forall (m :: * -> *) a. Monad m => a -> m a
return Int
off'

    ----------------------------------------------------------------
    pushPromise :: StreamId -> StreamId -> TokenHeaderList -> Offset -> IO Int
    pushPromise :: Int -> Int -> TokenHeaderList -> Int -> IO Int
pushPromise Int
pid Int
sid TokenHeaderList
ths Int
off = do
        let offsid :: Int
offsid = Int
off forall a. Num a => a -> a -> a
+ Int
frameHeaderLength -- checkme
            bufsid :: Ptr b
bufsid = Buffer
confWriteBuffer forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offsid
        Word32 -> Buffer -> Int -> IO ()
poke32 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sid) forall {b}. Ptr b
bufsid Int
0
        let offkv :: Int
offkv  = Int
offsid forall a. Num a => a -> a -> a
+ Int
4
            bufkv :: Ptr b
bufkv  = Buffer
confWriteBuffer forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offkv
            limkv :: Int
limkv  = Int
confBufferSize forall a. Num a => a -> a -> a
- Int
offkv
        (TokenHeaderList
_,Int
kvlen) <- Context
-> Buffer -> Int -> TokenHeaderList -> IO (TokenHeaderList, Int)
hpackEncodeHeader Context
ctx forall {b}. Ptr b
bufkv Int
limkv TokenHeaderList
ths
        let flag :: FrameFlags
flag = FrameFlags -> FrameFlags
setEndHeader FrameFlags
defaultFlags -- No EndStream flag
            buf :: Ptr b
buf = Buffer
confWriteBuffer forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
            len :: Int
len = Int
kvlen forall a. Num a => a -> a -> a
+ Int
4
        FrameType -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameType
FramePushPromise Int
len Int
pid FrameFlags
flag forall {b}. Ptr b
buf
        forall (m :: * -> *) a. Monad m => a -> m a
return Int
len

    ----------------------------------------------------------------
    {-# INLINE fillFrameHeader #-}
    fillFrameHeader :: FrameType -> Int -> StreamId -> FrameFlags -> Buffer -> IO ()
    fillFrameHeader :: FrameType -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameType
ftyp Int
len Int
sid FrameFlags
flag Buffer
buf = FrameType -> FrameHeader -> Buffer -> IO ()
encodeFrameHeaderBuf FrameType
ftyp FrameHeader
hinfo Buffer
buf
      where
        hinfo :: FrameHeader
hinfo = FrameHeader {
            payloadLength :: Int
payloadLength = Int
len
          , flags :: FrameFlags
flags         = FrameFlags
flag
          , streamId :: Int
streamId      = Int
sid
          }

-- | Running trailers-maker.
--
-- > bufferIO buf siz $ \bs -> tlrmkr (Just bs)
runTrailersMaker :: TrailersMaker -> Buffer -> Int -> IO NextTrailersMaker
runTrailersMaker :: TrailersMaker -> Buffer -> Int -> IO NextTrailersMaker
runTrailersMaker TrailersMaker
tlrmkr Buffer
buf Int
siz = forall a. Buffer -> Int -> (HeaderValue -> IO a) -> IO a
bufferIO Buffer
buf Int
siz forall a b. (a -> b) -> a -> b
$ \HeaderValue
bs -> TrailersMaker
tlrmkr (forall a. a -> Maybe a
Just HeaderValue
bs)

----------------------------------------------------------------

fillBuilderBodyGetNext :: Builder -> DynaNext
fillBuilderBodyGetNext :: Builder -> DynaNext
fillBuilderBodyGetNext Builder
bb Buffer
buf Int
siz Int
lim = do
    let room :: Int
room = forall a. Ord a => a -> a -> a
min Int
siz Int
lim
    (Int
len, Next
signal) <- Builder -> BufferWriter
B.runBuilder Builder
bb Buffer
buf Int
room
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Next -> Next
nextForBuilder Int
len Next
signal

fillFileBodyGetNext :: PositionRead -> FileOffset -> ByteCount -> IO () -> DynaNext
fillFileBodyGetNext :: PositionRead -> Int64 -> Int64 -> IO () -> DynaNext
fillFileBodyGetNext PositionRead
pread Int64
start Int64
bytecount IO ()
refresh Buffer
buf Int
siz Int
lim = do
    let room :: Int
room = forall a. Ord a => a -> a -> a
min Int
siz Int
lim
    Int64
len <- PositionRead
pread Int64
start (Int -> Int64 -> Int64
mini Int
room Int64
bytecount) Buffer
buf
    let len' :: Int
len' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> PositionRead -> Int64 -> Int64 -> IO () -> Next
nextForFile Int
len' PositionRead
pread (Int64
start forall a. Num a => a -> a -> a
+ Int64
len) (Int64
bytecount forall a. Num a => a -> a -> a
- Int64
len) IO ()
refresh

fillStreamBodyGetNext :: IO (Maybe StreamingChunk) -> DynaNext
fillStreamBodyGetNext :: IO (Maybe StreamingChunk) -> DynaNext
fillStreamBodyGetNext IO (Maybe StreamingChunk)
takeQ Buffer
buf Int
siz Int
lim = do
    let room :: Int
room = forall a. Ord a => a -> a -> a
min Int
siz Int
lim
    (Bool
cont, Int
len, Bool
reqflush, Leftover
leftover) <- Buffer
-> Int
-> IO (Maybe StreamingChunk)
-> IO (Bool, Int, Bool, Leftover)
runStreamBuilder Buffer
buf Int
room IO (Maybe StreamingChunk)
takeQ
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool
-> Int -> Bool -> Leftover -> IO (Maybe StreamingChunk) -> Next
nextForStream Bool
cont Int
len Bool
reqflush Leftover
leftover IO (Maybe StreamingChunk)
takeQ

----------------------------------------------------------------

fillBufBuilder :: Leftover -> DynaNext
fillBufBuilder :: Leftover -> DynaNext
fillBufBuilder Leftover
leftover Buffer
buf0 Int
siz0 Int
lim = do
    let room :: Int
room = forall a. Ord a => a -> a -> a
min Int
siz0 Int
lim
    case Leftover
leftover of
        Leftover
LZero -> forall a. HasCallStack => FilePath -> a
error FilePath
"fillBufBuilder: LZero"
        LOne BufferWriter
writer -> do
            (Int
len, Next
signal) <- BufferWriter
writer Buffer
buf0 Int
room
            forall {m :: * -> *}. Monad m => Int -> Next -> m Next
getNext Int
len Next
signal
        LTwo HeaderValue
bs BufferWriter
writer
          | HeaderValue -> Int
BS.length HeaderValue
bs forall a. Ord a => a -> a -> Bool
<= Int
room -> do
              Buffer
buf1 <- Buffer -> HeaderValue -> IO Buffer
copy Buffer
buf0 HeaderValue
bs
              let len1 :: Int
len1 = HeaderValue -> Int
BS.length HeaderValue
bs
              (Int
len2, Next
signal) <- BufferWriter
writer Buffer
buf1 (Int
room forall a. Num a => a -> a -> a
- Int
len1)
              forall {m :: * -> *}. Monad m => Int -> Next -> m Next
getNext (Int
len1 forall a. Num a => a -> a -> a
+ Int
len2) Next
signal
          | Bool
otherwise -> do
              let (HeaderValue
bs1,HeaderValue
bs2) = Int -> HeaderValue -> (HeaderValue, HeaderValue)
BS.splitAt Int
room HeaderValue
bs
              forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Buffer -> HeaderValue -> IO Buffer
copy Buffer
buf0 HeaderValue
bs1
              forall {m :: * -> *}. Monad m => Int -> Next -> m Next
getNext Int
room (HeaderValue -> BufferWriter -> Next
B.Chunk HeaderValue
bs2 BufferWriter
writer)
  where
    getNext :: Int -> Next -> m Next
getNext Int
l Next
s = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Next -> Next
nextForBuilder Int
l Next
s

nextForBuilder :: BytesFilled -> B.Next -> Next
nextForBuilder :: Int -> Next -> Next
nextForBuilder Int
len Next
B.Done
    = Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
True forall a. Maybe a
Nothing -- let's flush
nextForBuilder Int
len (B.More Int
_ BufferWriter
writer)
    = Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Leftover -> DynaNext
fillBufBuilder (BufferWriter -> Leftover
LOne BufferWriter
writer))
nextForBuilder Int
len (B.Chunk HeaderValue
bs BufferWriter
writer)
    = Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Leftover -> DynaNext
fillBufBuilder (HeaderValue -> BufferWriter -> Leftover
LTwo HeaderValue
bs BufferWriter
writer))

----------------------------------------------------------------

runStreamBuilder :: Buffer -> BufferSize -> IO (Maybe StreamingChunk)
                 -> IO (Bool  -- continue
                       ,BytesFilled
                       ,Bool  -- require flusing
                       ,Leftover)
runStreamBuilder :: Buffer
-> Int
-> IO (Maybe StreamingChunk)
-> IO (Bool, Int, Bool, Leftover)
runStreamBuilder Buffer
buf0 Int
room0 IO (Maybe StreamingChunk)
takeQ = Buffer -> Int -> Int -> IO (Bool, Int, Bool, Leftover)
loop Buffer
buf0 Int
room0 Int
0
  where
    loop :: Buffer -> Int -> Int -> IO (Bool, Int, Bool, Leftover)
loop Buffer
buf Int
room Int
total = do
        Maybe StreamingChunk
mbuilder <- IO (Maybe StreamingChunk)
takeQ
        case Maybe StreamingChunk
mbuilder of
            Maybe StreamingChunk
Nothing      -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Int
total, Bool
False, Leftover
LZero)
            Just (StreamingBuilder Builder
builder) -> do
                (Int
len, Next
signal) <- Builder -> BufferWriter
B.runBuilder Builder
builder Buffer
buf Int
room
                let total' :: Int
total' = Int
total forall a. Num a => a -> a -> a
+ Int
len
                case Next
signal of
                    Next
B.Done -> Buffer -> Int -> Int -> IO (Bool, Int, Bool, Leftover)
loop (Buffer
buf forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len) (Int
room forall a. Num a => a -> a -> a
- Int
len) Int
total'
                    B.More  Int
_ BufferWriter
writer  -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True,  Int
total', Bool
False, BufferWriter -> Leftover
LOne BufferWriter
writer)
                    B.Chunk HeaderValue
bs BufferWriter
writer -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True,  Int
total', Bool
False, HeaderValue -> BufferWriter -> Leftover
LTwo HeaderValue
bs BufferWriter
writer)
            Just StreamingChunk
StreamingFlush       -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True,  Int
total,  Bool
True,  Leftover
LZero)
            Just (StreamingFinished IO ()
dec) -> do
                IO ()
dec
                forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Int
total,  Bool
True,  Leftover
LZero)

fillBufStream :: Leftover -> IO (Maybe StreamingChunk) -> DynaNext
fillBufStream :: Leftover -> IO (Maybe StreamingChunk) -> DynaNext
fillBufStream Leftover
leftover0 IO (Maybe StreamingChunk)
takeQ Buffer
buf0 Int
siz0 Int
lim0 = do
    let room0 :: Int
room0 = forall a. Ord a => a -> a -> a
min Int
siz0 Int
lim0
    case Leftover
leftover0 of
        Leftover
LZero -> do
            (Bool
cont, Int
len, Bool
reqflush, Leftover
leftover) <- Buffer
-> Int
-> IO (Maybe StreamingChunk)
-> IO (Bool, Int, Bool, Leftover)
runStreamBuilder Buffer
buf0 Int
room0 IO (Maybe StreamingChunk)
takeQ
            Bool -> Int -> Bool -> Leftover -> IO Next
getNext Bool
cont Int
len Bool
reqflush Leftover
leftover
        LOne BufferWriter
writer -> BufferWriter -> DynaNext
write BufferWriter
writer Buffer
buf0 Int
room0 Int
0
        LTwo HeaderValue
bs BufferWriter
writer
          | HeaderValue -> Int
BS.length HeaderValue
bs forall a. Ord a => a -> a -> Bool
<= Int
room0 -> do
              Buffer
buf1 <- Buffer -> HeaderValue -> IO Buffer
copy Buffer
buf0 HeaderValue
bs
              let len :: Int
len = HeaderValue -> Int
BS.length HeaderValue
bs
              BufferWriter -> DynaNext
write BufferWriter
writer Buffer
buf1 (Int
room0 forall a. Num a => a -> a -> a
- Int
len) Int
len
          | Bool
otherwise -> do
              let (HeaderValue
bs1,HeaderValue
bs2) = Int -> HeaderValue -> (HeaderValue, HeaderValue)
BS.splitAt Int
room0 HeaderValue
bs
              forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Buffer -> HeaderValue -> IO Buffer
copy Buffer
buf0 HeaderValue
bs1
              Bool -> Int -> Bool -> Leftover -> IO Next
getNext Bool
True Int
room0 Bool
False forall a b. (a -> b) -> a -> b
$ HeaderValue -> BufferWriter -> Leftover
LTwo HeaderValue
bs2 BufferWriter
writer
  where
    getNext :: Bool -> BytesFilled -> Bool -> Leftover -> IO Next
    getNext :: Bool -> Int -> Bool -> Leftover -> IO Next
getNext Bool
cont Int
len Bool
reqflush Leftover
l = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool
-> Int -> Bool -> Leftover -> IO (Maybe StreamingChunk) -> Next
nextForStream Bool
cont Int
len Bool
reqflush Leftover
l IO (Maybe StreamingChunk)
takeQ

    write :: (Buffer -> BufferSize -> IO (Int, B.Next))
          -> Buffer -> BufferSize -> Int
          -> IO Next
    write :: BufferWriter -> DynaNext
write BufferWriter
writer1 Buffer
buf Int
room Int
sofar = do
        (Int
len, Next
signal) <- BufferWriter
writer1 Buffer
buf Int
room
        case Next
signal of
            Next
B.Done -> do
                (Bool
cont, Int
extra, Bool
reqflush, Leftover
leftover) <- Buffer
-> Int
-> IO (Maybe StreamingChunk)
-> IO (Bool, Int, Bool, Leftover)
runStreamBuilder (Buffer
buf forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len) (Int
room forall a. Num a => a -> a -> a
- Int
len) IO (Maybe StreamingChunk)
takeQ
                let total :: Int
total = Int
sofar forall a. Num a => a -> a -> a
+ Int
len forall a. Num a => a -> a -> a
+ Int
extra
                Bool -> Int -> Bool -> Leftover -> IO Next
getNext Bool
cont Int
total Bool
reqflush Leftover
leftover
            B.More  Int
_ BufferWriter
writer -> do
                let total :: Int
total = Int
sofar forall a. Num a => a -> a -> a
+ Int
len
                Bool -> Int -> Bool -> Leftover -> IO Next
getNext Bool
True Int
total Bool
False forall a b. (a -> b) -> a -> b
$ BufferWriter -> Leftover
LOne BufferWriter
writer
            B.Chunk HeaderValue
bs BufferWriter
writer -> do
                let total :: Int
total = Int
sofar forall a. Num a => a -> a -> a
+ Int
len
                Bool -> Int -> Bool -> Leftover -> IO Next
getNext Bool
True Int
total Bool
False forall a b. (a -> b) -> a -> b
$ HeaderValue -> BufferWriter -> Leftover
LTwo HeaderValue
bs BufferWriter
writer

nextForStream :: Bool -> BytesFilled -> Bool
              -> Leftover -> IO (Maybe StreamingChunk)
              -> Next
nextForStream :: Bool
-> Int -> Bool -> Leftover -> IO (Maybe StreamingChunk) -> Next
nextForStream Bool
False Int
len Bool
reqflush Leftover
_          IO (Maybe StreamingChunk)
_     = Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
reqflush forall a. Maybe a
Nothing
nextForStream Bool
True  Int
len Bool
reqflush Leftover
leftOrZero IO (Maybe StreamingChunk)
takeQ =
    Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
reqflush forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Leftover -> IO (Maybe StreamingChunk) -> DynaNext
fillBufStream Leftover
leftOrZero IO (Maybe StreamingChunk)
takeQ)

----------------------------------------------------------------

fillBufFile :: PositionRead -> FileOffset -> ByteCount -> IO () -> DynaNext
fillBufFile :: PositionRead -> Int64 -> Int64 -> IO () -> DynaNext
fillBufFile PositionRead
pread Int64
start Int64
bytes IO ()
refresh Buffer
buf Int
siz Int
lim = do
    let room :: Int
room = forall a. Ord a => a -> a -> a
min Int
siz Int
lim
    Int64
len <- PositionRead
pread Int64
start (Int -> Int64 -> Int64
mini Int
room Int64
bytes) Buffer
buf
    IO ()
refresh
    let len' :: Int
len' = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> PositionRead -> Int64 -> Int64 -> IO () -> Next
nextForFile Int
len' PositionRead
pread (Int64
start forall a. Num a => a -> a -> a
+ Int64
len) (Int64
bytes forall a. Num a => a -> a -> a
- Int64
len) IO ()
refresh

nextForFile :: BytesFilled -> PositionRead -> FileOffset -> ByteCount -> IO () -> Next
nextForFile :: Int -> PositionRead -> Int64 -> Int64 -> IO () -> Next
nextForFile Int
0   PositionRead
_  Int64
_     Int64
_     IO ()
_       = Int -> Bool -> Maybe DynaNext -> Next
Next Int
0   Bool
True  forall a. Maybe a
Nothing -- let's flush
nextForFile Int
len PositionRead
_  Int64
_     Int64
0     IO ()
_       = Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
False forall a. Maybe a
Nothing
nextForFile Int
len PositionRead
pread Int64
start Int64
bytes IO ()
refresh =
    Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PositionRead -> Int64 -> Int64 -> IO () -> DynaNext
fillBufFile PositionRead
pread Int64
start Int64
bytes IO ()
refresh

{-# INLINE mini #-}
mini :: Int -> Int64 -> Int64
mini :: Int -> Int64 -> Int64
mini Int
i Int64
n
  | forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Ord a => a -> a -> Bool
< Int64
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
  | Bool
otherwise          = Int64
n