module Network.QUIC.IO where
import Control.Concurrent.STM
import qualified Control.Exception as E
import qualified Data.ByteString as BS
import Network.Control
import Network.QUIC.Connection
import Network.QUIC.Connector
import Network.QUIC.Imports
import Network.QUIC.Stream
import Network.QUIC.Types
stream :: Connection -> IO Stream
stream :: Connection -> IO Stream
stream Connection
conn = do
Int
sid <- Connection -> IO Int
waitMyNewStreamId Connection
conn
Connection -> Int -> IO Stream
addStream Connection
conn Int
sid
unidirectionalStream :: Connection -> IO Stream
unidirectionalStream :: Connection -> IO Stream
unidirectionalStream Connection
conn = do
Int
sid <- Connection -> IO Int
waitMyNewUniStreamId Connection
conn
Connection -> Int -> IO Stream
addStream Connection
conn Int
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 (Int -> Blocked -> ShowS
[Blocked] -> ShowS
Blocked -> String
(Int -> Blocked -> ShowS)
-> (Blocked -> String) -> ([Blocked] -> ShowS) -> Show Blocked
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Blocked -> ShowS
showsPrec :: Int -> Blocked -> ShowS
$cshow :: Blocked -> String
show :: Blocked -> String
$cshowList :: [Blocked] -> ShowS
showList :: [Blocked] -> ShowS
Show)
addTx :: Connection -> Stream -> Int -> IO ()
addTx :: Connection -> Stream -> Int -> IO ()
addTx Connection
conn Stream
s Int
len = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Stream -> Int -> STM ()
addTxStreamData Stream
s Int
len
Connection -> Int -> STM ()
addTxData Connection
conn Int
len
sendStreamMany :: Stream -> [ByteString] -> IO ()
sendStreamMany :: Stream -> [ByteString] -> IO ()
sendStreamMany Stream
_ [] = () -> IO ()
forall a. a -> IO a
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 e a. Exception e => e -> IO a
E.throwIO QUICException
StreamIsClosed
let len :: Int
len = [ByteString] -> Int
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] -> Int -> Bool -> TxStreamData
TxStreamData Stream
s [ByteString]
dats0 Int
len Bool
False
Connection -> Stream -> Int -> IO ()
addTx Connection
conn Stream
s Int
len
else [ByteString] -> Int -> Bool -> IO ()
flowControl [ByteString]
dats0 Int
len Bool
False
where
conn :: Connection
conn = Stream -> Connection
streamConnection Stream
s
flowControl :: [ByteString] -> Int -> Bool -> IO ()
flowControl [ByteString]
dats Int
len Bool
wait = do
Either Blocked Int
eblocked <- Stream -> Int -> Bool -> IO (Either Blocked Int)
checkBlocked Stream
s Int
len Bool
wait
case Either Blocked Int
eblocked of
Right Int
n
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n -> do
Connection -> TxStreamData -> IO ()
putSendStreamQ Connection
conn (TxStreamData -> IO ()) -> TxStreamData -> IO ()
forall a b. (a -> b) -> a -> b
$ Stream -> [ByteString] -> Int -> Bool -> TxStreamData
TxStreamData Stream
s [ByteString]
dats Int
len Bool
False
Connection -> Stream -> Int -> IO ()
addTx Connection
conn Stream
s Int
n
| Bool
otherwise -> do
let ([ByteString]
dats1, [ByteString]
dats2) = Int -> [ByteString] -> ([ByteString], [ByteString])
split Int
n [ByteString]
dats
Connection -> TxStreamData -> IO ()
putSendStreamQ Connection
conn (TxStreamData -> IO ()) -> TxStreamData -> IO ()
forall a b. (a -> b) -> a -> b
$ Stream -> [ByteString] -> Int -> Bool -> TxStreamData
TxStreamData Stream
s [ByteString]
dats1 Int
n Bool
False
Connection -> Stream -> Int -> IO ()
addTx Connection
conn Stream
s Int
n
[ByteString] -> Int -> Bool -> IO ()
flowControl [ByteString]
dats2 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Bool
False
Left Blocked
blocked -> do
Connection -> EncryptionLevel -> Blocked -> IO ()
sendBlocked Connection
conn EncryptionLevel
RTT1Level Blocked
blocked
[ByteString] -> Int -> Bool -> IO ()
flowControl [ByteString]
dats Int
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 Int
n -> [Int -> Int -> Frame
StreamDataBlocked (Stream -> Int
streamId Stream
strm) Int
n]
ConnBlocked Int
n -> [Int -> Frame
DataBlocked Int
n]
BothBlocked Stream
strm Int
n Int
m -> [Int -> Int -> Frame
StreamDataBlocked (Stream -> Int
streamId Stream
strm) Int
n, Int -> Frame
DataBlocked Int
m]
split :: Int -> [BS.ByteString] -> ([BS.ByteString], [BS.ByteString])
split :: Int -> [ByteString] -> ([ByteString], [ByteString])
split Int
n0 [ByteString]
dats0 = Int
-> [ByteString]
-> ([ByteString] -> [ByteString])
-> ([ByteString], [ByteString])
forall {c}.
Int -> [ByteString] -> ([ByteString] -> c) -> (c, [ByteString])
loop Int
n0 [ByteString]
dats0 [ByteString] -> [ByteString]
forall a. a -> a
id
where
loop :: Int -> [ByteString] -> ([ByteString] -> c) -> (c, [ByteString])
loop Int
0 [ByteString]
bss [ByteString] -> c
build = ([ByteString] -> c
build [], [ByteString]
bss)
loop Int
_ [] [ByteString] -> c
build = ([ByteString] -> c
build [], [])
loop Int
n (ByteString
bs : [ByteString]
bss) [ByteString] -> c
build = case Int
len Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
n of
Ordering
GT ->
let (ByteString
bs1, ByteString
bs2) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
n ByteString
bs
in ([ByteString] -> c
build [ByteString
bs1], ByteString
bs2 ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
bss)
Ordering
EQ -> ([ByteString] -> c
build [ByteString
bs], [ByteString]
bss)
Ordering
LT -> Int -> [ByteString] -> ([ByteString] -> c) -> (c, [ByteString])
loop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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 :: Int
len = ByteString -> Int
BS.length ByteString
bs
checkBlocked :: Stream -> Int -> Bool -> IO (Either Blocked Int)
checkBlocked :: Stream -> Int -> Bool -> IO (Either Blocked Int)
checkBlocked Stream
s Int
len Bool
wait = STM (Either Blocked Int) -> IO (Either Blocked Int)
forall a. STM a -> IO a
atomically (STM (Either Blocked Int) -> IO (Either Blocked Int))
-> STM (Either Blocked Int) -> IO (Either Blocked Int)
forall a b. (a -> b) -> a -> b
$ do
let conn :: Connection
conn = Stream -> Connection
streamConnection Stream
s
TxFlow
strmFlow <- Stream -> STM TxFlow
readStreamFlowTx Stream
s
TxFlow
connFlow <- Connection -> STM TxFlow
readConnectionFlowTx Connection
conn
let strmWindow :: Int
strmWindow = TxFlow -> Int
txWindowSize TxFlow
strmFlow
connWindow :: Int
connWindow = TxFlow -> Int
txWindowSize TxFlow
connFlow
minFlow :: Int
minFlow = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
strmWindow Int
connWindow
n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
len Int
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 (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then Either Blocked Int -> STM (Either Blocked Int)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Blocked Int -> STM (Either Blocked Int))
-> Either Blocked Int -> STM (Either Blocked Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either Blocked Int
forall a b. b -> Either a b
Right Int
n
else do
let cs :: Bool
cs = Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
strmWindow
cw :: Bool
cw = Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
connWindow
blocked :: Blocked
blocked
| Bool
cs Bool -> Bool -> Bool
&& Bool
cw = Stream -> Int -> Int -> Blocked
BothBlocked Stream
s (TxFlow -> Int
txfLimit TxFlow
strmFlow) (TxFlow -> Int
txfLimit TxFlow
connFlow)
| Bool
cs = Stream -> Int -> Blocked
StrmBlocked Stream
s (TxFlow -> Int
txfLimit TxFlow
strmFlow)
| Bool
otherwise = Int -> Blocked
ConnBlocked (TxFlow -> Int
txfLimit TxFlow
connFlow)
Either Blocked Int -> STM (Either Blocked Int)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Blocked Int -> STM (Either Blocked Int))
-> Either Blocked Int -> STM (Either Blocked Int)
forall a b. (a -> b) -> a -> b
$ Blocked -> Either Blocked Int
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 e a. Exception e => e -> IO 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] -> Int -> Bool -> TxStreamData
TxStreamData Stream
s [] Int
0 Bool
True
Stream -> IO ()
waitFinTx Stream
s
closeStream :: Stream -> IO ()
closeStream :: Stream -> IO ()
closeStream Stream
s = do
let conn :: Connection
conn = Stream -> Connection
streamConnection Stream
s
let sid :: Int
sid = Stream -> Int
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] -> Int -> Bool -> TxStreamData
TxStreamData Stream
s [] Int
0 Bool
True
Stream -> IO ()
waitFinTx Stream
s
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
&& Int -> Bool
isServerInitiatedBidirectional Int
sid)
Bool -> Bool -> Bool
|| (Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
conn Bool -> Bool -> Bool
&& Int -> Bool
isClientInitiatedBidirectional Int
sid)
)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Connection -> Direction -> IO ()
checkMaxStreams Connection
conn Direction
Bidirectional
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
&& Int -> Bool
isServerInitiatedUnidirectional Int
sid)
Bool -> Bool -> Bool
|| (Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
conn Bool -> Bool -> Bool
&& Int -> Bool
isClientInitiatedUnidirectional Int
sid)
)
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Connection -> Direction -> IO ()
checkMaxStreams Connection
conn Direction
Unidirectional
where
checkMaxStreams :: Connection -> Direction -> IO ()
checkMaxStreams Connection
conn Direction
dir = do
Maybe Int
mx <- Connection -> Direction -> IO (Maybe Int)
checkStreamIdRoom Connection
conn Direction
dir
case Maybe Int
mx of
Maybe Int
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Int
nms -> do
Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
RTT1Level [Direction -> Int -> Frame
MaxStreams Direction
dir Int
nms]
Connection -> Microseconds -> IO () -> IO ()
fire Connection
conn (Int -> Microseconds
Microseconds Int
50000) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
RTT1Level [Direction -> Int -> Frame
MaxStreams Direction
dir Int
nms]
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
s
recvStream :: Stream -> Int -> IO ByteString
recvStream :: Stream -> Int -> IO ByteString
recvStream Stream
s Int
n = do
ByteString
bs <- Stream -> Int -> IO ByteString
takeRecvStreamQwithSize Stream
s Int
n
let len :: Int
len = ByteString -> Int
BS.length ByteString
bs
sid :: Int
sid = Stream -> Int
streamId Stream
s
conn :: Connection
conn = Stream -> Connection
streamConnection Stream
s
Maybe Int
mxs <- Stream -> Int -> IO (Maybe Int)
updateStreamFlowRx Stream
s Int
len
Maybe Int -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Int
mxs ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
newMax -> do
Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
RTT1Level [Int -> Int -> Frame
MaxStreamData Int
sid Int
newMax]
Connection -> Microseconds -> IO () -> IO ()
fire Connection
conn (Int -> Microseconds
Microseconds Int
50000) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
RTT1Level [Int -> Int -> Frame
MaxStreamData Int
sid Int
newMax]
Maybe Int
mxc <- Connection -> Int -> IO (Maybe Int)
updateFlowRx Connection
conn Int
len
Maybe Int -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Int
mxc ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
newMax -> do
Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
RTT1Level [Int -> Frame
MaxData Int
newMax]
Connection -> Microseconds -> IO () -> IO ()
fire Connection
conn (Int -> Microseconds
Microseconds Int
50000) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
RTT1Level [Int -> Frame
MaxData Int
newMax]
ByteString -> IO ByteString
forall a. a -> IO a
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 :: Int
sid = Stream -> Int
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 = Int -> ApplicationProtocolError -> Int -> Frame
ResetStream Int
sid ApplicationProtocolError
aerr Int
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 a. a -> IO a
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 :: Int
sid = Stream -> Int
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 = Int -> ApplicationProtocolError -> Frame
StopSending Int
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()