{-# LANGUAGE OverloadedStrings #-}
module Network.QUIC.IO where
import Control.Concurrent.STM
import qualified Data.ByteString as BS
import qualified UnliftIO.Exception as E
import Network.QUIC.Connection
import Network.QUIC.Connector
import Network.QUIC.Imports
import Network.QUIC.Parameters
import Network.QUIC.Stream
import Network.QUIC.Types
stream :: Connection -> IO Stream
stream :: Connection -> IO Stream
stream Connection
conn = do
StreamId
sid <- Connection -> IO StreamId
waitMyNewStreamId Connection
conn
Connection -> StreamId -> IO Stream
addStream Connection
conn StreamId
sid
unidirectionalStream :: Connection -> IO Stream
unidirectionalStream :: Connection -> IO Stream
unidirectionalStream Connection
conn = do
StreamId
sid <- Connection -> IO StreamId
waitMyNewUniStreamId Connection
conn
Connection -> StreamId -> IO Stream
addStream Connection
conn StreamId
sid
sendStream :: Stream -> ByteString -> IO ()
sendStream :: Stream -> ByteString -> IO ()
sendStream Stream
s ByteString
dat = Stream -> [ByteString] -> IO ()
sendStreamMany Stream
s [ByteString
dat]
data Blocked = BothBlocked Stream Int Int
| ConnBlocked Int
| StrmBlocked Stream Int
deriving StreamId -> Blocked -> ShowS
[Blocked] -> ShowS
Blocked -> String
(StreamId -> Blocked -> ShowS)
-> (Blocked -> String) -> ([Blocked] -> ShowS) -> Show Blocked
forall a.
(StreamId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Blocked] -> ShowS
$cshowList :: [Blocked] -> ShowS
show :: Blocked -> String
$cshow :: Blocked -> String
showsPrec :: StreamId -> Blocked -> ShowS
$cshowsPrec :: StreamId -> Blocked -> ShowS
Show
addTx :: Connection -> Stream -> Int -> IO ()
addTx :: Connection -> Stream -> StreamId -> IO ()
addTx Connection
conn Stream
s StreamId
len = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Stream -> StreamId -> STM ()
addTxStreamData Stream
s StreamId
len
Connection -> StreamId -> STM ()
addTxData Connection
conn StreamId
len
sendStreamMany :: Stream -> [ByteString] -> IO ()
sendStreamMany :: Stream -> [ByteString] -> IO ()
sendStreamMany Stream
_ [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sendStreamMany Stream
s [ByteString]
dats0 = do
Bool
sclosed <- Stream -> IO Bool
isTxStreamClosed Stream
s
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sclosed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ QUICException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO QUICException
StreamIsClosed
let len :: StreamId
len = [ByteString] -> StreamId
totalLen [ByteString]
dats0
Bool
ready <- Connection -> IO Bool
isConnection1RTTReady Connection
conn
if Bool -> Bool
not Bool
ready then do
Connection -> TxStreamData -> IO ()
putSendStreamQ Connection
conn (TxStreamData -> IO ()) -> TxStreamData -> IO ()
forall a b. (a -> b) -> a -> b
$ Stream -> [ByteString] -> StreamId -> Bool -> TxStreamData
TxStreamData Stream
s [ByteString]
dats0 StreamId
len Bool
False
Connection -> Stream -> StreamId -> IO ()
addTx Connection
conn Stream
s StreamId
len
else
[ByteString] -> StreamId -> Bool -> IO ()
flowControl [ByteString]
dats0 StreamId
len Bool
False
where
conn :: Connection
conn = Stream -> Connection
streamConnection Stream
s
flowControl :: [ByteString] -> StreamId -> Bool -> IO ()
flowControl [ByteString]
dats StreamId
len Bool
wait = do
Either Blocked StreamId
eblocked <- Stream -> StreamId -> Bool -> IO (Either Blocked StreamId)
checkBlocked Stream
s StreamId
len Bool
wait
case Either Blocked StreamId
eblocked of
Right StreamId
n
| StreamId
len StreamId -> StreamId -> Bool
forall a. Eq a => a -> a -> Bool
== StreamId
n -> do
Connection -> TxStreamData -> IO ()
putSendStreamQ Connection
conn (TxStreamData -> IO ()) -> TxStreamData -> IO ()
forall a b. (a -> b) -> a -> b
$ Stream -> [ByteString] -> StreamId -> Bool -> TxStreamData
TxStreamData Stream
s [ByteString]
dats StreamId
len Bool
False
Connection -> Stream -> StreamId -> IO ()
addTx Connection
conn Stream
s StreamId
n
| Bool
otherwise -> do
let ([ByteString]
dats1,[ByteString]
dats2) = StreamId -> [ByteString] -> ([ByteString], [ByteString])
split StreamId
n [ByteString]
dats
Connection -> TxStreamData -> IO ()
putSendStreamQ Connection
conn (TxStreamData -> IO ()) -> TxStreamData -> IO ()
forall a b. (a -> b) -> a -> b
$ Stream -> [ByteString] -> StreamId -> Bool -> TxStreamData
TxStreamData Stream
s [ByteString]
dats1 StreamId
n Bool
False
Connection -> Stream -> StreamId -> IO ()
addTx Connection
conn Stream
s StreamId
n
[ByteString] -> StreamId -> Bool -> IO ()
flowControl [ByteString]
dats2 (StreamId
len StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
- StreamId
n) Bool
False
Left Blocked
blocked -> do
Connection -> EncryptionLevel -> Blocked -> IO ()
sendBlocked Connection
conn EncryptionLevel
RTT1Level Blocked
blocked
[ByteString] -> StreamId -> Bool -> IO ()
flowControl [ByteString]
dats StreamId
len Bool
True
sendBlocked :: Connection -> EncryptionLevel -> Blocked -> IO ()
sendBlocked :: Connection -> EncryptionLevel -> Blocked -> IO ()
sendBlocked Connection
conn EncryptionLevel
lvl Blocked
blocked = Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
lvl [Frame]
frames
where
frames :: [Frame]
frames = case Blocked
blocked of
StrmBlocked Stream
strm StreamId
n -> [StreamId -> StreamId -> Frame
StreamDataBlocked (Stream -> StreamId
streamId Stream
strm) StreamId
n]
ConnBlocked StreamId
n -> [StreamId -> Frame
DataBlocked StreamId
n]
BothBlocked Stream
strm StreamId
n StreamId
m -> [StreamId -> StreamId -> Frame
StreamDataBlocked (Stream -> StreamId
streamId Stream
strm) StreamId
n, StreamId -> Frame
DataBlocked StreamId
m]
split :: Int -> [BS.ByteString] -> ([BS.ByteString],[BS.ByteString])
split :: StreamId -> [ByteString] -> ([ByteString], [ByteString])
split StreamId
n0 [ByteString]
dats0 = StreamId
-> [ByteString]
-> ([ByteString] -> [ByteString])
-> ([ByteString], [ByteString])
forall c.
StreamId
-> [ByteString] -> ([ByteString] -> c) -> (c, [ByteString])
loop StreamId
n0 [ByteString]
dats0 [ByteString] -> [ByteString]
forall a. a -> a
id
where
loop :: StreamId
-> [ByteString] -> ([ByteString] -> c) -> (c, [ByteString])
loop StreamId
0 [ByteString]
bss [ByteString] -> c
build = ([ByteString] -> c
build [], [ByteString]
bss)
loop StreamId
_ [] [ByteString] -> c
build = ([ByteString] -> c
build [], [])
loop StreamId
n (ByteString
bs:[ByteString]
bss) [ByteString] -> c
build = case StreamId
len StreamId -> StreamId -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` StreamId
n of
Ordering
GT -> let (ByteString
bs1,ByteString
bs2) = StreamId -> ByteString -> (ByteString, ByteString)
BS.splitAt StreamId
n ByteString
bs
in ([ByteString] -> c
build [ByteString
bs1], ByteString
bs2ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
bss)
Ordering
EQ -> ([ByteString] -> c
build [ByteString
bs], [ByteString]
bss)
Ordering
LT -> StreamId
-> [ByteString] -> ([ByteString] -> c) -> (c, [ByteString])
loop (StreamId
n StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
- StreamId
len) [ByteString]
bss ([ByteString] -> c
build ([ByteString] -> c)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:))
where
len :: StreamId
len = ByteString -> StreamId
BS.length ByteString
bs
checkBlocked :: Stream -> Int -> Bool -> IO (Either Blocked Int)
checkBlocked :: Stream -> StreamId -> Bool -> IO (Either Blocked StreamId)
checkBlocked Stream
s StreamId
len Bool
wait = STM (Either Blocked StreamId) -> IO (Either Blocked StreamId)
forall a. STM a -> IO a
atomically (STM (Either Blocked StreamId) -> IO (Either Blocked StreamId))
-> STM (Either Blocked StreamId) -> IO (Either Blocked StreamId)
forall a b. (a -> b) -> a -> b
$ do
let conn :: Connection
conn = Stream -> Connection
streamConnection Stream
s
Flow
strmFlow <- Stream -> STM Flow
readStreamFlowTx Stream
s
Flow
connFlow <- Connection -> STM Flow
readConnectionFlowTx Connection
conn
let strmWindow :: StreamId
strmWindow = Flow -> StreamId
flowWindow Flow
strmFlow
connWindow :: StreamId
connWindow = Flow -> StreamId
flowWindow Flow
connFlow
minFlow :: StreamId
minFlow = StreamId -> StreamId -> StreamId
forall a. Ord a => a -> a -> a
min StreamId
strmWindow StreamId
connWindow
n :: StreamId
n = StreamId -> StreamId -> StreamId
forall a. Ord a => a -> a -> a
min StreamId
len StreamId
minFlow
Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
wait (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$ Bool -> STM ()
check (StreamId
n StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
> StreamId
0)
if StreamId
n StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
> StreamId
0 then
Either Blocked StreamId -> STM (Either Blocked StreamId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Blocked StreamId -> STM (Either Blocked StreamId))
-> Either Blocked StreamId -> STM (Either Blocked StreamId)
forall a b. (a -> b) -> a -> b
$ StreamId -> Either Blocked StreamId
forall a b. b -> Either a b
Right StreamId
n
else do
let cs :: Bool
cs = StreamId
len StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
> StreamId
strmWindow
cw :: Bool
cw = StreamId
len StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
> StreamId
connWindow
blocked :: Blocked
blocked
| Bool
cs Bool -> Bool -> Bool
&& Bool
cw = Stream -> StreamId -> StreamId -> Blocked
BothBlocked Stream
s (Flow -> StreamId
flowMaxData Flow
strmFlow) (Flow -> StreamId
flowMaxData Flow
connFlow)
| Bool
cs = Stream -> StreamId -> Blocked
StrmBlocked Stream
s (Flow -> StreamId
flowMaxData Flow
strmFlow)
| Bool
otherwise = StreamId -> Blocked
ConnBlocked (Flow -> StreamId
flowMaxData Flow
connFlow)
Either Blocked StreamId -> STM (Either Blocked StreamId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Blocked StreamId -> STM (Either Blocked StreamId))
-> Either Blocked StreamId -> STM (Either Blocked StreamId)
forall a b. (a -> b) -> a -> b
$ Blocked -> Either Blocked StreamId
forall a b. a -> Either a b
Left Blocked
blocked
shutdownStream :: Stream -> IO ()
shutdownStream :: Stream -> IO ()
shutdownStream Stream
s = do
Bool
sclosed <- Stream -> IO Bool
isTxStreamClosed Stream
s
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sclosed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ QUICException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO QUICException
StreamIsClosed
Stream -> IO ()
setTxStreamClosed Stream
s
Connection -> TxStreamData -> IO ()
putSendStreamQ (Stream -> Connection
streamConnection Stream
s) (TxStreamData -> IO ()) -> TxStreamData -> IO ()
forall a b. (a -> b) -> a -> b
$ Stream -> [ByteString] -> StreamId -> Bool -> TxStreamData
TxStreamData Stream
s [] StreamId
0 Bool
True
closeStream :: Stream -> IO ()
closeStream :: Stream -> IO ()
closeStream Stream
s = do
let conn :: Connection
conn = Stream -> Connection
streamConnection Stream
s
let sid :: StreamId
sid = Stream -> StreamId
streamId Stream
s
Bool
sclosed <- Stream -> IO Bool
isTxStreamClosed Stream
s
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
sclosed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Stream -> IO ()
setTxStreamClosed Stream
s
Stream -> IO ()
setRxStreamClosed Stream
s
Connection -> TxStreamData -> IO ()
putSendStreamQ Connection
conn (TxStreamData -> IO ()) -> TxStreamData -> IO ()
forall a b. (a -> b) -> a -> b
$ Stream -> [ByteString] -> StreamId -> Bool -> TxStreamData
TxStreamData Stream
s [] StreamId
0 Bool
True
Connection -> Stream -> IO ()
delStream Connection
conn Stream
s
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn Bool -> Bool -> Bool
&& StreamId -> Bool
isServerInitiatedBidirectional StreamId
sid)
Bool -> Bool -> Bool
|| (Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
conn Bool -> Bool -> Bool
&& StreamId -> Bool
isClientInitiatedBidirectional StreamId
sid)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StreamId
n <- Connection -> IO StreamId
getPeerMaxStreams Connection
conn
Connection -> Output -> IO ()
putOutput Connection
conn (Output -> IO ()) -> Output -> IO ()
forall a b. (a -> b) -> a -> b
$ EncryptionLevel -> [Frame] -> IO () -> Output
OutControl EncryptionLevel
RTT1Level [Direction -> StreamId -> Frame
MaxStreams Direction
Unidirectional StreamId
n] (IO () -> Output) -> IO () -> Output
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
acceptStream :: Connection -> IO Stream
acceptStream :: Connection -> IO Stream
acceptStream Connection
conn = do
InpStream Stream
s <- Connection -> IO Input
takeInput Connection
conn
Stream -> IO Stream
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
s
recvStream :: Stream -> Int -> IO ByteString
recvStream :: Stream -> StreamId -> IO ByteString
recvStream Stream
s StreamId
n = do
ByteString
bs <- Stream -> StreamId -> IO ByteString
takeRecvStreamQwithSize Stream
s StreamId
n
let len :: StreamId
len = ByteString -> StreamId
BS.length ByteString
bs
conn :: Connection
conn = Stream -> Connection
streamConnection Stream
s
Stream -> StreamId -> IO ()
addRxStreamData Stream
s StreamId
len
Connection -> StreamId -> IO ()
addRxData Connection
conn StreamId
len
StreamId
window <- Stream -> IO StreamId
getRxStreamWindow Stream
s
let sid :: StreamId
sid = Stream -> StreamId
streamId Stream
s
initialWindow :: StreamId
initialWindow = Connection -> StreamId -> StreamId
initialRxMaxStreamData Connection
conn StreamId
sid
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StreamId
window StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
<= (StreamId
initialWindow StreamId -> StreamId -> StreamId
forall a. Bits a => a -> StreamId -> a
.>>. StreamId
1)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StreamId
newMax <- Stream -> StreamId -> IO StreamId
addRxMaxStreamData Stream
s StreamId
initialWindow
Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
RTT1Level [StreamId -> StreamId -> Frame
MaxStreamData StreamId
sid StreamId
newMax]
Connection -> Microseconds -> IO () -> IO ()
fire Connection
conn (StreamId -> Microseconds
Microseconds StreamId
50000) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StreamId
newMax' <- Stream -> IO StreamId
getRxMaxStreamData Stream
s
Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
RTT1Level [StreamId -> StreamId -> Frame
MaxStreamData StreamId
sid StreamId
newMax']
StreamId
cwindow <- Connection -> IO StreamId
getRxDataWindow Connection
conn
let cinitialWindow :: StreamId
cinitialWindow = Parameters -> StreamId
initialMaxData (Parameters -> StreamId) -> Parameters -> StreamId
forall a b. (a -> b) -> a -> b
$ Connection -> Parameters
getMyParameters Connection
conn
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StreamId
cwindow StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
<= (StreamId
cinitialWindow StreamId -> StreamId -> StreamId
forall a. Bits a => a -> StreamId -> a
.>>. StreamId
1)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StreamId
newMax <- Connection -> StreamId -> IO StreamId
addRxMaxData Connection
conn StreamId
cinitialWindow
Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
RTT1Level [StreamId -> Frame
MaxData StreamId
newMax]
Connection -> Microseconds -> IO () -> IO ()
fire Connection
conn (StreamId -> Microseconds
Microseconds StreamId
50000) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
StreamId
newMax' <- Connection -> IO StreamId
getRxMaxData Connection
conn
Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
RTT1Level [StreamId -> Frame
MaxData StreamId
newMax']
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
resetStream :: Stream -> ApplicationProtocolError -> IO ()
resetStream :: Stream -> ApplicationProtocolError -> IO ()
resetStream Stream
s ApplicationProtocolError
aerr = do
let conn :: Connection
conn = Stream -> Connection
streamConnection Stream
s
let sid :: StreamId
sid = Stream -> StreamId
streamId Stream
s
Bool
sclosed <- Stream -> IO Bool
isTxStreamClosed Stream
s
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
sclosed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Stream -> IO ()
setTxStreamClosed Stream
s
Stream -> IO ()
setRxStreamClosed Stream
s
EncryptionLevel
lvl <- Connection -> IO EncryptionLevel
forall a. Connector a => a -> IO EncryptionLevel
getEncryptionLevel Connection
conn
let frame :: Frame
frame = StreamId -> ApplicationProtocolError -> StreamId -> Frame
ResetStream StreamId
sid ApplicationProtocolError
aerr StreamId
0
Connection -> Output -> IO ()
putOutput Connection
conn (Output -> IO ()) -> Output -> IO ()
forall a b. (a -> b) -> a -> b
$ EncryptionLevel -> [Frame] -> IO () -> Output
OutControl EncryptionLevel
lvl [Frame
frame] (IO () -> Output) -> IO () -> Output
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Connection -> Stream -> IO ()
delStream Connection
conn Stream
s
stopStream :: Stream -> ApplicationProtocolError -> IO ()
stopStream :: Stream -> ApplicationProtocolError -> IO ()
stopStream Stream
s ApplicationProtocolError
aerr = do
let conn :: Connection
conn = Stream -> Connection
streamConnection Stream
s
let sid :: StreamId
sid = Stream -> StreamId
streamId Stream
s
Bool
sclosed <- Stream -> IO Bool
isRxStreamClosed Stream
s
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
sclosed (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Stream -> IO ()
setRxStreamClosed Stream
s
EncryptionLevel
lvl <- Connection -> IO EncryptionLevel
forall a. Connector a => a -> IO EncryptionLevel
getEncryptionLevel Connection
conn
let frame :: Frame
frame = StreamId -> ApplicationProtocolError -> Frame
StopSending StreamId
sid ApplicationProtocolError
aerr
Connection -> Output -> IO ()
putOutput Connection
conn (Output -> IO ()) -> Output -> IO ()
forall a b. (a -> b) -> a -> b
$ EncryptionLevel -> [Frame] -> IO () -> Output
OutControl EncryptionLevel
lvl [Frame
frame] (IO () -> Output) -> IO () -> Output
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()