{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Ouroboros.Network.Subscription.Dns
( DnsSubscriptionTarget (..)
, Resolver (..)
, DnsSubscriptionParams
, dnsSubscriptionWorker'
, dnsSubscriptionWorker
, dnsResolve
, resolutionDelay
, SubscriptionTrace (..)
, DnsTrace (..)
, ErrorPolicyTrace (..)
, WithDomainName (..)
, WithAddr (..)
) where
import Control.Monad.Class.MonadAsync
import qualified Control.Monad.Class.MonadSTM as Lazy
import Control.Monad.Class.MonadSTM.Strict
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTime
import Control.Monad.Class.MonadTimer
import Control.Tracer
import qualified Data.IP as IP
import Data.Void (Void)
import qualified Network.DNS as DNS
import qualified Network.Socket as Socket
import Text.Printf
import Ouroboros.Network.ErrorPolicy
import Ouroboros.Network.Subscription.Ip
import Ouroboros.Network.Subscription.Subscriber
import Ouroboros.Network.Subscription.Worker
import Ouroboros.Network.Snocket (Snocket)
import Ouroboros.Network.Socket
resolutionDelay :: DiffTime
resolutionDelay :: DiffTime
resolutionDelay = DiffTime
0.05
data DnsSubscriptionTarget = DnsSubscriptionTarget {
DnsSubscriptionTarget -> Domain
dstDomain :: !DNS.Domain
, DnsSubscriptionTarget -> PortNumber
dstPort :: !Socket.PortNumber
, DnsSubscriptionTarget -> Int
dstValency :: !Int
} deriving (DnsSubscriptionTarget -> DnsSubscriptionTarget -> Bool
(DnsSubscriptionTarget -> DnsSubscriptionTarget -> Bool)
-> (DnsSubscriptionTarget -> DnsSubscriptionTarget -> Bool)
-> Eq DnsSubscriptionTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DnsSubscriptionTarget -> DnsSubscriptionTarget -> Bool
$c/= :: DnsSubscriptionTarget -> DnsSubscriptionTarget -> Bool
== :: DnsSubscriptionTarget -> DnsSubscriptionTarget -> Bool
$c== :: DnsSubscriptionTarget -> DnsSubscriptionTarget -> Bool
Eq, Int -> DnsSubscriptionTarget -> ShowS
[DnsSubscriptionTarget] -> ShowS
DnsSubscriptionTarget -> String
(Int -> DnsSubscriptionTarget -> ShowS)
-> (DnsSubscriptionTarget -> String)
-> ([DnsSubscriptionTarget] -> ShowS)
-> Show DnsSubscriptionTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DnsSubscriptionTarget] -> ShowS
$cshowList :: [DnsSubscriptionTarget] -> ShowS
show :: DnsSubscriptionTarget -> String
$cshow :: DnsSubscriptionTarget -> String
showsPrec :: Int -> DnsSubscriptionTarget -> ShowS
$cshowsPrec :: Int -> DnsSubscriptionTarget -> ShowS
Show)
data Resolver m = Resolver {
Resolver m -> Domain -> m (Either DNSError [SockAddr])
lookupA :: DNS.Domain -> m (Either DNS.DNSError [Socket.SockAddr])
, Resolver m -> Domain -> m (Either DNSError [SockAddr])
lookupAAAA :: DNS.Domain -> m (Either DNS.DNSError [Socket.SockAddr])
}
withResolver :: Socket.PortNumber -> DNS.ResolvSeed -> (Resolver IO -> IO a) -> IO a
withResolver :: PortNumber -> ResolvSeed -> (Resolver IO -> IO a) -> IO a
withResolver PortNumber
port ResolvSeed
rs Resolver IO -> IO a
k = do
ResolvSeed -> (Resolver -> IO a) -> IO a
forall a. ResolvSeed -> (Resolver -> IO a) -> IO a
DNS.withResolver ResolvSeed
rs ((Resolver -> IO a) -> IO a) -> (Resolver -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Resolver
dnsResolver ->
Resolver IO -> IO a
k ((Domain -> IO (Either DNSError [SockAddr]))
-> (Domain -> IO (Either DNSError [SockAddr])) -> Resolver IO
forall (m :: * -> *).
(Domain -> m (Either DNSError [SockAddr]))
-> (Domain -> m (Either DNSError [SockAddr])) -> Resolver m
Resolver
(Resolver -> Domain -> IO (Either DNSError [SockAddr])
ipv4ToSockAddr Resolver
dnsResolver)
(Resolver -> Domain -> IO (Either DNSError [SockAddr])
ipv6ToSockAddr Resolver
dnsResolver))
where
ipv4ToSockAddr :: Resolver -> Domain -> IO (Either DNSError [SockAddr])
ipv4ToSockAddr Resolver
dnsResolver Domain
d = do
Either DNSError [IPv4]
r <- Resolver -> Domain -> IO (Either DNSError [IPv4])
DNS.lookupA Resolver
dnsResolver Domain
d
case Either DNSError [IPv4]
r of
(Right [IPv4]
ips) -> Either DNSError [SockAddr] -> IO (Either DNSError [SockAddr])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DNSError [SockAddr] -> IO (Either DNSError [SockAddr]))
-> Either DNSError [SockAddr] -> IO (Either DNSError [SockAddr])
forall a b. (a -> b) -> a -> b
$ [SockAddr] -> Either DNSError [SockAddr]
forall a b. b -> Either a b
Right ([SockAddr] -> Either DNSError [SockAddr])
-> [SockAddr] -> Either DNSError [SockAddr]
forall a b. (a -> b) -> a -> b
$ (IPv4 -> SockAddr) -> [IPv4] -> [SockAddr]
forall a b. (a -> b) -> [a] -> [b]
map (PortNumber -> HostAddress -> SockAddr
Socket.SockAddrInet PortNumber
port (HostAddress -> SockAddr)
-> (IPv4 -> HostAddress) -> IPv4 -> SockAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
IPv4 -> HostAddress
IP.toHostAddress) [IPv4]
ips
(Left DNSError
e) -> Either DNSError [SockAddr] -> IO (Either DNSError [SockAddr])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DNSError [SockAddr] -> IO (Either DNSError [SockAddr]))
-> Either DNSError [SockAddr] -> IO (Either DNSError [SockAddr])
forall a b. (a -> b) -> a -> b
$ DNSError -> Either DNSError [SockAddr]
forall a b. a -> Either a b
Left DNSError
e
ipv6ToSockAddr :: Resolver -> Domain -> IO (Either DNSError [SockAddr])
ipv6ToSockAddr Resolver
dnsResolver Domain
d = do
Either DNSError [IPv6]
r <- Resolver -> Domain -> IO (Either DNSError [IPv6])
DNS.lookupAAAA Resolver
dnsResolver Domain
d
case Either DNSError [IPv6]
r of
(Right [IPv6]
ips) -> Either DNSError [SockAddr] -> IO (Either DNSError [SockAddr])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DNSError [SockAddr] -> IO (Either DNSError [SockAddr]))
-> Either DNSError [SockAddr] -> IO (Either DNSError [SockAddr])
forall a b. (a -> b) -> a -> b
$ [SockAddr] -> Either DNSError [SockAddr]
forall a b. b -> Either a b
Right ([SockAddr] -> Either DNSError [SockAddr])
-> [SockAddr] -> Either DNSError [SockAddr]
forall a b. (a -> b) -> a -> b
$ (IPv6 -> SockAddr) -> [IPv6] -> [SockAddr]
forall a b. (a -> b) -> [a] -> [b]
map (\IPv6
ip -> PortNumber
-> HostAddress -> HostAddress6 -> HostAddress -> SockAddr
Socket.SockAddrInet6 PortNumber
port HostAddress
0 (IPv6 -> HostAddress6
IP.toHostAddress6 IPv6
ip) HostAddress
0) [IPv6]
ips
(Left DNSError
e) -> Either DNSError [SockAddr] -> IO (Either DNSError [SockAddr])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DNSError [SockAddr] -> IO (Either DNSError [SockAddr]))
-> Either DNSError [SockAddr] -> IO (Either DNSError [SockAddr])
forall a b. (a -> b) -> a -> b
$ DNSError -> Either DNSError [SockAddr]
forall a b. a -> Either a b
Left DNSError
e
dnsResolve :: forall a m s.
( MonadAsync m
, MonadCatch m
, MonadTime m
, MonadTimer m
)
=> Tracer m DnsTrace
-> m a
-> (a -> (Resolver m -> m (SubscriptionTarget m Socket.SockAddr)) -> m (SubscriptionTarget m Socket.SockAddr))
-> StrictTVar m s
-> BeforeConnect m s Socket.SockAddr
-> DnsSubscriptionTarget
-> m (SubscriptionTarget m Socket.SockAddr)
dnsResolve :: Tracer m DnsTrace
-> m a
-> (a
-> (Resolver m -> m (SubscriptionTarget m SockAddr))
-> m (SubscriptionTarget m SockAddr))
-> StrictTVar m s
-> BeforeConnect m s SockAddr
-> DnsSubscriptionTarget
-> m (SubscriptionTarget m SockAddr)
dnsResolve Tracer m DnsTrace
tracer m a
getSeed a
-> (Resolver m -> m (SubscriptionTarget m SockAddr))
-> m (SubscriptionTarget m SockAddr)
withResolverFn StrictTVar m s
peerStatesVar BeforeConnect m s SockAddr
beforeConnect (DnsSubscriptionTarget Domain
domain PortNumber
_ Int
_) = do
Either SomeException a
rs_e <- (a -> Either SomeException a
forall a b. b -> Either a b
Right (a -> Either SomeException a) -> m a -> m (Either SomeException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
getSeed) m (Either SomeException a)
-> [Handler m (Either SomeException a)]
-> m (Either SomeException a)
forall (m :: * -> *) a. MonadCatch m => m a -> [Handler m a] -> m a
`catches`
[ (DNSError -> m (Either SomeException a))
-> Handler m (Either SomeException a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (\ (DNSError
e :: DNS.DNSError) ->
Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left (SomeException -> Either SomeException a)
-> SomeException -> Either SomeException a
forall a b. (a -> b) -> a -> b
$ DNSError -> SomeException
forall e. Exception e => e -> SomeException
toException DNSError
e) :: m (Either SomeException a))
, (IOError -> m (Either SomeException a))
-> Handler m (Either SomeException a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler (\ (IOError
e :: IOError) ->
Either SomeException a -> m (Either SomeException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeException -> Either SomeException a
forall a b. a -> Either a b
Left (SomeException -> Either SomeException a)
-> SomeException -> Either SomeException a
forall a b. (a -> b) -> a -> b
$ IOError -> SomeException
forall e. Exception e => e -> SomeException
toException IOError
e) :: m (Either SomeException a))
]
case Either SomeException a
rs_e of
Left SomeException
e -> do
Tracer m DnsTrace -> DnsTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m DnsTrace
tracer (DnsTrace -> m ()) -> DnsTrace -> m ()
forall a b. (a -> b) -> a -> b
$ SomeException -> DnsTrace
DnsTraceLookupException SomeException
e
SubscriptionTarget m SockAddr -> m (SubscriptionTarget m SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (SubscriptionTarget m SockAddr
-> m (SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
-> m (SubscriptionTarget m SockAddr)
forall a b. (a -> b) -> a -> b
$ [SockAddr] -> SubscriptionTarget m SockAddr
forall (m :: * -> *) target.
Applicative m =>
[target] -> SubscriptionTarget m target
listSubscriptionTarget []
Right a
rs -> do
a
-> (Resolver m -> m (SubscriptionTarget m SockAddr))
-> m (SubscriptionTarget m SockAddr)
withResolverFn a
rs ((Resolver m -> m (SubscriptionTarget m SockAddr))
-> m (SubscriptionTarget m SockAddr))
-> (Resolver m -> m (SubscriptionTarget m SockAddr))
-> m (SubscriptionTarget m SockAddr)
forall a b. (a -> b) -> a -> b
$ \Resolver m
resolver -> do
StrictTMVar m [SockAddr]
ipv6Rsps <- m (StrictTMVar m [SockAddr])
forall (m :: * -> *) a. MonadSTM m => m (StrictTMVar m a)
newEmptyTMVarIO
StrictTMVar m [SockAddr]
ipv4Rsps <- m (StrictTMVar m [SockAddr])
forall (m :: * -> *) a. MonadSTM m => m (StrictTMVar m a)
newEmptyTMVarIO
StrictTVar m Bool
gotIpv6Rsp <- Bool -> m (StrictTVar m Bool)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO Bool
False
Maybe (SubscriptionTarget m SockAddr)
res <- DiffTime
-> m (SubscriptionTarget m SockAddr)
-> m (Maybe (SubscriptionTarget m SockAddr))
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
20 (m (SubscriptionTarget m SockAddr)
-> m (Maybe (SubscriptionTarget m SockAddr)))
-> m (SubscriptionTarget m SockAddr)
-> m (Maybe (SubscriptionTarget m SockAddr))
forall a b. (a -> b) -> a -> b
$ do
Async m (Maybe DNSError)
aid_ipv6 <- m (Maybe DNSError) -> m (Async m (Maybe DNSError))
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (m (Maybe DNSError) -> m (Async m (Maybe DNSError)))
-> m (Maybe DNSError) -> m (Async m (Maybe DNSError))
forall a b. (a -> b) -> a -> b
$ Resolver m
-> StrictTVar m Bool
-> StrictTMVar m [SockAddr]
-> m (Maybe DNSError)
resolveAAAA Resolver m
resolver StrictTVar m Bool
gotIpv6Rsp StrictTMVar m [SockAddr]
ipv6Rsps
Async m (Maybe DNSError)
aid_ipv4 <- m (Maybe DNSError) -> m (Async m (Maybe DNSError))
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (m (Maybe DNSError) -> m (Async m (Maybe DNSError)))
-> m (Maybe DNSError) -> m (Async m (Maybe DNSError))
forall a b. (a -> b) -> a -> b
$ Resolver m
-> StrictTVar m Bool
-> StrictTMVar m [SockAddr]
-> m (Maybe DNSError)
resolveA Resolver m
resolver StrictTVar m Bool
gotIpv6Rsp StrictTMVar m [SockAddr]
ipv4Rsps
Either
(Either SomeException (Maybe DNSError))
(Either SomeException (Maybe DNSError))
rd_e <- Async m (Maybe DNSError)
-> Async m (Maybe DNSError)
-> m (Either
(Either SomeException (Maybe DNSError))
(Either SomeException (Maybe DNSError)))
forall (m :: * -> *) a b.
MonadAsync m =>
Async m a
-> Async m b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch Async m (Maybe DNSError)
aid_ipv6 Async m (Maybe DNSError)
aid_ipv4
StrictTMVar m [SockAddr]
-> StrictTMVar m [SockAddr]
-> Either
(Either SomeException (Maybe DNSError))
(Either SomeException (Maybe DNSError))
-> m (SubscriptionTarget m SockAddr)
handleResult StrictTMVar m [SockAddr]
ipv6Rsps StrictTMVar m [SockAddr]
ipv4Rsps Either
(Either SomeException (Maybe DNSError))
(Either SomeException (Maybe DNSError))
rd_e
case Maybe (SubscriptionTarget m SockAddr)
res of
Maybe (SubscriptionTarget m SockAddr)
Nothing -> do
SubscriptionTarget m SockAddr -> m (SubscriptionTarget m SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
forall (m :: * -> *) target.
m (Maybe (target, SubscriptionTarget m target))
-> SubscriptionTarget m target
SubscriptionTarget (m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
forall a b. (a -> b) -> a -> b
$ Maybe (SockAddr, SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SockAddr, SubscriptionTarget m SockAddr)
forall a. Maybe a
Nothing)
Just SubscriptionTarget m SockAddr
st ->
SubscriptionTarget m SockAddr -> m (SubscriptionTarget m SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return SubscriptionTarget m SockAddr
st
where
handleResult :: StrictTMVar m [Socket.SockAddr]
-> StrictTMVar m [Socket.SockAddr]
-> Either
(Either SomeException (Maybe DNS.DNSError))
(Either SomeException (Maybe DNS.DNSError))
-> m (SubscriptionTarget m Socket.SockAddr)
handleResult :: StrictTMVar m [SockAddr]
-> StrictTMVar m [SockAddr]
-> Either
(Either SomeException (Maybe DNSError))
(Either SomeException (Maybe DNSError))
-> m (SubscriptionTarget m SockAddr)
handleResult StrictTMVar m [SockAddr]
_ StrictTMVar m [SockAddr]
ipv4Rsps (Left (Left SomeException
e_ipv6)) = do
Tracer m DnsTrace -> DnsTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m DnsTrace
tracer (DnsTrace -> m ()) -> DnsTrace -> m ()
forall a b. (a -> b) -> a -> b
$ SomeException -> DnsTrace
DnsTraceLookupException SomeException
e_ipv6
SubscriptionTarget m SockAddr -> m (SubscriptionTarget m SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (SubscriptionTarget m SockAddr
-> m (SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
-> m (SubscriptionTarget m SockAddr)
forall a b. (a -> b) -> a -> b
$ m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
forall (m :: * -> *) target.
m (Maybe (target, SubscriptionTarget m target))
-> SubscriptionTarget m target
SubscriptionTarget (m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
forall a b. (a -> b) -> a -> b
$ Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets (StrictTMVar m [SockAddr]
-> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. b -> Either a b
Right StrictTMVar m [SockAddr]
ipv4Rsps) ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left [])
handleResult StrictTMVar m [SockAddr]
ipv6Rsps StrictTMVar m [SockAddr]
ipv4Rsps (Left (Right Maybe DNSError
_)) = do
Tracer m DnsTrace -> DnsTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m DnsTrace
tracer DnsTrace
DnsTraceLookupIPv6First
[SockAddr]
ipv6Res <- STM m [SockAddr] -> m [SockAddr]
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m [SockAddr] -> m [SockAddr])
-> STM m [SockAddr] -> m [SockAddr]
forall a b. (a -> b) -> a -> b
$ StrictTMVar m [SockAddr] -> STM m [SockAddr]
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
takeTMVar StrictTMVar m [SockAddr]
ipv6Rsps
SubscriptionTarget m SockAddr -> m (SubscriptionTarget m SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (SubscriptionTarget m SockAddr
-> m (SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
-> m (SubscriptionTarget m SockAddr)
forall a b. (a -> b) -> a -> b
$ m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
forall (m :: * -> *) target.
m (Maybe (target, SubscriptionTarget m target))
-> SubscriptionTarget m target
SubscriptionTarget (m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
forall a b. (a -> b) -> a -> b
$ Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left [SockAddr]
ipv6Res) (StrictTMVar m [SockAddr]
-> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. b -> Either a b
Right StrictTMVar m [SockAddr]
ipv4Rsps)
handleResult StrictTMVar m [SockAddr]
ipv6Rsps StrictTMVar m [SockAddr]
_ (Right (Left SomeException
e_ipv4)) = do
Tracer m DnsTrace -> DnsTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m DnsTrace
tracer (DnsTrace -> m ()) -> DnsTrace -> m ()
forall a b. (a -> b) -> a -> b
$ SomeException -> DnsTrace
DnsTraceLookupException SomeException
e_ipv4
SubscriptionTarget m SockAddr -> m (SubscriptionTarget m SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (SubscriptionTarget m SockAddr
-> m (SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
-> m (SubscriptionTarget m SockAddr)
forall a b. (a -> b) -> a -> b
$ m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
forall (m :: * -> *) target.
m (Maybe (target, SubscriptionTarget m target))
-> SubscriptionTarget m target
SubscriptionTarget (m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
forall a b. (a -> b) -> a -> b
$ Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets (StrictTMVar m [SockAddr]
-> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. b -> Either a b
Right StrictTMVar m [SockAddr]
ipv6Rsps) ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left [])
handleResult StrictTMVar m [SockAddr]
ipv6Rsps StrictTMVar m [SockAddr]
ipv4Rsps (Right (Right Maybe DNSError
_)) = do
Tracer m DnsTrace -> DnsTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m DnsTrace
tracer DnsTrace
DnsTraceLookupIPv4First
SubscriptionTarget m SockAddr -> m (SubscriptionTarget m SockAddr)
forall (m :: * -> *) a. Monad m => a -> m a
return (SubscriptionTarget m SockAddr
-> m (SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
-> m (SubscriptionTarget m SockAddr)
forall a b. (a -> b) -> a -> b
$ m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
forall (m :: * -> *) target.
m (Maybe (target, SubscriptionTarget m target))
-> SubscriptionTarget m target
SubscriptionTarget (m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
forall a b. (a -> b) -> a -> b
$ Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets (StrictTMVar m [SockAddr]
-> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. b -> Either a b
Right StrictTMVar m [SockAddr]
ipv4Rsps) (StrictTMVar m [SockAddr]
-> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. b -> Either a b
Right StrictTMVar m [SockAddr]
ipv6Rsps)
listTargets :: Either [Socket.SockAddr] (StrictTMVar m [Socket.SockAddr])
-> Either [Socket.SockAddr] (StrictTMVar m [Socket.SockAddr])
-> m (Maybe (Socket.SockAddr, SubscriptionTarget m Socket.SockAddr))
listTargets :: Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets (Left []) (Left []) = Maybe (SockAddr, SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SockAddr, SubscriptionTarget m SockAddr)
forall a. Maybe a
Nothing
listTargets (Left []) Either [SockAddr] (StrictTMVar m [SockAddr])
ipvB = Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets Either [SockAddr] (StrictTMVar m [SockAddr])
ipvB ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left [])
listTargets (Left (SockAddr
addr : [SockAddr]
addrs)) Either [SockAddr] (StrictTMVar m [SockAddr])
ipvB = do
Bool
b <- StrictTVar m s -> BeforeConnect m s SockAddr -> SockAddr -> m Bool
forall (m :: * -> *) s addr.
(MonadSTM m, MonadTime m) =>
StrictTVar m s -> BeforeConnect m s addr -> addr -> m Bool
runBeforeConnect StrictTVar m s
peerStatesVar BeforeConnect m s SockAddr
beforeConnect SockAddr
addr
if Bool
b
then Maybe (SockAddr, SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SockAddr, SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> Maybe (SockAddr, SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
forall a b. (a -> b) -> a -> b
$ (SockAddr, SubscriptionTarget m SockAddr)
-> Maybe (SockAddr, SubscriptionTarget m SockAddr)
forall a. a -> Maybe a
Just (SockAddr
addr, m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
forall (m :: * -> *) target.
m (Maybe (target, SubscriptionTarget m target))
-> SubscriptionTarget m target
SubscriptionTarget (Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets Either [SockAddr] (StrictTMVar m [SockAddr])
ipvB ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left [SockAddr]
addrs)))
else Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets Either [SockAddr] (StrictTMVar m [SockAddr])
ipvB ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left [SockAddr]
addrs)
listTargets (Right StrictTMVar m [SockAddr]
addrsVarA) (Right StrictTMVar m [SockAddr]
addrsVarB) = do
Either [SockAddr] [SockAddr]
addrsRes <- STM m (Either [SockAddr] [SockAddr])
-> m (Either [SockAddr] [SockAddr])
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Either [SockAddr] [SockAddr])
-> m (Either [SockAddr] [SockAddr]))
-> STM m (Either [SockAddr] [SockAddr])
-> m (Either [SockAddr] [SockAddr])
forall a b. (a -> b) -> a -> b
$ do
Maybe [SockAddr]
a_m <- StrictTMVar m [SockAddr] -> STM m (Maybe [SockAddr])
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> STM m (Maybe a)
tryReadTMVar StrictTMVar m [SockAddr]
addrsVarA
Maybe [SockAddr]
b_m <- StrictTMVar m [SockAddr] -> STM m (Maybe [SockAddr])
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> STM m (Maybe a)
tryReadTMVar StrictTMVar m [SockAddr]
addrsVarB
case (Maybe [SockAddr]
a_m, Maybe [SockAddr]
b_m) of
(Maybe [SockAddr]
Nothing, Maybe [SockAddr]
Nothing) -> STM m (Either [SockAddr] [SockAddr])
forall (stm :: * -> *) a. MonadSTMTx stm => stm a
retry
(Just [SockAddr]
a, Maybe [SockAddr]
_) -> Either [SockAddr] [SockAddr]
-> STM m (Either [SockAddr] [SockAddr])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [SockAddr] [SockAddr]
-> STM m (Either [SockAddr] [SockAddr]))
-> Either [SockAddr] [SockAddr]
-> STM m (Either [SockAddr] [SockAddr])
forall a b. (a -> b) -> a -> b
$ [SockAddr] -> Either [SockAddr] [SockAddr]
forall a b. a -> Either a b
Left [SockAddr]
a
(Maybe [SockAddr]
_, Just [SockAddr]
b) -> Either [SockAddr] [SockAddr]
-> STM m (Either [SockAddr] [SockAddr])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [SockAddr] [SockAddr]
-> STM m (Either [SockAddr] [SockAddr]))
-> Either [SockAddr] [SockAddr]
-> STM m (Either [SockAddr] [SockAddr])
forall a b. (a -> b) -> a -> b
$ [SockAddr] -> Either [SockAddr] [SockAddr]
forall a b. b -> Either a b
Right [SockAddr]
b
let ([SockAddr]
addrs, Either [SockAddr] (StrictTMVar m [SockAddr])
nextAddrs) = case Either [SockAddr] [SockAddr]
addrsRes of
Left [SockAddr]
a -> ([SockAddr]
a, StrictTMVar m [SockAddr]
-> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. b -> Either a b
Right StrictTMVar m [SockAddr]
addrsVarB)
Right [SockAddr]
a -> ([SockAddr]
a, StrictTMVar m [SockAddr]
-> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. b -> Either a b
Right StrictTMVar m [SockAddr]
addrsVarA)
if [SockAddr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SockAddr]
addrs
then Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets (StrictTMVar m [SockAddr]
-> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. b -> Either a b
Right StrictTMVar m [SockAddr]
addrsVarB) ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left [])
else do
let addr :: SockAddr
addr = [SockAddr] -> SockAddr
forall a. [a] -> a
head [SockAddr]
addrs
Bool
b <- StrictTVar m s -> BeforeConnect m s SockAddr -> SockAddr -> m Bool
forall (m :: * -> *) s addr.
(MonadSTM m, MonadTime m) =>
StrictTVar m s -> BeforeConnect m s addr -> addr -> m Bool
runBeforeConnect StrictTVar m s
peerStatesVar BeforeConnect m s SockAddr
beforeConnect SockAddr
addr
if Bool
b
then Maybe (SockAddr, SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SockAddr, SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> Maybe (SockAddr, SubscriptionTarget m SockAddr)
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
forall a b. (a -> b) -> a -> b
$ (SockAddr, SubscriptionTarget m SockAddr)
-> Maybe (SockAddr, SubscriptionTarget m SockAddr)
forall a. a -> Maybe a
Just ([SockAddr] -> SockAddr
forall a. [a] -> a
head [SockAddr]
addrs, m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> SubscriptionTarget m SockAddr
forall (m :: * -> *) target.
m (Maybe (target, SubscriptionTarget m target))
-> SubscriptionTarget m target
SubscriptionTarget (Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets Either [SockAddr] (StrictTMVar m [SockAddr])
nextAddrs ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr]))
-> [SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. (a -> b) -> a -> b
$ [SockAddr] -> [SockAddr]
forall a. [a] -> [a]
tail [SockAddr]
addrs)))
else Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets Either [SockAddr] (StrictTMVar m [SockAddr])
nextAddrs ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr]))
-> [SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. (a -> b) -> a -> b
$ [SockAddr] -> [SockAddr]
forall a. [a] -> [a]
tail [SockAddr]
addrs)
listTargets (Right StrictTMVar m [SockAddr]
addrsVar) (Left []) = do
[SockAddr]
addrs <- STM m [SockAddr] -> m [SockAddr]
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m [SockAddr] -> m [SockAddr])
-> STM m [SockAddr] -> m [SockAddr]
forall a b. (a -> b) -> a -> b
$ StrictTMVar m [SockAddr] -> STM m [SockAddr]
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
takeTMVar StrictTMVar m [SockAddr]
addrsVar
Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left [SockAddr]
addrs) ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left [])
listTargets (Right StrictTMVar m [SockAddr]
addrsVar) (Left [SockAddr]
a) = do
Maybe [SockAddr]
addrs_m <- STM m (Maybe [SockAddr]) -> m (Maybe [SockAddr])
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Maybe [SockAddr]) -> m (Maybe [SockAddr]))
-> STM m (Maybe [SockAddr]) -> m (Maybe [SockAddr])
forall a b. (a -> b) -> a -> b
$ StrictTMVar m [SockAddr] -> STM m (Maybe [SockAddr])
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> STM m (Maybe a)
tryTakeTMVar StrictTMVar m [SockAddr]
addrsVar
case Maybe [SockAddr]
addrs_m of
Just [SockAddr]
addrs -> Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left [SockAddr]
addrs) ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left [SockAddr]
a)
Maybe [SockAddr]
Nothing -> Either [SockAddr] (StrictTMVar m [SockAddr])
-> Either [SockAddr] (StrictTMVar m [SockAddr])
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
listTargets ([SockAddr] -> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. a -> Either a b
Left [SockAddr]
a) (StrictTMVar m [SockAddr]
-> Either [SockAddr] (StrictTMVar m [SockAddr])
forall a b. b -> Either a b
Right StrictTMVar m [SockAddr]
addrsVar)
resolveAAAA :: Resolver m
-> StrictTVar m Bool
-> StrictTMVar m [Socket.SockAddr]
-> m (Maybe DNS.DNSError)
resolveAAAA :: Resolver m
-> StrictTVar m Bool
-> StrictTMVar m [SockAddr]
-> m (Maybe DNSError)
resolveAAAA Resolver m
resolver StrictTVar m Bool
gotIpv6RspVar StrictTMVar m [SockAddr]
rspsVar = do
Either DNSError [SockAddr]
r_e <- Resolver m -> Domain -> m (Either DNSError [SockAddr])
forall (m :: * -> *).
Resolver m -> Domain -> m (Either DNSError [SockAddr])
lookupAAAA Resolver m
resolver Domain
domain
case Either DNSError [SockAddr]
r_e of
Left DNSError
e -> do
STM m () -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTMVar m [SockAddr] -> [SockAddr] -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m ()
putTMVar StrictTMVar m [SockAddr]
rspsVar []
STM m () -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTVar m Bool -> Bool -> STM m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m Bool
gotIpv6RspVar Bool
True
Tracer m DnsTrace -> DnsTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m DnsTrace
tracer (DnsTrace -> m ()) -> DnsTrace -> m ()
forall a b. (a -> b) -> a -> b
$ DNSError -> DnsTrace
DnsTraceLookupAAAAError DNSError
e
Maybe DNSError -> m (Maybe DNSError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DNSError -> m (Maybe DNSError))
-> Maybe DNSError -> m (Maybe DNSError)
forall a b. (a -> b) -> a -> b
$ DNSError -> Maybe DNSError
forall a. a -> Maybe a
Just DNSError
e
Right [SockAddr]
r -> do
Tracer m DnsTrace -> DnsTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m DnsTrace
tracer (DnsTrace -> m ()) -> DnsTrace -> m ()
forall a b. (a -> b) -> a -> b
$ [SockAddr] -> DnsTrace
DnsTraceLookupAAAAResult [SockAddr]
r
STM m () -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTMVar m [SockAddr] -> [SockAddr] -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m ()
putTMVar StrictTMVar m [SockAddr]
rspsVar [SockAddr]
r
STM m () -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTVar m Bool -> Bool -> STM m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m Bool
gotIpv6RspVar Bool
True
Maybe DNSError -> m (Maybe DNSError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DNSError
forall a. Maybe a
Nothing
resolveA :: Resolver m
-> StrictTVar m Bool
-> StrictTMVar m [Socket.SockAddr]
-> m (Maybe DNS.DNSError)
resolveA :: Resolver m
-> StrictTVar m Bool
-> StrictTMVar m [SockAddr]
-> m (Maybe DNSError)
resolveA Resolver m
resolver StrictTVar m Bool
gotIpv6RspVar StrictTMVar m [SockAddr]
rspsVar= do
Either DNSError [SockAddr]
r_e <- Resolver m -> Domain -> m (Either DNSError [SockAddr])
forall (m :: * -> *).
Resolver m -> Domain -> m (Either DNSError [SockAddr])
lookupA Resolver m
resolver Domain
domain
case Either DNSError [SockAddr]
r_e of
Left DNSError
e -> do
STM m () -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTMVar m [SockAddr] -> [SockAddr] -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m ()
putTMVar StrictTMVar m [SockAddr]
rspsVar []
Tracer m DnsTrace -> DnsTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m DnsTrace
tracer (DnsTrace -> m ()) -> DnsTrace -> m ()
forall a b. (a -> b) -> a -> b
$ DNSError -> DnsTrace
DnsTraceLookupAError DNSError
e
Maybe DNSError -> m (Maybe DNSError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DNSError -> m (Maybe DNSError))
-> Maybe DNSError -> m (Maybe DNSError)
forall a b. (a -> b) -> a -> b
$ DNSError -> Maybe DNSError
forall a. a -> Maybe a
Just DNSError
e
Right [SockAddr]
r -> do
Tracer m DnsTrace -> DnsTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m DnsTrace
tracer (DnsTrace -> m ()) -> DnsTrace -> m ()
forall a b. (a -> b) -> a -> b
$ [SockAddr] -> DnsTrace
DnsTraceLookupAResult [SockAddr]
r
TVar_ (STM m) Bool
timeoutVar <- DiffTime -> m (TVar_ (STM m) Bool)
forall (m :: * -> *). MonadTimer m => DiffTime -> m (TVar m Bool)
registerDelay DiffTime
resolutionDelay
STM m () -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
timedOut <- TVar_ (STM m) Bool -> STM m Bool
forall (stm :: * -> *) a. MonadSTMTx stm => TVar_ stm a -> stm a
Lazy.readTVar TVar_ (STM m) Bool
timeoutVar
Bool
gotIpv6Rsp <- StrictTVar m Bool -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m Bool
gotIpv6RspVar
Bool -> STM m ()
forall (stm :: * -> *). MonadSTMTx stm => Bool -> stm ()
check (Bool
timedOut Bool -> Bool -> Bool
|| Bool
gotIpv6Rsp)
STM m () -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTMVar m [SockAddr] -> [SockAddr] -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m ()
putTMVar StrictTMVar m [SockAddr]
rspsVar [SockAddr]
r
Maybe DNSError -> m (Maybe DNSError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DNSError
forall a. Maybe a
Nothing
dnsSubscriptionWorker'
:: Snocket IO Socket.Socket Socket.SockAddr
-> Tracer IO (WithDomainName (SubscriptionTrace Socket.SockAddr))
-> Tracer IO (WithDomainName DnsTrace)
-> Tracer IO (WithAddr Socket.SockAddr ErrorPolicyTrace)
-> NetworkMutableState Socket.SockAddr
-> IO b
-> (b -> (Resolver IO -> IO (SubscriptionTarget IO Socket.SockAddr))
-> IO (SubscriptionTarget IO Socket.SockAddr))
-> DnsSubscriptionParams a
-> Main IO (PeerStates IO Socket.SockAddr) x
-> (Socket.Socket -> IO a)
-> IO x
dnsSubscriptionWorker' :: Snocket IO Socket SockAddr
-> Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
-> Tracer IO (WithDomainName DnsTrace)
-> Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
-> NetworkMutableState SockAddr
-> IO b
-> (b
-> (Resolver IO -> IO (SubscriptionTarget IO SockAddr))
-> IO (SubscriptionTarget IO SockAddr))
-> DnsSubscriptionParams a
-> Main IO (PeerStates IO SockAddr) x
-> (Socket -> IO a)
-> IO x
dnsSubscriptionWorker' Snocket IO Socket SockAddr
snocket Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
subTracer Tracer IO (WithDomainName DnsTrace)
dnsTracer Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
errorPolicyTracer
networkState :: NetworkMutableState SockAddr
networkState@NetworkMutableState { StrictTVar IO (PeerStates IO SockAddr)
nmsPeerStates :: forall addr.
NetworkMutableState addr -> StrictTVar IO (PeerStates IO addr)
nmsPeerStates :: StrictTVar IO (PeerStates IO SockAddr)
nmsPeerStates }
IO b
setupResolver b
-> (Resolver IO -> IO (SubscriptionTarget IO SockAddr))
-> IO (SubscriptionTarget IO SockAddr)
resolver
SubscriptionParams { LocalAddresses SockAddr
spLocalAddresses :: forall a target.
SubscriptionParams a target -> LocalAddresses SockAddr
spLocalAddresses :: LocalAddresses SockAddr
spLocalAddresses
, SockAddr -> Maybe DiffTime
spConnectionAttemptDelay :: forall a target.
SubscriptionParams a target -> SockAddr -> Maybe DiffTime
spConnectionAttemptDelay :: SockAddr -> Maybe DiffTime
spConnectionAttemptDelay
, spSubscriptionTarget :: forall a target. SubscriptionParams a target -> target
spSubscriptionTarget = DnsSubscriptionTarget
dst
, ErrorPolicies
spErrorPolicies :: forall a target. SubscriptionParams a target -> ErrorPolicies
spErrorPolicies :: ErrorPolicies
spErrorPolicies
}
Main IO (PeerStates IO SockAddr) x
main Socket -> IO a
k =
Snocket IO Socket SockAddr
-> Tracer IO (SubscriptionTrace SockAddr)
-> Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
-> NetworkMutableState SockAddr
-> WorkerParams IO LocalAddresses SockAddr
-> ErrorPolicies
-> Main IO (PeerStates IO SockAddr) x
-> (Socket -> IO a)
-> IO x
forall x a.
Snocket IO Socket SockAddr
-> Tracer IO (SubscriptionTrace SockAddr)
-> Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
-> NetworkMutableState SockAddr
-> WorkerParams IO LocalAddresses SockAddr
-> ErrorPolicies
-> Main IO (PeerStates IO SockAddr) x
-> (Socket -> IO a)
-> IO x
subscriptionWorker Snocket IO Socket SockAddr
snocket
(Domain
-> SubscriptionTrace SockAddr
-> WithDomainName (SubscriptionTrace SockAddr)
forall a. Domain -> a -> WithDomainName a
WithDomainName (DnsSubscriptionTarget -> Domain
dstDomain DnsSubscriptionTarget
dst) (SubscriptionTrace SockAddr
-> WithDomainName (SubscriptionTrace SockAddr))
-> Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
-> Tracer IO (SubscriptionTrace SockAddr)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
`contramap` Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
subTracer)
Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
errorPolicyTracer
NetworkMutableState SockAddr
networkState
WorkerParams :: forall (m :: * -> *) (localAddrs :: * -> *) addr.
localAddrs addr
-> (addr -> localAddrs addr -> Maybe addr)
-> (addr -> Maybe DiffTime)
-> m (SubscriptionTarget m addr)
-> Int
-> WorkerParams m localAddrs addr
WorkerParams { wpLocalAddresses :: LocalAddresses SockAddr
wpLocalAddresses = LocalAddresses SockAddr
spLocalAddresses
, wpConnectionAttemptDelay :: SockAddr -> Maybe DiffTime
wpConnectionAttemptDelay = SockAddr -> Maybe DiffTime
spConnectionAttemptDelay
, wpSubscriptionTarget :: IO (SubscriptionTarget IO SockAddr)
wpSubscriptionTarget =
Tracer IO DnsTrace
-> IO b
-> (b
-> (Resolver IO -> IO (SubscriptionTarget IO SockAddr))
-> IO (SubscriptionTarget IO SockAddr))
-> StrictTVar IO (PeerStates IO SockAddr)
-> BeforeConnect IO (PeerStates IO SockAddr) SockAddr
-> DnsSubscriptionTarget
-> IO (SubscriptionTarget IO SockAddr)
forall a (m :: * -> *) s.
(MonadAsync m, MonadCatch m, MonadTime m, MonadTimer m) =>
Tracer m DnsTrace
-> m a
-> (a
-> (Resolver m -> m (SubscriptionTarget m SockAddr))
-> m (SubscriptionTarget m SockAddr))
-> StrictTVar m s
-> BeforeConnect m s SockAddr
-> DnsSubscriptionTarget
-> m (SubscriptionTarget m SockAddr)
dnsResolve
(Domain -> DnsTrace -> WithDomainName DnsTrace
forall a. Domain -> a -> WithDomainName a
WithDomainName (DnsSubscriptionTarget -> Domain
dstDomain DnsSubscriptionTarget
dst) (DnsTrace -> WithDomainName DnsTrace)
-> Tracer IO (WithDomainName DnsTrace) -> Tracer IO DnsTrace
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
`contramap` Tracer IO (WithDomainName DnsTrace)
dnsTracer)
IO b
setupResolver b
-> (Resolver IO -> IO (SubscriptionTarget IO SockAddr))
-> IO (SubscriptionTarget IO SockAddr)
resolver StrictTVar IO (PeerStates IO SockAddr)
nmsPeerStates BeforeConnect IO (PeerStates IO SockAddr) SockAddr
forall (m :: * -> *) addr.
(MonadSTM m, Ord addr) =>
BeforeConnect m (PeerStates m addr) addr
beforeConnectTx DnsSubscriptionTarget
dst
, wpValency :: Int
wpValency = DnsSubscriptionTarget -> Int
dstValency DnsSubscriptionTarget
dst
, wpSelectAddress :: SockAddr -> LocalAddresses SockAddr -> Maybe SockAddr
wpSelectAddress = SockAddr -> LocalAddresses SockAddr -> Maybe SockAddr
selectSockAddr
}
ErrorPolicies
spErrorPolicies
Main IO (PeerStates IO SockAddr) x
main
Socket -> IO a
k
type DnsSubscriptionParams a = SubscriptionParams a DnsSubscriptionTarget
dnsSubscriptionWorker
:: Snocket IO Socket.Socket Socket.SockAddr
-> Tracer IO (WithDomainName (SubscriptionTrace Socket.SockAddr))
-> Tracer IO (WithDomainName DnsTrace)
-> Tracer IO (WithAddr Socket.SockAddr ErrorPolicyTrace)
-> NetworkMutableState Socket.SockAddr
-> DnsSubscriptionParams a
-> (Socket.Socket -> IO a)
-> IO Void
dnsSubscriptionWorker :: Snocket IO Socket SockAddr
-> Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
-> Tracer IO (WithDomainName DnsTrace)
-> Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
-> NetworkMutableState SockAddr
-> DnsSubscriptionParams a
-> (Socket -> IO a)
-> IO Void
dnsSubscriptionWorker Snocket IO Socket SockAddr
snocket Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
subTracer Tracer IO (WithDomainName DnsTrace)
dnsTracer Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
errTrace NetworkMutableState SockAddr
networkState
params :: DnsSubscriptionParams a
params@SubscriptionParams { DnsSubscriptionTarget
spSubscriptionTarget :: DnsSubscriptionTarget
spSubscriptionTarget :: forall a target. SubscriptionParams a target -> target
spSubscriptionTarget } Socket -> IO a
k =
Snocket IO Socket SockAddr
-> Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
-> Tracer IO (WithDomainName DnsTrace)
-> Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
-> NetworkMutableState SockAddr
-> IO ResolvSeed
-> (ResolvSeed
-> (Resolver IO -> IO (SubscriptionTarget IO SockAddr))
-> IO (SubscriptionTarget IO SockAddr))
-> DnsSubscriptionParams a
-> Main IO (PeerStates IO SockAddr) Void
-> (Socket -> IO a)
-> IO Void
forall b a x.
Snocket IO Socket SockAddr
-> Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
-> Tracer IO (WithDomainName DnsTrace)
-> Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
-> NetworkMutableState SockAddr
-> IO b
-> (b
-> (Resolver IO -> IO (SubscriptionTarget IO SockAddr))
-> IO (SubscriptionTarget IO SockAddr))
-> DnsSubscriptionParams a
-> Main IO (PeerStates IO SockAddr) x
-> (Socket -> IO a)
-> IO x
dnsSubscriptionWorker'
Snocket IO Socket SockAddr
snocket
Tracer IO (WithDomainName (SubscriptionTrace SockAddr))
subTracer Tracer IO (WithDomainName DnsTrace)
dnsTracer Tracer IO (WithAddr SockAddr ErrorPolicyTrace)
errTrace
NetworkMutableState SockAddr
networkState
(ResolvConf -> IO ResolvSeed
DNS.makeResolvSeed ResolvConf
DNS.defaultResolvConf)
(PortNumber
-> ResolvSeed
-> (Resolver IO -> IO (SubscriptionTarget IO SockAddr))
-> IO (SubscriptionTarget IO SockAddr)
forall a. PortNumber -> ResolvSeed -> (Resolver IO -> IO a) -> IO a
withResolver (DnsSubscriptionTarget -> PortNumber
dstPort DnsSubscriptionTarget
spSubscriptionTarget))
DnsSubscriptionParams a
params
Main IO (PeerStates IO SockAddr) Void
forall (m :: * -> *) addr.
(MonadThrow (STM m), MonadSTM m) =>
Main m (PeerStates m addr) Void
mainTx
Socket -> IO a
k
data WithDomainName a = WithDomainName {
WithDomainName a -> Domain
wdnDomain :: !DNS.Domain
, WithDomainName a -> a
wdnEvent :: !a
}
instance Show a => Show (WithDomainName a) where
show :: WithDomainName a -> String
show WithDomainName {Domain
wdnDomain :: Domain
wdnDomain :: forall a. WithDomainName a -> Domain
wdnDomain, a
wdnEvent :: a
wdnEvent :: forall a. WithDomainName a -> a
wdnEvent} = String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Domain: %s %s" (Domain -> String
forall a. Show a => a -> String
show Domain
wdnDomain) (a -> String
forall a. Show a => a -> String
show a
wdnEvent)
data DnsTrace =
DnsTraceLookupException SomeException
| DnsTraceLookupAError DNS.DNSError
| DnsTraceLookupAAAAError DNS.DNSError
| DnsTraceLookupIPv6First
| DnsTraceLookupIPv4First
| DnsTraceLookupAResult [Socket.SockAddr]
| DnsTraceLookupAAAAResult [Socket.SockAddr]
instance Show DnsTrace where
show :: DnsTrace -> String
show (DnsTraceLookupException SomeException
e) = String
"lookup exception " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
show (DnsTraceLookupAError DNSError
e) = String
"A lookup failed with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DNSError -> String
forall a. Show a => a -> String
show DNSError
e
show (DnsTraceLookupAAAAError DNSError
e) = String
"AAAA lookup failed with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DNSError -> String
forall a. Show a => a -> String
show DNSError
e
show DnsTrace
DnsTraceLookupIPv4First = String
"Returning IPv4 address first"
show DnsTrace
DnsTraceLookupIPv6First = String
"Returning IPv6 address first"
show (DnsTraceLookupAResult [SockAddr]
as) = String
"Lookup A result: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SockAddr] -> String
forall a. Show a => a -> String
show [SockAddr]
as
show (DnsTraceLookupAAAAResult [SockAddr]
as) = String
"Lookup AAAAA result: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [SockAddr] -> String
forall a. Show a => a -> String
show [SockAddr]
as