    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE BangPatterns #-}

    -- | Resolver related data types.
    module Network.DNS.Resolver (
      -- * Configuration for resolver
        ResolvConf
      , defaultResolvConf
      -- ** Accessors
      , resolvInfo
      , resolvTimeout
      , resolvRetry
      , resolvConcurrent
      , resolvCache
      , resolvQueryControls
      -- ** Specifying DNS servers
      , FileOrNumericHost(..)
      -- ** Configuring cache
      , CacheConf
      , defaultCacheConf
      , maximumTTL
      , pruningDelay
      -- * Intermediate data type for resolver
      , ResolvSeed
      , makeResolvSeed
      -- * Type and function for resolver
      , Resolver
      , withResolver
      , withResolvers
      ) where

    import Control.Exception as E
    import qualified Crypto.Random as C
    import qualified Data.ByteString as BS
    import Data.IORef (IORef)
    import qualified Data.IORef as I
    import qualified Data.List.NonEmpty as NE
    import Network.Socket (AddrInfoFlag(..), AddrInfo(..), PortNumber, HostName, SocketType(Datagram), getAddrInfo, defaultHints)
    import Prelude

    import Network.DNS.Imports
    import Network.DNS.Memo
    import Network.DNS.Resolver.Internal
    import Network.DNS.Transport
    import Network.DNS.Types.Internal
    import Network.DNS.Types.Resolver

    ----------------------------------------------------------------

    -- |  Make a 'ResolvSeed' from a 'ResolvConf'.
    --
    --    Examples:
    --
    --    >>> rs <- makeResolvSeed defaultResolvConf
    --
    makeResolvSeed :: ResolvConf -> IO ResolvSeed
    makeResolvSeed :: ResolvConf -> IO ResolvSeed
    makeResolvSeed conf :: ResolvConf
    conf = ResolvConf -> NonEmpty AddrInfo -> ResolvSeed
    ResolvSeed ResolvConf
    conf (NonEmpty AddrInfo -> ResolvSeed)
    -> IO (NonEmpty AddrInfo) -> IO ResolvSeed
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (NonEmpty AddrInfo)
    findAddresses
      where
        findAddresses :: IO (NonEmpty AddrInfo)
        findAddresses :: IO (NonEmpty AddrInfo)
    findAddresses = case ResolvConf -> FileOrNumericHost
    resolvInfo ResolvConf
    conf of
            RCHostName numhost :: HostName
    numhost       -> (AddrInfo -> [AddrInfo] -> NonEmpty AddrInfo
    forall a. a -> [a] -> NonEmpty a
    :| []) (AddrInfo -> NonEmpty AddrInfo)
    -> IO AddrInfo -> IO (NonEmpty AddrInfo)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HostName -> Maybe PortNumber -> IO AddrInfo
    makeAddrInfo HostName
    numhost Maybe PortNumber
    forall a. Maybe a
    Nothing
            RCHostPort numhost :: HostName
    numhost mport :: PortNumber
    mport -> (AddrInfo -> [AddrInfo] -> NonEmpty AddrInfo
    forall a. a -> [a] -> NonEmpty a
    :| []) (AddrInfo -> NonEmpty AddrInfo)
    -> IO AddrInfo -> IO (NonEmpty AddrInfo)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HostName -> Maybe PortNumber -> IO AddrInfo
    makeAddrInfo HostName
    numhost (PortNumber -> Maybe PortNumber
    forall a. a -> Maybe a
    Just PortNumber
    mport)
            RCHostNames nss :: [HostName]
    nss          -> [HostName] -> IO (NonEmpty AddrInfo)
    mkAddrs [HostName]
    nss
            RCFilePath file :: HostName
    file          -> HostName -> IO [HostName]
    getDefaultDnsServers HostName
    file IO [HostName]
    -> ([HostName] -> IO (NonEmpty AddrInfo)) -> IO (NonEmpty AddrInfo)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [HostName] -> IO (NonEmpty AddrInfo)
    mkAddrs
        mkAddrs :: [HostName] -> IO (NonEmpty AddrInfo)
    mkAddrs []     = DNSError -> IO (NonEmpty AddrInfo)
    forall e a. Exception e => e -> IO a
    E.throwIO DNSError
    BadConfiguration
        mkAddrs (l :: HostName
    l:ls :: [HostName]
    ls) = AddrInfo -> [AddrInfo] -> NonEmpty AddrInfo
    forall a. a -> [a] -> NonEmpty a
    (:|) (AddrInfo -> [AddrInfo] -> NonEmpty AddrInfo)
    -> IO AddrInfo -> IO ([AddrInfo] -> NonEmpty AddrInfo)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HostName -> Maybe PortNumber -> IO AddrInfo
    makeAddrInfo HostName
    l Maybe PortNumber
    forall a. Maybe a
    Nothing IO ([AddrInfo] -> NonEmpty AddrInfo)
    -> IO [AddrInfo] -> IO (NonEmpty AddrInfo)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [HostName] -> (HostName -> IO AddrInfo) -> IO [AddrInfo]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [HostName]
    ls (HostName -> Maybe PortNumber -> IO AddrInfo
    `makeAddrInfo` Maybe PortNumber
    forall a. Maybe a
    Nothing)

    makeAddrInfo :: HostName -> Maybe PortNumber -> IO AddrInfo
    makeAddrInfo :: HostName -> Maybe PortNumber -> IO AddrInfo
    makeAddrInfo addr :: HostName
    addr mport :: Maybe PortNumber
    mport = do
        let flgs :: [AddrInfoFlag]
    flgs = [AddrInfoFlag
    AI_ADDRCONFIG, AddrInfoFlag
    AI_NUMERICHOST, AddrInfoFlag
    AI_PASSIVE]
            hints :: AddrInfo
    hints = AddrInfo
    defaultHints {
                addrFlags :: [AddrInfoFlag]
    addrFlags = if Maybe PortNumber -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe PortNumber
    mport then AddrInfoFlag
    AI_NUMERICSERV AddrInfoFlag -> [AddrInfoFlag] -> [AddrInfoFlag]
    forall a. a -> [a] -> [a]
    : [AddrInfoFlag]
    flgs else [AddrInfoFlag]
    flgs
              , addrSocketType :: SocketType
    addrSocketType = SocketType
    Datagram
              }
            serv :: HostName
    serv = HostName
    -> (PortNumber -> HostName) -> Maybe PortNumber -> HostName
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe "domain" PortNumber -> HostName
    forall a. Show a => a -> HostName
    show Maybe PortNumber
    mport
        [AddrInfo] -> AddrInfo
    forall a. [a] -> a
    head ([AddrInfo] -> AddrInfo) -> IO [AddrInfo] -> IO AddrInfo
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe AddrInfo -> Maybe HostName -> Maybe HostName -> IO [AddrInfo]
    getAddrInfo (AddrInfo -> Maybe AddrInfo
    forall a. a -> Maybe a
    Just AddrInfo
    hints) (HostName -> Maybe HostName
    forall a. a -> Maybe a
    Just HostName
    addr) (HostName -> Maybe HostName
    forall a. a -> Maybe a
    Just HostName
    serv)

    ----------------------------------------------------------------

    -- | Giving a thread-safe 'Resolver' to the function of the second
    --   argument.
    withResolver :: ResolvSeed -> (Resolver -> IO a) -> IO a
    withResolver :: ResolvSeed -> (Resolver -> IO a) -> IO a
    withResolver seed :: ResolvSeed
    seed f :: Resolver -> IO a
    f = ResolvSeed -> IO Resolver
    makeResolver ResolvSeed
    seed IO Resolver -> (Resolver -> IO a) -> IO a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Resolver -> IO a
    f

    {-# DEPRECATED withResolvers "Use withResolver with resolvConcurrent set to True" #-}
    -- | Giving thread-safe 'Resolver's to the function of the second
    --   argument.  For each 'Resolver', multiple lookups must be done
    --   sequentially.  'Resolver's can be used concurrently.
    withResolvers :: [ResolvSeed] -> ([Resolver] -> IO a) -> IO a
    withResolvers :: [ResolvSeed] -> ([Resolver] -> IO a) -> IO a
    withResolvers seeds :: [ResolvSeed]
    seeds f :: [Resolver] -> IO a
    f = (ResolvSeed -> IO Resolver) -> [ResolvSeed] -> IO [Resolver]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ResolvSeed -> IO Resolver
    makeResolver [ResolvSeed]
    seeds IO [Resolver] -> ([Resolver] -> IO a) -> IO a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [Resolver] -> IO a
    f

    makeResolver :: ResolvSeed -> IO Resolver
    makeResolver :: ResolvSeed -> IO Resolver
    makeResolver seed :: ResolvSeed
    seed = do
      let n :: Int
    n = NonEmpty AddrInfo -> Int
    forall a. NonEmpty a -> Int
    NE.length (NonEmpty AddrInfo -> Int) -> NonEmpty AddrInfo -> Int
    forall a b. (a -> b) -> a -> b
    $ ResolvSeed -> NonEmpty AddrInfo
    nameservers ResolvSeed
    seed
      [IORef ChaChaDRG]
    refs <- Int -> IO (IORef ChaChaDRG) -> IO [IORef ChaChaDRG]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    n (IO ChaChaDRG
    forall (randomly :: * -> *).
    MonadRandom randomly =>
    randomly ChaChaDRG
    C.drgNew IO ChaChaDRG
    -> (ChaChaDRG -> IO (IORef ChaChaDRG)) -> IO (IORef ChaChaDRG)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ChaChaDRG -> IO (IORef ChaChaDRG)
    forall a. a -> IO (IORef a)
    I.newIORef)
      let gens :: NonEmpty (IO Word16)
    gens = [IO Word16] -> NonEmpty (IO Word16)
    forall a. [a] -> NonEmpty a
    NE.fromList ([IO Word16] -> NonEmpty (IO Word16))
    -> [IO Word16] -> NonEmpty (IO Word16)
    forall a b. (a -> b) -> a -> b
    $ (IORef ChaChaDRG -> IO Word16) -> [IORef ChaChaDRG] -> [IO Word16]
    forall a b. (a -> b) -> [a] -> [b]
    map IORef ChaChaDRG -> IO Word16
    getRandom [IORef ChaChaDRG]
    refs
      case ResolvConf -> Maybe CacheConf
    resolvCache (ResolvConf -> Maybe CacheConf) -> ResolvConf -> Maybe CacheConf
    forall a b. (a -> b) -> a -> b
    $ ResolvSeed -> ResolvConf
    resolvconf ResolvSeed
    seed of
        Just cacheconf :: CacheConf
    cacheconf -> do
            Cache
    c <- Int -> IO Cache
    newCache (Int -> IO Cache) -> Int -> IO Cache
    forall a b. (a -> b) -> a -> b
    $ CacheConf -> Int
    pruningDelay CacheConf
    cacheconf
            Resolver -> IO Resolver
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Resolver -> IO Resolver) -> Resolver -> IO Resolver
    forall a b. (a -> b) -> a -> b
    $ ResolvSeed -> NonEmpty (IO Word16) -> Maybe Cache -> Resolver
    Resolver ResolvSeed
    seed NonEmpty (IO Word16)
    gens (Maybe Cache -> Resolver) -> Maybe Cache -> Resolver
    forall a b. (a -> b) -> a -> b
    $ Cache -> Maybe Cache
    forall a. a -> Maybe a
    Just Cache
    c
        Nothing -> Resolver -> IO Resolver
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Resolver -> IO Resolver) -> Resolver -> IO Resolver
    forall a b. (a -> b) -> a -> b
    $ ResolvSeed -> NonEmpty (IO Word16) -> Maybe Cache -> Resolver
    Resolver ResolvSeed
    seed NonEmpty (IO Word16)
    gens Maybe Cache
    forall a. Maybe a
    Nothing

    getRandom :: IORef C.ChaChaDRG -> IO Word16
    getRandom :: IORef ChaChaDRG -> IO Word16
    getRandom ref :: IORef ChaChaDRG
    ref = IORef ChaChaDRG -> (ChaChaDRG -> (ChaChaDRG, Word16)) -> IO Word16
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    I.atomicModifyIORef' IORef ChaChaDRG
    ref ((ChaChaDRG -> (ChaChaDRG, Word16)) -> IO Word16)
    -> (ChaChaDRG -> (ChaChaDRG, Word16)) -> IO Word16
    forall a b. (a -> b) -> a -> b
    $ \gen :: ChaChaDRG
    gen ->
      let (bs :: ByteString
    bs, gen' :: ChaChaDRG
    gen') = Int -> ChaChaDRG -> (ByteString, ChaChaDRG)
    forall gen byteArray.
    (DRG gen, ByteArray byteArray) =>
    Int -> gen -> (byteArray, gen)
    C.randomBytesGenerate 2 ChaChaDRG
    gen
          [u :: Word16
    u,l :: Word16
    l] = (Word8 -> Word16) -> [Word8] -> [Word16]
    forall a b. (a -> b) -> [a] -> [b]
    map Word8 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ([Word8] -> [Word16]) -> [Word8] -> [Word16]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Word8]
    BS.unpack ByteString
    bs
          !seqno :: Word16
    seqno = Word16
    u Word16 -> Word16 -> Word16
    forall a. Num a => a -> a -> a
    * 256 Word16 -> Word16 -> Word16
    forall a. Num a => a -> a -> a
    + Word16
    l
      in (ChaChaDRG
    gen', Word16
    seqno)