{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

module Simplex.RemoteControl.Discovery
  ( pattern ANY_ADDR_V4,
    getLocalAddress,
    mkLastLocalHost,
    preferAddress,
    startTLSServer,
    withSender,
    withListener,
    recvAnnounce,
  ) where

import Control.Applicative ((<|>))
import Control.Logger.Simple
import Control.Monad
import Data.ByteString (ByteString)
import Data.Default (def)
import Data.List (delete, find, partition)
import Data.Maybe (mapMaybe)
import Data.String (IsString)
import qualified Data.Text as T
import Data.Word (Word16)
import Network.Info (IPv4 (..), NetworkInterface (..), getNetworkInterfaces)
import qualified Network.Socket as N
import qualified Network.TLS as TLS
import qualified Network.UDP as UDP
import Simplex.Messaging.Transport (TransportPeer (..), defaultSupportedParams)
import qualified Simplex.Messaging.Transport as Transport
import Simplex.Messaging.Transport.Client (TransportHost (..))
import Simplex.Messaging.Transport.Server (mkTransportServerConfig, runTransportServerSocket, startTCPServer)
import Simplex.Messaging.Util (ifM, tshow)
import Simplex.RemoteControl.Discovery.Multicast (setMembership)
import Simplex.RemoteControl.Types
import UnliftIO

-- | mDNS multicast group
pattern MULTICAST_ADDR_V4 :: (IsString a, Eq a) => a
pattern $mMULTICAST_ADDR_V4 :: forall {r} {a}.
(IsString a, Eq a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bMULTICAST_ADDR_V4 :: forall a. (IsString a, Eq a) => a
MULTICAST_ADDR_V4 = "224.0.0.251"

pattern ANY_ADDR_V4 :: (IsString a, Eq a) => a
pattern $mANY_ADDR_V4 :: forall {r} {a}.
(IsString a, Eq a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bANY_ADDR_V4 :: forall a. (IsString a, Eq a) => a
ANY_ADDR_V4 = "0.0.0.0"

pattern DISCOVERY_PORT :: (IsString a, Eq a) => a
pattern $mDISCOVERY_PORT :: forall {r} {a}.
(IsString a, Eq a) =>
a -> ((# #) -> r) -> ((# #) -> r) -> r
$bDISCOVERY_PORT :: forall a. (IsString a, Eq a) => a
DISCOVERY_PORT = "5227"

getLocalAddress :: Maybe RCCtrlAddress -> IO [RCCtrlAddress]
getLocalAddress :: Maybe RCCtrlAddress -> IO [RCCtrlAddress]
getLocalAddress Maybe RCCtrlAddress
preferred_ =
  ([RCCtrlAddress] -> [RCCtrlAddress])
-> (RCCtrlAddress -> [RCCtrlAddress] -> [RCCtrlAddress])
-> Maybe RCCtrlAddress
-> [RCCtrlAddress]
-> [RCCtrlAddress]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [RCCtrlAddress] -> [RCCtrlAddress]
forall a. a -> a
id RCCtrlAddress -> [RCCtrlAddress] -> [RCCtrlAddress]
preferAddress Maybe RCCtrlAddress
preferred_ ([RCCtrlAddress] -> [RCCtrlAddress])
-> ([NetworkInterface] -> [RCCtrlAddress])
-> [NetworkInterface]
-> [RCCtrlAddress]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RCCtrlAddress] -> [RCCtrlAddress]
mkLastLocalHost ([RCCtrlAddress] -> [RCCtrlAddress])
-> ([NetworkInterface] -> [RCCtrlAddress])
-> [NetworkInterface]
-> [RCCtrlAddress]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NetworkInterface -> Maybe RCCtrlAddress)
-> [NetworkInterface] -> [RCCtrlAddress]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NetworkInterface -> Maybe RCCtrlAddress
toCtrlAddr ([NetworkInterface] -> [RCCtrlAddress])
-> IO [NetworkInterface] -> IO [RCCtrlAddress]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [NetworkInterface]
getNetworkInterfaces
  where
    toCtrlAddr :: NetworkInterface -> Maybe RCCtrlAddress
toCtrlAddr NetworkInterface {ServiceName
name :: ServiceName
name :: NetworkInterface -> ServiceName
name, ipv4 :: NetworkInterface -> IPv4
ipv4 = IPv4 Word32
ha} = case Word32 -> (Word8, Word8, Word8, Word8)
N.hostAddressToTuple Word32
ha of
      (Word8
0, Word8
0, Word8
0, Word8
0) -> Maybe RCCtrlAddress
forall a. Maybe a
Nothing -- "no" address
      (Word8
255, Word8
255, Word8
255, Word8
255) -> Maybe RCCtrlAddress
forall a. Maybe a
Nothing -- broadcast
      (Word8
169, Word8
254, Word8
_, Word8
_) -> Maybe RCCtrlAddress
forall a. Maybe a
Nothing -- link-local
      (Word8, Word8, Word8, Word8)
ok -> RCCtrlAddress -> Maybe RCCtrlAddress
forall a. a -> Maybe a
Just RCCtrlAddress {$sel:address:RCCtrlAddress :: TransportHost
address = (Word8, Word8, Word8, Word8) -> TransportHost
THIPv4 (Word8, Word8, Word8, Word8)
ok, $sel:interface:RCCtrlAddress :: Text
interface = ServiceName -> Text
T.pack ServiceName
name}

mkLastLocalHost :: [RCCtrlAddress] -> [RCCtrlAddress]
mkLastLocalHost :: [RCCtrlAddress] -> [RCCtrlAddress]
mkLastLocalHost [RCCtrlAddress]
addrs = [RCCtrlAddress]
other [RCCtrlAddress] -> [RCCtrlAddress] -> [RCCtrlAddress]
forall a. Semigroup a => a -> a -> a
<> [RCCtrlAddress]
local
  where
    ([RCCtrlAddress]
local, [RCCtrlAddress]
other) = (RCCtrlAddress -> Bool)
-> [RCCtrlAddress] -> ([RCCtrlAddress], [RCCtrlAddress])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition RCCtrlAddress -> Bool
localHost [RCCtrlAddress]
addrs
    localHost :: RCCtrlAddress -> Bool
localHost RCCtrlAddress {$sel:address:RCCtrlAddress :: RCCtrlAddress -> TransportHost
address = THIPv4 (Word8
127, Word8
_, Word8
_, Word8
_)} = Bool
True
    localHost RCCtrlAddress
_ = Bool
False

preferAddress :: RCCtrlAddress -> [RCCtrlAddress] -> [RCCtrlAddress]
preferAddress :: RCCtrlAddress -> [RCCtrlAddress] -> [RCCtrlAddress]
preferAddress RCCtrlAddress {TransportHost
$sel:address:RCCtrlAddress :: RCCtrlAddress -> TransportHost
address :: TransportHost
address, Text
$sel:interface:RCCtrlAddress :: RCCtrlAddress -> Text
interface :: Text
interface} [RCCtrlAddress]
addrs =
  case (RCCtrlAddress -> Bool) -> [RCCtrlAddress] -> Maybe RCCtrlAddress
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find RCCtrlAddress -> Bool
matchAddr [RCCtrlAddress]
addrs Maybe RCCtrlAddress -> Maybe RCCtrlAddress -> Maybe RCCtrlAddress
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (RCCtrlAddress -> Bool) -> [RCCtrlAddress] -> Maybe RCCtrlAddress
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find RCCtrlAddress -> Bool
matchIface [RCCtrlAddress]
addrs of
    Maybe RCCtrlAddress
Nothing -> [RCCtrlAddress]
addrs
    Just RCCtrlAddress
p -> RCCtrlAddress
p RCCtrlAddress -> [RCCtrlAddress] -> [RCCtrlAddress]
forall a. a -> [a] -> [a]
: RCCtrlAddress -> [RCCtrlAddress] -> [RCCtrlAddress]
forall a. Eq a => a -> [a] -> [a]
delete RCCtrlAddress
p [RCCtrlAddress]
addrs
  where
    matchAddr :: RCCtrlAddress -> Bool
matchAddr RCCtrlAddress {$sel:address:RCCtrlAddress :: RCCtrlAddress -> TransportHost
address = TransportHost
a} = TransportHost
a TransportHost -> TransportHost -> Bool
forall a. Eq a => a -> a -> Bool
== TransportHost
address
    matchIface :: RCCtrlAddress -> Bool
matchIface RCCtrlAddress {$sel:interface:RCCtrlAddress :: RCCtrlAddress -> Text
interface = Text
i} = Text
i Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
interface

startTLSServer :: Maybe Word16 -> TMVar (Maybe N.PortNumber) -> TLS.Credential -> TLS.ServerHooks -> (Transport.TLS 'TServer -> IO ()) -> IO (Async ())
startTLSServer :: Maybe Word16
-> TMVar (Maybe PortNumber)
-> Credential
-> ServerHooks
-> (TLS 'TServer -> IO ())
-> IO (Async ())
startTLSServer Maybe Word16
port_ TMVar (Maybe PortNumber)
startedOnPort Credential
credentials ServerHooks
hooks TLS 'TServer -> IO ()
server = IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ()))
-> (IO () -> IO ()) -> IO () -> IO (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ do
  TMVar Bool
started <- IO (TMVar Bool)
forall (m :: * -> *) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO
  IO Socket -> (Socket -> IO ()) -> (Socket -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError (TMVar Bool -> Maybe ServiceName -> ServiceName -> IO Socket
startTCPServer TMVar Bool
started Maybe ServiceName
forall a. Maybe a
Nothing (ServiceName -> IO Socket) -> ServiceName -> IO Socket
forall a b. (a -> b) -> a -> b
$ ServiceName
-> (Word16 -> ServiceName) -> Maybe Word16 -> ServiceName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ServiceName
"0" Word16 -> ServiceName
forall a. Show a => a -> ServiceName
show Maybe Word16
port_) (\Socket
_e -> Maybe PortNumber -> IO ()
setPort Maybe PortNumber
forall a. Maybe a
Nothing) ((Socket -> IO ()) -> IO ()) -> (Socket -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Socket
socket ->
    IO Bool -> IO () -> IO () -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM
      (STM Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TMVar Bool -> STM Bool
forall a. TMVar a -> STM a
readTMVar TMVar Bool
started)
      (TMVar Bool -> Socket -> IO ()
runServer TMVar Bool
started Socket
socket)
      (Maybe PortNumber -> IO ()
setPort Maybe PortNumber
forall a. Maybe a
Nothing)
  where
    runServer :: TMVar Bool -> Socket -> IO ()
runServer TMVar Bool
started Socket
socket = do
      PortNumber
port <- Socket -> IO PortNumber
N.socketPort Socket
socket
      Text -> IO ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
logInfo (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"System-assigned port: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PortNumber -> Text
forall a. Show a => a -> Text
tshow PortNumber
port
      Maybe PortNumber -> IO ()
setPort (Maybe PortNumber -> IO ()) -> Maybe PortNumber -> IO ()
forall a b. (a -> b) -> a -> b
$ PortNumber -> Maybe PortNumber
forall a. a -> Maybe a
Just PortNumber
port
      TMVar Bool
-> IO Socket
-> ServiceName
-> ServerParams
-> TransportServerConfig
-> (TLS 'TServer -> IO ())
-> IO ()
forall (c :: TransportPeer -> *).
Transport c =>
TMVar Bool
-> IO Socket
-> ServiceName
-> ServerParams
-> TransportServerConfig
-> (c 'TServer -> IO ())
-> IO ()
runTransportServerSocket TMVar Bool
started (Socket -> IO Socket
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Socket
socket) ServiceName
"RCP TLS" ServerParams
serverParams (Bool -> Maybe [ALPN] -> Bool -> TransportServerConfig
mkTransportServerConfig Bool
True Maybe [ALPN]
forall a. Maybe a
Nothing Bool
True) TLS 'TServer -> IO ()
server
    setPort :: Maybe PortNumber -> IO ()
setPort = IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ())
-> (Maybe PortNumber -> IO Bool) -> Maybe PortNumber -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Bool -> IO Bool)
-> (Maybe PortNumber -> STM Bool) -> Maybe PortNumber -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMVar (Maybe PortNumber) -> Maybe PortNumber -> STM Bool
forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar (Maybe PortNumber)
startedOnPort
    serverParams :: ServerParams
serverParams =
      ServerParams
forall a. Default a => a
def
        { TLS.serverWantClientCert = True,
          TLS.serverShared = def {TLS.sharedCredentials = TLS.Credentials [credentials]},
          TLS.serverHooks = hooks,
          TLS.serverSupported = defaultSupportedParams
        }

withSender :: (UDP.UDPSocket -> IO a) -> IO a
withSender :: forall a. (UDPSocket -> IO a) -> IO a
withSender = IO UDPSocket -> (UDPSocket -> IO ()) -> (UDPSocket -> IO a) -> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (ServiceName -> ServiceName -> Bool -> IO UDPSocket
UDP.clientSocket ServiceName
forall a. (IsString a, Eq a) => a
MULTICAST_ADDR_V4 ServiceName
forall a. (IsString a, Eq a) => a
DISCOVERY_PORT Bool
False) (UDPSocket -> IO ()
UDP.close)

withListener :: TMVar Int -> (UDP.ListenSocket -> IO a) -> IO a
withListener :: forall a. TMVar Int -> (ListenSocket -> IO a) -> IO a
withListener TMVar Int
subscribers = IO ListenSocket
-> (ListenSocket -> IO ()) -> (ListenSocket -> IO a) -> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (TMVar Int -> IO ListenSocket
openListener TMVar Int
subscribers) (TMVar Int -> ListenSocket -> IO ()
closeListener TMVar Int
subscribers)

openListener :: TMVar Int -> IO UDP.ListenSocket
openListener :: TMVar Int -> IO ListenSocket
openListener TMVar Int
subscribers = do
  ListenSocket
sock <- (IP, PortNumber) -> IO ListenSocket
UDP.serverSocket (IP
forall a. (IsString a, Eq a) => a
MULTICAST_ADDR_V4, ServiceName -> PortNumber
forall a. Read a => ServiceName -> a
read ServiceName
forall a. (IsString a, Eq a) => a
DISCOVERY_PORT)
  Text -> IO ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
logDebug (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Discovery listener socket: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ListenSocket -> Text
forall a. Show a => a -> Text
tshow ListenSocket
sock
  let raw :: Socket
raw = ListenSocket -> Socket
UDP.listenSocket ListenSocket
sock
  -- N.setSocketOption raw N.Broadcast 1
  TMVar Int -> Socket -> Word32 -> IO ()
joinMulticast TMVar Int
subscribers Socket
raw (ListenSocket -> Word32
listenerHostAddr4 ListenSocket
sock)
  ListenSocket -> IO ListenSocket
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListenSocket
sock

closeListener :: TMVar Int -> UDP.ListenSocket -> IO ()
closeListener :: TMVar Int -> ListenSocket -> IO ()
closeListener TMVar Int
subscribers ListenSocket
sock =
  TMVar Int -> Socket -> Word32 -> IO ()
partMulticast TMVar Int
subscribers (ListenSocket -> Socket
UDP.listenSocket ListenSocket
sock) (ListenSocket -> Word32
listenerHostAddr4 ListenSocket
sock) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`finally` ListenSocket -> IO ()
UDP.stop ListenSocket
sock

joinMulticast :: TMVar Int -> N.Socket -> N.HostAddress -> IO ()
joinMulticast :: TMVar Int -> Socket -> Word32 -> IO ()
joinMulticast TMVar Int
subscribers Socket
sock Word32
group = do
  Int
now <- STM Int -> IO Int
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Int -> IO Int) -> STM Int -> IO Int
forall a b. (a -> b) -> a -> b
$ TMVar Int -> STM Int
forall a. TMVar a -> STM a
takeTMVar TMVar Int
subscribers
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
now Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Socket -> Word32 -> Bool -> IO (Either CInt ())
setMembership Socket
sock Word32
group Bool
True IO (Either CInt ()) -> (Either CInt () -> 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 CInt
e -> STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TMVar Int -> Int -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar Int
subscribers Int
now) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> IO ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
logError (Text
"setMembership failed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CInt -> Text
forall a. Show a => a -> Text
tshow CInt
e)
      Right () -> STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar Int -> Int -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar Int
subscribers (Int
now Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

partMulticast :: TMVar Int -> N.Socket -> N.HostAddress -> IO ()
partMulticast :: TMVar Int -> Socket -> Word32 -> IO ()
partMulticast TMVar Int
subscribers Socket
sock Word32
group = do
  Int
now <- STM Int -> IO Int
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Int -> IO Int) -> STM Int -> IO Int
forall a b. (a -> b) -> a -> b
$ TMVar Int -> STM Int
forall a. TMVar a -> STM a
takeTMVar TMVar Int
subscribers
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
now Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Socket -> Word32 -> Bool -> IO (Either CInt ())
setMembership Socket
sock Word32
group Bool
False IO (Either CInt ()) -> (Either CInt () -> 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 CInt
e -> STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TMVar Int -> Int -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar Int
subscribers Int
now) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> IO ()
forall (m :: * -> *). (HasCallStack, MonadIO m) => Text -> m ()
logError (Text
"setMembership failed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CInt -> Text
forall a. Show a => a -> Text
tshow CInt
e)
      Right () -> STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar Int -> Int -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar Int
subscribers (Int
now Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

listenerHostAddr4 :: UDP.ListenSocket -> N.HostAddress
listenerHostAddr4 :: ListenSocket -> Word32
listenerHostAddr4 ListenSocket
sock = case ListenSocket -> SockAddr
UDP.mySockAddr ListenSocket
sock of
  N.SockAddrInet PortNumber
_port Word32
host -> Word32
host
  SockAddr
_ -> ServiceName -> Word32
forall a. HasCallStack => ServiceName -> a
error ServiceName
"MULTICAST_ADDR_V4 is V4"

recvAnnounce :: UDP.ListenSocket -> IO (N.SockAddr, ByteString)
recvAnnounce :: ListenSocket -> IO (SockAddr, ALPN)
recvAnnounce ListenSocket
sock = do
  (ALPN
invite, UDP.ClientSockAddr SockAddr
source [Cmsg]
_cmsg) <- ListenSocket -> IO (ALPN, ClientSockAddr)
UDP.recvFrom ListenSocket
sock
  (SockAddr, ALPN) -> IO (SockAddr, ALPN)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SockAddr
source, ALPN
invite)