{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}

module Network.QUIC.Connection.Types where

import qualified Crypto.Token as CT
import Data.Array.IO
import Data.ByteString.Internal
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.X509 (CertificateChain)
import Foreign.Marshal.Alloc
import Foreign.Ptr (nullPtr)
import Network.TLS.QUIC
import Network.UDP (UDPSocket)
import UnliftIO.Concurrent
import UnliftIO.STM

import Network.QUIC.Config
import Network.QUIC.Connector
import Network.QUIC.Crypto
import Network.QUIC.Imports
import Network.QUIC.Logger
import Network.QUIC.Parameters
import Network.QUIC.Qlog
import Network.QUIC.Recovery
import Network.QUIC.Stream
import Network.QUIC.Types

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

dummySecrets :: TrafficSecrets a
dummySecrets :: forall a. TrafficSecrets a
dummySecrets = (forall a. ByteString -> ClientTrafficSecret a
ClientTrafficSecret ByteString
"", forall a. ByteString -> ServerTrafficSecret a
ServerTrafficSecret ByteString
"")

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

data RoleInfo = ClientInfo { RoleInfo -> ByteString
clientInitialToken :: Token -- new or retry token
                           , RoleInfo -> ResumptionInfo
resumptionInfo     :: ResumptionInfo
                           , RoleInfo -> Bool
incompatibleVN     :: Bool
                           }
              | ServerInfo { RoleInfo -> TokenManager
tokenManager    :: ~CT.TokenManager
                           , RoleInfo -> CID -> Connection -> IO ()
registerCID     :: CID -> Connection -> IO ()
                           , RoleInfo -> CID -> IO ()
unregisterCID   :: CID -> IO ()
                           , RoleInfo -> Bool
askRetry        :: Bool
                           , RoleInfo -> ThreadId
baseThreadId    :: ~ThreadId
                           , RoleInfo -> Maybe CertificateChain
certChain       :: Maybe CertificateChain
                           }

defaultClientRoleInfo :: RoleInfo
defaultClientRoleInfo :: RoleInfo
defaultClientRoleInfo = ClientInfo {
    clientInitialToken :: ByteString
clientInitialToken = ByteString
emptyToken
  , resumptionInfo :: ResumptionInfo
resumptionInfo     = ResumptionInfo
defaultResumptionInfo
  , incompatibleVN :: Bool
incompatibleVN     = Bool
False
  }

defaultServerRoleInfo :: RoleInfo
defaultServerRoleInfo :: RoleInfo
defaultServerRoleInfo = ServerInfo {
    tokenManager :: TokenManager
tokenManager = forall a. HasCallStack => a
undefined
  , registerCID :: CID -> Connection -> IO ()
registerCID = \CID
_ Connection
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , unregisterCID :: CID -> IO ()
unregisterCID = \CID
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , askRetry :: Bool
askRetry = Bool
False
  , baseThreadId :: ThreadId
baseThreadId = forall a. HasCallStack => a
undefined
  , certChain :: Maybe CertificateChain
certChain = forall a. Maybe a
Nothing
  }

-- fixme: limitation
data CIDDB = CIDDB {
    CIDDB -> CIDInfo
usedCIDInfo   :: CIDInfo
  , CIDDB -> IntMap CIDInfo
cidInfos      :: IntMap CIDInfo
  , CIDDB -> Map CID Int
revInfos      :: Map CID Int
  , CIDDB -> Int
nextSeqNum    :: Int  -- only for mine (new)
  , CIDDB -> Bool
triggeredByMe :: Bool -- only for peer's
  } deriving (Int -> CIDDB -> ShowS
[CIDDB] -> ShowS
CIDDB -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CIDDB] -> ShowS
$cshowList :: [CIDDB] -> ShowS
show :: CIDDB -> String
$cshow :: CIDDB -> String
showsPrec :: Int -> CIDDB -> ShowS
$cshowsPrec :: Int -> CIDDB -> ShowS
Show)

newCIDDB :: CID -> CIDDB
newCIDDB :: CID -> CIDDB
newCIDDB CID
cid = CIDDB {
    usedCIDInfo :: CIDInfo
usedCIDInfo   = CIDInfo
cidInfo
  , cidInfos :: IntMap CIDInfo
cidInfos      = forall a. Int -> a -> IntMap a
IntMap.singleton Int
0 CIDInfo
cidInfo
  , revInfos :: Map CID Int
revInfos      = forall k a. k -> a -> Map k a
Map.singleton CID
cid Int
0
  , nextSeqNum :: Int
nextSeqNum    = Int
1
  , triggeredByMe :: Bool
triggeredByMe = Bool
False
  }
  where
    cidInfo :: CIDInfo
cidInfo = Int -> CID -> StatelessResetToken -> CIDInfo
CIDInfo Int
0 CID
cid (Bytes -> StatelessResetToken
StatelessResetToken Bytes
"")

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

data MigrationState = NonMigration
                    | MigrationStarted
                    | SendChallenge [PathData]
                    | RecvResponse
                    deriving (MigrationState -> MigrationState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MigrationState -> MigrationState -> Bool
$c/= :: MigrationState -> MigrationState -> Bool
== :: MigrationState -> MigrationState -> Bool
$c== :: MigrationState -> MigrationState -> Bool
Eq, Int -> MigrationState -> ShowS
[MigrationState] -> ShowS
MigrationState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MigrationState] -> ShowS
$cshowList :: [MigrationState] -> ShowS
show :: MigrationState -> String
$cshow :: MigrationState -> String
showsPrec :: Int -> MigrationState -> ShowS
$cshowsPrec :: Int -> MigrationState -> ShowS
Show)

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

data Coder = Coder {
    Coder -> Buffer -> ByteString -> AssDat -> Int -> IO Int
encrypt    :: Buffer -> PlainText  -> AssDat -> PacketNumber -> IO Int
  , Coder -> Buffer -> ByteString -> AssDat -> Int -> IO Int
decrypt    :: Buffer -> CipherText -> AssDat -> PacketNumber -> IO Int
  , Coder -> Maybe Supplement
supplement :: Maybe Supplement
  }

initialCoder :: Coder
initialCoder :: Coder
initialCoder = Coder {
    encrypt :: Buffer -> ByteString -> AssDat -> Int -> IO Int
encrypt    = \Buffer
_ ByteString
_ AssDat
_ Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
  , decrypt :: Buffer -> ByteString -> AssDat -> Int -> IO Int
decrypt    = \Buffer
_ ByteString
_ AssDat
_ Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
  , supplement :: Maybe Supplement
supplement = forall a. Maybe a
Nothing
  }

data Coder1RTT = Coder1RTT {
    Coder1RTT -> Coder
coder1RTT  :: Coder
  , Coder1RTT -> TrafficSecrets ApplicationSecret
secretN    :: TrafficSecrets ApplicationSecret
  }

initialCoder1RTT :: Coder1RTT
initialCoder1RTT :: Coder1RTT
initialCoder1RTT = Coder1RTT {
    coder1RTT :: Coder
coder1RTT  = Coder
initialCoder
  , secretN :: TrafficSecrets ApplicationSecret
secretN    = (forall a. ByteString -> ClientTrafficSecret a
ClientTrafficSecret ByteString
"", forall a. ByteString -> ServerTrafficSecret a
ServerTrafficSecret ByteString
"")
  }

data Protector = Protector {
    Protector -> Buffer -> IO ()
setSample  :: Buffer -> IO ()
  , Protector -> IO Buffer
getMask    :: IO Buffer
  , Protector -> Sample -> Mask
unprotect :: Sample -> Mask
  }

initialProtector :: Protector
initialProtector :: Protector
initialProtector = Protector {
    setSample :: Buffer -> IO ()
setSample  = \Buffer
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , getMask :: IO Buffer
getMask    = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ptr a
nullPtr
  , unprotect :: Sample -> Mask
unprotect = \Sample
_ -> ByteString -> Mask
Mask ByteString
""
  }

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

data Negotiated = Negotiated {
      Negotiated -> HandshakeMode13
tlsHandshakeMode :: HandshakeMode13
    , Negotiated -> Maybe ByteString
applicationProtocol :: Maybe NegotiatedProtocol
    , Negotiated -> ApplicationSecretInfo
applicationSecretInfo :: ApplicationSecretInfo
    }

initialNegotiated :: Negotiated
initialNegotiated :: Negotiated
initialNegotiated = Negotiated {
      tlsHandshakeMode :: HandshakeMode13
tlsHandshakeMode = HandshakeMode13
FullHandshake
    , applicationProtocol :: Maybe ByteString
applicationProtocol = forall a. Maybe a
Nothing
    , applicationSecretInfo :: ApplicationSecretInfo
applicationSecretInfo = TrafficSecrets ApplicationSecret -> ApplicationSecretInfo
ApplicationSecretInfo forall a. TrafficSecrets a
defaultTrafficSecrets
    }

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

data Concurrency = Concurrency {
    Concurrency -> Int
currentStream :: Int
  , Concurrency -> Int
streamType    :: Int
  , Concurrency -> Int
maxStreams    :: Int
  }

newConcurrency :: Role -> Direction -> Int -> Concurrency
newConcurrency :: Role -> Direction -> Int -> Concurrency
newConcurrency Role
rl Direction
dir Int
n = Int -> Int -> Int -> Concurrency
Concurrency Int
typ Int
typ Int
n
 where
   bidi :: Bool
bidi = Direction
dir forall a. Eq a => a -> a -> Bool
== Direction
Bidirectional
   typ :: Int
typ | Role
rl forall a. Eq a => a -> a -> Bool
== Role
Client = if Bool
bidi then Int
0 else Int
2
       | Bool
otherwise    = if Bool
bidi then Int
1 else Int
3

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

type Send = Buffer -> Int -> IO ()
type Recv = IO ReceivedPacket

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

-- | A quic connection to carry multiple streams.
data Connection = Connection {
    Connection -> ConnState
connState         :: ConnState
  -- Actions
  , Connection -> DebugLogger
connDebugLog      :: DebugLogger -- ^ A logger for debugging.
  , Connection -> QLogger
connQLog          :: QLogger
  , Connection -> Hooks
connHooks         :: Hooks
  , Connection -> Send
connSend          :: ~Send -- ~ for testing
  , Connection -> Recv
connRecv          :: ~Recv -- ~ for testing
  -- Manage
  , Connection -> RecvQ
connRecvQ         :: RecvQ
  , Connection -> IORef UDPSocket
udpSocket         :: ~(IORef UDPSocket)
  , Connection -> IORef (IO ())
readers           :: IORef (IO ())
  , Connection -> IORef (IO ())
tmouter           :: IORef (IO ())
  , Connection -> ThreadId
mainThreadId      :: ThreadId
  -- Info
  , Connection -> IORef RoleInfo
roleInfo          :: IORef RoleInfo
  , Connection -> IORef VersionInfo
quicVersionInfo   :: IORef VersionInfo
  , Connection -> VersionInfo
origVersionInfo   :: VersionInfo -- chosenVersion is client's ver in Initial
  -- Mine
  , Connection -> Parameters
myParameters      :: Parameters
  , Connection -> IORef CIDDB
myCIDDB           :: IORef CIDDB
  -- Peer
  , Connection -> IORef Parameters
peerParameters    :: IORef Parameters
  , Connection -> TVar CIDDB
peerCIDDB         :: TVar CIDDB
  -- Queues
  , Connection -> InputQ
inputQ            :: InputQ
  , Connection -> CryptoQ
cryptoQ           :: CryptoQ
  , Connection -> OutputQ
outputQ           :: OutputQ
  , Connection -> MigrationQ
migrationQ        :: MigrationQ
  , Connection -> Shared
shared            :: Shared
  , Connection -> IORef Int
delayedAckCount   :: IORef Int
  , Connection -> IORef (IO ())
delayedAckCancel  :: IORef (IO ())
  -- State
  , Connection -> IORef Int
peerPacketNumber  :: IORef PacketNumber      -- for RTT1
  , Connection -> IORef StreamTable
streamTable       :: IORef StreamTable
  , Connection -> TVar Concurrency
myStreamId        :: TVar Concurrency
  , Connection -> TVar Concurrency
myUniStreamId     :: TVar Concurrency
  , Connection -> IORef Concurrency
peerStreamId      :: IORef Concurrency
  , Connection -> TVar Flow
flowTx            :: TVar Flow
  , Connection -> IORef Flow
flowRx            :: IORef Flow
  , Connection -> TVar MigrationState
migrationState    :: TVar MigrationState
  , Connection -> IORef Microseconds
minIdleTimeout    :: IORef Microseconds
  , Connection -> TVar Int
bytesTx           :: TVar Int
  , Connection -> TVar Int
bytesRx           :: TVar Int
  , Connection -> TVar Bool
addressValidated  :: TVar Bool
  -- TLS
  , Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
pendingQ          :: Array   EncryptionLevel (TVar [ReceivedPacket])
  , Connection -> IOArray EncryptionLevel Cipher
ciphers           :: IOArray EncryptionLevel Cipher
  , Connection -> IOArray EncryptionLevel Coder
coders            :: IOArray EncryptionLevel Coder
  , Connection -> IOArray Bool Coder1RTT
coders1RTT        :: IOArray Bool            Coder1RTT
  , Connection -> IOArray EncryptionLevel Protector
protectors        :: IOArray EncryptionLevel Protector
  , Connection -> IORef (Bool, Int)
currentKeyPhase   :: IORef (Bool, PacketNumber)
  , Connection -> IORef Negotiated
negotiated        :: IORef Negotiated
  , Connection -> IORef AuthCIDs
connMyAuthCIDs    :: IORef AuthCIDs
  , Connection -> IORef AuthCIDs
connPeerAuthCIDs  :: IORef AuthCIDs
  -- Resources
  , Connection -> IORef (IO ())
connResources     :: IORef (IO ())
  , Connection -> Buffer
encodeBuf         :: Buffer
  , Connection -> SizedBuffer
encryptRes        :: SizedBuffer
  , Connection -> Buffer
decryptBuf        :: Buffer
  -- Recovery
  , Connection -> LDCC
connLDCC          :: LDCC
  }

instance KeepQlog Connection where
    keepQlog :: Connection -> QLogger
keepQlog Connection
conn = Connection -> QLogger
connQLog Connection
conn

instance Connector Connection where
    getRole :: Connection -> Role
getRole            = ConnState -> Role
role forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getEncryptionLevel :: Connection -> IO EncryptionLevel
getEncryptionLevel = forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> TVar EncryptionLevel
encryptionLevel forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getMaxPacketSize :: Connection -> IO Int
getMaxPacketSize   = forall a. IORef a -> IO a
readIORef  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> IORef Int
maxPacketSize   forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getConnectionState :: Connection -> IO ConnectionState
getConnectionState = forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> TVar ConnectionState
connectionState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getPacketNumber :: Connection -> IO Int
getPacketNumber    = forall a. IORef a -> IO a
readIORef  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> IORef Int
packetNumber    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getAlive :: Connection -> IO Bool
getAlive           = forall a. IORef a -> IO a
readIORef  forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> IORef Bool
connectionAlive forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState

setDead :: Connection -> IO ()
setDead :: Connection -> IO ()
setDead Connection
conn = forall a. IORef a -> a -> IO ()
writeIORef (ConnState -> IORef Bool
connectionAlive forall a b. (a -> b) -> a -> b
$ Connection -> ConnState
connState Connection
conn) Bool
False

makePendingQ :: IO (Array EncryptionLevel (TVar [ReceivedPacket]))
makePendingQ :: IO (Array EncryptionLevel (TVar [ReceivedPacket]))
makePendingQ = do
    TVar [ReceivedPacket]
q1 <- forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO []
    TVar [ReceivedPacket]
q2 <- forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO []
    TVar [ReceivedPacket]
q3 <- forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO []
    let lst :: [(EncryptionLevel, TVar [ReceivedPacket])]
lst = [(EncryptionLevel
RTT0Level,TVar [ReceivedPacket]
q1),(EncryptionLevel
HandshakeLevel,TVar [ReceivedPacket]
q2),(EncryptionLevel
RTT1Level,TVar [ReceivedPacket]
q3)]
        arr :: Array EncryptionLevel (TVar [ReceivedPacket])
arr = forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (EncryptionLevel
RTT0Level,EncryptionLevel
RTT1Level) [(EncryptionLevel, TVar [ReceivedPacket])]
lst
    forall (m :: * -> *) a. Monad m => a -> m a
return Array EncryptionLevel (TVar [ReceivedPacket])
arr

newConnection :: Role
              -> Parameters
              -> VersionInfo -> AuthCIDs -> AuthCIDs
              -> DebugLogger -> QLogger -> Hooks
              -> IORef UDPSocket
              -> RecvQ
              -> Send
              -> Recv
              -> IO Connection
newConnection :: Role
-> Parameters
-> VersionInfo
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef UDPSocket
-> RecvQ
-> Send
-> Recv
-> IO Connection
newConnection Role
rl Parameters
myparams VersionInfo
verInfo AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs DebugLogger
debugLog QLogger
qLog Hooks
hooks IORef UDPSocket
sref RecvQ
recvQ ~Send
send ~Recv
recv = do
    OutputQ
outQ <- forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
    let put :: PlainPacket -> m ()
put PlainPacket
x = forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TQueue a -> a -> STM ()
writeTQueue OutputQ
outQ forall a b. (a -> b) -> a -> b
$ PlainPacket -> Output
OutRetrans PlainPacket
x
    ConnState
connstate <- Role -> IO ConnState
newConnState Role
rl
    let bufsiz :: Int
bufsiz = Int
maximumUdpPayloadSize
    Buffer
encBuf   <- forall a. Int -> IO (Ptr a)
mallocBytes Int
bufsiz
    Buffer
ecrptBuf <- forall a. Int -> IO (Ptr a)
mallocBytes Int
bufsiz
    Buffer
dcrptBuf <- forall a. Int -> IO (Ptr a)
mallocBytes Int
bufsiz
    ConnState
-> DebugLogger
-> QLogger
-> Hooks
-> Send
-> Recv
-> RecvQ
-> IORef UDPSocket
-> IORef (IO ())
-> IORef (IO ())
-> ThreadId
-> IORef RoleInfo
-> IORef VersionInfo
-> VersionInfo
-> Parameters
-> IORef CIDDB
-> IORef Parameters
-> TVar CIDDB
-> InputQ
-> CryptoQ
-> OutputQ
-> MigrationQ
-> Shared
-> IORef Int
-> IORef (IO ())
-> IORef Int
-> IORef StreamTable
-> TVar Concurrency
-> TVar Concurrency
-> IORef Concurrency
-> TVar Flow
-> IORef Flow
-> TVar MigrationState
-> IORef Microseconds
-> TVar Int
-> TVar Int
-> TVar Bool
-> Array EncryptionLevel (TVar [ReceivedPacket])
-> IOArray EncryptionLevel Cipher
-> IOArray EncryptionLevel Coder
-> IOArray Bool Coder1RTT
-> IOArray EncryptionLevel Protector
-> IORef (Bool, Int)
-> IORef Negotiated
-> IORef AuthCIDs
-> IORef AuthCIDs
-> IORef (IO ())
-> Buffer
-> SizedBuffer
-> Buffer
-> LDCC
-> Connection
Connection ConnState
connstate DebugLogger
debugLog QLogger
qLog Hooks
hooks Send
send Recv
recv RecvQ
recvQ IORef UDPSocket
sref
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef (forall (m :: * -> *) a. Monad m => a -> m a
return ())
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef (forall (m :: * -> *) a. Monad m => a -> m a
return ())
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadIO m => m ThreadId
myThreadId
        -- Info
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef RoleInfo
initialRoleInfo
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef VersionInfo
verInfo
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return VersionInfo
verInfo
        -- Mine
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Parameters
myparams
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef (CID -> CIDDB
newCIDDB CID
myCID)
        -- Peer
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Parameters
baseParameters
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (CID -> CIDDB
newCIDDB CID
peerCID)
        -- Queues
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return OutputQ
outQ
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Shared
newShared
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Int
0
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef (forall (m :: * -> *) a. Monad m => a -> m a
return ())
        -- State
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Int
0
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef StreamTable
emptyStreamTable
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (Role -> Direction -> Int -> Concurrency
newConcurrency Role
rl Direction
Bidirectional  Int
0)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (Role -> Direction -> Int -> Concurrency
newConcurrency Role
rl Direction
Unidirectional Int
0)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef  Concurrency
peerConcurrency
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Flow
defaultFlow
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Flow
defaultFlow { flowMaxData :: Int
flowMaxData = Parameters -> Int
initialMaxData Parameters
myparams }
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO MigrationState
NonMigration
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef (Milliseconds -> Microseconds
milliToMicro forall a b. (a -> b) -> a -> b
$ Parameters -> Milliseconds
maxIdleTimeout Parameters
myparams)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int
0
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int
0
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Bool
False
        -- TLS
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Array EncryptionLevel (TVar [ReceivedPacket]))
makePendingQ
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (EncryptionLevel
InitialLevel,EncryptionLevel
RTT1Level) Cipher
defaultCipher
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (EncryptionLevel
InitialLevel,EncryptionLevel
HandshakeLevel) Coder
initialCoder
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Bool
False,Bool
True) Coder1RTT
initialCoder1RTT
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (EncryptionLevel
InitialLevel,EncryptionLevel
RTT1Level) Protector
initialProtector
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef (Bool
False,Int
0)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Negotiated
initialNegotiated
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef AuthCIDs
myAuthCIDs
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef AuthCIDs
peerAuthCIDs
        -- Resources
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef (forall a. Ptr a -> IO ()
free Buffer
encBuf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Ptr a -> IO ()
free Buffer
ecrptBuf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Ptr a -> IO ()
free Buffer
dcrptBuf)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
encBuf   -- used sender or closere
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return (Buffer -> Int -> SizedBuffer
SizedBuffer Buffer
ecrptBuf Int
bufsiz) -- used sender
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
dcrptBuf -- used receiver
        -- Recovery
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConnState -> QLogger -> (PlainPacket -> IO ()) -> IO LDCC
newLDCC ConnState
connstate QLogger
qLog forall {m :: * -> *}. MonadIO m => PlainPacket -> m ()
put
  where
    isclient :: Bool
isclient = Role
rl forall a. Eq a => a -> a -> Bool
== Role
Client
    initialRoleInfo :: RoleInfo
initialRoleInfo
      | Bool
isclient  = RoleInfo
defaultClientRoleInfo
      | Bool
otherwise = RoleInfo
defaultServerRoleInfo
    myCID :: CID
myCID   = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ AuthCIDs -> Maybe CID
initSrcCID AuthCIDs
myAuthCIDs
    peerCID :: CID
peerCID = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ AuthCIDs -> Maybe CID
initSrcCID AuthCIDs
peerAuthCIDs
    peer :: Role
peer | Bool
isclient  = Role
Server
         | Bool
otherwise = Role
Client
    peerConcurrency :: Concurrency
peerConcurrency = Role -> Direction -> Int -> Concurrency
newConcurrency Role
peer Direction
Bidirectional (Parameters -> Int
initialMaxStreamsBidi Parameters
myparams)

defaultTrafficSecrets :: (ClientTrafficSecret a, ServerTrafficSecret a)
defaultTrafficSecrets :: forall a. TrafficSecrets a
defaultTrafficSecrets = (forall a. ByteString -> ClientTrafficSecret a
ClientTrafficSecret ByteString
"", forall a. ByteString -> ServerTrafficSecret a
ServerTrafficSecret ByteString
"")

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

clientConnection :: ClientConfig
                 -> VersionInfo -> AuthCIDs -> AuthCIDs
                 -> DebugLogger -> QLogger -> Hooks
                 -> IORef UDPSocket
                 -> RecvQ -> Send -> Recv
                 -> IO Connection
clientConnection :: ClientConfig
-> VersionInfo
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef UDPSocket
-> RecvQ
-> Send
-> Recv
-> IO Connection
clientConnection ClientConfig{Bool
String
[Cipher]
[Group]
[Version]
Maybe Int
Maybe String
Credentials
ResumptionInfo
Parameters
Hooks
String -> IO ()
Version -> IO (Maybe [ByteString])
ccAutoMigration :: ClientConfig -> Bool
ccDebugLog :: ClientConfig -> Bool
ccPacketSize :: ClientConfig -> Maybe Int
ccResumption :: ClientConfig -> ResumptionInfo
ccValidate :: ClientConfig -> Bool
ccALPN :: ClientConfig -> Version -> IO (Maybe [ByteString])
ccPortName :: ClientConfig -> String
ccServerName :: ClientConfig -> String
ccUse0RTT :: ClientConfig -> Bool
ccHooks :: ClientConfig -> Hooks
ccCredentials :: ClientConfig -> Credentials
ccQLog :: ClientConfig -> Maybe String
ccKeyLog :: ClientConfig -> String -> IO ()
ccParameters :: ClientConfig -> Parameters
ccGroups :: ClientConfig -> [Group]
ccCiphers :: ClientConfig -> [Cipher]
ccVersions :: ClientConfig -> [Version]
ccAutoMigration :: Bool
ccDebugLog :: Bool
ccPacketSize :: Maybe Int
ccResumption :: ResumptionInfo
ccValidate :: Bool
ccALPN :: Version -> IO (Maybe [ByteString])
ccPortName :: String
ccServerName :: String
ccUse0RTT :: Bool
ccHooks :: Hooks
ccCredentials :: Credentials
ccQLog :: Maybe String
ccKeyLog :: String -> IO ()
ccParameters :: Parameters
ccGroups :: [Group]
ccCiphers :: [Cipher]
ccVersions :: [Version]
..} VersionInfo
verInfo AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs =
    Role
-> Parameters
-> VersionInfo
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef UDPSocket
-> RecvQ
-> Send
-> Recv
-> IO Connection
newConnection Role
Client Parameters
ccParameters VersionInfo
verInfo AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs

serverConnection :: ServerConfig
                 -> VersionInfo -> AuthCIDs -> AuthCIDs
                 -> DebugLogger -> QLogger -> Hooks
                 -> IORef UDPSocket
                 -> RecvQ -> Send -> Recv
                 -> IO Connection
serverConnection :: ServerConfig
-> VersionInfo
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef UDPSocket
-> RecvQ
-> Send
-> Recv
-> IO Connection
serverConnection ServerConfig{Bool
[(IP, PortNumber)]
[Cipher]
[Group]
[Version]
Maybe String
Maybe (Version -> [ByteString] -> IO ByteString)
Credentials
SessionManager
Parameters
Hooks
String -> IO ()
scDebugLog :: ServerConfig -> Maybe String
scSessionManager :: ServerConfig -> SessionManager
scRequireRetry :: ServerConfig -> Bool
scALPN :: ServerConfig -> Maybe (Version -> [ByteString] -> IO ByteString)
scAddresses :: ServerConfig -> [(IP, PortNumber)]
scUse0RTT :: ServerConfig -> Bool
scHooks :: ServerConfig -> Hooks
scCredentials :: ServerConfig -> Credentials
scQLog :: ServerConfig -> Maybe String
scKeyLog :: ServerConfig -> String -> IO ()
scParameters :: ServerConfig -> Parameters
scGroups :: ServerConfig -> [Group]
scCiphers :: ServerConfig -> [Cipher]
scVersions :: ServerConfig -> [Version]
scDebugLog :: Maybe String
scSessionManager :: SessionManager
scRequireRetry :: Bool
scALPN :: Maybe (Version -> [ByteString] -> IO ByteString)
scAddresses :: [(IP, PortNumber)]
scUse0RTT :: Bool
scHooks :: Hooks
scCredentials :: Credentials
scQLog :: Maybe String
scKeyLog :: String -> IO ()
scParameters :: Parameters
scGroups :: [Group]
scCiphers :: [Cipher]
scVersions :: [Version]
..} VersionInfo
verInfo AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs =
    Role
-> Parameters
-> VersionInfo
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef UDPSocket
-> RecvQ
-> Send
-> Recv
-> IO Connection
newConnection Role
Server Parameters
scParameters VersionInfo
verInfo AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs

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

newtype Input = InpStream Stream deriving Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Input] -> ShowS
$cshowList :: [Input] -> ShowS
show :: Input -> String
$cshow :: Input -> String
showsPrec :: Int -> Input -> ShowS
$cshowsPrec :: Int -> Input -> ShowS
Show
data   Crypto = InpHandshake EncryptionLevel ByteString deriving Int -> Crypto -> ShowS
[Crypto] -> ShowS
Crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Crypto] -> ShowS
$cshowList :: [Crypto] -> ShowS
show :: Crypto -> String
$cshow :: Crypto -> String
showsPrec :: Int -> Crypto -> ShowS
$cshowsPrec :: Int -> Crypto -> ShowS
Show

data Output = OutControl   EncryptionLevel [Frame] (IO ())
            | OutHandshake [(EncryptionLevel,ByteString)]
            | OutRetrans   PlainPacket

type InputQ  = TQueue Input
type CryptoQ = TQueue Crypto
type OutputQ = TQueue Output
type MigrationQ = TQueue ReceivedPacket

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

type SendStreamQ = TQueue TxStreamData

data Shared = Shared {
    Shared -> IORef Bool
sharedCloseSent     :: IORef Bool
  , Shared -> IORef Bool
sharedCloseReceived :: IORef Bool
  , Shared -> IORef Bool
shared1RTTReady     :: IORef Bool
  , Shared -> SendStreamQ
sharedSendStreamQ   :: SendStreamQ
  }

newShared :: IO Shared
newShared :: IO Shared
newShared = IORef Bool -> IORef Bool -> IORef Bool -> SendStreamQ -> Shared
Shared forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef Bool
False
                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Bool
False
                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Bool
False
                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO