{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Network.Transport.QUIC.Internal
  ( createTransport,
    QUICTransportConfig (..),
    defaultQUICTransportConfig,
    QUICAddr (..),
    encodeQUICAddr,
    decodeQUICAddr,

    -- * Re-export to generate credentials
    Credential,
    credentialLoadX509,

    -- * Message encoding and decoding
    decodeMessage,
    MessageReceived (..),
    encodeMessage,
  )
where

import Control.Concurrent (forkIO, killThread, modifyMVar_, newEmptyMVar, readMVar)
import Control.Concurrent.MVar (modifyMVar, putMVar, takeMVar, withMVar)
import Control.Concurrent.STM (atomically, newTQueueIO)
import Control.Concurrent.STM.TQueue
  ( TQueue,
    readTQueue,
    writeTQueue,
  )
import Control.Exception (Exception (displayException), IOException, bracket, throwIO, try)
import Control.Monad (unless, when)
import Data.Bifunctor (Bifunctor (first))
import Data.Binary qualified as Binary (decodeOrFail)
import Data.ByteString (ByteString, fromStrict)
import Data.Foldable (forM_)
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict qualified as Map
import Data.Maybe (isNothing)
import Lens.Micro.Platform ((+~))
import Network.QUIC qualified as QUIC
import Network.TLS (Credential)
import Network.Transport
  ( ConnectErrorCode (ConnectFailed),
    ConnectHints,
    Connection (..),
    EndPoint (..),
    EndPointAddress,
    Event (..),
    EventErrorCode (EventConnectionLost),
    NewEndPointErrorCode,
    NewMulticastGroupErrorCode (NewMulticastGroupUnsupported),
    Reliability (ReliableOrdered),
    ResolveMulticastGroupErrorCode (ResolveMulticastGroupUnsupported),
    SendErrorCode (SendClosed, SendFailed),
    Transport (..),
    TransportError (..),
  )
import Network.Transport.QUIC.Internal.Configuration (credentialLoadX509)
import Network.Transport.QUIC.Internal.Messaging
  ( ClientConnId,
    MessageReceived (..),
    createConnectionId,
    decodeMessage,
    encodeMessage,
    receiveMessage,
    recvWord32,
    sendAck,
    sendCloseConnection,
    sendMessage,
    sendRejection,
    serverSelfConnId,
  )
import Network.Transport.QUIC.Internal.QUICAddr (QUICAddr (..), decodeQUICAddr, encodeQUICAddr)
import Network.Transport.QUIC.Internal.QUICTransport
  ( Direction (..),
    LocalEndPoint,
    LocalEndPointState (LocalEndPointStateClosed, LocalEndPointStateValid),
    QUICTransport,
    QUICTransportConfig (..),
    RemoteEndPoint (..),
    RemoteEndPointState (..),
    TransportState (..),
    ValidRemoteEndPointState (..),
    closeLocalEndpoint,
    closeRemoteEndPoint,
    createConnectionTo,
    createRemoteEndPoint,
    defaultQUICTransportConfig,
    foldOpenEndPoints,
    localAddress,
    localEndPointState,
    localEndPoints,
    localQueue,
    newLocalEndPoint,
    newQUICTransport,
    nextSelfConnOutId,
    remoteEndPointAddress,
    remoteEndPointState,
    remoteIncoming,
    remoteServerConnId,
    remoteStream,
    transportConfig,
    transportInputSocket,
    transportState,
    (^.),
  )
import Network.Transport.QUIC.Internal.Server (forkServer)

-- | Create a new Transport based on the QUIC protocol.
--
-- Only a single transport should be created per Haskell process
-- (threads can, and should, create their own endpoints though).
createTransport ::
  QUICTransportConfig ->
  IO Transport
createTransport :: QUICTransportConfig -> IO Transport
createTransport QUICTransportConfig
initialConfig = do
  QUICTransport
quicTransport <- QUICTransportConfig -> IO QUICTransport
newQUICTransport QUICTransportConfig
initialConfig

  let resolvedConfig :: QUICTransportConfig
resolvedConfig = 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
  ThreadId
serverThread <-
    Socket
-> NonEmpty Credential
-> (SomeException -> IO ())
-> (SomeException -> IO ())
-> (Stream -> IO ())
-> IO ThreadId
forkServer
      (QUICTransport
quicTransport QUICTransport -> Getting Socket QUICTransport Socket -> Socket
forall s a. s -> Getting a s a -> a
^. Getting Socket QUICTransport Socket
Lens' QUICTransport Socket
transportInputSocket)
      (QUICTransportConfig -> NonEmpty Credential
credentials QUICTransportConfig
resolvedConfig)
      SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO
      SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO
      (QUICTransport -> Stream -> IO ()
handleNewStream QUICTransport
quicTransport)

  Transport -> IO Transport
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Transport -> IO Transport) -> Transport -> IO Transport
forall a b. (a -> b) -> a -> b
$
    Transport
      { newEndPoint :: IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndPoint = IO (TQueue Event)
forall a. IO (TQueue a)
newTQueueIO IO (TQueue Event)
-> (TQueue Event
    -> IO (Either (TransportError NewEndPointErrorCode) EndPoint))
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QUICTransport
-> TQueue Event
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndpoint QUICTransport
quicTransport,
        closeTransport :: IO ()
closeTransport =
          QUICTransport -> (LocalEndPoint -> IO ()) -> IO [()]
forall a. QUICTransport -> (LocalEndPoint -> IO a) -> IO [a]
foldOpenEndPoints QUICTransport
quicTransport (QUICTransport -> LocalEndPoint -> IO ()
closeLocalEndpoint QUICTransport
quicTransport)
            IO [()] -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ThreadId -> IO ()
killThread ThreadId
serverThread -- TODO: use a synchronization mechanism to close the thread gracefully
            IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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
_ -> TransportState -> IO TransportState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TransportState
TransportStateClosed)
      }

-- | Handle a new incoming connection.
--
-- This is the function which:
-- 1. First initiates a relationship between endpoints, called a /handshake/
-- 2. then continuously reads from the stream to queue up events for the appropriate endpoint.
handleNewStream :: QUICTransport -> QUIC.Stream -> IO ()
handleNewStream :: QUICTransport -> Stream -> IO ()
handleNewStream QUICTransport
quicTransport Stream
stream = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    ( Int -> Bool
QUIC.isClientInitiatedBidirectional
        (Stream -> Int
QUIC.streamId Stream
stream)
    )
    (IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (String -> IOException
userError String
"QUIC stream is not bidirectional"))

  -- HANDSHAKE
  -- At this time, the handshake is very simple:
  -- we read the first message, which must be addressed
  -- correctly by EndPointId. This first message is expected
  -- to contain the other side's EndPointAddress
  --
  -- If the EndPointId does not exist, we terminate the connection.
  Stream -> IO (Either String Word32)
recvWord32 Stream
stream
    IO (Either String Word32)
-> (Either String Word32 -> IO Int) -> IO Int
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Int)
-> (Word32 -> IO Int) -> Either String Word32 -> IO Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IOException -> IO Int
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO Int)
-> (String -> IOException) -> String -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException
userError) (Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> (Word32 -> Int) -> Word32 -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
    IO Int -> (Int -> IO ByteString) -> IO ByteString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream -> Int -> IO ByteString
QUIC.recvStream Stream
stream
    IO ByteString -> (ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
payload -> do
      case ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, (EndPointAddress, EndPointId))
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Binary.decodeOrFail (ByteString -> ByteString
fromStrict ByteString
payload) of
        Left (ByteString
_, ByteOffset
_, String
errmsg) ->
          IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (String -> IOException
userError (String -> IOException) -> String -> IOException
forall a b. (a -> b) -> a -> b
$ String
"(handleNewStream) remote endpoint address in handshake could not be decoded: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
errmsg)
        Right (ByteString
_, ByteOffset
_, (EndPointAddress
remoteAddress, EndPointId
endpointId)) ->
          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 ()) -> IO ()
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 -> IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOException
userError String
"Transport closed"
            TransportStateValid ValidTransportState
state -> case EndPointId -> Map EndPointId LocalEndPoint -> Maybe LocalEndPoint
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup EndPointId
endpointId (ValidTransportState
state 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) of
              Maybe LocalEndPoint
Nothing -> Stream -> IO ()
sendRejection Stream
stream
              Just LocalEndPoint
ourEndPoint -> do
                MVar LocalEndPointState -> IO LocalEndPointState
forall a. MVar a -> IO a
readMVar (LocalEndPoint
ourEndPoint 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) IO LocalEndPointState -> (LocalEndPointState -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  LocalEndPointState
LocalEndPointStateClosed -> Stream -> IO ()
sendRejection Stream
stream
                  LocalEndPointStateValid ValidLocalEndPointState
_ -> do
                    Stream -> IO ()
sendAck Stream
stream

                    (RemoteEndPoint
remoteEndPoint, ConnectionCounter
_) <- (TransportError ConnectErrorCode
 -> IO (RemoteEndPoint, ConnectionCounter))
-> ((RemoteEndPoint, ConnectionCounter)
    -> IO (RemoteEndPoint, ConnectionCounter))
-> Either
     (TransportError ConnectErrorCode)
     (RemoteEndPoint, ConnectionCounter)
-> IO (RemoteEndPoint, ConnectionCounter)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TransportError ConnectErrorCode
-> IO (RemoteEndPoint, ConnectionCounter)
forall e a. Exception e => e -> IO a
throwIO (RemoteEndPoint, ConnectionCounter)
-> IO (RemoteEndPoint, ConnectionCounter)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (TransportError ConnectErrorCode)
   (RemoteEndPoint, ConnectionCounter)
 -> IO (RemoteEndPoint, ConnectionCounter))
-> IO
     (Either
        (TransportError ConnectErrorCode)
        (RemoteEndPoint, ConnectionCounter))
-> IO (RemoteEndPoint, ConnectionCounter)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LocalEndPoint
-> EndPointAddress
-> Direction
-> IO
     (Either
        (TransportError ConnectErrorCode)
        (RemoteEndPoint, ConnectionCounter))
createRemoteEndPoint LocalEndPoint
ourEndPoint EndPointAddress
remoteAddress Direction
Incoming
                    MVar ()
doneMVar <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar

                    -- Sending an ack is important, because otherwise
                    -- the client may start sending messages well before we
                    -- start being able to receive them

                    ClientConnId
clientConnId <- (String -> IO ClientConnId)
-> (Word32 -> IO ClientConnId)
-> Either String Word32
-> IO ClientConnId
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IOException -> IO ClientConnId
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ClientConnId)
-> (String -> IOException) -> String -> IO ClientConnId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException
userError) (ClientConnId -> IO ClientConnId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientConnId -> IO ClientConnId)
-> (Word32 -> ClientConnId) -> Word32 -> IO ClientConnId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ClientConnId
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Either String Word32 -> IO ClientConnId)
-> IO (Either String Word32) -> IO ClientConnId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Stream -> IO (Either String Word32)
recvWord32 Stream
stream
                    let serverConnId :: ServerConnId
serverConnId = RemoteEndPoint -> ServerConnId
remoteServerConnId RemoteEndPoint
remoteEndPoint
                        connectionId :: ConnectionId
connectionId = ServerConnId -> ClientConnId -> ConnectionId
createConnectionId ServerConnId
serverConnId ClientConnId
clientConnId

                    let st :: RemoteEndPointState
st =
                          ValidRemoteEndPointState -> RemoteEndPointState
RemoteEndPointValid (ValidRemoteEndPointState -> RemoteEndPointState)
-> ValidRemoteEndPointState -> RemoteEndPointState
forall a b. (a -> b) -> a -> b
$
                            ValidRemoteEndPointState
                              { _remoteStream :: Stream
_remoteStream = Stream
stream,
                                _remoteStreamIsClosed :: MVar ()
_remoteStreamIsClosed = MVar ()
doneMVar,
                                _remoteIncoming :: Maybe ClientConnId
_remoteIncoming = ClientConnId -> Maybe ClientConnId
forall a. a -> Maybe a
Just ClientConnId
clientConnId,
                                _remoteNextConnOutId :: ClientConnId
_remoteNextConnOutId = ClientConnId
0
                              }
                    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)
                      ( \case
                          RemoteEndPointState
RemoteEndPointInit -> RemoteEndPointState -> IO RemoteEndPointState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteEndPointState
st
                          RemoteEndPointState
_ -> IO RemoteEndPointState
forall a. HasCallStack => a
undefined
                      )

                    ThreadId
tid <-
                      IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$
                        -- If we've reached this stage, the connection handhake succeeded
                        LocalEndPoint -> RemoteEndPoint -> IO ()
handleIncomingMessages
                          LocalEndPoint
ourEndPoint
                          RemoteEndPoint
remoteEndPoint

                    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
ourEndPoint 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)
                        ( ConnectionId -> Reliability -> EndPointAddress -> Event
ConnectionOpened
                            ConnectionId
connectionId
                            Reliability
ReliableOrdered
                            EndPointAddress
remoteAddress
                        )

                    MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
doneMVar
                    Stream -> IO ()
QUIC.shutdownStream Stream
stream
                    ThreadId -> IO ()
killThread ThreadId
tid

-- | Infinite loop that listens for messages from the remote endpoint and processes them.
--
-- This function assumes that the handshake has been completed.
handleIncomingMessages :: LocalEndPoint -> RemoteEndPoint -> IO ()
handleIncomingMessages :: LocalEndPoint -> RemoteEndPoint -> IO ()
handleIncomingMessages LocalEndPoint
ourEndPoint RemoteEndPoint
remoteEndPoint =
  IO (Either IOException Stream)
-> (Either IOException Stream -> IO ())
-> (Either IOException Stream -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Either IOException Stream)
acquire Either IOException Stream -> IO ()
release Either IOException Stream -> IO ()
go
  where
    serverConnId :: ServerConnId
serverConnId = RemoteEndPoint -> ServerConnId
remoteServerConnId RemoteEndPoint
remoteEndPoint
    ourQueue :: TQueue Event
ourQueue = LocalEndPoint
ourEndPoint 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
    remoteAddress :: EndPointAddress
remoteAddress = RemoteEndPoint
remoteEndPoint RemoteEndPoint
-> Getting EndPointAddress RemoteEndPoint EndPointAddress
-> EndPointAddress
forall s a. s -> Getting a s a -> a
^. Getting EndPointAddress RemoteEndPoint EndPointAddress
Lens' RemoteEndPoint EndPointAddress
remoteEndPointAddress
    remoteState :: MVar RemoteEndPointState
remoteState = 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

    acquire :: IO (Either IOError QUIC.Stream)
    acquire :: IO (Either IOException Stream)
acquire = MVar RemoteEndPointState
-> (RemoteEndPointState -> IO (Either IOException Stream))
-> IO (Either IOException Stream)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar RemoteEndPointState
remoteState ((RemoteEndPointState -> IO (Either IOException Stream))
 -> IO (Either IOException Stream))
-> (RemoteEndPointState -> IO (Either IOException Stream))
-> IO (Either IOException Stream)
forall a b. (a -> b) -> a -> b
$ \case
      RemoteEndPointState
RemoteEndPointInit -> Either IOException Stream -> IO (Either IOException Stream)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either IOException Stream -> IO (Either IOException Stream))
-> (IOException -> Either IOException Stream)
-> IOException
-> IO (Either IOException Stream)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> Either IOException Stream
forall a b. a -> Either a b
Left (IOException -> IO (Either IOException Stream))
-> IOException -> IO (Either IOException Stream)
forall a b. (a -> b) -> a -> b
$ String -> IOException
userError String
"handleIncomingMessages (init)"
      RemoteEndPointState
RemoteEndPointClosed -> Either IOException Stream -> IO (Either IOException Stream)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either IOException Stream -> IO (Either IOException Stream))
-> (IOException -> Either IOException Stream)
-> IOException
-> IO (Either IOException Stream)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> Either IOException Stream
forall a b. a -> Either a b
Left (IOException -> IO (Either IOException Stream))
-> IOException -> IO (Either IOException Stream)
forall a b. (a -> b) -> a -> b
$ String -> IOException
userError String
"handleIncomingMessages (closed)"
      RemoteEndPointValid ValidRemoteEndPointState
validState -> Either IOException Stream -> IO (Either IOException Stream)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either IOException Stream -> IO (Either IOException Stream))
-> (Stream -> Either IOException Stream)
-> Stream
-> IO (Either IOException Stream)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream -> Either IOException Stream
forall a b. b -> Either a b
Right (Stream -> IO (Either IOException Stream))
-> Stream -> IO (Either IOException Stream)
forall a b. (a -> b) -> a -> b
$ ValidRemoteEndPointState
validState ValidRemoteEndPointState
-> Getting Stream ValidRemoteEndPointState Stream -> Stream
forall s a. s -> Getting a s a -> a
^. Getting Stream ValidRemoteEndPointState Stream
Lens' ValidRemoteEndPointState Stream
remoteStream

    release :: Either IOError QUIC.Stream -> IO ()
    release :: Either IOException Stream -> IO ()
release (Left IOException
err) = Direction -> RemoteEndPoint -> IO ()
closeRemoteEndPoint Direction
Incoming RemoteEndPoint
remoteEndPoint IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IOException -> IO ()
prematureExit IOException
err
    release (Right Stream
_) = Direction -> RemoteEndPoint -> IO ()
closeRemoteEndPoint Direction
Incoming RemoteEndPoint
remoteEndPoint

    connectionId :: ClientConnId -> ConnectionId
connectionId = ServerConnId -> ClientConnId -> ConnectionId
createConnectionId ServerConnId
serverConnId

    writeConnectionClosedSTM :: ClientConnId -> STM ()
writeConnectionClosedSTM ClientConnId
connId =
      TQueue Event -> Event -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue
        TQueue Event
ourQueue
        (ConnectionId -> Event
ConnectionClosed (ClientConnId -> ConnectionId
connectionId ClientConnId
connId))

    go :: Either IOException Stream -> IO ()
go = (IOException -> IO ())
-> (Stream -> IO ()) -> Either IOException Stream -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IOException -> IO ()
prematureExit Stream -> IO ()
loop

    loop :: Stream -> IO ()
loop Stream
stream =
      Stream -> IO (Either String MessageReceived)
receiveMessage Stream
stream
        IO (Either String MessageReceived)
-> (Either String MessageReceived -> IO ()) -> IO ()
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 String
errmsg -> do
            -- Throwing will trigger 'prematureExit'
            IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOException
userError (String -> IOException) -> String -> IOException
forall a b. (a -> b) -> a -> b
$ String
"(handleIncomingMessages) Failed with: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
errmsg
          Right (Message ClientConnId
connId [ByteString]
bytes) -> ClientConnId -> [ByteString] -> IO ()
handleMessage ClientConnId
connId [ByteString]
bytes IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Stream -> IO ()
loop Stream
stream
          Right MessageReceived
StreamClosed -> IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOException -> IO ()) -> IOException -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOException
userError String
"(handleIncomingMessages) Stream closed"
          Right (CloseConnection ClientConnId
connId) -> do
            STM () -> IO ()
forall a. STM a -> IO a
atomically (ClientConnId -> STM ()
writeConnectionClosedSTM ClientConnId
connId)
            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
_ MVar ()
isClosed Maybe ClientConnId
_ ClientConnId
_) -> do
                (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
$ MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
isClosed ())
            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 ()
cleanup -> IO ()
cleanup
          Right MessageReceived
CloseEndPoint -> do
            Maybe ClientConnId
connIds <- MVar RemoteEndPointState
-> (RemoteEndPointState
    -> IO (RemoteEndPointState, Maybe ClientConnId))
-> IO (Maybe ClientConnId)
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 ClientConnId))
 -> IO (Maybe ClientConnId))
-> (RemoteEndPointState
    -> IO (RemoteEndPointState, Maybe ClientConnId))
-> IO (Maybe ClientConnId)
forall a b. (a -> b) -> a -> b
$ \case
              RemoteEndPointValid ValidRemoteEndPointState
vst -> do
                (RemoteEndPointState, Maybe ClientConnId)
-> IO (RemoteEndPointState, Maybe ClientConnId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteEndPointState
RemoteEndPointClosed, ValidRemoteEndPointState
vst ValidRemoteEndPointState
-> Getting
     (Maybe ClientConnId) ValidRemoteEndPointState (Maybe ClientConnId)
-> Maybe ClientConnId
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe ClientConnId) ValidRemoteEndPointState (Maybe ClientConnId)
Lens' ValidRemoteEndPointState (Maybe ClientConnId)
remoteIncoming)
              RemoteEndPointState
other -> (RemoteEndPointState, Maybe ClientConnId)
-> IO (RemoteEndPointState, Maybe ClientConnId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteEndPointState
other, Maybe ClientConnId
forall a. Maybe a
Nothing)
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
              (Maybe ClientConnId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ClientConnId
connIds)
              ( STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$
                  Maybe ClientConnId -> (ClientConnId -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
                    Maybe ClientConnId
connIds
                    (TQueue Event -> Event -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue Event
ourQueue (Event -> STM ())
-> (ClientConnId -> Event) -> ClientConnId -> STM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionId -> Event
ConnectionClosed (ConnectionId -> Event)
-> (ClientConnId -> ConnectionId) -> ClientConnId -> Event
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientConnId -> ConnectionId
connectionId)
              )

    handleMessage :: ClientConnId -> [ByteString] -> IO ()
    handleMessage :: ClientConnId -> [ByteString] -> IO ()
handleMessage ClientConnId
clientConnId [ByteString]
payload =
      STM () -> IO ()
forall a. STM a -> IO a
atomically (TQueue Event -> Event -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue Event
ourQueue (ConnectionId -> [ByteString] -> Event
Received (ClientConnId -> ConnectionId
connectionId ClientConnId
clientConnId) [ByteString]
payload))

    prematureExit :: IOException -> IO ()
    prematureExit :: IOException -> IO ()
prematureExit IOException
exc = do
      MVar RemoteEndPointState
-> (RemoteEndPointState -> IO RemoteEndPointState) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar RemoteEndPointState
remoteState ((RemoteEndPointState -> IO RemoteEndPointState) -> IO ())
-> (RemoteEndPointState -> IO RemoteEndPointState) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
        RemoteEndPointValid {} -> RemoteEndPointState -> IO RemoteEndPointState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteEndPointState
RemoteEndPointClosed
        RemoteEndPointState
RemoteEndPointInit -> RemoteEndPointState -> IO RemoteEndPointState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteEndPointState
RemoteEndPointClosed
        RemoteEndPointState
RemoteEndPointClosed -> RemoteEndPointState -> IO RemoteEndPointState
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteEndPointState
RemoteEndPointClosed
      STM () -> IO ()
forall a. STM a -> IO a
atomically
        ( TQueue Event -> Event -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue
            TQueue Event
ourQueue
            ( TransportError EventErrorCode -> Event
ErrorEvent
                ( EventErrorCode -> String -> TransportError EventErrorCode
forall error. error -> String -> TransportError error
TransportError
                    (EndPointAddress -> EventErrorCode
EventConnectionLost EndPointAddress
remoteAddress)
                    (IOException -> String
forall e. Exception e => e -> String
displayException IOException
exc)
                )
            )
        )

newEndpoint ::
  QUICTransport ->
  TQueue Event ->
  IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndpoint :: QUICTransport
-> TQueue Event
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
newEndpoint QUICTransport
quicTransport TQueue Event
newLocalQueue = do
  QUICTransport
-> TQueue Event
-> IO (Either (TransportError NewEndPointErrorCode) LocalEndPoint)
newLocalEndPoint QUICTransport
quicTransport TQueue Event
newLocalQueue IO (Either (TransportError NewEndPointErrorCode) LocalEndPoint)
-> (Either (TransportError NewEndPointErrorCode) LocalEndPoint
    -> IO (Either (TransportError NewEndPointErrorCode) EndPoint))
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
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 NewEndPointErrorCode
err -> Either (TransportError NewEndPointErrorCode) EndPoint
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TransportError NewEndPointErrorCode) EndPoint
 -> IO (Either (TransportError NewEndPointErrorCode) EndPoint))
-> Either (TransportError NewEndPointErrorCode) EndPoint
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
forall a b. (a -> b) -> a -> b
$ TransportError NewEndPointErrorCode
-> Either (TransportError NewEndPointErrorCode) EndPoint
forall a b. a -> Either a b
Left TransportError NewEndPointErrorCode
err
    Right LocalEndPoint
ourEndPoint ->
      IO EndPoint
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO EndPoint
 -> IO (Either (TransportError NewEndPointErrorCode) EndPoint))
-> IO EndPoint
-> IO (Either (TransportError NewEndPointErrorCode) EndPoint)
forall a b. (a -> b) -> a -> b
$
        EndPoint -> IO EndPoint
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EndPoint -> IO EndPoint) -> EndPoint -> IO EndPoint
forall a b. (a -> b) -> a -> b
$
          EndPoint
            { receive :: IO Event
receive = STM Event -> IO Event
forall a. STM a -> IO a
atomically (TQueue Event -> STM Event
forall a. TQueue a -> STM a
readTQueue (LocalEndPoint
ourEndPoint 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)),
              address :: EndPointAddress
address = LocalEndPoint
ourEndPoint LocalEndPoint
-> Getting EndPointAddress LocalEndPoint EndPointAddress
-> EndPointAddress
forall s a. s -> Getting a s a -> a
^. Getting EndPointAddress LocalEndPoint EndPointAddress
Lens' LocalEndPoint EndPointAddress
localAddress,
              connect :: EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
connect =
                LocalEndPoint
-> NonEmpty Credential
-> Bool
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
newConnection
                  LocalEndPoint
ourEndPoint
                  (QUICTransportConfig -> NonEmpty Credential
credentials (QUICTransportConfig -> NonEmpty Credential)
-> QUICTransportConfig -> NonEmpty Credential
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 -> Bool
validateCredentials (QUICTransportConfig -> Bool) -> QUICTransportConfig -> Bool
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),
              newMulticastGroup :: IO
  (Either (TransportError NewMulticastGroupErrorCode) MulticastGroup)
newMulticastGroup =
                Either (TransportError NewMulticastGroupErrorCode) MulticastGroup
-> IO
     (Either (TransportError NewMulticastGroupErrorCode) MulticastGroup)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TransportError NewMulticastGroupErrorCode) MulticastGroup
 -> IO
      (Either
         (TransportError NewMulticastGroupErrorCode) MulticastGroup))
-> (TransportError NewMulticastGroupErrorCode
    -> Either
         (TransportError NewMulticastGroupErrorCode) MulticastGroup)
-> TransportError NewMulticastGroupErrorCode
-> IO
     (Either (TransportError NewMulticastGroupErrorCode) MulticastGroup)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransportError NewMulticastGroupErrorCode
-> Either
     (TransportError NewMulticastGroupErrorCode) MulticastGroup
forall a b. a -> Either a b
Left (TransportError NewMulticastGroupErrorCode
 -> IO
      (Either
         (TransportError NewMulticastGroupErrorCode) MulticastGroup))
-> TransportError NewMulticastGroupErrorCode
-> IO
     (Either (TransportError NewMulticastGroupErrorCode) MulticastGroup)
forall a b. (a -> b) -> a -> b
$
                  NewMulticastGroupErrorCode
-> String -> TransportError NewMulticastGroupErrorCode
forall error. error -> String -> TransportError error
TransportError
                    NewMulticastGroupErrorCode
NewMulticastGroupUnsupported
                    String
"Multicast not supported",
              resolveMulticastGroup :: MulticastAddress
-> IO
     (Either
        (TransportError ResolveMulticastGroupErrorCode) MulticastGroup)
resolveMulticastGroup =
                Either
  (TransportError ResolveMulticastGroupErrorCode) MulticastGroup
-> IO
     (Either
        (TransportError ResolveMulticastGroupErrorCode) MulticastGroup)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                  (Either
   (TransportError ResolveMulticastGroupErrorCode) MulticastGroup
 -> IO
      (Either
         (TransportError ResolveMulticastGroupErrorCode) MulticastGroup))
-> (MulticastAddress
    -> Either
         (TransportError ResolveMulticastGroupErrorCode) MulticastGroup)
-> MulticastAddress
-> IO
     (Either
        (TransportError ResolveMulticastGroupErrorCode) MulticastGroup)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransportError ResolveMulticastGroupErrorCode
-> Either
     (TransportError ResolveMulticastGroupErrorCode) MulticastGroup
forall a b. a -> Either a b
Left
                  (TransportError ResolveMulticastGroupErrorCode
 -> Either
      (TransportError ResolveMulticastGroupErrorCode) MulticastGroup)
-> (MulticastAddress
    -> TransportError ResolveMulticastGroupErrorCode)
-> MulticastAddress
-> Either
     (TransportError ResolveMulticastGroupErrorCode) MulticastGroup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransportError ResolveMulticastGroupErrorCode
-> MulticastAddress
-> TransportError ResolveMulticastGroupErrorCode
forall a b. a -> b -> a
const
                    ( ResolveMulticastGroupErrorCode
-> String -> TransportError ResolveMulticastGroupErrorCode
forall error. error -> String -> TransportError error
TransportError
                        ResolveMulticastGroupErrorCode
ResolveMulticastGroupUnsupported
                        String
"Multicast not supported"
                    ),
              closeEndPoint :: IO ()
closeEndPoint = QUICTransport -> LocalEndPoint -> IO ()
closeLocalEndpoint QUICTransport
quicTransport LocalEndPoint
ourEndPoint
            }

newConnection ::
  LocalEndPoint ->
  NonEmpty Credential ->
  -- | Validate credentials
  Bool ->
  EndPointAddress ->
  Reliability ->
  ConnectHints ->
  IO (Either (TransportError ConnectErrorCode) Connection)
newConnection :: LocalEndPoint
-> NonEmpty Credential
-> Bool
-> EndPointAddress
-> Reliability
-> ConnectHints
-> IO (Either (TransportError ConnectErrorCode) Connection)
newConnection LocalEndPoint
ourEndPoint NonEmpty Credential
creds Bool
validateCreds EndPointAddress
remoteAddress Reliability
_reliability ConnectHints
_connectHints =
  if EndPointAddress
ourAddress EndPointAddress -> EndPointAddress -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointAddress
remoteAddress
    then LocalEndPoint
-> IO (Either (TransportError ConnectErrorCode) Connection)
connectToSelf LocalEndPoint
ourEndPoint
    else
      NonEmpty Credential
-> Bool
-> LocalEndPoint
-> EndPointAddress
-> IO
     (Either
        (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
createConnectionTo NonEmpty Credential
creds Bool
validateCreds LocalEndPoint
ourEndPoint EndPointAddress
remoteAddress IO
  (Either
     (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId))
-> (Either
      (TransportError ConnectErrorCode) (RemoteEndPoint, ClientConnId)
    -> IO (Either (TransportError ConnectErrorCode) Connection))
-> IO (Either (TransportError ConnectErrorCode) Connection)
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) Connection
-> IO (Either (TransportError ConnectErrorCode) Connection)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TransportError ConnectErrorCode) Connection
 -> IO (Either (TransportError ConnectErrorCode) Connection))
-> Either (TransportError ConnectErrorCode) Connection
-> IO (Either (TransportError ConnectErrorCode) Connection)
forall a b. (a -> b) -> a -> b
$ TransportError ConnectErrorCode
-> Either (TransportError ConnectErrorCode) Connection
forall a b. a -> Either a b
Left TransportError ConnectErrorCode
err
        Right (RemoteEndPoint
remoteEndPoint, ClientConnId
connId) -> do
          IORef Bool
connAlive <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True
          Either (TransportError ConnectErrorCode) Connection
-> IO (Either (TransportError ConnectErrorCode) Connection)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (Either (TransportError ConnectErrorCode) Connection
 -> IO (Either (TransportError ConnectErrorCode) Connection))
-> (Connection
    -> Either (TransportError ConnectErrorCode) Connection)
-> Connection
-> IO (Either (TransportError ConnectErrorCode) Connection)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Either (TransportError ConnectErrorCode) Connection
forall a b. b -> Either a b
Right
            (Connection
 -> IO (Either (TransportError ConnectErrorCode) Connection))
-> Connection
-> IO (Either (TransportError ConnectErrorCode) Connection)
forall a b. (a -> b) -> a -> b
$ Connection
              { send :: [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send = RemoteEndPoint
-> IORef Bool
-> ClientConnId
-> [ByteString]
-> IO (Either (TransportError SendErrorCode) ())
sendConn RemoteEndPoint
remoteEndPoint IORef Bool
connAlive ClientConnId
connId,
                close :: IO ()
close = RemoteEndPoint -> IORef Bool -> ClientConnId -> IO ()
closeConn RemoteEndPoint
remoteEndPoint IORef Bool
connAlive ClientConnId
connId
              }
  where
    ourAddress :: EndPointAddress
ourAddress = LocalEndPoint
ourEndPoint LocalEndPoint
-> Getting EndPointAddress LocalEndPoint EndPointAddress
-> EndPointAddress
forall s a. s -> Getting a s a -> a
^. Getting EndPointAddress LocalEndPoint EndPointAddress
Lens' LocalEndPoint EndPointAddress
localAddress
    sendConn :: RemoteEndPoint
-> IORef Bool
-> ClientConnId
-> [ByteString]
-> IO (Either (TransportError SendErrorCode) ())
sendConn RemoteEndPoint
remoteEndPoint IORef Bool
connAlive ClientConnId
connId [ByteString]
packets =
      MVar RemoteEndPointState -> IO RemoteEndPointState
forall a. MVar a -> IO a
readMVar (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) IO RemoteEndPointState
-> (RemoteEndPointState
    -> IO (Either (TransportError SendErrorCode) ()))
-> IO (Either (TransportError SendErrorCode) ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        RemoteEndPointState
RemoteEndPointInit -> IO (Either (TransportError SendErrorCode) ())
forall a. HasCallStack => a
undefined
        RemoteEndPointValid ValidRemoteEndPointState
vst ->
          IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
connAlive IO Bool
-> (Bool -> IO (Either (TransportError SendErrorCode) ()))
-> IO (Either (TransportError SendErrorCode) ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
False -> Either (TransportError SendErrorCode) ()
-> IO (Either (TransportError SendErrorCode) ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TransportError SendErrorCode) ()
 -> IO (Either (TransportError SendErrorCode) ()))
-> (TransportError SendErrorCode
    -> Either (TransportError SendErrorCode) ())
-> TransportError SendErrorCode
-> IO (Either (TransportError SendErrorCode) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransportError SendErrorCode
-> Either (TransportError SendErrorCode) ()
forall a b. a -> Either a b
Left (TransportError SendErrorCode
 -> IO (Either (TransportError SendErrorCode) ()))
-> TransportError SendErrorCode
-> IO (Either (TransportError SendErrorCode) ())
forall a b. (a -> b) -> a -> b
$ SendErrorCode -> String -> TransportError SendErrorCode
forall error. error -> String -> TransportError error
TransportError SendErrorCode
SendClosed String
"Connection closed"
            Bool
True ->
              Stream
-> ClientConnId -> [ByteString] -> IO (Either QUICException ())
sendMessage (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) ClientConnId
connId [ByteString]
packets
                IO (Either QUICException ())
-> (Either QUICException ()
    -> Either (TransportError SendErrorCode) ())
-> IO (Either (TransportError SendErrorCode) ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (QUICException -> TransportError SendErrorCode)
-> Either QUICException ()
-> Either (TransportError SendErrorCode) ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (SendErrorCode -> String -> TransportError SendErrorCode
forall error. error -> String -> TransportError error
TransportError SendErrorCode
SendFailed (String -> TransportError SendErrorCode)
-> (QUICException -> String)
-> QUICException
-> TransportError SendErrorCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QUICException -> String
forall a. Show a => a -> String
show)
        RemoteEndPointState
RemoteEndPointClosed -> do
          IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
connAlive IO Bool
-> (Bool -> IO (Either (TransportError SendErrorCode) ()))
-> IO (Either (TransportError SendErrorCode) ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            -- This is normal. If the remote endpoint closes up while we have
            -- an outgoing connection (CloseEndPoint or CloseSocket message),
            -- we'll post the connection lost event but we won't update these
            -- 'connAlive' IORefs.
            Bool
False -> Either (TransportError SendErrorCode) ()
-> IO (Either (TransportError SendErrorCode) ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TransportError SendErrorCode) ()
 -> IO (Either (TransportError SendErrorCode) ()))
-> (TransportError SendErrorCode
    -> Either (TransportError SendErrorCode) ())
-> TransportError SendErrorCode
-> IO (Either (TransportError SendErrorCode) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransportError SendErrorCode
-> Either (TransportError SendErrorCode) ()
forall a b. a -> Either a b
Left (TransportError SendErrorCode
 -> IO (Either (TransportError SendErrorCode) ()))
-> TransportError SendErrorCode
-> IO (Either (TransportError SendErrorCode) ())
forall a b. (a -> b) -> a -> b
$ SendErrorCode -> String -> TransportError SendErrorCode
forall error. error -> String -> TransportError error
TransportError SendErrorCode
SendClosed String
"Connection closed"
            Bool
True -> Either (TransportError SendErrorCode) ()
-> IO (Either (TransportError SendErrorCode) ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TransportError SendErrorCode) ()
 -> IO (Either (TransportError SendErrorCode) ()))
-> (TransportError SendErrorCode
    -> Either (TransportError SendErrorCode) ())
-> TransportError SendErrorCode
-> IO (Either (TransportError SendErrorCode) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransportError SendErrorCode
-> Either (TransportError SendErrorCode) ()
forall a b. a -> Either a b
Left (TransportError SendErrorCode
 -> IO (Either (TransportError SendErrorCode) ()))
-> TransportError SendErrorCode
-> IO (Either (TransportError SendErrorCode) ())
forall a b. (a -> b) -> a -> b
$ SendErrorCode -> String -> TransportError SendErrorCode
forall error. error -> String -> TransportError error
TransportError SendErrorCode
SendFailed String
"Remote endpoint closed"
    closeConn :: RemoteEndPoint -> IORef Bool -> ClientConnId -> IO ()
closeConn RemoteEndPoint
remoteEndPoint IORef Bool
connAlive ClientConnId
connId = 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
        RemoteEndPointValid vst :: ValidRemoteEndPointState
vst@(ValidRemoteEndPointState Stream
stream MVar ()
isClosed Maybe ClientConnId
_ ClientConnId
_) -> do
          IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
connAlive IO Bool
-> (Bool -> IO (RemoteEndPointState, Maybe (IO ())))
-> IO (RemoteEndPointState, Maybe (IO ()))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Bool
False -> (RemoteEndPointState, Maybe (IO ()))
-> IO (RemoteEndPointState, Maybe (IO ()))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ValidRemoteEndPointState -> RemoteEndPointState
RemoteEndPointValid ValidRemoteEndPointState
vst, Maybe (IO ())
forall a. Maybe a
Nothing)
            Bool
True -> do
              IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
connAlive Bool
False
              -- We want to run this cleanup action OUTSIDE of the MVar modification
              let cleanup :: IO (Either QUICException ())
cleanup = ClientConnId -> Stream -> IO (Either QUICException ())
sendCloseConnection ClientConnId
connId Stream
stream
              (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
$ IO (Either QUICException ())
cleanup 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 ())
        RemoteEndPointState
_ -> (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)

      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

connectToSelf ::
  LocalEndPoint ->
  IO (Either (TransportError ConnectErrorCode) Connection)
connectToSelf :: LocalEndPoint
-> IO (Either (TransportError ConnectErrorCode) Connection)
connectToSelf LocalEndPoint
ourEndPoint = do
  IORef Bool
connAlive <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True
  MVar LocalEndPointState
-> (LocalEndPointState
    -> IO
         (LocalEndPointState,
          Either (TransportError ConnectErrorCode) ClientConnId))
-> IO (Either (TransportError ConnectErrorCode) ClientConnId)
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar
    (LocalEndPoint
ourEndPoint 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)
    ( \case
        LocalEndPointState
LocalEndPointStateClosed ->
          (LocalEndPointState,
 Either (TransportError ConnectErrorCode) ClientConnId)
-> IO
     (LocalEndPointState,
      Either (TransportError ConnectErrorCode) ClientConnId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( LocalEndPointState
LocalEndPointStateClosed,
              TransportError ConnectErrorCode
-> Either (TransportError ConnectErrorCode) ClientConnId
forall a b. a -> Either a b
Left (TransportError ConnectErrorCode
 -> Either (TransportError ConnectErrorCode) ClientConnId)
-> TransportError ConnectErrorCode
-> Either (TransportError ConnectErrorCode) ClientConnId
forall a b. (a -> b) -> a -> b
$ ConnectErrorCode -> String -> TransportError ConnectErrorCode
forall error. error -> String -> TransportError error
TransportError ConnectErrorCode
ConnectFailed String
"Local endpoint closed"
            )
        LocalEndPointStateValid ValidLocalEndPointState
vst ->
          (LocalEndPointState,
 Either (TransportError ConnectErrorCode) ClientConnId)
-> IO
     (LocalEndPointState,
      Either (TransportError ConnectErrorCode) ClientConnId)
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
vst ValidLocalEndPointState
-> (ValidLocalEndPointState -> ValidLocalEndPointState)
-> ValidLocalEndPointState
forall a b. a -> (a -> b) -> b
& (ClientConnId -> Identity ClientConnId)
-> ValidLocalEndPointState -> Identity ValidLocalEndPointState
Lens' ValidLocalEndPointState ClientConnId
nextSelfConnOutId ((ClientConnId -> Identity ClientConnId)
 -> ValidLocalEndPointState -> Identity ValidLocalEndPointState)
-> ClientConnId
-> ValidLocalEndPointState
-> ValidLocalEndPointState
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ ClientConnId
1,
              ClientConnId
-> Either (TransportError ConnectErrorCode) ClientConnId
forall a b. b -> Either a b
Right (ClientConnId
 -> Either (TransportError ConnectErrorCode) ClientConnId)
-> ClientConnId
-> Either (TransportError ConnectErrorCode) ClientConnId
forall a b. (a -> b) -> a -> b
$ ValidLocalEndPointState
vst ValidLocalEndPointState
-> Getting ClientConnId ValidLocalEndPointState ClientConnId
-> ClientConnId
forall s a. s -> Getting a s a -> a
^. Getting ClientConnId ValidLocalEndPointState ClientConnId
Lens' ValidLocalEndPointState ClientConnId
nextSelfConnOutId
            )
    )
    IO (Either (TransportError ConnectErrorCode) ClientConnId)
-> (Either (TransportError ConnectErrorCode) ClientConnId
    -> IO (Either (TransportError ConnectErrorCode) Connection))
-> IO (Either (TransportError ConnectErrorCode) Connection)
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) Connection
-> IO (Either (TransportError ConnectErrorCode) Connection)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TransportError ConnectErrorCode) Connection
 -> IO (Either (TransportError ConnectErrorCode) Connection))
-> Either (TransportError ConnectErrorCode) Connection
-> IO (Either (TransportError ConnectErrorCode) Connection)
forall a b. (a -> b) -> a -> b
$ TransportError ConnectErrorCode
-> Either (TransportError ConnectErrorCode) Connection
forall a b. a -> Either a b
Left TransportError ConnectErrorCode
err
      Right ClientConnId
clientConnId -> do
        let connId :: ConnectionId
connId = ServerConnId -> ClientConnId -> ConnectionId
createConnectionId ServerConnId
serverSelfConnId ClientConnId
clientConnId
        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
            TQueue Event
queue
            ( ConnectionId -> Reliability -> EndPointAddress -> Event
ConnectionOpened
                ConnectionId
connId
                Reliability
ReliableOrdered
                (LocalEndPoint
ourEndPoint LocalEndPoint
-> Getting EndPointAddress LocalEndPoint EndPointAddress
-> EndPointAddress
forall s a. s -> Getting a s a -> a
^. Getting EndPointAddress LocalEndPoint EndPointAddress
Lens' LocalEndPoint EndPointAddress
localAddress)
            )
        Either (TransportError ConnectErrorCode) Connection
-> IO (Either (TransportError ConnectErrorCode) Connection)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TransportError ConnectErrorCode) Connection
 -> IO (Either (TransportError ConnectErrorCode) Connection))
-> (Connection
    -> Either (TransportError ConnectErrorCode) Connection)
-> Connection
-> IO (Either (TransportError ConnectErrorCode) Connection)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Either (TransportError ConnectErrorCode) Connection
forall a b. b -> Either a b
Right (Connection
 -> IO (Either (TransportError ConnectErrorCode) Connection))
-> Connection
-> IO (Either (TransportError ConnectErrorCode) Connection)
forall a b. (a -> b) -> a -> b
$
          Connection
            { send :: [ByteString] -> IO (Either (TransportError SendErrorCode) ())
send = IORef Bool
-> ConnectionId
-> [ByteString]
-> IO (Either (TransportError SendErrorCode) ())
forall {e}.
Exception e =>
IORef Bool -> ConnectionId -> [ByteString] -> IO (Either e ())
selfSend IORef Bool
connAlive ConnectionId
connId,
              close :: IO ()
close = IORef Bool -> ConnectionId -> IO ()
selfClose IORef Bool
connAlive ConnectionId
connId
            }
  where
    queue :: TQueue Event
queue = LocalEndPoint
ourEndPoint 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
    selfSend :: IORef Bool -> ConnectionId -> [ByteString] -> IO (Either e ())
selfSend IORef Bool
connAlive ConnectionId
connId [ByteString]
msg =
      IO () -> IO (Either e ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either e ()))
-> ((LocalEndPointState -> IO ()) -> IO ())
-> (LocalEndPointState -> IO ())
-> IO (Either e ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar LocalEndPointState -> (LocalEndPointState -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (LocalEndPoint
ourEndPoint 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 ()) -> IO (Either e ()))
-> (LocalEndPointState -> IO ()) -> IO (Either e ())
forall a b. (a -> b) -> a -> b
$ \case
        LocalEndPointStateValid ValidLocalEndPointState
_ -> do
          Bool
alive <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
connAlive
          if Bool
alive
            then
              () -> IO () -> IO ()
forall a b. a -> b -> b
seq
                ((ByteString -> () -> ()) -> () -> [ByteString] -> ()
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ByteString -> () -> ()
forall a b. a -> b -> b
seq () [ByteString]
msg)
                ( 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
                      TQueue Event
queue
                      (ConnectionId -> [ByteString] -> Event
Received ConnectionId
connId [ByteString]
msg)
                )
            else TransportError SendErrorCode -> IO ()
forall e a. Exception e => e -> IO a
throwIO (TransportError SendErrorCode -> IO ())
-> TransportError SendErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ SendErrorCode -> String -> TransportError SendErrorCode
forall error. error -> String -> TransportError error
TransportError SendErrorCode
SendClosed String
"Connection closed"
        LocalEndPointState
LocalEndPointStateClosed ->
          TransportError SendErrorCode -> IO ()
forall e a. Exception e => e -> IO a
throwIO (TransportError SendErrorCode -> IO ())
-> TransportError SendErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ SendErrorCode -> String -> TransportError SendErrorCode
forall error. error -> String -> TransportError error
TransportError SendErrorCode
SendFailed String
"Endpoint closed"

    selfClose :: IORef Bool -> ConnectionId -> IO ()
selfClose IORef Bool
connAlive ConnectionId
connId =
      MVar LocalEndPointState -> (LocalEndPointState -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar (LocalEndPoint
ourEndPoint 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 ()) -> IO ())
-> (LocalEndPointState -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
        LocalEndPointStateValid ValidLocalEndPointState
_ -> do
          Bool
alive <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
connAlive
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
alive (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            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 TQueue Event
queue (ConnectionId -> Event
ConnectionClosed ConnectionId
connId)
            IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
connAlive Bool
False
        LocalEndPointState
LocalEndPointStateClosed ->
          () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()