{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}

{- Partial implementation of RFC8305, https://tools.ietf.org/html/rfc8305 .
 - Prioritization of destination addresses doesn't implement longest prefix matching
 - and doesn't take address scope etc. into account.
 -}

module Ouroboros.Network.Subscription.Dns
  ( DnsSubscriptionTarget (..)
  , Resolver (..)
  , DnsSubscriptionParams
  , dnsSubscriptionWorker'
  , dnsSubscriptionWorker
  , dnsResolve
  , resolutionDelay
    -- * Traces
  , 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.Maybe (isJust)
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.Snocket (Snocket)
import           Ouroboros.Network.Socket
import           Ouroboros.Network.Subscription.Ip
import           Ouroboros.Network.Subscription.Subscriber
import           Ouroboros.Network.Subscription.Worker


-- | Time to wait for an AAAA response after receiving an A response.
resolutionDelay :: DiffTime
resolutionDelay :: DiffTime
resolutionDelay = DiffTime
0.05 -- 50ms delay


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))
        -- On windows getSeed fails with BadConfiguration if the network is down.
        , (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))
        -- On OSX getSeed can fail with IOError if all network devices are down.
        ]
    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
                 -- Though the DNS lib does have its own timeouts, these do not work
                 -- on Windows reliably so as a workaround we add an extra layer
                 -- of timeout on the outside.
                 -- TODO: Fix upstream dns lib.
                 --       On windows the aid_ipv6 and aid_ipv4 threads are leaked incase
                 --       of an exception in the main thread.
                 Maybe (Maybe (SockAddr, SubscriptionTarget m SockAddr))
res <- DiffTime
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> m (Maybe (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout DiffTime
20 (m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
 -> m (Maybe (Maybe (SockAddr, SubscriptionTarget m SockAddr))))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> m (Maybe (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
forall a b. (a -> b) -> a -> b
$ do
                          Async m [SockAddr]
aid_ipv6 <- m [SockAddr] -> m (Async m [SockAddr])
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (m [SockAddr] -> m (Async m [SockAddr]))
-> m [SockAddr] -> m (Async m [SockAddr])
forall a b. (a -> b) -> a -> b
$ Resolver m -> m [SockAddr]
resolveAAAA Resolver m
resolver
                          Async m [SockAddr]
aid_ipv4 <- m [SockAddr] -> m (Async m [SockAddr])
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (m [SockAddr] -> m (Async m [SockAddr]))
-> m [SockAddr] -> m (Async m [SockAddr])
forall a b. (a -> b) -> a -> b
$ Resolver m -> Async m [SockAddr] -> m [SockAddr]
resolveA Resolver m
resolver Async m [SockAddr]
aid_ipv6
                          Either
  (Either SomeException [SockAddr]) (Either SomeException [SockAddr])
rd_e <- Async m [SockAddr]
-> Async m [SockAddr]
-> m (Either
        (Either SomeException [SockAddr])
        (Either SomeException [SockAddr]))
forall (m :: * -> *) a b.
MonadAsync m =>
Async m a
-> Async m b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch Async m [SockAddr]
aid_ipv6 Async m [SockAddr]
aid_ipv4
                          case Either
  (Either SomeException [SockAddr]) (Either SomeException [SockAddr])
rd_e of
                            Left Either SomeException [SockAddr]
r -> do
                              Tracer m DnsTrace -> DnsTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m DnsTrace
tracer DnsTrace
DnsTraceLookupIPv6First
                              Either SomeException [SockAddr]
-> ([SockAddr]
    -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
handleThreadResult Either SomeException [SockAddr]
r (([SockAddr]
  -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
 -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> ([SockAddr]
    -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
forall a b. (a -> b) -> a -> b
$ Async m [SockAddr]
-> [SockAddr]
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
threadTargetCycle Async m [SockAddr]
aid_ipv4
                            Right Either SomeException [SockAddr]
r -> do
                              Tracer m DnsTrace -> DnsTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m DnsTrace
tracer DnsTrace
DnsTraceLookupIPv4First
                              Either SomeException [SockAddr]
-> ([SockAddr]
    -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
handleThreadResult Either SomeException [SockAddr]
r (([SockAddr]
  -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
 -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> ([SockAddr]
    -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
forall a b. (a -> b) -> a -> b
$ Async m [SockAddr]
-> [SockAddr]
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
threadTargetCycle Async m [SockAddr]
aid_ipv6
                 case Maybe (Maybe (SockAddr, SubscriptionTarget m SockAddr))
res of
                   Maybe (Maybe (SockAddr, SubscriptionTarget m SockAddr))
Nothing -> do
                     -- TODO: the thread timedout, we should trace it
                     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 Maybe (SockAddr, SubscriptionTarget m SockAddr)
st ->
                     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)
st)
  where
    -- Creates a subscription target from an optional first socket and a tail
    targetCons
      :: Socket.SockAddr
      -> m (Maybe (Socket.SockAddr, SubscriptionTarget m Socket.SockAddr))
      -> m (Maybe (Socket.SockAddr, SubscriptionTarget m Socket.SockAddr))
    targetCons :: SockAddr
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
targetCons SockAddr
addr m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
next = 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 (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
addr, 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))
next)
        else m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
next

    -- Takes the result of a thread, returning an optional first socket in the subscription target result,
    -- then calls the given function to get the tail
    handleThreadResult
      :: Either SomeException [Socket.SockAddr]
      -> ([Socket.SockAddr] -> m (Maybe (Socket.SockAddr, SubscriptionTarget m Socket.SockAddr)))
      -> m (Maybe (Socket.SockAddr, SubscriptionTarget m Socket.SockAddr))
    handleThreadResult :: Either SomeException [SockAddr]
-> ([SockAddr]
    -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
handleThreadResult (Left SomeException
e) [SockAddr] -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
cont = 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
      [SockAddr] -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
cont []
    handleThreadResult (Right []) [SockAddr] -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
cont = [SockAddr] -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
cont []
    handleThreadResult (Right (SockAddr
addr:[SockAddr]
addrs)) [SockAddr] -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
cont = SockAddr
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
targetCons SockAddr
addr (m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
 -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
forall a b. (a -> b) -> a -> b
$ [SockAddr] -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
cont [SockAddr]
addrs

    -- Called when a thread is still running, and the other finished already
    -- Cycles between trying to get a result from the running thread, and the results of the finished thread
    -- If results of the finished thread are exhausted, wait until the running thread completes
    threadTargetCycle
      :: Async m [Socket.SockAddr]
      -> [Socket.SockAddr]
      -> m (Maybe (Socket.SockAddr, SubscriptionTarget m Socket.SockAddr))
    threadTargetCycle :: Async m [SockAddr]
-> [SockAddr]
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
threadTargetCycle Async m [SockAddr]
asyn [] = do
      Either SomeException [SockAddr]
result <- Async m [SockAddr] -> m (Either SomeException [SockAddr])
forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> m (Either SomeException a)
waitCatch Async m [SockAddr]
asyn
      Either SomeException [SockAddr]
-> ([SockAddr]
    -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
handleThreadResult Either SomeException [SockAddr]
result (([SockAddr]
  -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
 -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> ([SockAddr]
    -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
forall a b. (a -> b) -> a -> b
$ [SockAddr]
-> [SockAddr]
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
targetCycle []
    threadTargetCycle Async m [SockAddr]
asyn a :: [SockAddr]
a@(SockAddr
addr : [SockAddr]
addrs) = do
      Maybe (Either SomeException [SockAddr])
result <- Async m [SockAddr] -> m (Maybe (Either SomeException [SockAddr]))
forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> m (Maybe (Either SomeException a))
poll Async m [SockAddr]
asyn
      case Maybe (Either SomeException [SockAddr])
result of
        -- The running thread finished, handle the result, then cycle over all results
        Just Either SomeException [SockAddr]
r  -> Either SomeException [SockAddr]
-> ([SockAddr]
    -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
handleThreadResult Either SomeException [SockAddr]
r (([SockAddr]
  -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
 -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> ([SockAddr]
    -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
forall a b. (a -> b) -> a -> b
$ [SockAddr]
-> [SockAddr]
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
targetCycle [SockAddr]
a
        -- The running thread is still going, emit an address of the finished thread, then check again
        Maybe (Either SomeException [SockAddr])
Nothing -> SockAddr
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
targetCons SockAddr
addr (m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
 -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr)))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
forall a b. (a -> b) -> a -> b
$ Async m [SockAddr]
-> [SockAddr]
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
threadTargetCycle Async m [SockAddr]
asyn [SockAddr]
addrs

    -- Called when both threads exited and we know the results of both.
    -- Returns a subscription target that cycles between the results until both results are exhausted
    targetCycle
      :: [Socket.SockAddr]
      -> [Socket.SockAddr]
      -> m (Maybe (Socket.SockAddr, SubscriptionTarget m Socket.SockAddr))
    targetCycle :: [SockAddr]
-> [SockAddr]
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
targetCycle [SockAddr]
as [SockAddr]
bs = [SockAddr] -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
go ([SockAddr]
as [SockAddr] -> [SockAddr] -> [SockAddr]
forall a. [a] -> [a] -> [a]
`interleave` [SockAddr]
bs)
      where
        go :: [SockAddr] -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
go []       = 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
        go (SockAddr
x : [SockAddr]
xs) = SockAddr
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
-> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
targetCons SockAddr
x ([SockAddr] -> m (Maybe (SockAddr, SubscriptionTarget m SockAddr))
go [SockAddr]
xs)

        interleave :: [a] -> [a] -> [a]
interleave []       [a]
ys = [a]
ys
        interleave (a
x : [a]
xs) [a]
ys = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
interleave [a]
ys [a]
xs

    resolveAAAA :: Resolver m
                -> m [Socket.SockAddr]
    resolveAAAA :: Resolver m -> m [SockAddr]
resolveAAAA Resolver m
resolver = 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
                 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
                 [SockAddr] -> m [SockAddr]
forall (m :: * -> *) a. Monad m => a -> m a
return []
             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

                 -- XXX Addresses should be sorted here based on DeltaQueue.
                 [SockAddr] -> m [SockAddr]
forall (m :: * -> *) a. Monad m => a -> m a
return [SockAddr]
r

    resolveA :: Resolver m
             -> Async m [Socket.SockAddr]
             -> m [Socket.SockAddr]
    resolveA :: Resolver m -> Async m [SockAddr] -> m [SockAddr]
resolveA Resolver m
resolver Async m [SockAddr]
aid_ipv6 = 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
                 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
                 [SockAddr] -> m [SockAddr]
forall (m :: * -> *) a. Monad m => a -> m a
return []
             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

                 {- From RFC8305.
                  - If a positive A response is received first due to reordering, the client
                  - SHOULD wait a short time for the AAAA response to ensure that preference is
                  - given to IPv6.
                  -}
                 TVar m Bool
timeoutVar <- DiffTime -> m (TVar 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 m Bool -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
Lazy.readTVar TVar m Bool
timeoutVar
                     Maybe (Either SomeException [SockAddr])
ipv6Done <- Async m [SockAddr]
-> STM m (Maybe (Either SomeException [SockAddr]))
forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Maybe (Either SomeException a))
pollSTM Async m [SockAddr]
aid_ipv6
                     Bool -> STM m ()
forall (m :: * -> *). MonadSTM m => Bool -> STM m ()
check (Bool
timedOut Bool -> Bool -> Bool
|| Maybe (Either SomeException [SockAddr]) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Either SomeException [SockAddr])
ipv6Done)

                 -- XXX Addresses should be sorted here based on DeltaQueue.
                 [SockAddr] -> m [SockAddr]
forall (m :: * -> *) a. Monad m => a -> m a
return [SockAddr]
r


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