{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module Network.Transport.QUIC.Internal.QUICTransport
  ( -- * QUICTransport
    QUICTransport,
    newQUICTransport,
    foldOpenEndPoints,
    transportConfig,
    transportInputSocket,
    transportState,

    -- ** Configuration
    QUICTransportConfig (..),
    defaultQUICTransportConfig,

    -- * TransportState
    TransportState (..),
    localEndPoints,
    nextEndPointId,

    -- * LocalEndPoint
    LocalEndPoint,
    localAddress,
    localEndPointId,
    localEndPointState,
    localQueue,
    nextConnInId,
    nextSelfConnOutId,
    newLocalEndPoint,
    closeLocalEndpoint,

    -- * LocalEndPointState
    LocalEndPointState (..),
    ValidLocalEndPointState,
    incomingConnections,
    outgoingConnections,
    nextConnectionCounter,

    -- ** ConnectionCounter
    ConnectionCounter,

    -- * RemoteEndPoint
    RemoteEndPoint (..),
    remoteEndPointAddress,
    remoteEndPointId,
    remoteServerConnId,
    remoteEndPointState,
    closeRemoteEndPoint,
    createRemoteEndPoint,
    createConnectionTo,

    -- ** Remote endpoint state
    RemoteEndPointState (..),
    ValidRemoteEndPointState (..),
    remoteStream,
    remoteStreamIsClosed,
    remoteIncoming,
    remoteNextConnOutId,
    Direction (..),

    -- * Re-exports
    (^.),
  )
where

import Control.Concurrent.Async (forConcurrently_)
import Control.Concurrent.MVar (MVar, modifyMVar, modifyMVar_, newMVar, putMVar, readMVar)
import Control.Concurrent.STM.TQueue (TQueue, writeTQueue)
import Control.Exception (Exception (displayException), SomeException, bracketOnError, try)
import Control.Monad (forM_)
import Control.Monad.STM (atomically)
import Data.Binary qualified as Binary
import Data.ByteString qualified as BS
import Data.Function ((&))
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Word (Word32)
import Lens.Micro.Platform (makeLenses, (%~), (+~), (^.))
import Network.QUIC (Stream)
import Network.QUIC qualified as QUIC
import Network.Socket (HostName, ServiceName, Socket)
import Network.Socket qualified as N
import Network.TLS (Credential)
import Network.Transport (ConnectErrorCode (ConnectFailed), EndPointAddress, Event (EndPointClosed, ErrorEvent), EventErrorCode (EventConnectionLost), NewEndPointErrorCode (NewEndPointFailed), TransportError (TransportError))
import Network.Transport.QUIC.Internal.Client (streamToEndpoint)
import Network.Transport.QUIC.Internal.Messaging
  ( ClientConnId,
    ServerConnId,
    firstNonReservedServerConnId,
    sendCloseConnection,
    sendCloseEndPoint,
  )
import Network.Transport.QUIC.Internal.QUICAddr (EndPointId, QUICAddr (..), encodeQUICAddr)

{- The QUIC transport has three levels of statefullness:

1. The transport itself

The transport contains state required to create new endpoints, and close them. This includes,
for example, a container of existing endpoints.

2. Endpoints

An endpoint has some state regarding the connections it has. An endpoint may have zero or more
connection, and must have state to be able to create new connections, and close existing ones.

3. Connections

Finally, each connection between endpoint has some state, needed to receive data.
-}

-- | Represents the configuration used by the entire transport.
data QUICTransportConfig = QUICTransportConfig
  { -- | Host name, which can be an IP address or a domain name.
    QUICTransportConfig -> HostName
hostName :: HostName,
    -- | Port or service name. The default is port 443.
    QUICTransportConfig -> HostName
serviceName :: ServiceName,
    -- | At least one set of credentials is required.
    QUICTransportConfig -> NonEmpty Credential
credentials :: NonEmpty Credential,
    -- | Note that if your credentials is self-signed, you will have
    -- to turn off 'validateCredentials'. This should only be set to 'False'
    -- in tests, or in a private network.
    QUICTransportConfig -> Bool
validateCredentials :: Bool
  }
  deriving (QUICTransportConfig -> QUICTransportConfig -> Bool
(QUICTransportConfig -> QUICTransportConfig -> Bool)
-> (QUICTransportConfig -> QUICTransportConfig -> Bool)
-> Eq QUICTransportConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QUICTransportConfig -> QUICTransportConfig -> Bool
== :: QUICTransportConfig -> QUICTransportConfig -> Bool
$c/= :: QUICTransportConfig -> QUICTransportConfig -> Bool
/= :: QUICTransportConfig -> QUICTransportConfig -> Bool
Eq, Int -> QUICTransportConfig -> ShowS
[QUICTransportConfig] -> ShowS
QUICTransportConfig -> HostName
(Int -> QUICTransportConfig -> ShowS)
-> (QUICTransportConfig -> HostName)
-> ([QUICTransportConfig] -> ShowS)
-> Show QUICTransportConfig
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QUICTransportConfig -> ShowS
showsPrec :: Int -> QUICTransportConfig -> ShowS
$cshow :: QUICTransportConfig -> HostName
show :: QUICTransportConfig -> HostName
$cshowList :: [QUICTransportConfig] -> ShowS
showList :: [QUICTransportConfig] -> ShowS
Show)

defaultQUICTransportConfig :: HostName -> NonEmpty Credential -> QUICTransportConfig
defaultQUICTransportConfig :: HostName -> NonEmpty Credential -> QUICTransportConfig
defaultQUICTransportConfig HostName
host NonEmpty Credential
creds =
  QUICTransportConfig
    { hostName :: HostName
hostName = HostName
host,
      serviceName :: HostName
serviceName = HostName
"443",
      credentials :: NonEmpty Credential
credentials = NonEmpty Credential
creds,
      validateCredentials :: Bool
validateCredentials = Bool
True
    }

data QUICTransport = QUICTransport
  { QUICTransport -> QUICTransportConfig
_transportConfig :: QUICTransportConfig,
    QUICTransport -> Socket
_transportInputSocket :: Socket,
    QUICTransport -> MVar TransportState
_transportState :: MVar TransportState
  }

data TransportState
  = TransportStateValid ValidTransportState
  | TransportStateClosed

data ValidTransportState = ValidTransportState
  { ValidTransportState -> Map EndPointId LocalEndPoint
_localEndPoints :: !(Map EndPointId LocalEndPoint),
    ValidTransportState -> EndPointId
_nextEndPointId :: !EndPointId
  }

-- | Create a new QUICTransport
newQUICTransport :: QUICTransportConfig -> IO QUICTransport
newQUICTransport :: QUICTransportConfig -> IO QUICTransport
newQUICTransport QUICTransportConfig
config = do
  AddrInfo
addr <- NonEmpty AddrInfo -> AddrInfo
forall a. NonEmpty a -> a
NE.head (NonEmpty AddrInfo -> AddrInfo)
-> IO (NonEmpty AddrInfo) -> IO AddrInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe AddrInfo
-> Maybe HostName -> Maybe HostName -> IO (NonEmpty AddrInfo)
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo
-> Maybe HostName -> Maybe HostName -> IO (t AddrInfo)
N.getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
N.defaultHints) (HostName -> Maybe HostName
forall a. a -> Maybe a
Just (QUICTransportConfig -> HostName
hostName QUICTransportConfig
config)) (HostName -> Maybe HostName
forall a. a -> Maybe a
Just (QUICTransportConfig -> HostName
serviceName QUICTransportConfig
config))
  IO Socket
-> (Socket -> IO ())
-> (Socket -> IO QUICTransport)
-> IO QUICTransport
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
    ( Family -> SocketType -> ProtocolNumber -> IO Socket
N.socket
        (AddrInfo -> Family
N.addrFamily AddrInfo
addr)
        SocketType
N.Datagram -- QUIC is based on UDP
        ProtocolNumber
N.defaultProtocol
    )
    Socket -> IO ()
N.close
    ((Socket -> IO QUICTransport) -> IO QUICTransport)
-> (Socket -> IO QUICTransport) -> IO QUICTransport
forall a b. (a -> b) -> a -> b
$ \Socket
socket -> do
      Socket -> SocketOption -> Int -> IO ()
N.setSocketOption Socket
socket SocketOption
N.ReuseAddr Int
1
      Socket -> (ProtocolNumber -> IO ()) -> IO ()
forall r. Socket -> (ProtocolNumber -> IO r) -> IO r
N.withFdSocket Socket
socket ProtocolNumber -> IO ()
N.setCloseOnExecIfNeeded
      Socket -> SockAddr -> IO ()
N.bind Socket
socket (AddrInfo -> SockAddr
N.addrAddress AddrInfo
addr)

      PortNumber
port <- Socket -> IO PortNumber
N.socketPort Socket
socket
      QUICTransportConfig
-> Socket -> MVar TransportState -> QUICTransport
QUICTransport
        QUICTransportConfig
config{serviceName=show port}
        Socket
socket
        (MVar TransportState -> QUICTransport)
-> IO (MVar TransportState) -> IO QUICTransport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TransportState -> IO (MVar TransportState)
forall a. a -> IO (MVar a)
newMVar (ValidTransportState -> TransportState
TransportStateValid (ValidTransportState -> TransportState)
-> ValidTransportState -> TransportState
forall a b. (a -> b) -> a -> b
$ Map EndPointId LocalEndPoint -> EndPointId -> ValidTransportState
ValidTransportState Map EndPointId LocalEndPoint
forall a. Monoid a => a
mempty EndPointId
1)

data LocalEndPoint = OpenLocalEndPoint
  { LocalEndPoint -> EndPointAddress
_localAddress :: !EndPointAddress,
    LocalEndPoint -> EndPointId
_localEndPointId :: !EndPointId,
    LocalEndPoint -> MVar LocalEndPointState
_localEndPointState :: !(MVar LocalEndPointState),
    -- | Queue used to receive events
    LocalEndPoint -> TQueue Event
_localQueue :: !(TQueue Event)
  }

-- | A 'ConnectionCounter' uniquely identifies a connections within the context of an endpoint.
-- This allows to hold multiple separate connections between two endpoint addresses.
--
-- NOTE: I tried to use the `StreamId` type from the `quic` library, but it was
-- clearly not unique per stream. I don't understand if this was intentional or not.
newtype ConnectionCounter = ConnectionCounter Word32
  deriving newtype (ConnectionCounter -> ConnectionCounter -> Bool
(ConnectionCounter -> ConnectionCounter -> Bool)
-> (ConnectionCounter -> ConnectionCounter -> Bool)
-> Eq ConnectionCounter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionCounter -> ConnectionCounter -> Bool
== :: ConnectionCounter -> ConnectionCounter -> Bool
$c/= :: ConnectionCounter -> ConnectionCounter -> Bool
/= :: ConnectionCounter -> ConnectionCounter -> Bool
Eq, Int -> ConnectionCounter -> ShowS
[ConnectionCounter] -> ShowS
ConnectionCounter -> HostName
(Int -> ConnectionCounter -> ShowS)
-> (ConnectionCounter -> HostName)
-> ([ConnectionCounter] -> ShowS)
-> Show ConnectionCounter
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionCounter -> ShowS
showsPrec :: Int -> ConnectionCounter -> ShowS
$cshow :: ConnectionCounter -> HostName
show :: ConnectionCounter -> HostName
$cshowList :: [ConnectionCounter] -> ShowS
showList :: [ConnectionCounter] -> ShowS
Show, Eq ConnectionCounter
Eq ConnectionCounter =>
(ConnectionCounter -> ConnectionCounter -> Ordering)
-> (ConnectionCounter -> ConnectionCounter -> Bool)
-> (ConnectionCounter -> ConnectionCounter -> Bool)
-> (ConnectionCounter -> ConnectionCounter -> Bool)
-> (ConnectionCounter -> ConnectionCounter -> Bool)
-> (ConnectionCounter -> ConnectionCounter -> ConnectionCounter)
-> (ConnectionCounter -> ConnectionCounter -> ConnectionCounter)
-> Ord ConnectionCounter
ConnectionCounter -> ConnectionCounter -> Bool
ConnectionCounter -> ConnectionCounter -> Ordering
ConnectionCounter -> ConnectionCounter -> ConnectionCounter
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConnectionCounter -> ConnectionCounter -> Ordering
compare :: ConnectionCounter -> ConnectionCounter -> Ordering
$c< :: ConnectionCounter -> ConnectionCounter -> Bool
< :: ConnectionCounter -> ConnectionCounter -> Bool
$c<= :: ConnectionCounter -> ConnectionCounter -> Bool
<= :: ConnectionCounter -> ConnectionCounter -> Bool
$c> :: ConnectionCounter -> ConnectionCounter -> Bool
> :: ConnectionCounter -> ConnectionCounter -> Bool
$c>= :: ConnectionCounter -> ConnectionCounter -> Bool
>= :: ConnectionCounter -> ConnectionCounter -> Bool
$cmax :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
max :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
$cmin :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
min :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
Ord, ConnectionCounter
ConnectionCounter -> ConnectionCounter -> Bounded ConnectionCounter
forall a. a -> a -> Bounded a
$cminBound :: ConnectionCounter
minBound :: ConnectionCounter
$cmaxBound :: ConnectionCounter
maxBound :: ConnectionCounter
Bounded, Int -> ConnectionCounter
ConnectionCounter -> Int
ConnectionCounter -> [ConnectionCounter]
ConnectionCounter -> ConnectionCounter
ConnectionCounter -> ConnectionCounter -> [ConnectionCounter]
ConnectionCounter
-> ConnectionCounter -> ConnectionCounter -> [ConnectionCounter]
(ConnectionCounter -> ConnectionCounter)
-> (ConnectionCounter -> ConnectionCounter)
-> (Int -> ConnectionCounter)
-> (ConnectionCounter -> Int)
-> (ConnectionCounter -> [ConnectionCounter])
-> (ConnectionCounter -> ConnectionCounter -> [ConnectionCounter])
-> (ConnectionCounter -> ConnectionCounter -> [ConnectionCounter])
-> (ConnectionCounter
    -> ConnectionCounter -> ConnectionCounter -> [ConnectionCounter])
-> Enum ConnectionCounter
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ConnectionCounter -> ConnectionCounter
succ :: ConnectionCounter -> ConnectionCounter
$cpred :: ConnectionCounter -> ConnectionCounter
pred :: ConnectionCounter -> ConnectionCounter
$ctoEnum :: Int -> ConnectionCounter
toEnum :: Int -> ConnectionCounter
$cfromEnum :: ConnectionCounter -> Int
fromEnum :: ConnectionCounter -> Int
$cenumFrom :: ConnectionCounter -> [ConnectionCounter]
enumFrom :: ConnectionCounter -> [ConnectionCounter]
$cenumFromThen :: ConnectionCounter -> ConnectionCounter -> [ConnectionCounter]
enumFromThen :: ConnectionCounter -> ConnectionCounter -> [ConnectionCounter]
$cenumFromTo :: ConnectionCounter -> ConnectionCounter -> [ConnectionCounter]
enumFromTo :: ConnectionCounter -> ConnectionCounter -> [ConnectionCounter]
$cenumFromThenTo :: ConnectionCounter
-> ConnectionCounter -> ConnectionCounter -> [ConnectionCounter]
enumFromThenTo :: ConnectionCounter
-> ConnectionCounter -> ConnectionCounter -> [ConnectionCounter]
Enum, Num ConnectionCounter
Ord ConnectionCounter
(Num ConnectionCounter, Ord ConnectionCounter) =>
(ConnectionCounter -> Rational) -> Real ConnectionCounter
ConnectionCounter -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: ConnectionCounter -> Rational
toRational :: ConnectionCounter -> Rational
Real, Enum ConnectionCounter
Real ConnectionCounter
(Real ConnectionCounter, Enum ConnectionCounter) =>
(ConnectionCounter -> ConnectionCounter -> ConnectionCounter)
-> (ConnectionCounter -> ConnectionCounter -> ConnectionCounter)
-> (ConnectionCounter -> ConnectionCounter -> ConnectionCounter)
-> (ConnectionCounter -> ConnectionCounter -> ConnectionCounter)
-> (ConnectionCounter
    -> ConnectionCounter -> (ConnectionCounter, ConnectionCounter))
-> (ConnectionCounter
    -> ConnectionCounter -> (ConnectionCounter, ConnectionCounter))
-> (ConnectionCounter -> Integer)
-> Integral ConnectionCounter
ConnectionCounter -> Integer
ConnectionCounter
-> ConnectionCounter -> (ConnectionCounter, ConnectionCounter)
ConnectionCounter -> ConnectionCounter -> ConnectionCounter
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
quot :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
$crem :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
rem :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
$cdiv :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
div :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
$cmod :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
mod :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
$cquotRem :: ConnectionCounter
-> ConnectionCounter -> (ConnectionCounter, ConnectionCounter)
quotRem :: ConnectionCounter
-> ConnectionCounter -> (ConnectionCounter, ConnectionCounter)
$cdivMod :: ConnectionCounter
-> ConnectionCounter -> (ConnectionCounter, ConnectionCounter)
divMod :: ConnectionCounter
-> ConnectionCounter -> (ConnectionCounter, ConnectionCounter)
$ctoInteger :: ConnectionCounter -> Integer
toInteger :: ConnectionCounter -> Integer
Integral, Integer -> ConnectionCounter
ConnectionCounter -> ConnectionCounter
ConnectionCounter -> ConnectionCounter -> ConnectionCounter
(ConnectionCounter -> ConnectionCounter -> ConnectionCounter)
-> (ConnectionCounter -> ConnectionCounter -> ConnectionCounter)
-> (ConnectionCounter -> ConnectionCounter -> ConnectionCounter)
-> (ConnectionCounter -> ConnectionCounter)
-> (ConnectionCounter -> ConnectionCounter)
-> (ConnectionCounter -> ConnectionCounter)
-> (Integer -> ConnectionCounter)
-> Num ConnectionCounter
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
+ :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
$c- :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
- :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
$c* :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
* :: ConnectionCounter -> ConnectionCounter -> ConnectionCounter
$cnegate :: ConnectionCounter -> ConnectionCounter
negate :: ConnectionCounter -> ConnectionCounter
$cabs :: ConnectionCounter -> ConnectionCounter
abs :: ConnectionCounter -> ConnectionCounter
$csignum :: ConnectionCounter -> ConnectionCounter
signum :: ConnectionCounter -> ConnectionCounter
$cfromInteger :: Integer -> ConnectionCounter
fromInteger :: Integer -> ConnectionCounter
Num)

data LocalEndPointState
  = LocalEndPointStateValid ValidLocalEndPointState
  | LocalEndPointStateClosed
  deriving (Int -> LocalEndPointState -> ShowS
[LocalEndPointState] -> ShowS
LocalEndPointState -> HostName
(Int -> LocalEndPointState -> ShowS)
-> (LocalEndPointState -> HostName)
-> ([LocalEndPointState] -> ShowS)
-> Show LocalEndPointState
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocalEndPointState -> ShowS
showsPrec :: Int -> LocalEndPointState -> ShowS
$cshow :: LocalEndPointState -> HostName
show :: LocalEndPointState -> HostName
$cshowList :: [LocalEndPointState] -> ShowS
showList :: [LocalEndPointState] -> ShowS
Show)

data ValidLocalEndPointState = ValidLocalEndPointState
  { ValidLocalEndPointState
-> Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
_incomingConnections :: Map (EndPointAddress, ConnectionCounter) RemoteEndPoint,
    ValidLocalEndPointState
-> Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
_outgoingConnections :: Map (EndPointAddress, ConnectionCounter) RemoteEndPoint,
    ValidLocalEndPointState -> ClientConnId
_nextSelfConnOutId :: !ClientConnId,
    -- | We identify connections by remote endpoint address, AND ConnectionCounter,
    --    to support multiple connections between the same two endpoint addresses
    ValidLocalEndPointState -> ServerConnId
_nextConnInId :: !ServerConnId,
    ValidLocalEndPointState -> ConnectionCounter
_nextConnectionCounter :: ConnectionCounter
  }
  deriving (Int -> ValidLocalEndPointState -> ShowS
[ValidLocalEndPointState] -> ShowS
ValidLocalEndPointState -> HostName
(Int -> ValidLocalEndPointState -> ShowS)
-> (ValidLocalEndPointState -> HostName)
-> ([ValidLocalEndPointState] -> ShowS)
-> Show ValidLocalEndPointState
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidLocalEndPointState -> ShowS
showsPrec :: Int -> ValidLocalEndPointState -> ShowS
$cshow :: ValidLocalEndPointState -> HostName
show :: ValidLocalEndPointState -> HostName
$cshowList :: [ValidLocalEndPointState] -> ShowS
showList :: [ValidLocalEndPointState] -> ShowS
Show)

data RemoteEndPoint = RemoteEndPoint
  { RemoteEndPoint -> EndPointAddress
_remoteEndPointAddress :: !EndPointAddress,
    RemoteEndPoint -> EndPointId
_remoteEndPointId :: !EndPointId,
    RemoteEndPoint -> MVar RemoteEndPointState
_remoteEndPointState :: !(MVar RemoteEndPointState)
  }

remoteServerConnId :: RemoteEndPoint -> ServerConnId
remoteServerConnId :: RemoteEndPoint -> ServerConnId
remoteServerConnId = EndPointId -> ServerConnId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EndPointId -> ServerConnId)
-> (RemoteEndPoint -> EndPointId) -> RemoteEndPoint -> ServerConnId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteEndPoint -> EndPointId
_remoteEndPointId

instance Show RemoteEndPoint where
  show :: RemoteEndPoint -> HostName
show (RemoteEndPoint EndPointAddress
address EndPointId
_ MVar RemoteEndPointState
_) = HostName
"<RemoteEndPoint @ " HostName -> ShowS
forall a. Semigroup a => a -> a -> a
<> EndPointAddress -> HostName
forall a. Show a => a -> HostName
show EndPointAddress
address HostName -> ShowS
forall a. Semigroup a => a -> a -> a
<> HostName
">"

data RemoteEndPointState
  = -- | In the short window between a connection
    --      being initiated and the handshake completing
    RemoteEndPointInit
  | RemoteEndPointValid ValidRemoteEndPointState
  | RemoteEndPointClosed

data ValidRemoteEndPointState = ValidRemoteEndPointState
  { ValidRemoteEndPointState -> Stream
_remoteStream :: Stream,
    ValidRemoteEndPointState -> MVar ()
_remoteStreamIsClosed :: MVar (),
    ValidRemoteEndPointState -> Maybe ClientConnId
_remoteIncoming :: !(Maybe ClientConnId),
    ValidRemoteEndPointState -> ClientConnId
_remoteNextConnOutId :: !ClientConnId
  }

makeLenses ''QUICTransport
makeLenses ''TransportState
makeLenses ''ValidTransportState
makeLenses ''LocalEndPoint
makeLenses ''LocalEndPointState
makeLenses ''ValidLocalEndPointState
makeLenses ''RemoteEndPoint
makeLenses ''ValidRemoteEndPointState

-- | Fold over all open local endpoitns of a transport
foldOpenEndPoints :: QUICTransport -> (LocalEndPoint -> IO a) -> IO [a]
foldOpenEndPoints :: forall a. QUICTransport -> (LocalEndPoint -> IO a) -> IO [a]
foldOpenEndPoints QUICTransport
quicTransport LocalEndPoint -> IO a
f =
  MVar TransportState -> IO TransportState
forall a. MVar a -> IO a
readMVar (QUICTransport
quicTransport QUICTransport
-> Getting
     (MVar TransportState) QUICTransport (MVar TransportState)
-> MVar TransportState
forall s a. s -> Getting a s a -> a
^. Getting (MVar TransportState) QUICTransport (MVar TransportState)
Lens' QUICTransport (MVar TransportState)
transportState) IO TransportState -> (TransportState -> IO [a]) -> IO [a]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    TransportState
TransportStateClosed -> [a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    TransportStateValid ValidTransportState
st ->
      (LocalEndPoint -> IO a) -> [LocalEndPoint] -> IO [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM LocalEndPoint -> IO a
f (Map EndPointId LocalEndPoint -> [LocalEndPoint]
forall k a. Map k a -> [a]
Map.elems (Map EndPointId LocalEndPoint -> [LocalEndPoint])
-> Map EndPointId LocalEndPoint -> [LocalEndPoint]
forall a b. (a -> b) -> a -> b
$ ValidTransportState
st ValidTransportState
-> Getting
     (Map EndPointId LocalEndPoint)
     ValidTransportState
     (Map EndPointId LocalEndPoint)
-> Map EndPointId LocalEndPoint
forall s a. s -> Getting a s a -> a
^. Getting
  (Map EndPointId LocalEndPoint)
  ValidTransportState
  (Map EndPointId LocalEndPoint)
Lens' ValidTransportState (Map EndPointId LocalEndPoint)
localEndPoints)

newLocalEndPoint :: QUICTransport -> TQueue Event -> IO (Either (TransportError NewEndPointErrorCode) LocalEndPoint)
newLocalEndPoint :: QUICTransport
-> TQueue Event
-> IO (Either (TransportError NewEndPointErrorCode) LocalEndPoint)
newLocalEndPoint QUICTransport
quicTransport TQueue Event
newLocalQueue = do
  MVar TransportState
-> (TransportState
    -> IO
         (TransportState,
          Either (TransportError NewEndPointErrorCode) LocalEndPoint))
-> IO (Either (TransportError NewEndPointErrorCode) LocalEndPoint)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (QUICTransport
quicTransport QUICTransport
-> Getting
     (MVar TransportState) QUICTransport (MVar TransportState)
-> MVar TransportState
forall s a. s -> Getting a s a -> a
^. Getting (MVar TransportState) QUICTransport (MVar TransportState)
Lens' QUICTransport (MVar TransportState)
transportState) ((TransportState
  -> IO
       (TransportState,
        Either (TransportError NewEndPointErrorCode) LocalEndPoint))
 -> IO (Either (TransportError NewEndPointErrorCode) LocalEndPoint))
-> (TransportState
    -> IO
         (TransportState,
          Either (TransportError NewEndPointErrorCode) LocalEndPoint))
-> IO (Either (TransportError NewEndPointErrorCode) LocalEndPoint)
forall a b. (a -> b) -> a -> b
$ \case
    TransportState
TransportStateClosed -> (TransportState,
 Either (TransportError NewEndPointErrorCode) LocalEndPoint)
-> IO
     (TransportState,
      Either (TransportError NewEndPointErrorCode) LocalEndPoint)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TransportState
TransportStateClosed, TransportError NewEndPointErrorCode
-> Either (TransportError NewEndPointErrorCode) LocalEndPoint
forall a b. a -> Either a b
Left (TransportError NewEndPointErrorCode
 -> Either (TransportError NewEndPointErrorCode) LocalEndPoint)
-> TransportError NewEndPointErrorCode
-> Either (TransportError NewEndPointErrorCode) LocalEndPoint
forall a b. (a -> b) -> a -> b
$ NewEndPointErrorCode
-> HostName -> TransportError NewEndPointErrorCode
forall error. error -> HostName -> TransportError error
TransportError NewEndPointErrorCode
NewEndPointFailed HostName
"Transport closed")
    TransportStateValid ValidTransportState
validState -> do
      let newEndPointId :: EndPointId
newEndPointId = ValidTransportState
validState ValidTransportState
-> Getting EndPointId ValidTransportState EndPointId -> EndPointId
forall s a. s -> Getting a s a -> a
^. Getting EndPointId ValidTransportState EndPointId
Lens' ValidTransportState EndPointId
nextEndPointId

      MVar LocalEndPointState
newLocalState <-
        LocalEndPointState -> IO (MVar LocalEndPointState)
forall a. a -> IO (MVar a)
newMVar
          ( ValidLocalEndPointState -> LocalEndPointState
LocalEndPointStateValid (ValidLocalEndPointState -> LocalEndPointState)
-> ValidLocalEndPointState -> LocalEndPointState
forall a b. (a -> b) -> a -> b
$
              ValidLocalEndPointState
                { _incomingConnections :: Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
_incomingConnections = Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
forall a. Monoid a => a
mempty,
                  _outgoingConnections :: Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
_outgoingConnections = Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
forall a. Monoid a => a
mempty,
                  _nextConnInId :: ServerConnId
_nextConnInId = ServerConnId
firstNonReservedServerConnId,
                  _nextSelfConnOutId :: ClientConnId
_nextSelfConnOutId = ClientConnId
0,
                  _nextConnectionCounter :: ConnectionCounter
_nextConnectionCounter = ConnectionCounter
0
                }
          )
      let openEndpoint :: LocalEndPoint
openEndpoint =
            OpenLocalEndPoint
              { _localAddress :: EndPointAddress
_localAddress =
                  QUICAddr -> EndPointAddress
encodeQUICAddr
                    ( HostName -> HostName -> EndPointId -> QUICAddr
QUICAddr
                        (QUICTransportConfig -> HostName
hostName (QUICTransportConfig -> HostName)
-> QUICTransportConfig -> HostName
forall a b. (a -> b) -> a -> b
$ QUICTransport
quicTransport QUICTransport
-> Getting QUICTransportConfig QUICTransport QUICTransportConfig
-> QUICTransportConfig
forall s a. s -> Getting a s a -> a
^. Getting QUICTransportConfig QUICTransport QUICTransportConfig
Lens' QUICTransport QUICTransportConfig
transportConfig)
                        (QUICTransportConfig -> HostName
serviceName (QUICTransportConfig -> HostName)
-> QUICTransportConfig -> HostName
forall a b. (a -> b) -> a -> b
$ QUICTransport
quicTransport QUICTransport
-> Getting QUICTransportConfig QUICTransport QUICTransportConfig
-> QUICTransportConfig
forall s a. s -> Getting a s a -> a
^. Getting QUICTransportConfig QUICTransport QUICTransportConfig
Lens' QUICTransport QUICTransportConfig
transportConfig)
                        EndPointId
newEndPointId
                    ),
                _localEndPointId :: EndPointId
_localEndPointId = EndPointId
newEndPointId,
                _localEndPointState :: MVar LocalEndPointState
_localEndPointState = MVar LocalEndPointState
newLocalState,
                _localQueue :: TQueue Event
_localQueue = TQueue Event
newLocalQueue
              }

      (TransportState,
 Either (TransportError NewEndPointErrorCode) LocalEndPoint)
-> IO
     (TransportState,
      Either (TransportError NewEndPointErrorCode) LocalEndPoint)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( ValidTransportState -> TransportState
TransportStateValid
            ( ValidTransportState
validState
                ValidTransportState
-> (ValidTransportState -> ValidTransportState)
-> ValidTransportState
forall a b. a -> (a -> b) -> b
& (Map EndPointId LocalEndPoint
 -> Identity (Map EndPointId LocalEndPoint))
-> ValidTransportState -> Identity ValidTransportState
Lens' ValidTransportState (Map EndPointId LocalEndPoint)
localEndPoints ((Map EndPointId LocalEndPoint
  -> Identity (Map EndPointId LocalEndPoint))
 -> ValidTransportState -> Identity ValidTransportState)
-> (Map EndPointId LocalEndPoint -> Map EndPointId LocalEndPoint)
-> ValidTransportState
-> ValidTransportState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ EndPointId
-> LocalEndPoint
-> Map EndPointId LocalEndPoint
-> Map EndPointId LocalEndPoint
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert EndPointId
newEndPointId LocalEndPoint
openEndpoint
                ValidTransportState
-> (ValidTransportState -> ValidTransportState)
-> ValidTransportState
forall a b. a -> (a -> b) -> b
& (EndPointId -> Identity EndPointId)
-> ValidTransportState -> Identity ValidTransportState
Lens' ValidTransportState EndPointId
nextEndPointId ((EndPointId -> Identity EndPointId)
 -> ValidTransportState -> Identity ValidTransportState)
-> EndPointId -> ValidTransportState -> ValidTransportState
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ EndPointId
1
            ),
          LocalEndPoint
-> Either (TransportError NewEndPointErrorCode) LocalEndPoint
forall a b. b -> Either a b
Right LocalEndPoint
openEndpoint
        )

closeLocalEndpoint ::
  QUICTransport ->
  LocalEndPoint ->
  IO ()
closeLocalEndpoint :: QUICTransport -> LocalEndPoint -> IO ()
closeLocalEndpoint QUICTransport
quicTransport LocalEndPoint
localEndPoint = do
  MVar TransportState
-> (TransportState -> IO TransportState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ (QUICTransport
quicTransport QUICTransport
-> Getting
     (MVar TransportState) QUICTransport (MVar TransportState)
-> MVar TransportState
forall s a. s -> Getting a s a -> a
^. Getting (MVar TransportState) QUICTransport (MVar TransportState)
Lens' QUICTransport (MVar TransportState)
transportState) ((TransportState -> IO TransportState) -> IO ())
-> (TransportState -> IO TransportState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
    TransportState
TransportStateClosed -> TransportState -> IO TransportState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransportState
TransportStateClosed
    TransportStateValid ValidTransportState
vst ->
      TransportState -> IO TransportState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TransportState -> IO TransportState)
-> (ValidTransportState -> TransportState)
-> ValidTransportState
-> IO TransportState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValidTransportState -> TransportState
TransportStateValid (ValidTransportState -> IO TransportState)
-> ValidTransportState -> IO TransportState
forall a b. (a -> b) -> a -> b
$
        ValidTransportState
vst
          ValidTransportState
-> (ValidTransportState -> ValidTransportState)
-> ValidTransportState
forall a b. a -> (a -> b) -> b
& (Map EndPointId LocalEndPoint
 -> Identity (Map EndPointId LocalEndPoint))
-> ValidTransportState -> Identity ValidTransportState
Lens' ValidTransportState (Map EndPointId LocalEndPoint)
localEndPoints
            ((Map EndPointId LocalEndPoint
  -> Identity (Map EndPointId LocalEndPoint))
 -> ValidTransportState -> Identity ValidTransportState)
-> (Map EndPointId LocalEndPoint -> Map EndPointId LocalEndPoint)
-> ValidTransportState
-> ValidTransportState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ EndPointId
-> Map EndPointId LocalEndPoint -> Map EndPointId LocalEndPoint
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (LocalEndPoint
localEndPoint LocalEndPoint
-> Getting EndPointId LocalEndPoint EndPointId -> EndPointId
forall s a. s -> Getting a s a -> a
^. Getting EndPointId LocalEndPoint EndPointId
Lens' LocalEndPoint EndPointId
localEndPointId)

  Maybe ValidLocalEndPointState
mPreviousState <- MVar LocalEndPointState
-> (LocalEndPointState
    -> IO (LocalEndPointState, Maybe ValidLocalEndPointState))
-> IO (Maybe ValidLocalEndPointState)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (LocalEndPoint
localEndPoint LocalEndPoint
-> Getting
     (MVar LocalEndPointState) LocalEndPoint (MVar LocalEndPointState)
-> MVar LocalEndPointState
forall s a. s -> Getting a s a -> a
^. Getting
  (MVar LocalEndPointState) LocalEndPoint (MVar LocalEndPointState)
Lens' LocalEndPoint (MVar LocalEndPointState)
localEndPointState) ((LocalEndPointState
  -> IO (LocalEndPointState, Maybe ValidLocalEndPointState))
 -> IO (Maybe ValidLocalEndPointState))
-> (LocalEndPointState
    -> IO (LocalEndPointState, Maybe ValidLocalEndPointState))
-> IO (Maybe ValidLocalEndPointState)
forall a b. (a -> b) -> a -> b
$ \case
    LocalEndPointState
LocalEndPointStateClosed -> (LocalEndPointState, Maybe ValidLocalEndPointState)
-> IO (LocalEndPointState, Maybe ValidLocalEndPointState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalEndPointState
LocalEndPointStateClosed, Maybe ValidLocalEndPointState
forall a. Maybe a
Nothing)
    LocalEndPointStateValid ValidLocalEndPointState
st -> (LocalEndPointState, Maybe ValidLocalEndPointState)
-> IO (LocalEndPointState, Maybe ValidLocalEndPointState)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalEndPointState
LocalEndPointStateClosed, ValidLocalEndPointState -> Maybe ValidLocalEndPointState
forall a. a -> Maybe a
Just ValidLocalEndPointState
st)

  Maybe ValidLocalEndPointState
-> (ValidLocalEndPointState -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ValidLocalEndPointState
mPreviousState ((ValidLocalEndPointState -> IO ()) -> IO ())
-> (ValidLocalEndPointState -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ValidLocalEndPointState
vst ->
    Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
-> (RemoteEndPoint -> IO ()) -> IO ()
forall (f :: * -> *) a b. Foldable f => f a -> (a -> IO b) -> IO ()
forConcurrently_
      (ValidLocalEndPointState
vst ValidLocalEndPointState
-> Getting
     (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
     ValidLocalEndPointState
     (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
-> Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
  ValidLocalEndPointState
  (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
Lens'
  ValidLocalEndPointState
  (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
incomingConnections Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
-> Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
-> Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
forall a. Semigroup a => a -> a -> a
<> ValidLocalEndPointState
vst ValidLocalEndPointState
-> Getting
     (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
     ValidLocalEndPointState
     (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
-> Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
  ValidLocalEndPointState
  (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
Lens'
  ValidLocalEndPointState
  (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
outgoingConnections)
      RemoteEndPoint -> IO ()
tryCloseRemoteStream
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue Event -> Event -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue (LocalEndPoint
localEndPoint LocalEndPoint
-> Getting (TQueue Event) LocalEndPoint (TQueue Event)
-> TQueue Event
forall s a. s -> Getting a s a -> a
^. Getting (TQueue Event) LocalEndPoint (TQueue Event)
Lens' LocalEndPoint (TQueue Event)
localQueue) Event
EndPointClosed
  where
    tryCloseRemoteStream :: RemoteEndPoint -> IO ()
    tryCloseRemoteStream :: RemoteEndPoint -> IO ()
tryCloseRemoteStream RemoteEndPoint
remoteEndPoint = do
      Maybe (IO ())
mCleanup <- MVar RemoteEndPointState
-> (RemoteEndPointState -> IO (RemoteEndPointState, Maybe (IO ())))
-> IO (Maybe (IO ()))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (RemoteEndPoint
remoteEndPoint RemoteEndPoint
-> Getting
     (MVar RemoteEndPointState)
     RemoteEndPoint
     (MVar RemoteEndPointState)
-> MVar RemoteEndPointState
forall s a. s -> Getting a s a -> a
^. Getting
  (MVar RemoteEndPointState)
  RemoteEndPoint
  (MVar RemoteEndPointState)
Lens' RemoteEndPoint (MVar RemoteEndPointState)
remoteEndPointState) ((RemoteEndPointState -> IO (RemoteEndPointState, Maybe (IO ())))
 -> IO (Maybe (IO ())))
-> (RemoteEndPointState -> IO (RemoteEndPointState, Maybe (IO ())))
-> IO (Maybe (IO ()))
forall a b. (a -> b) -> a -> b
$ \case
        RemoteEndPointState
RemoteEndPointInit -> (RemoteEndPointState, Maybe (IO ()))
-> IO (RemoteEndPointState, Maybe (IO ()))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteEndPointState
RemoteEndPointClosed, Maybe (IO ())
forall a. Maybe a
Nothing)
        RemoteEndPointState
RemoteEndPointClosed -> (RemoteEndPointState, Maybe (IO ()))
-> IO (RemoteEndPointState, Maybe (IO ()))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteEndPointState
RemoteEndPointClosed, Maybe (IO ())
forall a. Maybe a
Nothing)
        RemoteEndPointValid ValidRemoteEndPointState
vst ->
          (RemoteEndPointState, Maybe (IO ()))
-> IO (RemoteEndPointState, Maybe (IO ()))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( RemoteEndPointState
RemoteEndPointClosed,
              IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ do
                Stream -> IO (Either QUICException ())
sendCloseEndPoint (ValidRemoteEndPointState
vst ValidRemoteEndPointState
-> Getting Stream ValidRemoteEndPointState Stream -> Stream
forall s a. s -> Getting a s a -> a
^. Getting Stream ValidRemoteEndPointState Stream
Lens' ValidRemoteEndPointState Stream
remoteStream)
                  IO (Either QUICException ()) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (ValidRemoteEndPointState
vst ValidRemoteEndPointState
-> Getting (MVar ()) ValidRemoteEndPointState (MVar ()) -> MVar ()
forall s a. s -> Getting a s a -> a
^. Getting (MVar ()) ValidRemoteEndPointState (MVar ())
Lens' ValidRemoteEndPointState (MVar ())
remoteStreamIsClosed) ()
            )

      case Maybe (IO ())
mCleanup of
        Maybe (IO ())
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just IO ()
cleanup -> IO ()
cleanup

-- | Attempt to close a remote endpoint. If the remote endpoint is in
-- any non-valid state (e.g. already closed), then nothing happens.
--
-- Otherwise, a control message is sent to the remote end to nicely ask to
-- close this connection.
closeRemoteEndPoint :: Direction -> RemoteEndPoint -> IO ()
closeRemoteEndPoint :: Direction -> RemoteEndPoint -> IO ()
closeRemoteEndPoint Direction
direction RemoteEndPoint
remoteEndPoint = do
  Maybe (IO ())
mAct <- MVar RemoteEndPointState
-> (RemoteEndPointState -> IO (RemoteEndPointState, Maybe (IO ())))
-> IO (Maybe (IO ()))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (RemoteEndPoint
remoteEndPoint RemoteEndPoint
-> Getting
     (MVar RemoteEndPointState)
     RemoteEndPoint
     (MVar RemoteEndPointState)
-> MVar RemoteEndPointState
forall s a. s -> Getting a s a -> a
^. Getting
  (MVar RemoteEndPointState)
  RemoteEndPoint
  (MVar RemoteEndPointState)
Lens' RemoteEndPoint (MVar RemoteEndPointState)
remoteEndPointState) ((RemoteEndPointState -> IO (RemoteEndPointState, Maybe (IO ())))
 -> IO (Maybe (IO ())))
-> (RemoteEndPointState -> IO (RemoteEndPointState, Maybe (IO ())))
-> IO (Maybe (IO ()))
forall a b. (a -> b) -> a -> b
$ \case
    RemoteEndPointState
RemoteEndPointInit -> (RemoteEndPointState, Maybe (IO ()))
-> IO (RemoteEndPointState, Maybe (IO ()))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteEndPointState
RemoteEndPointClosed, Maybe (IO ())
forall a. Maybe a
Nothing)
    RemoteEndPointState
RemoteEndPointClosed -> (RemoteEndPointState, Maybe (IO ()))
-> IO (RemoteEndPointState, Maybe (IO ()))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteEndPointState
RemoteEndPointClosed, Maybe (IO ())
forall a. Maybe a
Nothing)
    RemoteEndPointValid (ValidRemoteEndPointState Stream
stream MVar ()
isClosed Maybe ClientConnId
conns ClientConnId
_) ->
      let cleanup :: IO ()
cleanup =
            case Direction
direction of
              Direction
Outgoing -> () -> Either QUICException ()
forall a b. b -> Either a b
Right (() -> Either QUICException ())
-> IO () -> IO (Either QUICException ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ClientConnId
-> (ClientConnId -> IO (Either QUICException ())) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ClientConnId
conns (ClientConnId -> Stream -> IO (Either QUICException ())
`sendCloseConnection` Stream
stream)
              Direction
Incoming -> Stream -> IO (Either QUICException ())
sendCloseEndPoint Stream
stream
              IO (Either QUICException ()) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
isClosed ()
       in (RemoteEndPointState, Maybe (IO ()))
-> IO (RemoteEndPointState, Maybe (IO ()))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteEndPointState
RemoteEndPointClosed, IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just IO ()
cleanup)

  case Maybe (IO ())
mAct of
    Maybe (IO ())
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just IO ()
act -> IO ()
act

data Direction
  = Outgoing
  | Incoming
  deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> HostName
(Int -> Direction -> ShowS)
-> (Direction -> HostName)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> HostName
show :: Direction -> HostName
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, Eq Direction
Eq Direction =>
(Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Direction -> Direction -> Ordering
compare :: Direction -> Direction -> Ordering
$c< :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
>= :: Direction -> Direction -> Bool
$cmax :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
min :: Direction -> Direction -> Direction
Ord, Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
(Direction -> Direction)
-> (Direction -> Direction)
-> (Int -> Direction)
-> (Direction -> Int)
-> (Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> Direction -> [Direction])
-> Enum Direction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Direction -> Direction
succ :: Direction -> Direction
$cpred :: Direction -> Direction
pred :: Direction -> Direction
$ctoEnum :: Int -> Direction
toEnum :: Int -> Direction
$cfromEnum :: Direction -> Int
fromEnum :: Direction -> Int
$cenumFrom :: Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
Enum, Direction
Direction -> Direction -> Bounded Direction
forall a. a -> a -> Bounded a
$cminBound :: Direction
minBound :: Direction
$cmaxBound :: Direction
maxBound :: Direction
Bounded)

-- | Create a remote end point in the 'init' state.
--
-- The resulting remote end point is NOT set up, such that
-- it could be set up separately to /receive/ messages, or /send/ them.
createRemoteEndPoint ::
  LocalEndPoint ->
  EndPointAddress ->
  Direction ->
  IO (Either (TransportError ConnectErrorCode) (RemoteEndPoint, ConnectionCounter))
createRemoteEndPoint :: LocalEndPoint
-> EndPointAddress
-> Direction
-> IO
     (Either
        (TransportError ConnectErrorCode)
        (RemoteEndPoint, ConnectionCounter))
createRemoteEndPoint LocalEndPoint
localEndPoint EndPointAddress
remoteAddress Direction
direction = do
  MVar LocalEndPointState
-> (LocalEndPointState
    -> IO
         (LocalEndPointState,
          Either
            (TransportError ConnectErrorCode)
            (RemoteEndPoint, ConnectionCounter)))
-> IO
     (Either
        (TransportError ConnectErrorCode)
        (RemoteEndPoint, ConnectionCounter))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (LocalEndPoint
localEndPoint LocalEndPoint
-> Getting
     (MVar LocalEndPointState) LocalEndPoint (MVar LocalEndPointState)
-> MVar LocalEndPointState
forall s a. s -> Getting a s a -> a
^. Getting
  (MVar LocalEndPointState) LocalEndPoint (MVar LocalEndPointState)
Lens' LocalEndPoint (MVar LocalEndPointState)
localEndPointState) ((LocalEndPointState
  -> IO
       (LocalEndPointState,
        Either
          (TransportError ConnectErrorCode)
          (RemoteEndPoint, ConnectionCounter)))
 -> IO
      (Either
         (TransportError ConnectErrorCode)
         (RemoteEndPoint, ConnectionCounter)))
-> (LocalEndPointState
    -> IO
         (LocalEndPointState,
          Either
            (TransportError ConnectErrorCode)
            (RemoteEndPoint, ConnectionCounter)))
-> IO
     (Either
        (TransportError ConnectErrorCode)
        (RemoteEndPoint, ConnectionCounter))
forall a b. (a -> b) -> a -> b
$ \case
    LocalEndPointState
LocalEndPointStateClosed -> (LocalEndPointState,
 Either
   (TransportError ConnectErrorCode)
   (RemoteEndPoint, ConnectionCounter))
-> IO
     (LocalEndPointState,
      Either
        (TransportError ConnectErrorCode)
        (RemoteEndPoint, ConnectionCounter))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalEndPointState
LocalEndPointStateClosed, TransportError ConnectErrorCode
-> Either
     (TransportError ConnectErrorCode)
     (RemoteEndPoint, ConnectionCounter)
forall a b. a -> Either a b
Left (TransportError ConnectErrorCode
 -> Either
      (TransportError ConnectErrorCode)
      (RemoteEndPoint, ConnectionCounter))
-> TransportError ConnectErrorCode
-> Either
     (TransportError ConnectErrorCode)
     (RemoteEndPoint, ConnectionCounter)
forall a b. (a -> b) -> a -> b
$ ConnectErrorCode -> HostName -> TransportError ConnectErrorCode
forall error. error -> HostName -> TransportError error
TransportError ConnectErrorCode
ConnectFailed HostName
"endpoint is closed")
    LocalEndPointStateValid ValidLocalEndPointState
st -> do
      RemoteEndPoint
remoteEndPoint <-
        EndPointAddress
-> EndPointId -> MVar RemoteEndPointState -> RemoteEndPoint
RemoteEndPoint
          EndPointAddress
remoteAddress
          -- The design of using the next Server connection ID
          -- as the RemoteId comes from the TCP transport

          (ServerConnId -> EndPointId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ServerConnId -> EndPointId) -> ServerConnId -> EndPointId
forall a b. (a -> b) -> a -> b
$ ValidLocalEndPointState
st ValidLocalEndPointState
-> Getting ServerConnId ValidLocalEndPointState ServerConnId
-> ServerConnId
forall s a. s -> Getting a s a -> a
^. Getting ServerConnId ValidLocalEndPointState ServerConnId
Lens' ValidLocalEndPointState ServerConnId
nextConnInId)
          (MVar RemoteEndPointState -> RemoteEndPoint)
-> IO (MVar RemoteEndPointState) -> IO RemoteEndPoint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RemoteEndPointState -> IO (MVar RemoteEndPointState)
forall a. a -> IO (MVar a)
newMVar RemoteEndPointState
RemoteEndPointInit
      (LocalEndPointState,
 Either
   (TransportError ConnectErrorCode)
   (RemoteEndPoint, ConnectionCounter))
-> IO
     (LocalEndPointState,
      Either
        (TransportError ConnectErrorCode)
        (RemoteEndPoint, ConnectionCounter))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( ValidLocalEndPointState -> LocalEndPointState
LocalEndPointStateValid (ValidLocalEndPointState -> LocalEndPointState)
-> ValidLocalEndPointState -> LocalEndPointState
forall a b. (a -> b) -> a -> b
$
            ValidLocalEndPointState
st
              ValidLocalEndPointState
-> (ValidLocalEndPointState -> ValidLocalEndPointState)
-> ValidLocalEndPointState
forall a b. a -> (a -> b) -> b
& (if Direction
direction Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Incoming then (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
 -> Identity
      (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint))
-> ValidLocalEndPointState -> Identity ValidLocalEndPointState
Lens'
  ValidLocalEndPointState
  (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
incomingConnections else (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
 -> Identity
      (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint))
-> ValidLocalEndPointState -> Identity ValidLocalEndPointState
Lens'
  ValidLocalEndPointState
  (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
outgoingConnections) ((Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
  -> Identity
       (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint))
 -> ValidLocalEndPointState -> Identity ValidLocalEndPointState)
-> (Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
    -> Map (EndPointAddress, ConnectionCounter) RemoteEndPoint)
-> ValidLocalEndPointState
-> ValidLocalEndPointState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (EndPointAddress, ConnectionCounter)
-> RemoteEndPoint
-> Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
-> Map (EndPointAddress, ConnectionCounter) RemoteEndPoint
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (EndPointAddress
remoteAddress, ValidLocalEndPointState
st ValidLocalEndPointState
-> Getting
     ConnectionCounter ValidLocalEndPointState ConnectionCounter
-> ConnectionCounter
forall s a. s -> Getting a s a -> a
^. Getting ConnectionCounter ValidLocalEndPointState ConnectionCounter
Lens' ValidLocalEndPointState ConnectionCounter
nextConnectionCounter) RemoteEndPoint
remoteEndPoint
              ValidLocalEndPointState
-> (ValidLocalEndPointState -> ValidLocalEndPointState)
-> ValidLocalEndPointState
forall a b. a -> (a -> b) -> b
& (ConnectionCounter -> Identity ConnectionCounter)
-> ValidLocalEndPointState -> Identity ValidLocalEndPointState
Lens' ValidLocalEndPointState ConnectionCounter
nextConnectionCounter ((ConnectionCounter -> Identity ConnectionCounter)
 -> ValidLocalEndPointState -> Identity ValidLocalEndPointState)
-> ConnectionCounter
-> ValidLocalEndPointState
-> ValidLocalEndPointState
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ ConnectionCounter
1
              ValidLocalEndPointState
-> (ValidLocalEndPointState -> ValidLocalEndPointState)
-> ValidLocalEndPointState
forall a b. a -> (a -> b) -> b
& (ServerConnId -> Identity ServerConnId)
-> ValidLocalEndPointState -> Identity ValidLocalEndPointState
Lens' ValidLocalEndPointState ServerConnId
nextConnInId ((ServerConnId -> Identity ServerConnId)
 -> ValidLocalEndPointState -> Identity ValidLocalEndPointState)
-> ServerConnId
-> ValidLocalEndPointState
-> ValidLocalEndPointState
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ ServerConnId
1,
          (RemoteEndPoint, ConnectionCounter)
-> Either
     (TransportError ConnectErrorCode)
     (RemoteEndPoint, ConnectionCounter)
forall a b. b -> Either a b
Right (RemoteEndPoint
remoteEndPoint, ValidLocalEndPointState
st ValidLocalEndPointState
-> Getting
     ConnectionCounter ValidLocalEndPointState ConnectionCounter
-> ConnectionCounter
forall s a. s -> Getting a s a -> a
^. Getting ConnectionCounter ValidLocalEndPointState ConnectionCounter
Lens' ValidLocalEndPointState ConnectionCounter
nextConnectionCounter)
        )

-- | Create a remote end point, set up as a client that connects
-- to the remote 'EndPointAddress'.
createConnectionTo ::
  NonEmpty Credential ->
  -- | Validate credentials
  Bool ->
  LocalEndPoint ->
  EndPointAddress ->
  IO (Either (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
createConnectionTo :: NonEmpty Credential
-> Bool
-> LocalEndPoint
-> EndPointAddress
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
createConnectionTo NonEmpty Credential
creds Bool
validateCreds LocalEndPoint
localEndPoint EndPointAddress
remoteAddress = do
  LocalEndPoint
-> EndPointAddress
-> Direction
-> IO
     (Either
        (TransportError ConnectErrorCode)
        (RemoteEndPoint, ConnectionCounter))
createRemoteEndPoint LocalEndPoint
localEndPoint EndPointAddress
remoteAddress Direction
Outgoing IO
  (Either
     (TransportError ConnectErrorCode)
     (RemoteEndPoint, ConnectionCounter))
-> (Either
      (TransportError ConnectErrorCode)
      (RemoteEndPoint, ConnectionCounter)
    -> IO
         (Either
            (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)))
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left TransportError ConnectErrorCode
err -> Either
  (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
 -> IO
      (Either
         (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)))
-> Either
     (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
forall a b. (a -> b) -> a -> b
$ TransportError ConnectErrorCode
-> Either
     (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
forall a b. a -> Either a b
Left TransportError ConnectErrorCode
err
    Right (RemoteEndPoint
remoteEndPoint, ConnectionCounter
_) ->
      NonEmpty Credential
-> Bool
-> EndPointAddress
-> EndPointAddress
-> (SomeException -> IO ())
-> IO ()
-> IO (Either (TransportError ConnectErrorCode) (MVar (), Stream))
streamToEndpoint
        NonEmpty Credential
creds
        Bool
validateCreds
        (LocalEndPoint
localEndPoint LocalEndPoint
-> Getting EndPointAddress LocalEndPoint EndPointAddress
-> EndPointAddress
forall s a. s -> Getting a s a -> a
^. Getting EndPointAddress LocalEndPoint EndPointAddress
Lens' LocalEndPoint EndPointAddress
localAddress)
        EndPointAddress
remoteAddress
        (\SomeException
_ -> Direction -> RemoteEndPoint -> IO ()
closeRemoteEndPoint Direction
Outgoing RemoteEndPoint
remoteEndPoint)
        IO ()
onConnectionLost
        IO (Either (TransportError ConnectErrorCode) (MVar (), Stream))
-> (Either (TransportError ConnectErrorCode) (MVar (), Stream)
    -> IO
         (Either
            (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)))
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left TransportError ConnectErrorCode
exc -> Either
  (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
 -> IO
      (Either
         (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)))
-> Either
     (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
forall a b. (a -> b) -> a -> b
$ TransportError ConnectErrorCode
-> Either
     (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
forall a b. a -> Either a b
Left TransportError ConnectErrorCode
exc
          Right (MVar ()
closeStream, Stream
stream) -> do
            let clientConnId :: ClientConnId
clientConnId = ClientConnId
0
                validState :: RemoteEndPointState
validState =
                  ValidRemoteEndPointState -> RemoteEndPointState
RemoteEndPointValid (ValidRemoteEndPointState -> RemoteEndPointState)
-> ValidRemoteEndPointState -> RemoteEndPointState
forall a b. (a -> b) -> a -> b
$
                    ValidRemoteEndPointState
                      { _remoteStream :: Stream
_remoteStream = Stream
stream,
                        _remoteStreamIsClosed :: MVar ()
_remoteStreamIsClosed = MVar ()
closeStream,
                        _remoteIncoming :: Maybe ClientConnId
_remoteIncoming = Maybe ClientConnId
forall a. Maybe a
Nothing,
                        _remoteNextConnOutId :: ClientConnId
_remoteNextConnOutId = ClientConnId
clientConnId ClientConnId -> ClientConnId -> ClientConnId
forall a. Num a => a -> a -> a
+ ClientConnId
1
                      }
            MVar RemoteEndPointState
-> (RemoteEndPointState -> IO RemoteEndPointState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_
              (RemoteEndPoint
remoteEndPoint RemoteEndPoint
-> Getting
     (MVar RemoteEndPointState)
     RemoteEndPoint
     (MVar RemoteEndPointState)
-> MVar RemoteEndPointState
forall s a. s -> Getting a s a -> a
^. Getting
  (MVar RemoteEndPointState)
  RemoteEndPoint
  (MVar RemoteEndPointState)
Lens' RemoteEndPoint (MVar RemoteEndPointState)
remoteEndPointState)
              (\RemoteEndPointState
_ -> RemoteEndPointState -> IO RemoteEndPointState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteEndPointState
validState)

            IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try
              ( Stream -> ByteString -> IO ()
QUIC.sendStream
                  Stream
stream
                  ( LazyByteString -> ByteString
BS.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
                      ClientConnId -> LazyByteString
forall a. Binary a => a -> LazyByteString
Binary.encode ClientConnId
clientConnId
                  )
              )
              IO (Either SomeException ())
-> (Either SomeException ()
    -> IO
         (Either
            (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)))
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Left (SomeException
exc :: SomeException) -> Either
  (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
 -> IO
      (Either
         (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)))
-> (TransportError ConnectErrorCode
    -> Either
         (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
-> TransportError ConnectErrorCode
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransportError ConnectErrorCode
-> Either
     (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
forall a b. a -> Either a b
Left (TransportError ConnectErrorCode
 -> IO
      (Either
         (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)))
-> TransportError ConnectErrorCode
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
forall a b. (a -> b) -> a -> b
$ ConnectErrorCode -> HostName -> TransportError ConnectErrorCode
forall error. error -> HostName -> TransportError error
TransportError ConnectErrorCode
ConnectFailed (SomeException -> HostName
forall e. Exception e => e -> HostName
displayException SomeException
exc)
                Right () -> Either
  (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
 -> IO
      (Either
         (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)))
-> Either
     (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
forall a b. (a -> b) -> a -> b
$ (RemoteEndPoint, ClientConnId)
-> Either
     (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
forall a b. b -> Either a b
Right (RemoteEndPoint
remoteEndPoint, ClientConnId
clientConnId)
  where
    onConnectionLost :: IO ()
onConnectionLost =
      STM () -> IO ()
forall a. STM a -> IO a
atomically
        (STM () -> IO ())
-> (TransportError EventErrorCode -> STM ())
-> TransportError EventErrorCode
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TQueue Event -> Event -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue (LocalEndPoint
localEndPoint LocalEndPoint
-> Getting (TQueue Event) LocalEndPoint (TQueue Event)
-> TQueue Event
forall s a. s -> Getting a s a -> a
^. Getting (TQueue Event) LocalEndPoint (TQueue Event)
Lens' LocalEndPoint (TQueue Event)
localQueue)
        (Event -> STM ())
-> (TransportError EventErrorCode -> Event)
-> TransportError EventErrorCode
-> STM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransportError EventErrorCode -> Event
ErrorEvent
        (TransportError EventErrorCode -> IO ())
-> TransportError EventErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ EventErrorCode -> HostName -> TransportError EventErrorCode
forall error. error -> HostName -> TransportError error
TransportError
          (EndPointAddress -> EventErrorCode
EventConnectionLost EndPointAddress
remoteAddress)
          HostName
"Connection reset"