{-# 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 WindowSize
getStreamWindowSize Stream{TVar WindowSize
streamWindow :: Stream -> TVar WindowSize
streamWindow :: TVar WindowSize
streamWindow} = TVar WindowSize -> IO WindowSize
forall a. TVar a -> IO a
readTVarIO TVar WindowSize
streamWindow
{-# INLINE waitStreamWindowSize #-}
waitStreamWindowSize :: Stream -> IO ()
waitStreamWindowSize :: Stream -> IO ()
waitStreamWindowSize Stream{TVar WindowSize
streamWindow :: TVar WindowSize
streamWindow :: Stream -> TVar WindowSize
streamWindow} = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
WindowSize
w <- TVar WindowSize -> STM WindowSize
forall a. TVar a -> STM a
readTVar TVar WindowSize
streamWindow
Bool -> STM ()
check (WindowSize
w WindowSize -> WindowSize -> Bool
forall a. Ord a => a -> a -> Bool
> WindowSize
0)
{-# INLINE waitStreaming #-}
waitStreaming :: TBQueue a -> IO ()
waitStreaming :: TBQueue a -> IO ()
waitStreaming TBQueue a
tbq = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool
isEmpty <- TBQueue a -> STM Bool
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 WindowSize
connectionWindow :: Context -> TVar WindowSize
connectionWindow :: TVar WindowSize
connectionWindow,DynamicTable
encodeDynamicTable :: Context -> DynamicTable
encodeDynamicTable :: DynamicTable
encodeDynamicTable}
Config{WindowSize
Buffer
Manager
WindowSize -> IO ByteString
PositionReadMaker
ByteString -> IO ()
confTimeoutManager :: Config -> Manager
confPositionReadMaker :: Config -> PositionReadMaker
confReadN :: Config -> WindowSize -> IO ByteString
confSendAll :: Config -> ByteString -> IO ()
confBufferSize :: Config -> WindowSize
confWriteBuffer :: Config -> Buffer
confTimeoutManager :: Manager
confPositionReadMaker :: PositionReadMaker
confReadN :: WindowSize -> IO ByteString
confSendAll :: ByteString -> IO ()
confBufferSize :: WindowSize
confWriteBuffer :: Buffer
..}
Manager
mgr = WindowSize -> IO ()
loop WindowSize
0 IO () -> (SomeException -> IO ()) -> IO ()
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 <- TQueue Control -> STM Bool
forall a. TQueue a -> STM Bool
isEmptyTQueue TQueue Control
controlQ
if Bool
isEmpty then do
WindowSize
w <- TVar WindowSize -> STM WindowSize
forall a. TVar a -> STM a
readTVar TVar WindowSize
connectionWindow
Bool -> STM ()
check (WindowSize
w WindowSize -> WindowSize -> Bool
forall a. Ord a => a -> a -> Bool
> WindowSize
0)
Bool
emp <- TQueue (Output Stream) -> STM Bool
forall a. TQueue a -> STM Bool
isEmptyTQueue TQueue (Output Stream)
outputQ
if Bool
emp then
if a
off a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 then Switch -> STM Switch
forall (m :: * -> *) a. Monad m => a -> m a
return Switch
Flush else STM Switch
forall a. STM a
retry
else
Output Stream -> Switch
O (Output Stream -> Switch) -> STM (Output Stream) -> STM Switch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TQueue (Output Stream) -> STM (Output Stream)
forall a. TQueue a -> STM a
readTQueue TQueue (Output Stream)
outputQ
else
Control -> Switch
C (Control -> Switch) -> STM Control -> STM Switch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TQueue Control -> STM Control
forall a. TQueue a -> STM a
readTQueue TQueue Control
controlQ
hardLimit :: WindowSize
hardLimit = WindowSize
confBufferSize WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
- WindowSize
512
loop :: WindowSize -> IO ()
loop WindowSize
off = do
Switch
x <- STM Switch -> IO Switch
forall a. STM a -> IO a
atomically (STM Switch -> IO Switch) -> STM Switch -> IO Switch
forall a b. (a -> b) -> a -> b
$ WindowSize -> STM Switch
forall a. (Eq a, Num a) => a -> STM Switch
dequeue WindowSize
off
case Switch
x of
C Control
ctl -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WindowSize
off WindowSize -> WindowSize -> Bool
forall a. Eq a => a -> a -> Bool
/= WindowSize
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ WindowSize -> IO ()
flushN WindowSize
off
WindowSize
off' <- Control -> WindowSize -> IO WindowSize
control Control
ctl WindowSize
off
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WindowSize
off' WindowSize -> WindowSize -> Bool
forall a. Ord a => a -> a -> Bool
>= WindowSize
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ WindowSize -> IO ()
loop WindowSize
off'
O Output Stream
out -> do
WindowSize
off' <- Output Stream -> WindowSize -> IO WindowSize
outputOrEnqueueAgain Output Stream
out WindowSize
off
case WindowSize
off' of
WindowSize
0 -> WindowSize -> IO ()
loop WindowSize
0
WindowSize
_ | WindowSize
off' WindowSize -> WindowSize -> Bool
forall a. Ord a => a -> a -> Bool
> WindowSize
hardLimit -> WindowSize -> IO ()
flushN WindowSize
off' IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WindowSize -> IO ()
loop WindowSize
0
| Bool
otherwise -> WindowSize -> IO ()
loop WindowSize
off'
Switch
Flush -> WindowSize -> IO ()
flushN WindowSize
off IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WindowSize -> IO ()
loop WindowSize
0
control :: Control -> WindowSize -> IO WindowSize
control Control
CFinish WindowSize
_ = WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return (-WindowSize
1)
control (CGoaway ByteString
frame) WindowSize
_ = ByteString -> IO ()
confSendAll ByteString
frame IO () -> IO WindowSize -> IO WindowSize
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return (-WindowSize
1)
control (CFrame ByteString
frame) WindowSize
_ = ByteString -> IO ()
confSendAll ByteString
frame IO () -> IO WindowSize -> IO WindowSize
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
0
control (CSettings ByteString
frame SettingsList
alist) WindowSize
_ = do
ByteString -> IO ()
confSendAll ByteString
frame
SettingsList -> IO ()
setLimit SettingsList
alist
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
0
control (CSettings0 ByteString
frame1 ByteString
frame2 SettingsList
alist) WindowSize
off = do
let buf :: Ptr b
buf = Buffer
confWriteBuffer Buffer -> WindowSize -> Ptr b
forall a b. Ptr a -> WindowSize -> Ptr b
`plusPtr` WindowSize
off
off' :: WindowSize
off' = WindowSize
off WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ ByteString -> WindowSize
BS.length ByteString
frame1 WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ ByteString -> WindowSize
BS.length ByteString
frame2
Buffer
buf' <- Buffer -> ByteString -> IO Buffer
copy Buffer
forall b. Ptr b
buf ByteString
frame1
IO Buffer -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Buffer -> IO ()) -> IO Buffer -> IO ()
forall a b. (a -> b) -> a -> b
$ Buffer -> ByteString -> IO Buffer
copy Buffer
buf' ByteString
frame2
SettingsList -> IO ()
setLimit SettingsList
alist
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
off'
{-# INLINE setLimit #-}
setLimit :: SettingsList -> IO ()
setLimit SettingsList
alist = case SettingsKeyId -> SettingsList -> Maybe WindowSize
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup SettingsKeyId
SettingsHeaderTableSize SettingsList
alist of
Maybe WindowSize
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just WindowSize
siz -> WindowSize -> DynamicTable -> IO ()
setLimitForEncoding WindowSize
siz DynamicTable
encodeDynamicTable
output :: Output Stream -> WindowSize -> WindowSize -> IO WindowSize
output out :: Output Stream
out@(Output Stream
strm OutObj{} (ONext DynaNext
curr TrailersMaker
tlrmkr) Maybe (TBQueue StreamingChunk)
_ IO ()
sentinel) WindowSize
off0 WindowSize
lim = do
let payloadOff :: WindowSize
payloadOff = WindowSize
off0 WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
frameHeaderLength
datBuf :: Ptr b
datBuf = Buffer
confWriteBuffer Buffer -> WindowSize -> Ptr b
forall a b. Ptr a -> WindowSize -> Ptr b
`plusPtr` WindowSize
payloadOff
datBufSiz :: WindowSize
datBufSiz = WindowSize
confBufferSize WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
- WindowSize
payloadOff
Next WindowSize
datPayloadLen Maybe DynaNext
mnext <- DynaNext
curr Buffer
forall b. Ptr b
datBuf WindowSize
datBufSiz WindowSize
lim
NextTrailersMaker TrailersMaker
tlrmkr' <- TrailersMaker -> Buffer -> WindowSize -> IO NextTrailersMaker
runTrailersMaker TrailersMaker
tlrmkr Buffer
forall b. Ptr b
datBuf WindowSize
datPayloadLen
Stream
-> WindowSize
-> WindowSize
-> Maybe DynaNext
-> TrailersMaker
-> IO ()
-> Output Stream
-> IO WindowSize
forall a.
Stream
-> WindowSize
-> WindowSize
-> Maybe DynaNext
-> TrailersMaker
-> IO a
-> Output Stream
-> IO WindowSize
fillDataHeaderEnqueueNext Stream
strm WindowSize
off0 WindowSize
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 ()
_) WindowSize
off0 WindowSize
lim = do
let sid :: WindowSize
sid = Stream -> WindowSize
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 ([Header] -> IO (TokenHeaderList, ValueTable))
-> [Header] -> IO (TokenHeaderList, ValueTable)
forall a b. (a -> b) -> a -> b
$ [Header] -> [Header]
fixHeaders [Header]
hdr
WindowSize
kvlen <- WindowSize
-> TokenHeaderList -> Bool -> WindowSize -> IO WindowSize
headerContinue WindowSize
sid TokenHeaderList
ths Bool
endOfStream WindowSize
off0
WindowSize
off <- WindowSize -> IO WindowSize
sendHeadersIfNecessary (WindowSize -> IO WindowSize) -> WindowSize -> IO WindowSize
forall a b. (a -> b) -> a -> b
$ WindowSize
off0 WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
frameHeaderLength WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
kvlen
case OutBody
body of
OutBody
OutBodyNone -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Context -> Bool
isServer Context
ctx) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> Stream -> ClosedCode -> IO ()
halfClosedLocal Context
ctx Stream
strm ClosedCode
Finished
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
off
OutBodyFile (FileSpec FilePath
path FileOffset
fileoff FileOffset
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 -> IO () -> IO (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return IO ()
refresher
let next :: DynaNext
next = PositionRead -> FileOffset -> FileOffset -> IO () -> DynaNext
fillFileBodyGetNext PositionRead
pread FileOffset
fileoff FileOffset
bytecount IO ()
refresh
out' :: Output Stream
out' = Output Stream
out { outputType :: OutputType
outputType = DynaNext -> TrailersMaker -> OutputType
ONext DynaNext
next TrailersMaker
tlrmkr }
Output Stream -> WindowSize -> WindowSize -> IO WindowSize
output Output Stream
out' WindowSize
off WindowSize
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 -> WindowSize -> WindowSize -> IO WindowSize
output Output Stream
out' WindowSize
off WindowSize
lim
OutBodyStreaming (Builder -> IO ()) -> IO () -> IO ()
_ -> do
let tbq :: TBQueue StreamingChunk
tbq = Maybe (TBQueue StreamingChunk) -> TBQueue StreamingChunk
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (TBQueue StreamingChunk)
mtbq
takeQ :: IO (Maybe StreamingChunk)
takeQ = STM (Maybe StreamingChunk) -> IO (Maybe StreamingChunk)
forall a. STM a -> IO a
atomically (STM (Maybe StreamingChunk) -> IO (Maybe StreamingChunk))
-> STM (Maybe StreamingChunk) -> IO (Maybe StreamingChunk)
forall a b. (a -> b) -> a -> b
$ TBQueue StreamingChunk -> STM (Maybe StreamingChunk)
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 -> WindowSize -> WindowSize -> IO WindowSize
output Output Stream
out' WindowSize
off WindowSize
lim
output out :: Output Stream
out@(Output Stream
strm OutObj
_ (OPush TokenHeaderList
ths WindowSize
pid) Maybe (TBQueue StreamingChunk)
_ IO ()
_) WindowSize
off0 WindowSize
lim = do
let sid :: WindowSize
sid = Stream -> WindowSize
streamNumber Stream
strm
WindowSize
len <- WindowSize
-> WindowSize -> TokenHeaderList -> WindowSize -> IO WindowSize
forall a.
Integral a =>
WindowSize -> a -> TokenHeaderList -> WindowSize -> IO WindowSize
pushPromise WindowSize
pid WindowSize
sid TokenHeaderList
ths WindowSize
off0
WindowSize
off <- WindowSize -> IO WindowSize
sendHeadersIfNecessary (WindowSize -> IO WindowSize) -> WindowSize -> IO WindowSize
forall a b. (a -> b) -> a -> b
$ WindowSize
off0 WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
frameHeaderLength WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
len
Output Stream -> WindowSize -> WindowSize -> IO WindowSize
output Output Stream
out{outputType :: OutputType
outputType=OutputType
OObj} WindowSize
off WindowSize
lim
output Output Stream
_ WindowSize
_ WindowSize
_ = IO WindowSize
forall a. HasCallStack => a
undefined
outputOrEnqueueAgain :: Output Stream -> Int -> IO Int
outputOrEnqueueAgain :: Output Stream -> WindowSize -> IO WindowSize
outputOrEnqueueAgain out :: Output Stream
out@(Output Stream
strm OutObj
_ OutputType
otyp Maybe (TBQueue StreamingChunk)
_ IO ()
_) WindowSize
off = (SomeException -> IO WindowSize) -> IO WindowSize -> IO WindowSize
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle SomeException -> IO WindowSize
resetStream (IO WindowSize -> IO WindowSize) -> IO WindowSize -> IO WindowSize
forall a b. (a -> b) -> a -> b
$ do
StreamState
state <- Stream -> IO StreamState
readStreamState Stream
strm
if StreamState -> Bool
isHalfClosedLocal StreamState
state then
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
off
else case OutputType
otyp of
OWait IO ()
wait -> do
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
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
off
OutputType
_ -> case Maybe (TBQueue StreamingChunk)
mtbq of
Just TBQueue StreamingChunk
tbq -> TBQueue StreamingChunk -> IO WindowSize
forall a. TBQueue a -> IO WindowSize
checkStreaming TBQueue StreamingChunk
tbq
Maybe (TBQueue StreamingChunk)
_ -> IO WindowSize
checkStreamWindowSize
where
mtbq :: Maybe (TBQueue StreamingChunk)
mtbq = Output Stream -> Maybe (TBQueue StreamingChunk)
forall a. Output a -> Maybe (TBQueue StreamingChunk)
outputStrmQ Output Stream
out
checkStreaming :: TBQueue a -> IO WindowSize
checkStreaming TBQueue a
tbq = do
Bool
isEmpty <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TBQueue a -> STM Bool
forall a. TBQueue a -> STM Bool
isEmptyTBQueue TBQueue a
tbq
if Bool
isEmpty then do
IO ()
-> TQueue (Output Stream) -> Output Stream -> Manager -> IO ()
forkAndEnqueueWhenReady (TBQueue a -> IO ()
forall a. TBQueue a -> IO ()
waitStreaming TBQueue a
tbq) TQueue (Output Stream)
outputQ Output Stream
out Manager
mgr
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
off
else
IO WindowSize
checkStreamWindowSize
checkStreamWindowSize :: IO WindowSize
checkStreamWindowSize = do
WindowSize
sws <- Stream -> IO WindowSize
getStreamWindowSize Stream
strm
if WindowSize
sws WindowSize -> WindowSize -> Bool
forall a. Eq a => a -> a -> Bool
== WindowSize
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
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
off
else do
WindowSize
cws <- TVar WindowSize -> IO WindowSize
forall a. TVar a -> IO a
readTVarIO TVar WindowSize
connectionWindow
let lim :: WindowSize
lim = WindowSize -> WindowSize -> WindowSize
forall a. Ord a => a -> a -> a
min WindowSize
cws WindowSize
sws
Output Stream -> WindowSize -> WindowSize -> IO WindowSize
output Output Stream
out WindowSize
off WindowSize
lim
resetStream :: SomeException -> IO WindowSize
resetStream SomeException
e = do
Context -> Stream -> ClosedCode -> IO ()
closed Context
ctx Stream
strm (SomeException -> ClosedCode
ResetByMe SomeException
e)
let rst :: ByteString
rst = ErrorCodeId -> WindowSize -> ByteString
resetFrame ErrorCodeId
InternalError (WindowSize -> ByteString) -> WindowSize -> ByteString
forall a b. (a -> b) -> a -> b
$ Stream -> WindowSize
streamNumber Stream
strm
TQueue Control -> Control -> IO ()
enqueueControl TQueue Control
controlQ (Control -> IO ()) -> Control -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Control
CFrame ByteString
rst
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
off
{-# INLINE flushN #-}
flushN :: Int -> IO ()
flushN :: WindowSize -> IO ()
flushN WindowSize
n = Buffer -> WindowSize -> (ByteString -> IO ()) -> IO ()
forall a. Buffer -> WindowSize -> (ByteString -> IO a) -> IO a
bufferIO Buffer
confWriteBuffer WindowSize
n ByteString -> IO ()
confSendAll
headerContinue :: WindowSize
-> TokenHeaderList -> Bool -> WindowSize -> IO WindowSize
headerContinue WindowSize
sid TokenHeaderList
ths Bool
endOfStream WindowSize
off = do
let offkv :: WindowSize
offkv = WindowSize
off WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
frameHeaderLength
let bufkv :: Ptr b
bufkv = Buffer
confWriteBuffer Buffer -> WindowSize -> Ptr b
forall a b. Ptr a -> WindowSize -> Ptr b
`plusPtr` WindowSize
offkv
limkv :: WindowSize
limkv = WindowSize
confBufferSize WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
- WindowSize
offkv
(TokenHeaderList
hs,WindowSize
kvlen) <- Context
-> Buffer
-> WindowSize
-> TokenHeaderList
-> IO (TokenHeaderList, WindowSize)
hpackEncodeHeader Context
ctx Buffer
forall b. Ptr b
bufkv WindowSize
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 Buffer -> WindowSize -> Ptr b
forall a b. Ptr a -> WindowSize -> Ptr b
`plusPtr` WindowSize
off
FrameTypeId
-> WindowSize -> WindowSize -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameTypeId
FrameHeaders WindowSize
kvlen WindowSize
sid FrameFlags
flag Buffer
forall b. Ptr b
buf
WindowSize -> WindowSize -> TokenHeaderList -> IO WindowSize
continue WindowSize
sid WindowSize
kvlen TokenHeaderList
hs
bufHeaderPayload :: Ptr b
bufHeaderPayload = Buffer
confWriteBuffer Buffer -> WindowSize -> Ptr b
forall a b. Ptr a -> WindowSize -> Ptr b
`plusPtr` WindowSize
frameHeaderLength
headerPayloadLim :: WindowSize
headerPayloadLim = WindowSize
confBufferSize WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
- WindowSize
frameHeaderLength
continue :: WindowSize -> WindowSize -> TokenHeaderList -> IO WindowSize
continue WindowSize
_ WindowSize
kvlen [] = WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
kvlen
continue WindowSize
sid WindowSize
kvlen TokenHeaderList
ths = do
WindowSize -> IO ()
flushN (WindowSize -> IO ()) -> WindowSize -> IO ()
forall a b. (a -> b) -> a -> b
$ WindowSize
kvlen WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
frameHeaderLength
(TokenHeaderList
ths', WindowSize
kvlen') <- Context
-> Buffer
-> WindowSize
-> TokenHeaderList
-> IO (TokenHeaderList, WindowSize)
hpackEncodeHeaderLoop Context
ctx Buffer
forall b. Ptr b
bufHeaderPayload WindowSize
headerPayloadLim TokenHeaderList
ths
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TokenHeaderList
ths TokenHeaderList -> TokenHeaderList -> Bool
forall a. Eq a => a -> a -> Bool
== TokenHeaderList
ths') (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HTTP2Error -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO (HTTP2Error -> IO ()) -> HTTP2Error -> IO ()
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
-> WindowSize -> WindowSize -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameTypeId
FrameContinuation WindowSize
kvlen' WindowSize
sid FrameFlags
flag Buffer
confWriteBuffer
WindowSize -> WindowSize -> TokenHeaderList -> IO WindowSize
continue WindowSize
sid WindowSize
kvlen' TokenHeaderList
ths'
{-# INLINE sendHeadersIfNecessary #-}
sendHeadersIfNecessary :: WindowSize -> IO WindowSize
sendHeadersIfNecessary WindowSize
off
| WindowSize
off WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
frameHeaderLength WindowSize -> WindowSize -> Bool
forall a. Ord a => a -> a -> Bool
< WindowSize
confBufferSize = WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
off
| Bool
otherwise = do
WindowSize -> IO ()
flushN WindowSize
off
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
0
fillDataHeaderEnqueueNext :: Stream
-> WindowSize
-> WindowSize
-> Maybe DynaNext
-> TrailersMaker
-> IO a
-> Output Stream
-> IO WindowSize
fillDataHeaderEnqueueNext strm :: Stream
strm@Stream{TVar WindowSize
streamWindow :: TVar WindowSize
streamWindow :: Stream -> TVar WindowSize
streamWindow,WindowSize
streamNumber :: WindowSize
streamNumber :: Stream -> WindowSize
streamNumber}
WindowSize
off WindowSize
datPayloadLen Maybe DynaNext
Nothing TrailersMaker
tlrmkr IO a
tell Output Stream
_ = do
let buf :: Ptr b
buf = Buffer
confWriteBuffer Buffer -> WindowSize -> Ptr b
forall a b. Ptr a -> WindowSize -> Ptr b
`plusPtr` WindowSize
off
off' :: WindowSize
off' = WindowSize
off WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
frameHeaderLength WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
datPayloadLen
(Maybe [Header]
mtrailers, FrameFlags
flag) <- do
Trailers [Header]
trailers <- TrailersMaker
tlrmkr Maybe ByteString
forall a. Maybe a
Nothing
if [Header] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Header]
trailers then
(Maybe [Header], FrameFlags) -> IO (Maybe [Header], FrameFlags)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Header]
forall a. Maybe a
Nothing, FrameFlags -> FrameFlags
setEndStream FrameFlags
defaultFlags)
else
(Maybe [Header], FrameFlags) -> IO (Maybe [Header], FrameFlags)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Header] -> Maybe [Header]
forall a. a -> Maybe a
Just [Header]
trailers, FrameFlags
defaultFlags)
FrameTypeId
-> WindowSize -> WindowSize -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameTypeId
FrameData WindowSize
datPayloadLen WindowSize
streamNumber FrameFlags
flag Buffer
forall b. Ptr b
buf
WindowSize
off'' <- Maybe [Header] -> WindowSize -> IO WindowSize
handleTrailers Maybe [Header]
mtrailers WindowSize
off'
IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO a
tell
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Context -> Bool
isServer Context
ctx) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> Stream -> ClosedCode -> IO ()
halfClosedLocal Context
ctx Stream
strm ClosedCode
Finished
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar WindowSize -> (WindowSize -> WindowSize) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar WindowSize
connectionWindow (WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
subtract WindowSize
datPayloadLen)
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar WindowSize -> (WindowSize -> WindowSize) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar WindowSize
streamWindow (WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
subtract WindowSize
datPayloadLen)
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
off''
where
handleTrailers :: Maybe [Header] -> WindowSize -> IO WindowSize
handleTrailers Maybe [Header]
Nothing WindowSize
off0 = WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
off0
handleTrailers (Just [Header]
trailers) WindowSize
off0 = do
(TokenHeaderList
ths,ValueTable
_) <- [Header] -> IO (TokenHeaderList, ValueTable)
toHeaderTable [Header]
trailers
WindowSize
kvlen <- WindowSize
-> TokenHeaderList -> Bool -> WindowSize -> IO WindowSize
headerContinue WindowSize
streamNumber TokenHeaderList
ths Bool
True WindowSize
off0
WindowSize -> IO WindowSize
sendHeadersIfNecessary (WindowSize -> IO WindowSize) -> WindowSize -> IO WindowSize
forall a b. (a -> b) -> a -> b
$ WindowSize
off0 WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
frameHeaderLength WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
kvlen
fillDataHeaderEnqueueNext Stream
_
WindowSize
off WindowSize
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'
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
off
fillDataHeaderEnqueueNext Stream{TVar WindowSize
streamWindow :: TVar WindowSize
streamWindow :: Stream -> TVar WindowSize
streamWindow,WindowSize
streamNumber :: WindowSize
streamNumber :: Stream -> WindowSize
streamNumber}
WindowSize
off WindowSize
datPayloadLen (Just DynaNext
next) TrailersMaker
tlrmkr IO a
_ Output Stream
out = do
let buf :: Ptr b
buf = Buffer
confWriteBuffer Buffer -> WindowSize -> Ptr b
forall a b. Ptr a -> WindowSize -> Ptr b
`plusPtr` WindowSize
off
off' :: WindowSize
off' = WindowSize
off WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
frameHeaderLength WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
datPayloadLen
flag :: FrameFlags
flag = FrameFlags
defaultFlags
FrameTypeId
-> WindowSize -> WindowSize -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameTypeId
FrameData WindowSize
datPayloadLen WindowSize
streamNumber FrameFlags
flag Buffer
forall b. Ptr b
buf
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar WindowSize -> (WindowSize -> WindowSize) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar WindowSize
connectionWindow (WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
subtract WindowSize
datPayloadLen)
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar WindowSize -> (WindowSize -> WindowSize) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar WindowSize
streamWindow (WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
subtract WindowSize
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'
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
off'
pushPromise :: WindowSize -> a -> TokenHeaderList -> WindowSize -> IO WindowSize
pushPromise WindowSize
pid a
sid TokenHeaderList
ths WindowSize
off = do
let offsid :: WindowSize
offsid = WindowSize
off WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
frameHeaderLength
bufsid :: Ptr b
bufsid = Buffer
confWriteBuffer Buffer -> WindowSize -> Ptr b
forall a b. Ptr a -> WindowSize -> Ptr b
`plusPtr` WindowSize
offsid
Word32 -> Buffer -> WindowSize -> IO ()
poke32 (a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
sid) Buffer
forall b. Ptr b
bufsid WindowSize
0
let offkv :: WindowSize
offkv = WindowSize
offsid WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
4
bufkv :: Ptr b
bufkv = Buffer
confWriteBuffer Buffer -> WindowSize -> Ptr b
forall a b. Ptr a -> WindowSize -> Ptr b
`plusPtr` WindowSize
offkv
limkv :: WindowSize
limkv = WindowSize
confBufferSize WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
- WindowSize
offkv
(TokenHeaderList
_,WindowSize
kvlen) <- Context
-> Buffer
-> WindowSize
-> TokenHeaderList
-> IO (TokenHeaderList, WindowSize)
hpackEncodeHeader Context
ctx Buffer
forall b. Ptr b
bufkv WindowSize
limkv TokenHeaderList
ths
let flag :: FrameFlags
flag = FrameFlags -> FrameFlags
setEndHeader FrameFlags
defaultFlags
buf :: Ptr b
buf = Buffer
confWriteBuffer Buffer -> WindowSize -> Ptr b
forall a b. Ptr a -> WindowSize -> Ptr b
`plusPtr` WindowSize
off
len :: WindowSize
len = WindowSize
kvlen WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
4
FrameTypeId
-> WindowSize -> WindowSize -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameTypeId
FramePushPromise WindowSize
len WindowSize
pid FrameFlags
flag Buffer
forall b. Ptr b
buf
WindowSize -> IO WindowSize
forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
len
{-# INLINE fillFrameHeader #-}
fillFrameHeader :: FrameTypeId
-> WindowSize -> WindowSize -> FrameFlags -> Buffer -> IO ()
fillFrameHeader FrameTypeId
ftyp WindowSize
len WindowSize
sid FrameFlags
flag Buffer
buf = FrameTypeId -> FrameHeader -> Buffer -> IO ()
encodeFrameHeaderBuf FrameTypeId
ftyp FrameHeader
hinfo Buffer
buf
where
hinfo :: FrameHeader
hinfo = WindowSize -> FrameFlags -> WindowSize -> FrameHeader
FrameHeader WindowSize
len FrameFlags
flag WindowSize
sid
{-# INLINE ignore #-}
ignore :: E.SomeException -> IO ()
ignore :: SomeException -> IO ()
ignore SomeException
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
runTrailersMaker :: TrailersMaker -> Buffer -> Int -> IO NextTrailersMaker
runTrailersMaker :: TrailersMaker -> Buffer -> WindowSize -> IO NextTrailersMaker
runTrailersMaker TrailersMaker
tlrmkr Buffer
buf WindowSize
siz = Buffer
-> WindowSize
-> (ByteString -> IO NextTrailersMaker)
-> IO NextTrailersMaker
forall a. Buffer -> WindowSize -> (ByteString -> IO a) -> IO a
bufferIO Buffer
buf WindowSize
siz ((ByteString -> IO NextTrailersMaker) -> IO NextTrailersMaker)
-> (ByteString -> IO NextTrailersMaker) -> IO NextTrailersMaker
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> TrailersMaker
tlrmkr (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)
fillBuilderBodyGetNext :: Builder -> DynaNext
fillBuilderBodyGetNext :: Builder -> DynaNext
fillBuilderBodyGetNext Builder
bb Buffer
buf WindowSize
siz WindowSize
lim = do
let room :: WindowSize
room = WindowSize -> WindowSize -> WindowSize
forall a. Ord a => a -> a -> a
min WindowSize
siz WindowSize
lim
(WindowSize
len, Next
signal) <- Builder -> BufferWriter
B.runBuilder Builder
bb Buffer
buf WindowSize
room
Next -> IO Next
forall (m :: * -> *) a. Monad m => a -> m a
return (Next -> IO Next) -> Next -> IO Next
forall a b. (a -> b) -> a -> b
$ WindowSize -> Next -> Next
nextForBuilder WindowSize
len Next
signal
fillFileBodyGetNext :: PositionRead -> FileOffset -> ByteCount -> IO () -> DynaNext
fillFileBodyGetNext :: PositionRead -> FileOffset -> FileOffset -> IO () -> DynaNext
fillFileBodyGetNext PositionRead
pread FileOffset
start FileOffset
bytecount IO ()
refresh Buffer
buf WindowSize
siz WindowSize
lim = do
let room :: WindowSize
room = WindowSize -> WindowSize -> WindowSize
forall a. Ord a => a -> a -> a
min WindowSize
siz WindowSize
lim
FileOffset
len <- PositionRead
pread FileOffset
start (WindowSize -> FileOffset -> FileOffset
mini WindowSize
room FileOffset
bytecount) Buffer
buf
let len' :: WindowSize
len' = FileOffset -> WindowSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
len
Next -> IO Next
forall (m :: * -> *) a. Monad m => a -> m a
return (Next -> IO Next) -> Next -> IO Next
forall a b. (a -> b) -> a -> b
$ WindowSize
-> PositionRead -> FileOffset -> FileOffset -> IO () -> Next
nextForFile WindowSize
len' PositionRead
pread (FileOffset
start FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
len) (FileOffset
bytecount FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
- FileOffset
len) IO ()
refresh
fillStreamBodyGetNext :: IO (Maybe StreamingChunk) -> DynaNext
fillStreamBodyGetNext :: IO (Maybe StreamingChunk) -> DynaNext
fillStreamBodyGetNext IO (Maybe StreamingChunk)
takeQ Buffer
buf WindowSize
siz WindowSize
lim = do
let room :: WindowSize
room = WindowSize -> WindowSize -> WindowSize
forall a. Ord a => a -> a -> a
min WindowSize
siz WindowSize
lim
(Leftover
leftover, Bool
cont, WindowSize
len) <- Buffer
-> WindowSize
-> IO (Maybe StreamingChunk)
-> IO (Leftover, Bool, WindowSize)
runStreamBuilder Buffer
buf WindowSize
room IO (Maybe StreamingChunk)
takeQ
Next -> IO Next
forall (m :: * -> *) a. Monad m => a -> m a
return (Next -> IO Next) -> Next -> IO Next
forall a b. (a -> b) -> a -> b
$ IO (Maybe StreamingChunk) -> Leftover -> Bool -> WindowSize -> Next
nextForStream IO (Maybe StreamingChunk)
takeQ Leftover
leftover Bool
cont WindowSize
len
fillBufBuilder :: Leftover -> DynaNext
fillBufBuilder :: Leftover -> DynaNext
fillBufBuilder Leftover
leftover Buffer
buf0 WindowSize
siz0 WindowSize
lim = do
let room :: WindowSize
room = WindowSize -> WindowSize -> WindowSize
forall a. Ord a => a -> a -> a
min WindowSize
siz0 WindowSize
lim
case Leftover
leftover of
Leftover
LZero -> FilePath -> IO Next
forall a. HasCallStack => FilePath -> a
error FilePath
"fillBufBuilder: LZero"
LOne BufferWriter
writer -> do
(WindowSize
len, Next
signal) <- BufferWriter
writer Buffer
buf0 WindowSize
room
WindowSize -> Next -> IO Next
forall (m :: * -> *). Monad m => WindowSize -> Next -> m Next
getNext WindowSize
len Next
signal
LTwo ByteString
bs BufferWriter
writer
| ByteString -> WindowSize
BS.length ByteString
bs WindowSize -> WindowSize -> Bool
forall a. Ord a => a -> a -> Bool
<= WindowSize
room -> do
Buffer
buf1 <- Buffer -> ByteString -> IO Buffer
copy Buffer
buf0 ByteString
bs
let len1 :: WindowSize
len1 = ByteString -> WindowSize
BS.length ByteString
bs
(WindowSize
len2, Next
signal) <- BufferWriter
writer Buffer
buf1 (WindowSize
room WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
- WindowSize
len1)
WindowSize -> Next -> IO Next
forall (m :: * -> *). Monad m => WindowSize -> Next -> m Next
getNext (WindowSize
len1 WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
len2) Next
signal
| Bool
otherwise -> do
let (ByteString
bs1,ByteString
bs2) = WindowSize -> ByteString -> (ByteString, ByteString)
BS.splitAt WindowSize
room ByteString
bs
IO Buffer -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Buffer -> IO ()) -> IO Buffer -> IO ()
forall a b. (a -> b) -> a -> b
$ Buffer -> ByteString -> IO Buffer
copy Buffer
buf0 ByteString
bs1
WindowSize -> Next -> IO Next
forall (m :: * -> *). Monad m => WindowSize -> Next -> m Next
getNext WindowSize
room (ByteString -> BufferWriter -> Next
B.Chunk ByteString
bs2 BufferWriter
writer)
where
getNext :: WindowSize -> Next -> m Next
getNext WindowSize
l Next
s = Next -> m Next
forall (m :: * -> *) a. Monad m => a -> m a
return (Next -> m Next) -> Next -> m Next
forall a b. (a -> b) -> a -> b
$ WindowSize -> Next -> Next
nextForBuilder WindowSize
l Next
s
nextForBuilder :: BytesFilled -> B.Next -> Next
nextForBuilder :: WindowSize -> Next -> Next
nextForBuilder WindowSize
len Next
B.Done
= WindowSize -> Maybe DynaNext -> Next
Next WindowSize
len Maybe DynaNext
forall a. Maybe a
Nothing
nextForBuilder WindowSize
len (B.More WindowSize
_ BufferWriter
writer)
= WindowSize -> Maybe DynaNext -> Next
Next WindowSize
len (Maybe DynaNext -> Next) -> Maybe DynaNext -> Next
forall a b. (a -> b) -> a -> b
$ DynaNext -> Maybe DynaNext
forall a. a -> Maybe a
Just (Leftover -> DynaNext
fillBufBuilder (BufferWriter -> Leftover
LOne BufferWriter
writer))
nextForBuilder WindowSize
len (B.Chunk ByteString
bs BufferWriter
writer)
= WindowSize -> Maybe DynaNext -> Next
Next WindowSize
len (Maybe DynaNext -> Next) -> Maybe DynaNext -> Next
forall a b. (a -> b) -> a -> b
$ DynaNext -> Maybe DynaNext
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
-> WindowSize
-> IO (Maybe StreamingChunk)
-> IO (Leftover, Bool, WindowSize)
runStreamBuilder Buffer
buf0 WindowSize
room0 IO (Maybe StreamingChunk)
takeQ = Buffer
-> WindowSize -> WindowSize -> IO (Leftover, Bool, WindowSize)
loop Buffer
buf0 WindowSize
room0 WindowSize
0
where
loop :: Buffer
-> WindowSize -> WindowSize -> IO (Leftover, Bool, WindowSize)
loop Buffer
buf WindowSize
room WindowSize
total = do
Maybe StreamingChunk
mbuilder <- IO (Maybe StreamingChunk)
takeQ
case Maybe StreamingChunk
mbuilder of
Maybe StreamingChunk
Nothing -> (Leftover, Bool, WindowSize) -> IO (Leftover, Bool, WindowSize)
forall (m :: * -> *) a. Monad m => a -> m a
return (Leftover
LZero, Bool
True, WindowSize
total)
Just (StreamingBuilder Builder
builder) -> do
(WindowSize
len, Next
signal) <- Builder -> BufferWriter
B.runBuilder Builder
builder Buffer
buf WindowSize
room
let total' :: WindowSize
total' = WindowSize
total WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
len
case Next
signal of
Next
B.Done -> Buffer
-> WindowSize -> WindowSize -> IO (Leftover, Bool, WindowSize)
loop (Buffer
buf Buffer -> WindowSize -> Buffer
forall a b. Ptr a -> WindowSize -> Ptr b
`plusPtr` WindowSize
len) (WindowSize
room WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
- WindowSize
len) WindowSize
total'
B.More WindowSize
_ BufferWriter
writer -> (Leftover, Bool, WindowSize) -> IO (Leftover, Bool, WindowSize)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferWriter -> Leftover
LOne BufferWriter
writer, Bool
True, WindowSize
total')
B.Chunk ByteString
bs BufferWriter
writer -> (Leftover, Bool, WindowSize) -> IO (Leftover, Bool, WindowSize)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> BufferWriter -> Leftover
LTwo ByteString
bs BufferWriter
writer, Bool
True, WindowSize
total')
Just StreamingChunk
StreamingFlush -> (Leftover, Bool, WindowSize) -> IO (Leftover, Bool, WindowSize)
forall (m :: * -> *) a. Monad m => a -> m a
return (Leftover
LZero, Bool
True, WindowSize
total)
Just StreamingChunk
StreamingFinished -> (Leftover, Bool, WindowSize) -> IO (Leftover, Bool, WindowSize)
forall (m :: * -> *) a. Monad m => a -> m a
return (Leftover
LZero, Bool
False, WindowSize
total)
fillBufStream :: Leftover -> IO (Maybe StreamingChunk) -> DynaNext
fillBufStream :: Leftover -> IO (Maybe StreamingChunk) -> DynaNext
fillBufStream Leftover
leftover0 IO (Maybe StreamingChunk)
takeQ Buffer
buf0 WindowSize
siz0 WindowSize
lim0 = do
let room0 :: WindowSize
room0 = WindowSize -> WindowSize -> WindowSize
forall a. Ord a => a -> a -> a
min WindowSize
siz0 WindowSize
lim0
case Leftover
leftover0 of
Leftover
LZero -> do
(Leftover
leftover, Bool
cont, WindowSize
len) <- Buffer
-> WindowSize
-> IO (Maybe StreamingChunk)
-> IO (Leftover, Bool, WindowSize)
runStreamBuilder Buffer
buf0 WindowSize
room0 IO (Maybe StreamingChunk)
takeQ
Leftover -> Bool -> WindowSize -> IO Next
forall (m :: * -> *).
Monad m =>
Leftover -> Bool -> WindowSize -> m Next
getNext Leftover
leftover Bool
cont WindowSize
len
LOne BufferWriter
writer -> BufferWriter -> DynaNext
forall a.
(Ptr a -> WindowSize -> IO (WindowSize, Next))
-> Ptr a -> WindowSize -> WindowSize -> IO Next
write BufferWriter
writer Buffer
buf0 WindowSize
room0 WindowSize
0
LTwo ByteString
bs BufferWriter
writer
| ByteString -> WindowSize
BS.length ByteString
bs WindowSize -> WindowSize -> Bool
forall a. Ord a => a -> a -> Bool
<= WindowSize
room0 -> do
Buffer
buf1 <- Buffer -> ByteString -> IO Buffer
copy Buffer
buf0 ByteString
bs
let len :: WindowSize
len = ByteString -> WindowSize
BS.length ByteString
bs
BufferWriter -> DynaNext
forall a.
(Ptr a -> WindowSize -> IO (WindowSize, Next))
-> Ptr a -> WindowSize -> WindowSize -> IO Next
write BufferWriter
writer Buffer
buf1 (WindowSize
room0 WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
- WindowSize
len) WindowSize
len
| Bool
otherwise -> do
let (ByteString
bs1,ByteString
bs2) = WindowSize -> ByteString -> (ByteString, ByteString)
BS.splitAt WindowSize
room0 ByteString
bs
IO Buffer -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Buffer -> IO ()) -> IO Buffer -> IO ()
forall a b. (a -> b) -> a -> b
$ Buffer -> ByteString -> IO Buffer
copy Buffer
buf0 ByteString
bs1
Leftover -> Bool -> WindowSize -> IO Next
forall (m :: * -> *).
Monad m =>
Leftover -> Bool -> WindowSize -> m Next
getNext (ByteString -> BufferWriter -> Leftover
LTwo ByteString
bs2 BufferWriter
writer) Bool
True WindowSize
room0
where
getNext :: Leftover -> Bool -> WindowSize -> m Next
getNext Leftover
l Bool
b WindowSize
r = Next -> m Next
forall (m :: * -> *) a. Monad m => a -> m a
return (Next -> m Next) -> Next -> m Next
forall a b. (a -> b) -> a -> b
$ IO (Maybe StreamingChunk) -> Leftover -> Bool -> WindowSize -> Next
nextForStream IO (Maybe StreamingChunk)
takeQ Leftover
l Bool
b WindowSize
r
write :: (Ptr a -> WindowSize -> IO (WindowSize, Next))
-> Ptr a -> WindowSize -> WindowSize -> IO Next
write Ptr a -> WindowSize -> IO (WindowSize, Next)
writer1 Ptr a
buf WindowSize
room WindowSize
sofar = do
(WindowSize
len, Next
signal) <- Ptr a -> WindowSize -> IO (WindowSize, Next)
writer1 Ptr a
buf WindowSize
room
case Next
signal of
Next
B.Done -> do
(Leftover
leftover, Bool
cont, WindowSize
extra) <- Buffer
-> WindowSize
-> IO (Maybe StreamingChunk)
-> IO (Leftover, Bool, WindowSize)
runStreamBuilder (Ptr a
buf Ptr a -> WindowSize -> Buffer
forall a b. Ptr a -> WindowSize -> Ptr b
`plusPtr` WindowSize
len) (WindowSize
room WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
- WindowSize
len) IO (Maybe StreamingChunk)
takeQ
let total :: WindowSize
total = WindowSize
sofar WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
len WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
extra
Leftover -> Bool -> WindowSize -> IO Next
forall (m :: * -> *).
Monad m =>
Leftover -> Bool -> WindowSize -> m Next
getNext Leftover
leftover Bool
cont WindowSize
total
B.More WindowSize
_ BufferWriter
writer -> do
let total :: WindowSize
total = WindowSize
sofar WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
len
Leftover -> Bool -> WindowSize -> IO Next
forall (m :: * -> *).
Monad m =>
Leftover -> Bool -> WindowSize -> m Next
getNext (BufferWriter -> Leftover
LOne BufferWriter
writer) Bool
True WindowSize
total
B.Chunk ByteString
bs BufferWriter
writer -> do
let total :: WindowSize
total = WindowSize
sofar WindowSize -> WindowSize -> WindowSize
forall a. Num a => a -> a -> a
+ WindowSize
len
Leftover -> Bool -> WindowSize -> IO Next
forall (m :: * -> *).
Monad m =>
Leftover -> Bool -> WindowSize -> m Next
getNext (ByteString -> BufferWriter -> Leftover
LTwo ByteString
bs BufferWriter
writer) Bool
True WindowSize
total
nextForStream :: IO (Maybe StreamingChunk)
-> Leftover -> Bool -> BytesFilled
-> Next
nextForStream :: IO (Maybe StreamingChunk) -> Leftover -> Bool -> WindowSize -> Next
nextForStream IO (Maybe StreamingChunk)
_ Leftover
_ Bool
False WindowSize
len = WindowSize -> Maybe DynaNext -> Next
Next WindowSize
len Maybe DynaNext
forall a. Maybe a
Nothing
nextForStream IO (Maybe StreamingChunk)
takeQ Leftover
leftOrZero Bool
True WindowSize
len =
WindowSize -> Maybe DynaNext -> Next
Next WindowSize
len (Maybe DynaNext -> Next) -> Maybe DynaNext -> Next
forall a b. (a -> b) -> a -> b
$ DynaNext -> Maybe DynaNext
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 -> FileOffset -> FileOffset -> IO () -> DynaNext
fillBufFile PositionRead
pread FileOffset
start FileOffset
bytes IO ()
refresh Buffer
buf WindowSize
siz WindowSize
lim = do
let room :: WindowSize
room = WindowSize -> WindowSize -> WindowSize
forall a. Ord a => a -> a -> a
min WindowSize
siz WindowSize
lim
FileOffset
len <- PositionRead
pread FileOffset
start (WindowSize -> FileOffset -> FileOffset
mini WindowSize
room FileOffset
bytes) Buffer
buf
IO ()
refresh
let len' :: WindowSize
len' = FileOffset -> WindowSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral FileOffset
len
Next -> IO Next
forall (m :: * -> *) a. Monad m => a -> m a
return (Next -> IO Next) -> Next -> IO Next
forall a b. (a -> b) -> a -> b
$ WindowSize
-> PositionRead -> FileOffset -> FileOffset -> IO () -> Next
nextForFile WindowSize
len' PositionRead
pread (FileOffset
start FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
+ FileOffset
len) (FileOffset
bytes FileOffset -> FileOffset -> FileOffset
forall a. Num a => a -> a -> a
- FileOffset
len) IO ()
refresh
nextForFile :: BytesFilled -> PositionRead -> FileOffset -> ByteCount -> IO () -> Next
nextForFile :: WindowSize
-> PositionRead -> FileOffset -> FileOffset -> IO () -> Next
nextForFile WindowSize
0 PositionRead
_ FileOffset
_ FileOffset
_ IO ()
_ = WindowSize -> Maybe DynaNext -> Next
Next WindowSize
0 Maybe DynaNext
forall a. Maybe a
Nothing
nextForFile WindowSize
len PositionRead
_ FileOffset
_ FileOffset
0 IO ()
_ = WindowSize -> Maybe DynaNext -> Next
Next WindowSize
len Maybe DynaNext
forall a. Maybe a
Nothing
nextForFile WindowSize
len PositionRead
pread FileOffset
start FileOffset
bytes IO ()
refresh =
WindowSize -> Maybe DynaNext -> Next
Next WindowSize
len (Maybe DynaNext -> Next) -> Maybe DynaNext -> Next
forall a b. (a -> b) -> a -> b
$ DynaNext -> Maybe DynaNext
forall a. a -> Maybe a
Just (PositionRead -> FileOffset -> FileOffset -> IO () -> DynaNext
fillBufFile PositionRead
pread FileOffset
start FileOffset
bytes IO ()
refresh)
{-# INLINE mini #-}
mini :: Int -> Int64 -> Int64
mini :: WindowSize -> FileOffset -> FileOffset
mini WindowSize
i FileOffset
n
| WindowSize -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral WindowSize
i FileOffset -> FileOffset -> Bool
forall a. Ord a => a -> a -> Bool
< FileOffset
n = WindowSize -> FileOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral WindowSize
i
| Bool
otherwise = FileOffset
n