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

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

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 qualified UnliftIO.Exception as E
import UnliftIO.STM

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 (m :: * -> *) a. MonadIO m => TVar a -> m 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 (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
    Int
w <- forall a. TVar a -> STM a
readTVar TVar Int
streamWindow
    Bool -> STM ()
checkSTM (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 (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

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
  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 ()
checkSTM (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
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

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

    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
$ 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 SettingsKey
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 (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
                    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 (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 <- forall (m :: * -> *) a. MonadIO m => TVar a -> m 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 = ErrorCode -> Int -> ByteString
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
$ 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
        FrameType -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameType
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 (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 = case TokenHeaderList
ths' of
                [] -> FrameFlags -> FrameFlags
setEndHeader FrameFlags
defaultFlags
                TokenHeaderList
_  -> FrameFlags
defaultFlags
        FrameType -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameType
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)
        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 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 (m :: * -> *) a. MonadIO m => STM a -> m 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 (m :: * -> *) a. MonadIO m => STM a -> m 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
        FrameType -> Int -> Int -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameType
FrameData Int
datPayloadLen Int
streamNumber FrameFlags
flag forall {b}. Ptr b
buf
        forall (m :: * -> *) a. MonadIO m => STM a -> m 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 (m :: * -> *) a. MonadIO m => STM a -> m 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
        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 -> 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 = Int -> FrameFlags -> Int -> FrameHeader
FrameHeader Int
len FrameFlags
flag 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 -> (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