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

module Network.QUIC.Connection.Types where

import Control.Concurrent
import Control.Concurrent.STM
import qualified Crypto.Token as CT
import Data.Array.IO
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.Ptr
import Network.Socket (Socket, SockAddr)
import Network.TLS.QUIC

import Network.QUIC.Config
import Network.QUIC.Connector
import Network.QUIC.Crypto
import Network.QUIC.CryptoFusion
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 :: TrafficSecrets a
dummySecrets = (ByteString -> ClientTrafficSecret a
forall a. ByteString -> ClientTrafficSecret a
ClientTrafficSecret ByteString
"", ByteString -> ServerTrafficSecret a
forall a. ByteString -> ServerTrafficSecret a
ServerTrafficSecret ByteString
"")

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

data RoleInfo = ClientInfo { RoleInfo -> ByteString
clientInitialToken :: Token -- new or retry token
                           , RoleInfo -> ResumptionInfo
resumptionInfo     :: ResumptionInfo
                           , RoleInfo -> Maybe SockAddr
serverAddr         :: Maybe SockAddr
                           }
              | 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 :: ByteString -> ResumptionInfo -> Maybe SockAddr -> RoleInfo
ClientInfo {
    clientInitialToken :: ByteString
clientInitialToken = ByteString
emptyToken
  , resumptionInfo :: ResumptionInfo
resumptionInfo = ResumptionInfo
defaultResumptionInfo
  , serverAddr :: Maybe SockAddr
serverAddr     = Maybe SockAddr
forall a. Maybe a
Nothing
  }

defaultServerRoleInfo :: RoleInfo
defaultServerRoleInfo :: RoleInfo
defaultServerRoleInfo = ServerInfo :: TokenManager
-> (CID -> Connection -> IO ())
-> (CID -> IO ())
-> Bool
-> ThreadId
-> Maybe CertificateChain
-> RoleInfo
ServerInfo {
    tokenManager :: TokenManager
tokenManager = TokenManager
forall a. HasCallStack => a
undefined
  , registerCID :: CID -> Connection -> IO ()
registerCID = \CID
_ Connection
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , unregisterCID :: CID -> IO ()
unregisterCID = \CID
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , askRetry :: Bool
askRetry = Bool
False
  , baseThreadId :: ThreadId
baseThreadId = ThreadId
forall a. HasCallStack => a
undefined
  , certChain :: Maybe CertificateChain
certChain = Maybe CertificateChain
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
(Int -> CIDDB -> ShowS)
-> (CIDDB -> String) -> ([CIDDB] -> ShowS) -> Show CIDDB
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 :: CIDInfo -> IntMap CIDInfo -> Map CID Int -> Int -> Bool -> CIDDB
CIDDB {
    usedCIDInfo :: CIDInfo
usedCIDInfo   = CIDInfo
cidInfo
  , cidInfos :: IntMap CIDInfo
cidInfos      = Int -> CIDInfo -> IntMap CIDInfo
forall a. Int -> a -> IntMap a
IntMap.singleton Int
0 CIDInfo
cidInfo
  , revInfos :: Map CID Int
revInfos      = CID -> Int -> Map CID Int
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
(MigrationState -> MigrationState -> Bool)
-> (MigrationState -> MigrationState -> Bool) -> Eq MigrationState
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
(Int -> MigrationState -> ShowS)
-> (MigrationState -> String)
-> ([MigrationState] -> ShowS)
-> Show MigrationState
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 -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int
encrypt :: Buffer -> Int -> Buffer -> Int -> PacketNumber -> Buffer -> IO Int
  , Coder -> Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int
decrypt :: Buffer -> Int -> Buffer -> Int -> PacketNumber -> Buffer -> IO Int
  }

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

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

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

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

initialProtector :: Protector
initialProtector :: Protector
initialProtector = Protector :: (Buffer -> IO ()) -> IO Buffer -> (Sample -> Mask) -> Protector
Protector {
    setSample :: Buffer -> IO ()
setSample = \Buffer
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  , getMask :: IO Buffer
getMask   = Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
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 :: HandshakeMode13
-> Maybe ByteString -> ApplicationSecretInfo -> Negotiated
Negotiated {
      tlsHandshakeMode :: HandshakeMode13
tlsHandshakeMode = HandshakeMode13
FullHandshake
    , applicationProtocol :: Maybe ByteString
applicationProtocol = Maybe ByteString
forall a. Maybe a
Nothing
    , applicationSecretInfo :: ApplicationSecretInfo
applicationSecretInfo = TrafficSecrets ApplicationSecret -> ApplicationSecretInfo
ApplicationSecretInfo TrafficSecrets ApplicationSecret
forall a. (ClientTrafficSecret a, ServerTrafficSecret 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 Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Bidirectional
   typ :: Int
typ | Role
rl Role -> Role -> Bool
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

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

-- | 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
  -- Manage
  , Connection -> RecvQ
connRecvQ         :: RecvQ
  , Connection -> IORef [Socket]
sockets           :: IORef [Socket]
  , 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 Version
quicVersion       :: IORef Version
  -- 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
handshakeCIDs     :: IORef AuthCIDs
  -- Resources
  , Connection -> IORef (IO ())
connResources     :: IORef (IO ())
  -- 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 (ConnState -> Role)
-> (Connection -> ConnState) -> Connection -> Role
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getEncryptionLevel :: Connection -> IO EncryptionLevel
getEncryptionLevel = TVar EncryptionLevel -> IO EncryptionLevel
forall a. TVar a -> IO a
readTVarIO (TVar EncryptionLevel -> IO EncryptionLevel)
-> (Connection -> TVar EncryptionLevel)
-> Connection
-> IO EncryptionLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> TVar EncryptionLevel
encryptionLevel (ConnState -> TVar EncryptionLevel)
-> (Connection -> ConnState) -> Connection -> TVar EncryptionLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getMaxPacketSize :: Connection -> IO Int
getMaxPacketSize   = IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef  (IORef Int -> IO Int)
-> (Connection -> IORef Int) -> Connection -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> IORef Int
maxPacketSize   (ConnState -> IORef Int)
-> (Connection -> ConnState) -> Connection -> IORef Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getConnectionState :: Connection -> IO ConnectionState
getConnectionState = TVar ConnectionState -> IO ConnectionState
forall a. TVar a -> IO a
readTVarIO (TVar ConnectionState -> IO ConnectionState)
-> (Connection -> TVar ConnectionState)
-> Connection
-> IO ConnectionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> TVar ConnectionState
connectionState (ConnState -> TVar ConnectionState)
-> (Connection -> ConnState) -> Connection -> TVar ConnectionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getPacketNumber :: Connection -> IO Int
getPacketNumber    = IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef  (IORef Int -> IO Int)
-> (Connection -> IORef Int) -> Connection -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> IORef Int
packetNumber    (ConnState -> IORef Int)
-> (Connection -> ConnState) -> Connection -> IORef Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getAlive :: Connection -> IO Bool
getAlive           = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef  (IORef Bool -> IO Bool)
-> (Connection -> IORef Bool) -> Connection -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> IORef Bool
connectionAlive (ConnState -> IORef Bool)
-> (Connection -> ConnState) -> Connection -> IORef Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState

setDead :: Connection -> IO ()
setDead :: Connection -> IO ()
setDead Connection
conn = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ConnState -> IORef Bool
connectionAlive (ConnState -> IORef Bool) -> ConnState -> IORef Bool
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 <- [ReceivedPacket] -> IO (TVar [ReceivedPacket])
forall a. a -> IO (TVar a)
newTVarIO []
    TVar [ReceivedPacket]
q2 <- [ReceivedPacket] -> IO (TVar [ReceivedPacket])
forall a. a -> IO (TVar a)
newTVarIO []
    TVar [ReceivedPacket]
q3 <- [ReceivedPacket] -> IO (TVar [ReceivedPacket])
forall a. a -> IO (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 = (EncryptionLevel, EncryptionLevel)
-> [(EncryptionLevel, TVar [ReceivedPacket])]
-> Array EncryptionLevel (TVar [ReceivedPacket])
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (EncryptionLevel
RTT0Level,EncryptionLevel
RTT1Level) [(EncryptionLevel, TVar [ReceivedPacket])]
lst
    Array EncryptionLevel (TVar [ReceivedPacket])
-> IO (Array EncryptionLevel (TVar [ReceivedPacket]))
forall (m :: * -> *) a. Monad m => a -> m a
return Array EncryptionLevel (TVar [ReceivedPacket])
arr

newConnection :: Role
              -> Parameters
              -> Version -> AuthCIDs -> AuthCIDs
              -> DebugLogger -> QLogger -> Hooks
              -> IORef [Socket]
              -> RecvQ
              -> IO Connection
newConnection :: Role
-> Parameters
-> Version
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef [Socket]
-> RecvQ
-> IO Connection
newConnection Role
rl Parameters
myparams Version
ver AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs DebugLogger
debugLog QLogger
qLog Hooks
hooks IORef [Socket]
sref RecvQ
recvQ = do
    OutputQ
outQ <- IO OutputQ
forall a. IO (TQueue a)
newTQueueIO
    let put :: PlainPacket -> IO ()
put PlainPacket
x = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ OutputQ -> Output -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue OutputQ
outQ (Output -> STM ()) -> Output -> STM ()
forall a b. (a -> b) -> a -> b
$ PlainPacket -> Output
OutRetrans PlainPacket
x
    ConnState
connstate <- Role -> IO ConnState
newConnState Role
rl
    ConnState
-> DebugLogger
-> QLogger
-> Hooks
-> RecvQ
-> IORef [Socket]
-> IORef (IO ())
-> IORef (IO ())
-> ThreadId
-> IORef RoleInfo
-> IORef Version
-> 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 (IO ())
-> LDCC
-> Connection
Connection ConnState
connstate DebugLogger
debugLog QLogger
qLog Hooks
hooks RecvQ
recvQ IORef [Socket]
sref
        (IORef (IO ())
 -> IORef (IO ())
 -> ThreadId
 -> IORef RoleInfo
 -> IORef Version
 -> 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 (IO ())
 -> LDCC
 -> Connection)
-> IO (IORef (IO ()))
-> IO
     (IORef (IO ())
      -> ThreadId
      -> IORef RoleInfo
      -> IORef Version
      -> 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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> IO (IORef (IO ()))
forall a. a -> IO (IORef a)
newIORef (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        IO
  (IORef (IO ())
   -> ThreadId
   -> IORef RoleInfo
   -> IORef Version
   -> 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 (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef (IO ()))
-> IO
     (ThreadId
      -> IORef RoleInfo
      -> IORef Version
      -> 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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO () -> IO (IORef (IO ()))
forall a. a -> IO (IORef a)
newIORef (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        IO
  (ThreadId
   -> IORef RoleInfo
   -> IORef Version
   -> 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 (IO ())
   -> LDCC
   -> Connection)
-> IO ThreadId
-> IO
     (IORef RoleInfo
      -> IORef Version
      -> 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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO ThreadId
myThreadId
        -- Info
        IO
  (IORef RoleInfo
   -> IORef Version
   -> 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 (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef RoleInfo)
-> IO
     (IORef Version
      -> 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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RoleInfo -> IO (IORef RoleInfo)
forall a. a -> IO (IORef a)
newIORef RoleInfo
initialRoleInfo
        IO
  (IORef Version
   -> 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 (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef Version)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Version -> IO (IORef Version)
forall a. a -> IO (IORef a)
newIORef Version
ver
        -- Mine
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO Parameters
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parameters -> IO Parameters
forall (m :: * -> *) a. Monad m => a -> m a
return Parameters
myparams
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef CIDDB)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CIDDB -> IO (IORef CIDDB)
forall a. a -> IO (IORef a)
newIORef (CID -> CIDDB
newCIDDB CID
myCID)
        -- Peer
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef Parameters)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parameters -> IO (IORef Parameters)
forall a. a -> IO (IORef a)
newIORef Parameters
baseParameters
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (TVar CIDDB)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CIDDB -> IO (TVar CIDDB)
forall a. a -> IO (TVar a)
newTVarIO (CID -> CIDDB
newCIDDB CID
peerCID)
        -- Queues
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO InputQ
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO InputQ
forall a. IO (TQueue a)
newTQueueIO
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO CryptoQ
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO CryptoQ
forall a. IO (TQueue a)
newTQueueIO
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO OutputQ
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OutputQ -> IO OutputQ
forall (m :: * -> *) a. Monad m => a -> m a
return OutputQ
outQ
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO MigrationQ
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO MigrationQ
forall a. IO (TQueue a)
newTQueueIO
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO Shared
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Shared
newShared
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef Int)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef (IO ()))
-> 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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO () -> IO (IORef (IO ()))
forall a. a -> IO (IORef a)
newIORef (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        -- State
        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 (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef Int)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef StreamTable)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StreamTable -> IO (IORef StreamTable)
forall a. a -> IO (IORef a)
newIORef StreamTable
emptyStreamTable
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (TVar Concurrency)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Concurrency -> IO (TVar Concurrency)
forall a. a -> IO (TVar a)
newTVarIO (Role -> Direction -> Int -> Concurrency
newConcurrency Role
rl Direction
Bidirectional  Int
0)
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (TVar Concurrency)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Concurrency -> IO (TVar Concurrency)
forall a. a -> IO (TVar a)
newTVarIO (Role -> Direction -> Int -> Concurrency
newConcurrency Role
rl Direction
Unidirectional Int
0)
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef Concurrency)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Concurrency -> IO (IORef Concurrency)
forall a. a -> IO (IORef a)
newIORef  Concurrency
peerConcurrency
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (TVar Flow)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Flow -> IO (TVar Flow)
forall a. a -> IO (TVar a)
newTVarIO Flow
defaultFlow
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef Flow)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Flow -> IO (IORef Flow)
forall a. a -> IO (IORef a)
newIORef Flow
defaultFlow { flowMaxData :: Int
flowMaxData = Parameters -> Int
initialMaxData Parameters
myparams }
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (TVar MigrationState)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MigrationState -> IO (TVar MigrationState)
forall a. a -> IO (TVar a)
newTVarIO MigrationState
NonMigration
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef Microseconds)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Microseconds -> IO (IORef Microseconds)
forall a. a -> IO (IORef a)
newIORef (Milliseconds -> Microseconds
milliToMicro (Milliseconds -> Microseconds) -> Milliseconds -> Microseconds
forall a b. (a -> b) -> a -> b
$ Parameters -> Milliseconds
maxIdleTimeout Parameters
myparams)
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (TVar Int)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO Int
0
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (TVar Int)
-> IO
     (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 (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO Int
0
        IO
  (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 (IO ())
   -> LDCC
   -> Connection)
-> IO (TVar Bool)
-> IO
     (Array EncryptionLevel (TVar [ReceivedPacket])
      -> IOArray EncryptionLevel Cipher
      -> IOArray EncryptionLevel Coder
      -> IOArray Bool Coder1RTT
      -> IOArray EncryptionLevel Protector
      -> IORef (Bool, Int)
      -> IORef Negotiated
      -> IORef AuthCIDs
      -> IORef (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
newTVarIO Bool
False
        -- TLS
        IO
  (Array EncryptionLevel (TVar [ReceivedPacket])
   -> IOArray EncryptionLevel Cipher
   -> IOArray EncryptionLevel Coder
   -> IOArray Bool Coder1RTT
   -> IOArray EncryptionLevel Protector
   -> IORef (Bool, Int)
   -> IORef Negotiated
   -> IORef AuthCIDs
   -> IORef (IO ())
   -> LDCC
   -> Connection)
-> IO (Array EncryptionLevel (TVar [ReceivedPacket]))
-> IO
     (IOArray EncryptionLevel Cipher
      -> IOArray EncryptionLevel Coder
      -> IOArray Bool Coder1RTT
      -> IOArray EncryptionLevel Protector
      -> IORef (Bool, Int)
      -> IORef Negotiated
      -> IORef AuthCIDs
      -> IORef (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Array EncryptionLevel (TVar [ReceivedPacket]))
makePendingQ
        IO
  (IOArray EncryptionLevel Cipher
   -> IOArray EncryptionLevel Coder
   -> IOArray Bool Coder1RTT
   -> IOArray EncryptionLevel Protector
   -> IORef (Bool, Int)
   -> IORef Negotiated
   -> IORef AuthCIDs
   -> IORef (IO ())
   -> LDCC
   -> Connection)
-> IO (IOArray EncryptionLevel Cipher)
-> IO
     (IOArray EncryptionLevel Coder
      -> IOArray Bool Coder1RTT
      -> IOArray EncryptionLevel Protector
      -> IORef (Bool, Int)
      -> IORef Negotiated
      -> IORef AuthCIDs
      -> IORef (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (EncryptionLevel, EncryptionLevel)
-> Cipher -> IO (IOArray EncryptionLevel Cipher)
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
        IO
  (IOArray EncryptionLevel Coder
   -> IOArray Bool Coder1RTT
   -> IOArray EncryptionLevel Protector
   -> IORef (Bool, Int)
   -> IORef Negotiated
   -> IORef AuthCIDs
   -> IORef (IO ())
   -> LDCC
   -> Connection)
-> IO (IOArray EncryptionLevel Coder)
-> IO
     (IOArray Bool Coder1RTT
      -> IOArray EncryptionLevel Protector
      -> IORef (Bool, Int)
      -> IORef Negotiated
      -> IORef AuthCIDs
      -> IORef (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (EncryptionLevel, EncryptionLevel)
-> Coder -> IO (IOArray EncryptionLevel Coder)
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
        IO
  (IOArray Bool Coder1RTT
   -> IOArray EncryptionLevel Protector
   -> IORef (Bool, Int)
   -> IORef Negotiated
   -> IORef AuthCIDs
   -> IORef (IO ())
   -> LDCC
   -> Connection)
-> IO (IOArray Bool Coder1RTT)
-> IO
     (IOArray EncryptionLevel Protector
      -> IORef (Bool, Int)
      -> IORef Negotiated
      -> IORef AuthCIDs
      -> IORef (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool, Bool) -> Coder1RTT -> IO (IOArray Bool Coder1RTT)
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
        IO
  (IOArray EncryptionLevel Protector
   -> IORef (Bool, Int)
   -> IORef Negotiated
   -> IORef AuthCIDs
   -> IORef (IO ())
   -> LDCC
   -> Connection)
-> IO (IOArray EncryptionLevel Protector)
-> IO
     (IORef (Bool, Int)
      -> IORef Negotiated
      -> IORef AuthCIDs
      -> IORef (IO ())
      -> LDCC
      -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (EncryptionLevel, EncryptionLevel)
-> Protector -> IO (IOArray EncryptionLevel Protector)
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
        IO
  (IORef (Bool, Int)
   -> IORef Negotiated
   -> IORef AuthCIDs
   -> IORef (IO ())
   -> LDCC
   -> Connection)
-> IO (IORef (Bool, Int))
-> IO
     (IORef Negotiated
      -> IORef AuthCIDs -> IORef (IO ()) -> LDCC -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool, Int) -> IO (IORef (Bool, Int))
forall a. a -> IO (IORef a)
newIORef (Bool
False,Int
0)
        IO
  (IORef Negotiated
   -> IORef AuthCIDs -> IORef (IO ()) -> LDCC -> Connection)
-> IO (IORef Negotiated)
-> IO (IORef AuthCIDs -> IORef (IO ()) -> LDCC -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Negotiated -> IO (IORef Negotiated)
forall a. a -> IO (IORef a)
newIORef Negotiated
initialNegotiated
        IO (IORef AuthCIDs -> IORef (IO ()) -> LDCC -> Connection)
-> IO (IORef AuthCIDs) -> IO (IORef (IO ()) -> LDCC -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AuthCIDs -> IO (IORef AuthCIDs)
forall a. a -> IO (IORef a)
newIORef AuthCIDs
peerAuthCIDs
        -- Resources
        IO (IORef (IO ()) -> LDCC -> Connection)
-> IO (IORef (IO ())) -> IO (LDCC -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO () -> IO (IORef (IO ()))
forall a. a -> IO (IORef a)
newIORef (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        -- Recovery
        IO (LDCC -> Connection) -> IO LDCC -> IO Connection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConnState -> QLogger -> (PlainPacket -> IO ()) -> IO LDCC
newLDCC ConnState
connstate QLogger
qLog PlainPacket -> IO ()
put
  where
    isclient :: Bool
isclient = Role
rl Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role
Client
    initialRoleInfo :: RoleInfo
initialRoleInfo
      | Bool
isclient  = RoleInfo
defaultClientRoleInfo
      | Bool
otherwise = RoleInfo
defaultServerRoleInfo
    Just CID
myCID   = AuthCIDs -> Maybe CID
initSrcCID AuthCIDs
myAuthCIDs
    Just CID
peerCID = 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 :: (ClientTrafficSecret a, ServerTrafficSecret a)
defaultTrafficSecrets = (ByteString -> ClientTrafficSecret a
forall a. ByteString -> ClientTrafficSecret a
ClientTrafficSecret ByteString
"", ByteString -> ServerTrafficSecret a
forall a. ByteString -> ServerTrafficSecret a
ServerTrafficSecret ByteString
"")

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

clientConnection :: ClientConfig
                 -> Version -> AuthCIDs -> AuthCIDs
                 -> DebugLogger -> QLogger -> Hooks
                 -> IORef [Socket]
                 -> RecvQ
                 -> IO Connection
clientConnection :: ClientConfig
-> Version
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef [Socket]
-> RecvQ
-> 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]
..} Version
ver AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs =
    Role
-> Parameters
-> Version
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef [Socket]
-> RecvQ
-> IO Connection
newConnection Role
Client Parameters
ccParameters Version
ver AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs

serverConnection :: ServerConfig
                 -> Version -> AuthCIDs -> AuthCIDs
                 -> DebugLogger -> QLogger -> Hooks
                 -> IORef [Socket]
                 -> RecvQ
                 -> IO Connection
serverConnection :: ServerConfig
-> Version
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef [Socket]
-> RecvQ
-> 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]
..} Version
ver AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs =
    Role
-> Parameters
-> Version
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef [Socket]
-> RecvQ
-> IO Connection
newConnection Role
Server Parameters
scParameters Version
ver AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs

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

newtype Input = InpStream Stream deriving Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
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
(Int -> Crypto -> ShowS)
-> (Crypto -> String) -> ([Crypto] -> ShowS) -> Show Crypto
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 (IORef Bool -> IORef Bool -> IORef Bool -> SendStreamQ -> Shared)
-> IO (IORef Bool)
-> IO (IORef Bool -> IORef Bool -> SendStreamQ -> Shared)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
                   IO (IORef Bool -> IORef Bool -> SendStreamQ -> Shared)
-> IO (IORef Bool) -> IO (IORef Bool -> SendStreamQ -> Shared)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
                   IO (IORef Bool -> SendStreamQ -> Shared)
-> IO (IORef Bool) -> IO (SendStreamQ -> Shared)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
                   IO (SendStreamQ -> Shared) -> IO SendStreamQ -> IO Shared
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO SendStreamQ
forall a. IO (TQueue a)
newTQueueIO