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

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

import Control.Concurrent.STM
import qualified Control.Exception as E
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder.Extra as B
import Foreign.Ptr (plusPtr)
import Network.ByteOrder

import Imports
import Network.HPACK (setLimitForEncoding, toHeaderTable)
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.Frame

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

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

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

{-# INLINE getStreamWindowSize #-}
getStreamWindowSize :: Stream -> IO WindowSize
getStreamWindowSize :: Stream -> IO Int
getStreamWindowSize Stream{TVar Int
streamWindow :: Stream -> TVar Int
streamWindow :: TVar Int
streamWindow} = forall a. TVar a -> IO a
readTVarIO TVar Int
streamWindow

{-# INLINE waitStreamWindowSize #-}
waitStreamWindowSize :: Stream -> IO ()
waitStreamWindowSize :: Stream -> IO ()
waitStreamWindowSize Stream{TVar Int
streamWindow :: TVar Int
streamWindow :: Stream -> TVar Int
streamWindow} = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
    Int
w <- forall a. TVar a -> STM a
readTVar TVar Int
streamWindow
    Bool -> STM ()
check (Int
w forall a. Ord a => a -> a -> Bool
> Int
0)

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

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

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,TVar Int
connectionWindow :: Context -> TVar Int
connectionWindow :: TVar Int
connectionWindow,DynamicTable
encodeDynamicTable :: Context -> DynamicTable
encodeDynamicTable :: DynamicTable
encodeDynamicTable}
            Config{Int
Buffer
Manager
Int -> IO ByteString
PositionReadMaker
ByteString -> IO ()
confTimeoutManager :: Config -> Manager
confPositionReadMaker :: Config -> PositionReadMaker
confReadN :: Config -> Int -> IO ByteString
confSendAll :: Config -> ByteString -> IO ()
confBufferSize :: Config -> Int
confWriteBuffer :: Config -> Buffer
confTimeoutManager :: Manager
confPositionReadMaker :: PositionReadMaker
confReadN :: Int -> IO ByteString
confSendAll :: ByteString -> IO ()
confBufferSize :: Int
confWriteBuffer :: Buffer
..}
            Manager
mgr = Int -> IO ()
loop Int
0 forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` SomeException -> IO ()
ignore
  where
    dequeue :: a -> STM Switch
dequeue a
off = do
        Bool
isEmpty <- forall a. TQueue a -> STM Bool
isEmptyTQueue TQueue Control
controlQ
        if Bool
isEmpty then do
            Int
w <- forall a. TVar a -> STM a
readTVar TVar Int
connectionWindow
            Bool -> STM ()
check (Int
w forall a. Ord a => a -> a -> Bool
> Int
0)
            Bool
emp <- forall a. TQueue a -> STM Bool
isEmptyTQueue TQueue (Output Stream)
outputQ
            if Bool
emp then
                if a
off forall a. Eq a => a -> a -> Bool
/= a
0 then forall (m :: * -> *) a. Monad m => a -> m a
return Switch
Flush else forall a. STM a
retry
              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

    hardLimit :: Int
hardLimit = Int
confBufferSize forall a. Num a => a -> a -> a
- Int
512

    loop :: Int -> IO ()
loop Int
off = do
        Switch
x <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall {a}. (Eq a, Num a) => a -> STM Switch
dequeue Int
off
        case Switch
x of
            C Control
ctl -> do
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
off forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$ Int -> IO ()
flushN Int
off
                Int
off' <- Control -> Int -> IO Int
control Control
ctl Int
off
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
off' forall a. Ord a => a -> a -> Bool
>= Int
0) forall a b. (a -> b) -> a -> b
$ Int -> IO ()
loop Int
off'
            O Output Stream
out -> do
                Int
off' <- Output Stream -> Int -> IO Int
outputOrEnqueueAgain Output Stream
out Int
off
                case Int
off' of
                    Int
0                    -> Int -> IO ()
loop Int
0
                    Int
_ | Int
off' forall a. Ord a => a -> a -> Bool
> Int
hardLimit -> Int -> IO ()
flushN Int
off' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
loop Int
0
                      | Bool
otherwise        -> Int -> IO ()
loop Int
off'
            Switch
Flush -> Int -> IO ()
flushN Int
off forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
loop Int
0

    control :: Control -> Int -> IO Int
control Control
CFinish         Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
    control (CGoaway ByteString
frame) Int
_ = ByteString -> IO ()
confSendAll ByteString
frame forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
    control (CFrame ByteString
frame)  Int
_ = ByteString -> IO ()
confSendAll ByteString
frame forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
    control (CSettings ByteString
frame SettingsList
alist) Int
_ = do
        ByteString -> IO ()
confSendAll ByteString
frame
        SettingsList -> IO ()
setLimit SettingsList
alist
        forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
    control (CSettings0 ByteString
frame1 ByteString
frame2 SettingsList
alist) Int
off = do -- off == 0, just in case
        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
+ ByteString -> Int
BS.length ByteString
frame1 forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
frame2
        Buffer
buf' <- Buffer -> ByteString -> IO Buffer
copy forall {b}. Ptr b
buf ByteString
frame1
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Buffer -> ByteString -> IO Buffer
copy Buffer
buf' ByteString
frame2
        SettingsList -> IO ()
setLimit SettingsList
alist
        forall (m :: * -> *) a. Monad m => a -> m a
return Int
off'

    {-# INLINE setLimit #-}
    setLimit :: SettingsList -> IO ()
setLimit SettingsList
alist = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup SettingsKeyId
SettingsHeaderTableSize SettingsList
alist 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 -> 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
        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
confBufferSize forall a. Num a => a -> a -> a
- Int
payloadOff
        Next Int
datPayloadLen 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
        forall {a}.
Stream
-> Int
-> Int
-> Maybe DynaNext
-> TrailersMaker
-> IO a
-> Output Stream
-> IO Int
fillDataHeaderEnqueueNext Stream
strm Int
off0 Int
datPayloadLen Maybe DynaNext
mnext TrailersMaker
tlrmkr' IO ()
sentinel Output Stream
out

    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
kvlen <- Int -> TokenHeaderList -> Bool -> Int -> IO Int
headerContinue Int
sid TokenHeaderList
ths Bool
endOfStream Int
off0
        Int
off <- Int -> IO Int
sendHeadersIfNecessary 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
kvlen
        case OutBody
body of
            OutBody
OutBodyNone -> do
                -- halfClosedLocal calls closed which removes
                -- the stream from stream table.
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Context -> Bool
isServer Context
ctx) forall a b. (a -> b) -> a -> b
$ Context -> Stream -> ClosedCode -> IO ()
halfClosedLocal Context
ctx Stream
strm ClosedCode
Finished
                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 ()
_ -> do
                let tbq :: TBQueue StreamingChunk
tbq = forall a. HasCallStack => Maybe a -> a
fromJust Maybe (TBQueue StreamingChunk)
mtbq
                    takeQ :: IO (Maybe StreamingChunk)
takeQ = forall a. STM a -> IO 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
                    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

    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 <- forall {a}.
Integral a =>
Int -> a -> TokenHeaderList -> Int -> IO Int
pushPromise Int
pid Int
sid TokenHeaderList
ths Int
off0
        Int
off <- Int -> IO Int
sendHeadersIfNecessary 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

    outputOrEnqueueAgain :: Output Stream -> Int -> IO Int
    outputOrEnqueueAgain :: Output Stream -> Int -> IO Int
outputOrEnqueueAgain out :: Output Stream
out@(Output Stream
strm OutObj
_ OutputType
otyp Maybe (TBQueue StreamingChunk)
_ IO ()
_) Int
off = forall e a. Exception e => (e -> IO a) -> IO a -> IO 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 a. STM a -> IO 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 <- forall a. TVar a -> IO a
readTVarIO TVar Int
connectionWindow -- 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 :: ByteString
rst = ErrorCodeId -> Int -> ByteString
resetFrame ErrorCodeId
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
$ ByteString -> Control
CFrame ByteString
rst
            forall (m :: * -> *) a. Monad m => a -> m a
return Int
off

    {-# INLINE flushN #-}
    -- Flush the connection buffer to the socket, where the first 'n' bytes of
    -- the buffer are filled.
    flushN :: Int -> IO ()
    flushN :: Int -> IO ()
flushN Int
n = forall a. Buffer -> Int -> (ByteString -> IO a) -> IO a
bufferIO Buffer
confWriteBuffer Int
n ByteString -> IO ()
confSendAll

    headerContinue :: Int -> TokenHeaderList -> Bool -> Int -> IO Int
headerContinue Int
sid TokenHeaderList
ths Bool
endOfStream Int
off = do
        let offkv :: Int
offkv = Int
off forall a. Num a => a -> a -> a
+ Int
frameHeaderLength
        let 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
hs,Int
kvlen) <- Context
-> Buffer -> Int -> TokenHeaderList -> IO (TokenHeaderList, Int)
hpackEncodeHeader Context
ctx forall {b}. Ptr b
bufkv Int
limkv TokenHeaderList
ths
        let flag0 :: FrameFlags
flag0 = case TokenHeaderList
hs of
                [] -> FrameFlags -> FrameFlags
setEndHeader FrameFlags
defaultFlags
                TokenHeaderList
_  -> FrameFlags
defaultFlags
            flag :: FrameFlags
flag = if Bool
endOfStream then FrameFlags -> FrameFlags
setEndStream FrameFlags
flag0 else FrameFlags
flag0
        let buf :: Ptr b
buf = Buffer
confWriteBuffer forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
        FrameTypeId -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameTypeId
FrameHeaders Int
kvlen Int
sid FrameFlags
flag forall {b}. Ptr b
buf
        Int -> Int -> TokenHeaderList -> IO Int
continue Int
sid Int
kvlen TokenHeaderList
hs

    bufHeaderPayload :: Ptr b
bufHeaderPayload = Buffer
confWriteBuffer forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
frameHeaderLength
    headerPayloadLim :: Int
headerPayloadLim = Int
confBufferSize forall a. Num a => a -> a -> a
- Int
frameHeaderLength

    continue :: Int -> Int -> TokenHeaderList -> IO Int
continue Int
_   Int
kvlen [] = forall (m :: * -> *) a. Monad m => a -> m a
return Int
kvlen
    continue Int
sid Int
kvlen TokenHeaderList
ths = do
        Int -> IO ()
flushN forall a b. (a -> b) -> a -> b
$ Int
kvlen forall a. Num a => a -> a -> a
+ Int
frameHeaderLength
        -- Now off is 0
        (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 e a. Exception e => e -> IO a
E.throwIO forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
CompressionError ByteString
"cannot compress the header"
        let flag :: FrameFlags
flag = case TokenHeaderList
ths' of
                [] -> FrameFlags -> FrameFlags
setEndHeader FrameFlags
defaultFlags
                TokenHeaderList
_  -> FrameFlags
defaultFlags
        FrameTypeId -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameTypeId
FrameContinuation Int
kvlen' Int
sid FrameFlags
flag Buffer
confWriteBuffer
        Int -> Int -> TokenHeaderList -> IO Int
continue Int
sid Int
kvlen' TokenHeaderList
ths'

    {-# INLINE sendHeadersIfNecessary #-}
    -- Send headers if there is not room for a 1-byte data frame, and return
    -- the offset of the next frame's first header byte.
    sendHeadersIfNecessary :: Int -> IO Int
sendHeadersIfNecessary Int
off
      -- True if the connection buffer has room for a 1-byte data frame.
      | Int
off forall a. Num a => a -> a -> a
+ Int
frameHeaderLength forall a. Ord a => a -> a -> Bool
< Int
confBufferSize = forall (m :: * -> *) a. Monad m => a -> m a
return Int
off
      | Bool
otherwise = do
          Int -> IO ()
flushN Int
off
          forall (m :: * -> *) a. Monad m => a -> m a
return Int
0

    fillDataHeaderEnqueueNext :: Stream
-> Int
-> Int
-> Maybe DynaNext
-> TrailersMaker
-> IO a
-> Output Stream
-> IO Int
fillDataHeaderEnqueueNext strm :: Stream
strm@Stream{TVar Int
streamWindow :: TVar Int
streamWindow :: Stream -> TVar Int
streamWindow,Int
streamNumber :: Int
streamNumber :: Stream -> Int
streamNumber}
                   Int
off Int
datPayloadLen Maybe DynaNext
Nothing TrailersMaker
tlrmkr IO a
tell Output Stream
_ = 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)
        FrameTypeId -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameTypeId
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 a
tell
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Context -> Bool
isServer Context
ctx) forall a b. (a -> b) -> a -> b
$ Context -> Stream -> ClosedCode -> IO ()
halfClosedLocal Context
ctx Stream
strm ClosedCode
Finished
        forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
connectionWindow (forall a. Num a => a -> a -> a
subtract Int
datPayloadLen)
        forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
streamWindow (forall a. Num a => a -> a -> a
subtract Int
datPayloadLen)
        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
kvlen <- Int -> TokenHeaderList -> Bool -> Int -> IO Int
headerContinue Int
streamNumber TokenHeaderList
ths Bool
True Int
off0
            Int -> IO Int
sendHeadersIfNecessary 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
kvlen

    fillDataHeaderEnqueueNext Stream
_
                   Int
off Int
0 (Just DynaNext
next) TrailersMaker
tlrmkr IO a
_ Output Stream
out = 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'
        forall (m :: * -> *) a. Monad m => a -> m a
return Int
off

    fillDataHeaderEnqueueNext Stream{TVar Int
streamWindow :: TVar Int
streamWindow :: Stream -> TVar Int
streamWindow,Int
streamNumber :: Int
streamNumber :: Stream -> Int
streamNumber}
                   Int
off Int
datPayloadLen (Just DynaNext
next) TrailersMaker
tlrmkr IO a
_ Output Stream
out = 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
        FrameTypeId -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameTypeId
FrameData Int
datPayloadLen Int
streamNumber FrameFlags
flag forall {b}. Ptr b
buf
        forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
connectionWindow (forall a. Num a => a -> a -> a
subtract Int
datPayloadLen)
        forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
streamWindow (forall a. Num a => a -> a -> a
subtract 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'
        forall (m :: * -> *) a. Monad m => a -> m a
return Int
off'

    pushPromise :: Int -> a -> TokenHeaderList -> Int -> IO Int
pushPromise Int
pid a
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 a
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
        FrameTypeId -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameTypeId
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 :: FrameTypeId -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameTypeId
ftyp Int
len Int
sid FrameFlags
flag Buffer
buf = FrameTypeId -> FrameHeader -> Buffer -> IO ()
encodeFrameHeaderBuf FrameTypeId
ftyp FrameHeader
hinfo Buffer
buf
      where
        hinfo :: FrameHeader
hinfo = Int -> FrameFlags -> Int -> FrameHeader
FrameHeader Int
len FrameFlags
flag Int
sid

    {-# INLINE ignore #-}
    ignore :: E.SomeException -> IO ()
    ignore :: SomeException -> IO ()
ignore SomeException
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | 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 -> (ByteString -> IO a) -> IO a
bufferIO Buffer
buf Int
siz forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> TrailersMaker
tlrmkr (forall a. a -> Maybe a
Just ByteString
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
    (Leftover
leftover, Bool
cont, Int
len) <- Buffer
-> Int -> IO (Maybe StreamingChunk) -> IO (Leftover, Bool, Int)
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
$ IO (Maybe StreamingChunk) -> Leftover -> Bool -> Int -> Next
nextForStream IO (Maybe StreamingChunk)
takeQ Leftover
leftover Bool
cont Int
len

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

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 ByteString
bs BufferWriter
writer
          | ByteString -> Int
BS.length ByteString
bs forall a. Ord a => a -> a -> Bool
<= Int
room -> do
              Buffer
buf1 <- Buffer -> ByteString -> IO Buffer
copy Buffer
buf0 ByteString
bs
              let len1 :: Int
len1 = ByteString -> Int
BS.length ByteString
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 (ByteString
bs1,ByteString
bs2) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
room ByteString
bs
              forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Buffer -> ByteString -> IO Buffer
copy Buffer
buf0 ByteString
bs1
              forall {m :: * -> *}. Monad m => Int -> Next -> m Next
getNext Int
room (ByteString -> BufferWriter -> Next
B.Chunk ByteString
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 -> Maybe DynaNext -> Next
Next Int
len forall a. Maybe a
Nothing
nextForBuilder Int
len (B.More Int
_ BufferWriter
writer)
    = Int -> Maybe DynaNext -> Next
Next Int
len 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 ByteString
bs BufferWriter
writer)
    = Int -> Maybe DynaNext -> Next
Next Int
len forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Leftover -> DynaNext
fillBufBuilder (ByteString -> BufferWriter -> Leftover
LTwo ByteString
bs BufferWriter
writer))

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

runStreamBuilder :: Buffer -> BufferSize -> IO (Maybe StreamingChunk)
                 -> IO (Leftover, Bool, BytesFilled)
runStreamBuilder :: Buffer
-> Int -> IO (Maybe StreamingChunk) -> IO (Leftover, Bool, Int)
runStreamBuilder Buffer
buf0 Int
room0 IO (Maybe StreamingChunk)
takeQ = Buffer -> Int -> Int -> IO (Leftover, Bool, Int)
loop Buffer
buf0 Int
room0 Int
0
  where
    loop :: Buffer -> Int -> Int -> IO (Leftover, Bool, Int)
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 (Leftover
LZero, Bool
True, Int
total)
            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 (Leftover, Bool, Int)
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 (BufferWriter -> Leftover
LOne BufferWriter
writer, Bool
True, Int
total')
                    B.Chunk ByteString
bs BufferWriter
writer -> forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> BufferWriter -> Leftover
LTwo ByteString
bs BufferWriter
writer, Bool
True, Int
total')
            Just StreamingChunk
StreamingFlush       -> forall (m :: * -> *) a. Monad m => a -> m a
return (Leftover
LZero, Bool
True, Int
total)
            Just StreamingChunk
StreamingFinished    -> forall (m :: * -> *) a. Monad m => a -> m a
return (Leftover
LZero, Bool
False, Int
total)

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
            (Leftover
leftover, Bool
cont, Int
len) <- Buffer
-> Int -> IO (Maybe StreamingChunk) -> IO (Leftover, Bool, Int)
runStreamBuilder Buffer
buf0 Int
room0 IO (Maybe StreamingChunk)
takeQ
            forall {m :: * -> *}. Monad m => Leftover -> Bool -> Int -> m Next
getNext Leftover
leftover Bool
cont Int
len
        LOne BufferWriter
writer -> forall {a}.
(Ptr a -> Int -> IO (Int, Next)) -> Ptr a -> Int -> Int -> IO Next
write BufferWriter
writer Buffer
buf0 Int
room0 Int
0
        LTwo ByteString
bs BufferWriter
writer
          | ByteString -> Int
BS.length ByteString
bs forall a. Ord a => a -> a -> Bool
<= Int
room0 -> do
              Buffer
buf1 <- Buffer -> ByteString -> IO Buffer
copy Buffer
buf0 ByteString
bs
              let len :: Int
len = ByteString -> Int
BS.length ByteString
bs
              forall {a}.
(Ptr a -> Int -> IO (Int, Next)) -> Ptr a -> Int -> Int -> IO Next
write BufferWriter
writer Buffer
buf1 (Int
room0 forall a. Num a => a -> a -> a
- Int
len) Int
len
          | Bool
otherwise -> do
              let (ByteString
bs1,ByteString
bs2) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
room0 ByteString
bs
              forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Buffer -> ByteString -> IO Buffer
copy Buffer
buf0 ByteString
bs1
              forall {m :: * -> *}. Monad m => Leftover -> Bool -> Int -> m Next
getNext (ByteString -> BufferWriter -> Leftover
LTwo ByteString
bs2 BufferWriter
writer) Bool
True Int
room0
  where
    getNext :: Leftover -> Bool -> Int -> m Next
getNext Leftover
l Bool
b Int
r = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ IO (Maybe StreamingChunk) -> Leftover -> Bool -> Int -> Next
nextForStream IO (Maybe StreamingChunk)
takeQ Leftover
l Bool
b Int
r
    write :: (Ptr a -> Int -> IO (Int, Next)) -> Ptr a -> Int -> Int -> IO Next
write Ptr a -> Int -> IO (Int, Next)
writer1 Ptr a
buf Int
room Int
sofar = do
        (Int
len, Next
signal) <- Ptr a -> Int -> IO (Int, Next)
writer1 Ptr a
buf Int
room
        case Next
signal of
            Next
B.Done -> do
                (Leftover
leftover, Bool
cont, Int
extra) <- Buffer
-> Int -> IO (Maybe StreamingChunk) -> IO (Leftover, Bool, Int)
runStreamBuilder (Ptr a
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
                forall {m :: * -> *}. Monad m => Leftover -> Bool -> Int -> m Next
getNext Leftover
leftover Bool
cont Int
total
            B.More  Int
_ BufferWriter
writer -> do
                let total :: Int
total = Int
sofar forall a. Num a => a -> a -> a
+ Int
len
                forall {m :: * -> *}. Monad m => Leftover -> Bool -> Int -> m Next
getNext (BufferWriter -> Leftover
LOne BufferWriter
writer) Bool
True Int
total
            B.Chunk ByteString
bs BufferWriter
writer -> do
                let total :: Int
total = Int
sofar forall a. Num a => a -> a -> a
+ Int
len
                forall {m :: * -> *}. Monad m => Leftover -> Bool -> Int -> m Next
getNext (ByteString -> BufferWriter -> Leftover
LTwo ByteString
bs BufferWriter
writer) Bool
True Int
total

nextForStream :: IO (Maybe StreamingChunk)
              -> Leftover -> Bool -> BytesFilled
              -> Next
nextForStream :: IO (Maybe StreamingChunk) -> Leftover -> Bool -> Int -> Next
nextForStream IO (Maybe StreamingChunk)
_ Leftover
_ Bool
False Int
len = Int -> Maybe DynaNext -> Next
Next Int
len forall a. Maybe a
Nothing
nextForStream IO (Maybe StreamingChunk)
takeQ Leftover
leftOrZero Bool
True Int
len =
    Int -> Maybe DynaNext -> Next
Next Int
len 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 -> Maybe DynaNext -> Next
Next Int
0   forall a. Maybe a
Nothing
nextForFile Int
len PositionRead
_  Int64
_     Int64
0     IO ()
_       = Int -> Maybe DynaNext -> Next
Next Int
len forall a. Maybe a
Nothing
nextForFile Int
len PositionRead
pread Int64
start Int64
bytes IO ()
refresh =
    Int -> Maybe DynaNext -> Next
Next Int
len forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (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