{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.QUIC.Server.Reader (
Dispatch
, newDispatch
, clearDispatch
, runDispatcher
, tokenMgr
, accept
, Accept(..)
, RecvQ
, recvServer
, readerServer
) where
import Control.Concurrent
import Control.Concurrent.STM
import qualified Crypto.Token as CT
import qualified Data.ByteString as BS
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.OrdPSQ (OrdPSQ)
import qualified Data.OrdPSQ as PSQ
import Foreign.Marshal.Alloc
import qualified GHC.IO.Exception as E
import Network.ByteOrder
import Network.Socket hiding (accept, Debug)
import qualified Network.Socket.ByteString as NSB
import qualified System.IO.Error as E
import System.Log.FastLogger
import qualified UnliftIO.Exception as E
import Network.QUIC.Config
import Network.QUIC.Connection
import Network.QUIC.Connector
import Network.QUIC.Exception
import Network.QUIC.Imports
import Network.QUIC.Logger
import Network.QUIC.Packet
import Network.QUIC.Parameters
import Network.QUIC.Qlog
import Network.QUIC.Socket
import Network.QUIC.Types
data Dispatch = Dispatch {
Dispatch -> TokenManager
tokenMgr :: CT.TokenManager
, Dispatch -> IORef ConnectionDict
dstTable :: IORef ConnectionDict
, Dispatch -> IORef RecvQDict
srcTable :: IORef RecvQDict
, Dispatch -> AcceptQ
acceptQ :: AcceptQ
}
newDispatch :: IO Dispatch
newDispatch :: IO Dispatch
newDispatch = TokenManager
-> IORef ConnectionDict -> IORef RecvQDict -> AcceptQ -> Dispatch
Dispatch (TokenManager
-> IORef ConnectionDict -> IORef RecvQDict -> AcceptQ -> Dispatch)
-> IO TokenManager
-> IO
(IORef ConnectionDict -> IORef RecvQDict -> AcceptQ -> Dispatch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> IO TokenManager
CT.spawnTokenManager Config
CT.defaultConfig
IO (IORef ConnectionDict -> IORef RecvQDict -> AcceptQ -> Dispatch)
-> IO (IORef ConnectionDict)
-> IO (IORef RecvQDict -> AcceptQ -> Dispatch)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConnectionDict -> IO (IORef ConnectionDict)
forall a. a -> IO (IORef a)
newIORef ConnectionDict
emptyConnectionDict
IO (IORef RecvQDict -> AcceptQ -> Dispatch)
-> IO (IORef RecvQDict) -> IO (AcceptQ -> Dispatch)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RecvQDict -> IO (IORef RecvQDict)
forall a. a -> IO (IORef a)
newIORef RecvQDict
emptyRecvQDict
IO (AcceptQ -> Dispatch) -> IO AcceptQ -> IO Dispatch
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO AcceptQ
newAcceptQ
clearDispatch :: Dispatch -> IO ()
clearDispatch :: Dispatch -> IO ()
clearDispatch Dispatch
d = TokenManager -> IO ()
CT.killTokenManager (TokenManager -> IO ()) -> TokenManager -> IO ()
forall a b. (a -> b) -> a -> b
$ Dispatch -> TokenManager
tokenMgr Dispatch
d
newtype ConnectionDict = ConnectionDict (Map CID Connection)
emptyConnectionDict :: ConnectionDict
emptyConnectionDict :: ConnectionDict
emptyConnectionDict = Map CID Connection -> ConnectionDict
ConnectionDict Map CID Connection
forall k a. Map k a
M.empty
lookupConnectionDict :: IORef ConnectionDict -> CID -> IO (Maybe Connection)
lookupConnectionDict :: IORef ConnectionDict -> CID -> IO (Maybe Connection)
lookupConnectionDict IORef ConnectionDict
ref CID
cid = do
ConnectionDict Map CID Connection
tbl <- IORef ConnectionDict -> IO ConnectionDict
forall a. IORef a -> IO a
readIORef IORef ConnectionDict
ref
Maybe Connection -> IO (Maybe Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Connection -> IO (Maybe Connection))
-> Maybe Connection -> IO (Maybe Connection)
forall a b. (a -> b) -> a -> b
$ CID -> Map CID Connection -> Maybe Connection
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup CID
cid Map CID Connection
tbl
registerConnectionDict :: IORef ConnectionDict -> CID -> Connection -> IO ()
registerConnectionDict :: IORef ConnectionDict -> CID -> Connection -> IO ()
registerConnectionDict IORef ConnectionDict
ref CID
cid Connection
conn = IORef ConnectionDict -> (ConnectionDict -> ConnectionDict) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' IORef ConnectionDict
ref ((ConnectionDict -> ConnectionDict) -> IO ())
-> (ConnectionDict -> ConnectionDict) -> IO ()
forall a b. (a -> b) -> a -> b
$
\(ConnectionDict Map CID Connection
tbl) -> Map CID Connection -> ConnectionDict
ConnectionDict (Map CID Connection -> ConnectionDict)
-> Map CID Connection -> ConnectionDict
forall a b. (a -> b) -> a -> b
$ CID -> Connection -> Map CID Connection -> Map CID Connection
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert CID
cid Connection
conn Map CID Connection
tbl
unregisterConnectionDict :: IORef ConnectionDict -> CID -> IO ()
unregisterConnectionDict :: IORef ConnectionDict -> CID -> IO ()
unregisterConnectionDict IORef ConnectionDict
ref CID
cid = IORef ConnectionDict -> (ConnectionDict -> ConnectionDict) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' IORef ConnectionDict
ref ((ConnectionDict -> ConnectionDict) -> IO ())
-> (ConnectionDict -> ConnectionDict) -> IO ()
forall a b. (a -> b) -> a -> b
$
\(ConnectionDict Map CID Connection
tbl) -> Map CID Connection -> ConnectionDict
ConnectionDict (Map CID Connection -> ConnectionDict)
-> Map CID Connection -> ConnectionDict
forall a b. (a -> b) -> a -> b
$ CID -> Map CID Connection -> Map CID Connection
forall k a. Ord k => k -> Map k a -> Map k a
M.delete CID
cid Map CID Connection
tbl
data RecvQDict = RecvQDict Int (OrdPSQ CID Int RecvQ)
recvQDictSize :: Int
recvQDictSize :: Int
recvQDictSize = Int
100
emptyRecvQDict :: RecvQDict
emptyRecvQDict :: RecvQDict
emptyRecvQDict = Int -> OrdPSQ CID Int RecvQ -> RecvQDict
RecvQDict Int
0 OrdPSQ CID Int RecvQ
forall k p v. OrdPSQ k p v
PSQ.empty
lookupRecvQDict :: IORef RecvQDict -> CID -> IO (Maybe RecvQ)
lookupRecvQDict :: IORef RecvQDict -> CID -> IO (Maybe RecvQ)
lookupRecvQDict IORef RecvQDict
ref CID
dcid = do
RecvQDict Int
_ OrdPSQ CID Int RecvQ
qt <- IORef RecvQDict -> IO RecvQDict
forall a. IORef a -> IO a
readIORef IORef RecvQDict
ref
Maybe RecvQ -> IO (Maybe RecvQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RecvQ -> IO (Maybe RecvQ))
-> Maybe RecvQ -> IO (Maybe RecvQ)
forall a b. (a -> b) -> a -> b
$ case CID -> OrdPSQ CID Int RecvQ -> Maybe (Int, RecvQ)
forall k p v. Ord k => k -> OrdPSQ k p v -> Maybe (p, v)
PSQ.lookup CID
dcid OrdPSQ CID Int RecvQ
qt of
Maybe (Int, RecvQ)
Nothing -> Maybe RecvQ
forall a. Maybe a
Nothing
Just (Int
_,RecvQ
q) -> RecvQ -> Maybe RecvQ
forall a. a -> Maybe a
Just RecvQ
q
insertRecvQDict :: IORef RecvQDict -> CID -> RecvQ -> IO ()
insertRecvQDict :: IORef RecvQDict -> CID -> RecvQ -> IO ()
insertRecvQDict IORef RecvQDict
ref CID
dcid RecvQ
q = IORef RecvQDict -> (RecvQDict -> RecvQDict) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' IORef RecvQDict
ref RecvQDict -> RecvQDict
ins
where
ins :: RecvQDict -> RecvQDict
ins (RecvQDict Int
p OrdPSQ CID Int RecvQ
qt0) = let qt1 :: OrdPSQ CID Int RecvQ
qt1 | OrdPSQ CID Int RecvQ -> Int
forall k p v. OrdPSQ k p v -> Int
PSQ.size OrdPSQ CID Int RecvQ
qt0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
recvQDictSize = OrdPSQ CID Int RecvQ
qt0
| Bool
otherwise = OrdPSQ CID Int RecvQ -> OrdPSQ CID Int RecvQ
forall k p v. (Ord k, Ord p) => OrdPSQ k p v -> OrdPSQ k p v
PSQ.deleteMin OrdPSQ CID Int RecvQ
qt0
qt2 :: OrdPSQ CID Int RecvQ
qt2 = CID -> Int -> RecvQ -> OrdPSQ CID Int RecvQ -> OrdPSQ CID Int RecvQ
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.insert CID
dcid Int
p RecvQ
q OrdPSQ CID Int RecvQ
qt1
p' :: Int
p' = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in Int -> OrdPSQ CID Int RecvQ -> RecvQDict
RecvQDict Int
p' OrdPSQ CID Int RecvQ
qt2
data Accept = Accept {
Accept -> Version
accVersion :: Version
, Accept -> AuthCIDs
accMyAuthCIDs :: AuthCIDs
, Accept -> AuthCIDs
accPeerAuthCIDs :: AuthCIDs
, Accept -> SockAddr
accMySockAddr :: SockAddr
, Accept -> SockAddr
accPeerSockAddr :: SockAddr
, Accept -> RecvQ
accRecvQ :: RecvQ
, Accept -> Int
accPacketSize :: Int
, Accept -> CID -> Connection -> IO ()
accRegister :: CID -> Connection -> IO ()
, Accept -> CID -> IO ()
accUnregister :: CID -> IO ()
, Accept -> Bool
accAddressValidated :: Bool
, Accept -> TimeMicrosecond
accTime :: TimeMicrosecond
}
newtype AcceptQ = AcceptQ (TQueue Accept)
newAcceptQ :: IO AcceptQ
newAcceptQ :: IO AcceptQ
newAcceptQ = TQueue Accept -> AcceptQ
AcceptQ (TQueue Accept -> AcceptQ) -> IO (TQueue Accept) -> IO AcceptQ
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (TQueue Accept)
forall a. IO (TQueue a)
newTQueueIO
readAcceptQ :: AcceptQ -> IO Accept
readAcceptQ :: AcceptQ -> IO Accept
readAcceptQ (AcceptQ TQueue Accept
q) = STM Accept -> IO Accept
forall a. STM a -> IO a
atomically (STM Accept -> IO Accept) -> STM Accept -> IO Accept
forall a b. (a -> b) -> a -> b
$ TQueue Accept -> STM Accept
forall a. TQueue a -> STM a
readTQueue TQueue Accept
q
writeAcceptQ :: AcceptQ -> Accept -> IO ()
writeAcceptQ :: AcceptQ -> Accept -> IO ()
writeAcceptQ (AcceptQ TQueue Accept
q) Accept
x = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue Accept -> Accept -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue Accept
q Accept
x
accept :: Dispatch -> IO Accept
accept :: Dispatch -> IO Accept
accept = AcceptQ -> IO Accept
readAcceptQ (AcceptQ -> IO Accept)
-> (Dispatch -> AcceptQ) -> Dispatch -> IO Accept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dispatch -> AcceptQ
acceptQ
runDispatcher :: Dispatch -> ServerConfig -> (Socket, SockAddr) -> IO ThreadId
runDispatcher :: Dispatch -> ServerConfig -> (Socket, SockAddr) -> IO ThreadId
runDispatcher Dispatch
d ServerConfig
conf ssa :: (Socket, SockAddr)
ssa@(Socket
s,SockAddr
_) =
IO () -> (Either SomeException () -> IO ()) -> IO ThreadId
forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally (Dispatch -> ServerConfig -> (Socket, SockAddr) -> IO ()
dispatcher Dispatch
d ServerConfig
conf (Socket, SockAddr)
ssa) ((Either SomeException () -> IO ()) -> IO ThreadId)
-> (Either SomeException () -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \Either SomeException ()
_ -> Socket -> IO ()
close Socket
s
dispatcher :: Dispatch -> ServerConfig -> (Socket, SockAddr) -> IO ()
dispatcher :: Dispatch -> ServerConfig -> (Socket, SockAddr) -> IO ()
dispatcher Dispatch
d ServerConfig
conf (Socket
s,SockAddr
mysa) = DebugLogger -> IO () -> IO ()
handleLogUnit DebugLogger
logAction (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO (Ptr Word8)
-> (Ptr Word8 -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracket (Int -> IO (Ptr Word8)
forall a. Int -> IO (Ptr a)
mallocBytes Int
maximumUdpPayloadSize)
Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
free
Ptr Word8 -> IO ()
forall b. Ptr Word8 -> IO b
body
where
body :: Ptr Word8 -> IO b
body Ptr Word8
buf = do
IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO b) -> IO () -> IO b
forall a b. (a -> b) -> a -> b
$ do
(ByteString
bs0, SockAddr
peersa) <- IO (ByteString, SockAddr)
recv
let bytes :: Int
bytes = ByteString -> Int
BS.length ByteString
bs0
TimeMicrosecond
now <- IO TimeMicrosecond
getTimeMicrosecond
(PacketI
pkt, ByteString
bs0RTT) <- ByteString -> IO (PacketI, ByteString)
decodePacket ByteString
bs0
let send :: ByteString -> IO ()
send ByteString
bs = IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Socket -> ByteString -> SockAddr -> IO Int
NSB.sendTo Socket
s ByteString
bs SockAddr
peersa
Dispatch
-> ServerConfig
-> DebugLogger
-> PacketI
-> SockAddr
-> SockAddr
-> (ByteString -> IO ())
-> Ptr Word8
-> ByteString
-> Int
-> TimeMicrosecond
-> IO ()
dispatch Dispatch
d ServerConfig
conf DebugLogger
logAction PacketI
pkt SockAddr
mysa SockAddr
peersa ByteString -> IO ()
send Ptr Word8
buf ByteString
bs0RTT Int
bytes TimeMicrosecond
now
doDebug :: Bool
doDebug = Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool) -> Maybe FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ ServerConfig -> Maybe FilePath
scDebugLog ServerConfig
conf
logAction :: DebugLogger
logAction Builder
msg | Bool
doDebug = DebugLogger
stdoutLogger (Builder
"dispatch(er): " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
msg)
| Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
recv :: IO (ByteString, SockAddr)
recv = do
Either SomeException (ByteString, SockAddr)
ex <- IO (ByteString, SockAddr)
-> IO (Either SomeException (ByteString, SockAddr))
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
E.tryAny (IO (ByteString, SockAddr)
-> IO (Either SomeException (ByteString, SockAddr)))
-> IO (ByteString, SockAddr)
-> IO (Either SomeException (ByteString, SockAddr))
forall a b. (a -> b) -> a -> b
$ Socket -> Int -> IO (ByteString, SockAddr)
NSB.recvFrom Socket
s Int
maximumUdpPayloadSize
case Either SomeException (ByteString, SockAddr)
ex of
Right (ByteString, SockAddr)
x -> (ByteString, SockAddr) -> IO (ByteString, SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString, SockAddr)
x
Left SomeException
se -> case SomeException -> Maybe IOError
forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
se of
Just IOError
e | IOError -> IOErrorType
E.ioeGetErrorType IOError
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
E.InvalidArgument -> SomeException -> IO (ByteString, SockAddr)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO SomeException
se
Maybe IOError
_ -> do
DebugLogger
logAction DebugLogger -> DebugLogger
forall a b. (a -> b) -> a -> b
$ Builder
"recv again: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SomeException -> Builder
forall a. Show a => a -> Builder
bhow SomeException
se
IO (ByteString, SockAddr)
recv
dispatch :: Dispatch -> ServerConfig -> DebugLogger -> PacketI -> SockAddr -> SockAddr -> (ByteString -> IO ()) -> Buffer -> ByteString -> Int -> TimeMicrosecond -> IO ()
dispatch :: Dispatch
-> ServerConfig
-> DebugLogger
-> PacketI
-> SockAddr
-> SockAddr
-> (ByteString -> IO ())
-> Ptr Word8
-> ByteString
-> Int
-> TimeMicrosecond
-> IO ()
dispatch Dispatch{IORef RecvQDict
IORef ConnectionDict
TokenManager
AcceptQ
acceptQ :: AcceptQ
srcTable :: IORef RecvQDict
dstTable :: IORef ConnectionDict
tokenMgr :: TokenManager
acceptQ :: Dispatch -> AcceptQ
srcTable :: Dispatch -> IORef RecvQDict
dstTable :: Dispatch -> IORef ConnectionDict
tokenMgr :: Dispatch -> TokenManager
..} ServerConfig{Bool
[(IP, PortNumber)]
[Cipher]
[Group]
[Version]
Maybe FilePath
Maybe (Version -> [ByteString] -> IO ByteString)
Credentials
SessionManager
Parameters
Hooks
FilePath -> IO ()
scSessionManager :: ServerConfig -> SessionManager
scRequireRetry :: ServerConfig -> Bool
scALPN :: ServerConfig -> Maybe (Version -> [ByteString] -> IO ByteString)
scAddresses :: ServerConfig -> [(IP, PortNumber)]
scUse0RTT :: ServerConfig -> Bool
scHooks :: ServerConfig -> Hooks
scCredentials :: ServerConfig -> Credentials
scQLog :: ServerConfig -> Maybe FilePath
scKeyLog :: ServerConfig -> FilePath -> IO ()
scParameters :: ServerConfig -> Parameters
scGroups :: ServerConfig -> [Group]
scCiphers :: ServerConfig -> [Cipher]
scVersions :: ServerConfig -> [Version]
scDebugLog :: Maybe FilePath
scSessionManager :: SessionManager
scRequireRetry :: Bool
scALPN :: Maybe (Version -> [ByteString] -> IO ByteString)
scAddresses :: [(IP, PortNumber)]
scUse0RTT :: Bool
scHooks :: Hooks
scCredentials :: Credentials
scQLog :: Maybe FilePath
scKeyLog :: FilePath -> IO ()
scParameters :: Parameters
scGroups :: [Group]
scCiphers :: [Cipher]
scVersions :: [Version]
scDebugLog :: ServerConfig -> Maybe FilePath
..} DebugLogger
logAction
(PacketIC cpkt :: CryptPacket
cpkt@(CryptPacket (Initial Version
ver CID
dCID CID
sCID ByteString
token) Crypt
_) EncryptionLevel
lvl)
SockAddr
mysa SockAddr
peersa ByteString -> IO ()
send Ptr Word8
_ ByteString
bs0RTT Int
bytes TimeMicrosecond
tim
| Int
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
defaultQUICPacketSize = do
DebugLogger
logAction DebugLogger -> DebugLogger
forall a b. (a -> b) -> a -> b
$ Builder
"too small " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Show a => a -> Builder
bhow Int
bytes Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SockAddr -> Builder
forall a. Show a => a -> Builder
bhow SockAddr
peersa
| Version
ver Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Version]
scVersions= do
let vers :: [Version]
vers | Version
ver Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
GreasingVersion = Version
GreasingVersion2 Version -> [Version] -> [Version]
forall a. a -> [a] -> [a]
: [Version]
scVersions
| Bool
otherwise = Version
GreasingVersion Version -> [Version] -> [Version]
forall a. a -> [a] -> [a]
: [Version]
scVersions
ByteString
bss <- VersionNegotiationPacket -> IO ByteString
encodeVersionNegotiationPacket (VersionNegotiationPacket -> IO ByteString)
-> VersionNegotiationPacket -> IO ByteString
forall a b. (a -> b) -> a -> b
$ CID -> CID -> [Version] -> VersionNegotiationPacket
VersionNegotiationPacket CID
sCID CID
dCID [Version]
vers
ByteString -> IO ()
send ByteString
bss
| ByteString
token ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"" = do
Maybe Connection
mq <- IORef ConnectionDict -> CID -> IO (Maybe Connection)
lookupConnectionDict IORef ConnectionDict
dstTable CID
dCID
case Maybe Connection
mq of
Maybe Connection
Nothing
| Bool
scRequireRetry -> IO ()
sendRetry
| Bool
otherwise -> Bool -> IO ()
pushToAcceptFirst Bool
False
Maybe Connection
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Maybe CryptoToken
mct <- TokenManager -> ByteString -> IO (Maybe CryptoToken)
decryptToken TokenManager
tokenMgr ByteString
token
case Maybe CryptoToken
mct of
Just CryptoToken
ct
| CryptoToken -> Bool
isRetryToken CryptoToken
ct -> do
Bool
ok <- CryptoToken -> IO Bool
isRetryTokenValid CryptoToken
ct
if Bool
ok then CryptoToken -> IO ()
pushToAcceptRetried CryptoToken
ct else IO ()
sendRetry
| Bool
otherwise -> do
Maybe Connection
mq <- IORef ConnectionDict -> CID -> IO (Maybe Connection)
lookupConnectionDict IORef ConnectionDict
dstTable CID
dCID
case Maybe Connection
mq of
Maybe Connection
Nothing -> Bool -> IO ()
pushToAcceptFirst Bool
True
Maybe Connection
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe CryptoToken
_ -> IO ()
sendRetry
where
pushToAcceptQ :: AuthCIDs -> AuthCIDs -> CID -> Bool -> IO ()
pushToAcceptQ AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs CID
key Bool
addrValid = do
Maybe RecvQ
mq <- IORef RecvQDict -> CID -> IO (Maybe RecvQ)
lookupRecvQDict IORef RecvQDict
srcTable CID
key
case Maybe RecvQ
mq of
Just RecvQ
q -> RecvQ -> ReceivedPacket -> IO ()
writeRecvQ RecvQ
q (ReceivedPacket -> IO ()) -> ReceivedPacket -> IO ()
forall a b. (a -> b) -> a -> b
$ CryptPacket
-> TimeMicrosecond -> Int -> EncryptionLevel -> ReceivedPacket
mkReceivedPacket CryptPacket
cpkt TimeMicrosecond
tim Int
bytes EncryptionLevel
lvl
Maybe RecvQ
Nothing -> do
RecvQ
q <- IO RecvQ
newRecvQ
IORef RecvQDict -> CID -> RecvQ -> IO ()
insertRecvQDict IORef RecvQDict
srcTable CID
key RecvQ
q
RecvQ -> ReceivedPacket -> IO ()
writeRecvQ RecvQ
q (ReceivedPacket -> IO ()) -> ReceivedPacket -> IO ()
forall a b. (a -> b) -> a -> b
$ CryptPacket
-> TimeMicrosecond -> Int -> EncryptionLevel -> ReceivedPacket
mkReceivedPacket CryptPacket
cpkt TimeMicrosecond
tim Int
bytes EncryptionLevel
lvl
let reg :: CID -> Connection -> IO ()
reg = IORef ConnectionDict -> CID -> Connection -> IO ()
registerConnectionDict IORef ConnectionDict
dstTable
unreg :: CID -> IO ()
unreg = IORef ConnectionDict -> CID -> IO ()
unregisterConnectionDict IORef ConnectionDict
dstTable
ent :: Accept
ent = Accept :: Version
-> AuthCIDs
-> AuthCIDs
-> SockAddr
-> SockAddr
-> RecvQ
-> Int
-> (CID -> Connection -> IO ())
-> (CID -> IO ())
-> Bool
-> TimeMicrosecond
-> Accept
Accept {
accVersion :: Version
accVersion = Version
ver
, accMyAuthCIDs :: AuthCIDs
accMyAuthCIDs = AuthCIDs
myAuthCIDs
, accPeerAuthCIDs :: AuthCIDs
accPeerAuthCIDs = AuthCIDs
peerAuthCIDs
, accMySockAddr :: SockAddr
accMySockAddr = SockAddr
mysa
, accPeerSockAddr :: SockAddr
accPeerSockAddr = SockAddr
peersa
, accRecvQ :: RecvQ
accRecvQ = RecvQ
q
, accPacketSize :: Int
accPacketSize = Int
bytes
, accRegister :: CID -> Connection -> IO ()
accRegister = CID -> Connection -> IO ()
reg
, accUnregister :: CID -> IO ()
accUnregister = CID -> IO ()
unreg
, accAddressValidated :: Bool
accAddressValidated = Bool
addrValid
, accTime :: TimeMicrosecond
accTime = TimeMicrosecond
tim
}
AcceptQ -> Accept -> IO ()
writeAcceptQ AcceptQ
acceptQ Accept
ent
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
bs0RTT ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(PacketIC CryptPacket
cpktRTT0 EncryptionLevel
lvl', ByteString
_) <- ByteString -> IO (PacketI, ByteString)
decodePacket ByteString
bs0RTT
RecvQ -> ReceivedPacket -> IO ()
writeRecvQ RecvQ
q (ReceivedPacket -> IO ()) -> ReceivedPacket -> IO ()
forall a b. (a -> b) -> a -> b
$ CryptPacket
-> TimeMicrosecond -> Int -> EncryptionLevel -> ReceivedPacket
mkReceivedPacket CryptPacket
cpktRTT0 TimeMicrosecond
tim Int
bytes EncryptionLevel
lvl'
pushToAcceptFirst :: Bool -> IO ()
pushToAcceptFirst Bool
addrValid = do
CID
newdCID <- IO CID
newCID
let myAuthCIDs :: AuthCIDs
myAuthCIDs = AuthCIDs
defaultAuthCIDs {
initSrcCID :: Maybe CID
initSrcCID = CID -> Maybe CID
forall a. a -> Maybe a
Just CID
newdCID
, origDstCID :: Maybe CID
origDstCID = CID -> Maybe CID
forall a. a -> Maybe a
Just CID
dCID
}
peerAuthCIDs :: AuthCIDs
peerAuthCIDs = AuthCIDs
defaultAuthCIDs {
initSrcCID :: Maybe CID
initSrcCID = CID -> Maybe CID
forall a. a -> Maybe a
Just CID
sCID
}
AuthCIDs -> AuthCIDs -> CID -> Bool -> IO ()
pushToAcceptQ AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs CID
dCID Bool
addrValid
pushToAcceptRetried :: CryptoToken -> IO ()
pushToAcceptRetried (CryptoToken Version
_ TimeMicrosecond
_ (Just (CID
_,CID
_,CID
o))) = do
let myAuthCIDs :: AuthCIDs
myAuthCIDs = AuthCIDs
defaultAuthCIDs {
initSrcCID :: Maybe CID
initSrcCID = CID -> Maybe CID
forall a. a -> Maybe a
Just CID
dCID
, origDstCID :: Maybe CID
origDstCID = CID -> Maybe CID
forall a. a -> Maybe a
Just CID
o
, retrySrcCID :: Maybe CID
retrySrcCID = CID -> Maybe CID
forall a. a -> Maybe a
Just CID
dCID
}
peerAuthCIDs :: AuthCIDs
peerAuthCIDs = AuthCIDs
defaultAuthCIDs {
initSrcCID :: Maybe CID
initSrcCID = CID -> Maybe CID
forall a. a -> Maybe a
Just CID
sCID
}
AuthCIDs -> AuthCIDs -> CID -> Bool -> IO ()
pushToAcceptQ AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs CID
o Bool
True
pushToAcceptRetried CryptoToken
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
isRetryTokenValid :: CryptoToken -> IO Bool
isRetryTokenValid (CryptoToken Version
tver TimeMicrosecond
etim (Just (CID
l,CID
r,CID
_))) = do
Microseconds
diff <- TimeMicrosecond -> IO Microseconds
getElapsedTimeMicrosecond TimeMicrosecond
etim
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Version
tver Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
ver
Bool -> Bool -> Bool
&& Microseconds
diff Microseconds -> Microseconds -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Microseconds
Microseconds Int
30000000
Bool -> Bool -> Bool
&& CID
dCID CID -> CID -> Bool
forall a. Eq a => a -> a -> Bool
== CID
l
Bool -> Bool -> Bool
&& CID
sCID CID -> CID -> Bool
forall a. Eq a => a -> a -> Bool
== CID
r
isRetryTokenValid CryptoToken
_ = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
sendRetry :: IO ()
sendRetry = do
CID
newdCID <- IO CID
newCID
CryptoToken
retryToken <- Version -> CID -> CID -> CID -> IO CryptoToken
generateRetryToken Version
ver CID
newdCID CID
sCID CID
dCID
Maybe ByteString
mnewtoken <- Microseconds -> IO ByteString -> IO (Maybe ByteString)
forall a. Microseconds -> IO a -> IO (Maybe a)
timeout (Int -> Microseconds
Microseconds Int
100000) (IO ByteString -> IO (Maybe ByteString))
-> IO ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ TokenManager -> CryptoToken -> IO ByteString
encryptToken TokenManager
tokenMgr CryptoToken
retryToken
case Maybe ByteString
mnewtoken of
Maybe ByteString
Nothing -> DebugLogger
logAction Builder
"retry token stacked"
Just ByteString
newtoken -> do
ByteString
bss <- RetryPacket -> IO ByteString
encodeRetryPacket (RetryPacket -> IO ByteString) -> RetryPacket -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Version
-> CID
-> CID
-> ByteString
-> Either CID (ByteString, ByteString)
-> RetryPacket
RetryPacket Version
ver CID
sCID CID
newdCID ByteString
newtoken (CID -> Either CID (ByteString, ByteString)
forall a b. a -> Either a b
Left CID
dCID)
ByteString -> IO ()
send ByteString
bss
dispatch Dispatch{IORef RecvQDict
IORef ConnectionDict
TokenManager
AcceptQ
acceptQ :: AcceptQ
srcTable :: IORef RecvQDict
dstTable :: IORef ConnectionDict
tokenMgr :: TokenManager
acceptQ :: Dispatch -> AcceptQ
srcTable :: Dispatch -> IORef RecvQDict
dstTable :: Dispatch -> IORef ConnectionDict
tokenMgr :: Dispatch -> TokenManager
..} ServerConfig
_ DebugLogger
_
(PacketIC cpkt :: CryptPacket
cpkt@(CryptPacket (RTT0 Version
_ CID
o CID
_) Crypt
_) EncryptionLevel
lvl) SockAddr
_ SockAddr
_peersa ByteString -> IO ()
_ Ptr Word8
_ ByteString
_ Int
bytes TimeMicrosecond
tim = do
Maybe RecvQ
mq <- IORef RecvQDict -> CID -> IO (Maybe RecvQ)
lookupRecvQDict IORef RecvQDict
srcTable CID
o
case Maybe RecvQ
mq of
Just RecvQ
q -> RecvQ -> ReceivedPacket -> IO ()
writeRecvQ RecvQ
q (ReceivedPacket -> IO ()) -> ReceivedPacket -> IO ()
forall a b. (a -> b) -> a -> b
$ CryptPacket
-> TimeMicrosecond -> Int -> EncryptionLevel -> ReceivedPacket
mkReceivedPacket CryptPacket
cpkt TimeMicrosecond
tim Int
bytes EncryptionLevel
lvl
Maybe RecvQ
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
dispatch Dispatch{IORef RecvQDict
IORef ConnectionDict
TokenManager
AcceptQ
acceptQ :: AcceptQ
srcTable :: IORef RecvQDict
dstTable :: IORef ConnectionDict
tokenMgr :: TokenManager
acceptQ :: Dispatch -> AcceptQ
srcTable :: Dispatch -> IORef RecvQDict
dstTable :: Dispatch -> IORef ConnectionDict
tokenMgr :: Dispatch -> TokenManager
..} ServerConfig
_ DebugLogger
logAction
(PacketIC (CryptPacket hdr :: Header
hdr@(Short CID
dCID) Crypt
crypt) EncryptionLevel
lvl) SockAddr
mysa SockAddr
peersa ByteString -> IO ()
_ Ptr Word8
buf ByteString
_ Int
bytes TimeMicrosecond
tim = do
Maybe Connection
mx <- IORef ConnectionDict -> CID -> IO (Maybe Connection)
lookupConnectionDict IORef ConnectionDict
dstTable CID
dCID
case Maybe Connection
mx of
Maybe Connection
Nothing -> do
DebugLogger
logAction DebugLogger -> DebugLogger
forall a b. (a -> b) -> a -> b
$ Builder
"CID no match: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CID -> Builder
forall a. Show a => a -> Builder
bhow CID
dCID Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SockAddr -> Builder
forall a. Show a => a -> Builder
bhow SockAddr
peersa
Just Connection
conn -> do
let bufsiz :: Int
bufsiz = Int
maximumUdpPayloadSize
Maybe Plain
mplain <- Connection
-> Ptr Word8 -> Int -> Crypt -> EncryptionLevel -> IO (Maybe Plain)
decryptCrypt Connection
conn Ptr Word8
buf Int
bufsiz Crypt
crypt EncryptionLevel
RTT1Level
case Maybe Plain
mplain of
Maybe Plain
Nothing -> Connection -> DebugLogger
connDebugLog Connection
conn Builder
"debug: dispatch: cannot decrypt"
Just Plain
plain -> do
Bool
alive <- Connection -> IO Bool
forall a. Connector a => a -> IO Bool
getAlive Connection
conn
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
Connection -> PlainPacket -> TimeMicrosecond -> IO ()
forall q a.
(KeepQlog q, Qlog a) =>
q -> a -> TimeMicrosecond -> IO ()
qlogReceived Connection
conn (Header -> Plain -> PlainPacket
PlainPacket Header
hdr Plain
plain) TimeMicrosecond
tim
let cpkt' :: CryptPacket
cpkt' = Header -> Crypt -> CryptPacket
CryptPacket Header
hdr (Crypt -> CryptPacket) -> Crypt -> CryptPacket
forall a b. (a -> b) -> a -> b
$ Crypt -> Crypt
setCryptLogged Crypt
crypt
Connection -> ReceivedPacket -> IO ()
writeMigrationQ Connection
conn (ReceivedPacket -> IO ()) -> ReceivedPacket -> IO ()
forall a b. (a -> b) -> a -> b
$ CryptPacket
-> TimeMicrosecond -> Int -> EncryptionLevel -> ReceivedPacket
mkReceivedPacket CryptPacket
cpkt' TimeMicrosecond
tim Int
bytes EncryptionLevel
lvl
Bool
migrating <- Connection -> IO Bool
isPathValidating Connection
conn
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
migrating (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Connection -> IO ()
setMigrationStarted Connection
conn
Maybe CIDInfo
mcidinfo <- Microseconds -> IO CIDInfo -> IO (Maybe CIDInfo)
forall a. Microseconds -> IO a -> IO (Maybe a)
timeout (Int -> Microseconds
Microseconds Int
100000) (IO CIDInfo -> IO (Maybe CIDInfo))
-> IO CIDInfo -> IO (Maybe CIDInfo)
forall a b. (a -> b) -> a -> b
$ Connection -> IO CIDInfo
waitPeerCID Connection
conn
let msg :: Builder
msg = Builder
"Migration: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SockAddr -> Builder
forall a. Show a => a -> Builder
bhow SockAddr
peersa Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CID -> Builder
forall a. Show a => a -> Builder
bhow CID
dCID Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"
Connection -> Debug -> IO ()
forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug Connection
conn (Debug -> IO ()) -> Debug -> IO ()
forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug (LogStr -> Debug) -> LogStr -> Debug
forall a b. (a -> b) -> a -> b
$ Builder -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr Builder
msg
Connection -> DebugLogger
connDebugLog Connection
conn DebugLogger -> DebugLogger
forall a b. (a -> b) -> a -> b
$ Builder
"debug: dispatch: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
msg
IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Connection -> SockAddr -> SockAddr -> CID -> Maybe CIDInfo -> IO ()
migrator Connection
conn SockAddr
mysa SockAddr
peersa CID
dCID Maybe CIDInfo
mcidinfo
dispatch Dispatch
_ ServerConfig
_ DebugLogger
_ PacketI
_ipkt SockAddr
_ SockAddr
_peersa ByteString -> IO ()
_ Ptr Word8
_ ByteString
_ Int
_ TimeMicrosecond
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
readerServer :: Socket -> Connection -> IO ()
readerServer :: Socket -> Connection -> IO ()
readerServer Socket
s Connection
conn = DebugLogger -> IO () -> IO ()
handleLogUnit DebugLogger
logAction IO ()
loop
where
loop :: IO ()
loop = do
Microseconds
ito <- Connection -> IO Microseconds
readMinIdleTimeout Connection
conn
Maybe ByteString
mbs <- Microseconds -> IO ByteString -> IO (Maybe ByteString)
forall a. Microseconds -> IO a -> IO (Maybe a)
timeout Microseconds
ito (IO ByteString -> IO (Maybe ByteString))
-> IO ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Socket -> Int -> IO ByteString
NSB.recv Socket
s Int
maximumUdpPayloadSize
case Maybe ByteString
mbs of
Maybe ByteString
Nothing -> Socket -> IO ()
close Socket
s
Just ByteString
bs -> do
TimeMicrosecond
now <- IO TimeMicrosecond
getTimeMicrosecond
let bytes :: Int
bytes = ByteString -> Int
BS.length ByteString
bs
Connection -> Int -> IO ()
addRxBytes Connection
conn Int
bytes
[(CryptPacket, EncryptionLevel)]
pkts <- ByteString -> IO [(CryptPacket, EncryptionLevel)]
decodeCryptPackets ByteString
bs
((CryptPacket, EncryptionLevel) -> IO ())
-> [(CryptPacket, EncryptionLevel)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(CryptPacket
p,EncryptionLevel
l) -> RecvQ -> ReceivedPacket -> IO ()
writeRecvQ (Connection -> RecvQ
connRecvQ Connection
conn) (CryptPacket
-> TimeMicrosecond -> Int -> EncryptionLevel -> ReceivedPacket
mkReceivedPacket CryptPacket
p TimeMicrosecond
now Int
bytes EncryptionLevel
l)) [(CryptPacket, EncryptionLevel)]
pkts
IO ()
loop
logAction :: DebugLogger
logAction Builder
msg = Connection -> DebugLogger
connDebugLog Connection
conn (Builder
"debug: readerServer: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
msg)
recvServer :: RecvQ -> IO ReceivedPacket
recvServer :: RecvQ -> IO ReceivedPacket
recvServer = RecvQ -> IO ReceivedPacket
readRecvQ
migrator :: Connection -> SockAddr -> SockAddr -> CID -> Maybe CIDInfo -> IO ()
migrator :: Connection -> SockAddr -> SockAddr -> CID -> Maybe CIDInfo -> IO ()
migrator Connection
conn SockAddr
mysa SockAddr
peersa1 CID
dcid Maybe CIDInfo
mcidinfo = DebugLogger -> IO () -> IO ()
handleLogUnit DebugLogger
logAction (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO Socket -> (Socket -> IO ()) -> (Socket -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracketOnError IO Socket
setup Socket -> IO ()
close ((Socket -> IO ()) -> IO ()) -> (Socket -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Socket
s1 ->
IO Socket -> (Socket -> IO ()) -> (Socket -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracket (Connection -> Socket -> IO Socket
addSocket Connection
conn Socket
s1) Socket -> IO ()
close ((Socket -> IO ()) -> IO ()) -> (Socket -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Socket
_ -> do
IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Socket -> Connection -> IO ()
readerServer Socket
s1 Connection
conn
Connection -> CID -> IO ()
setMyCID Connection
conn CID
dcid
Connection -> Maybe CIDInfo -> IO ()
validatePath Connection
conn Maybe CIDInfo
mcidinfo
IO (Maybe Any) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe Any) -> IO ()) -> IO (Maybe Any) -> IO ()
forall a b. (a -> b) -> a -> b
$ Microseconds -> IO Any -> IO (Maybe Any)
forall a. Microseconds -> IO a -> IO (Maybe a)
timeout (Int -> Microseconds
Microseconds Int
2000000) (IO Any -> IO (Maybe Any)) -> IO Any -> IO (Maybe Any)
forall a b. (a -> b) -> a -> b
$ IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Connection -> IO ReceivedPacket
readMigrationQ Connection
conn IO ReceivedPacket -> (ReceivedPacket -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RecvQ -> ReceivedPacket -> IO ()
writeRecvQ (Connection -> RecvQ
connRecvQ Connection
conn))
where
setup :: IO Socket
setup = SockAddr -> SockAddr -> IO Socket
udpServerConnectedSocket SockAddr
mysa SockAddr
peersa1
logAction :: DebugLogger
logAction Builder
msg = Connection -> DebugLogger
connDebugLog Connection
conn (Builder
"debug: migrator: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
msg)