module Network.DNS.Types.Resolver where

import Network.Socket (AddrInfo(..), PortNumber, HostName)

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

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

-- | The type to specify a cache server.
data FileOrNumericHost = RCFilePath FilePath -- ^ A path for \"resolv.conf\"
                                             -- where one or more IP addresses
                                             -- of DNS servers should be found
                                             -- on Unix.
                                             -- Default DNS servers are
                                             -- automatically detected
                                             -- on Windows regardless of
                                             -- the value of the file name.
                       | RCHostName HostName -- ^ A numeric IP address. /Warning/: host names are invalid.
                       | RCHostNames [HostName] -- ^ Numeric IP addresses. /Warning/: host names are invalid.
                       | RCHostPort HostName PortNumber -- ^ A numeric IP address and port number. /Warning/: host names are invalid.
                       deriving Int -> FileOrNumericHost -> ShowS
[FileOrNumericHost] -> ShowS
FileOrNumericHost -> String
(Int -> FileOrNumericHost -> ShowS)
-> (FileOrNumericHost -> String)
-> ([FileOrNumericHost] -> ShowS)
-> Show FileOrNumericHost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileOrNumericHost] -> ShowS
$cshowList :: [FileOrNumericHost] -> ShowS
show :: FileOrNumericHost -> String
$cshow :: FileOrNumericHost -> String
showsPrec :: Int -> FileOrNumericHost -> ShowS
$cshowsPrec :: Int -> FileOrNumericHost -> ShowS
Show

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

-- | Cache configuration for responses.
data CacheConf = CacheConf {
    -- | If RR's TTL is higher than this value, this value is used instead.
    CacheConf -> TTL
maximumTTL  :: TTL
    -- | Cache pruning interval in seconds.
  , CacheConf -> Int
pruningDelay  :: Int
  } deriving Int -> CacheConf -> ShowS
[CacheConf] -> ShowS
CacheConf -> String
(Int -> CacheConf -> ShowS)
-> (CacheConf -> String)
-> ([CacheConf] -> ShowS)
-> Show CacheConf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheConf] -> ShowS
$cshowList :: [CacheConf] -> ShowS
show :: CacheConf -> String
$cshow :: CacheConf -> String
showsPrec :: Int -> CacheConf -> ShowS
$cshowsPrec :: Int -> CacheConf -> ShowS
Show

-- | Default cache configuration.
--
-- >>> defaultCacheConf
-- CacheConf {maximumTTL = 300, pruningDelay = 10}
defaultCacheConf :: CacheConf
defaultCacheConf :: CacheConf
defaultCacheConf = TTL -> Int -> CacheConf
CacheConf TTL
300 Int
10

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

-- | Type for resolver configuration.
--  Use 'defaultResolvConf' to create a new value.
--
--  An example to use Google's public DNS cache instead of resolv.conf:
--
--  >>> let conf = defaultResolvConf { resolvInfo = RCHostName "8.8.8.8" }
--
--  An example to use multiple Google's public DNS cache concurrently:
--
--  >>> let conf = defaultResolvConf { resolvInfo = RCHostNames ["8.8.8.8","8.8.4.4"], resolvConcurrent = True }
--
--  An example to disable EDNS:
--
--  >>> let conf = defaultResolvConf { resolvQueryControls = ednsEnabled FlagClear }
--
--  An example to enable query result caching:
--
--  >>> let conf = defaultResolvConf { resolvCache = Just defaultCacheConf }
--
-- An example to disable requesting recursive service.
--
--  >>> let conf = defaultResolvConf { resolvQueryControls = rdFlag FlagClear }
--
-- An example to set the AD bit in all queries by default.
--
--  >>> let conf = defaultResolvConf { resolvQueryControls = adFlag FlagSet }
--
-- An example to set the both the AD and CD bits in all queries by default.
--
--  >>> let conf = defaultResolvConf { resolvQueryControls = adFlag FlagSet <> cdFlag FlagSet }
--
-- An example with an EDNS buffer size of 1216 bytes, which is more robust with
-- IPv6, and the DO bit set to request DNSSEC responses.
--
--  >>> let conf = defaultResolvConf { resolvQueryControls = ednsSetUdpSize (Just 1216) <> doFlag FlagSet }
--
data ResolvConf = ResolvConf {
   -- | Server information.
    ResolvConf -> FileOrNumericHost
resolvInfo       :: FileOrNumericHost
   -- | Timeout in micro seconds.
  , ResolvConf -> Int
resolvTimeout    :: Int
   -- | The number of retries including the first try.
  , ResolvConf -> Int
resolvRetry      :: Int
   -- | Concurrent queries if multiple DNS servers are specified.
  , ResolvConf -> Bool
resolvConcurrent :: Bool
   -- | Cache configuration.
  , ResolvConf -> Maybe CacheConf
resolvCache      :: Maybe CacheConf
   -- | Overrides for the default flags used for queries via resolvers that use
   -- this configuration.
  , ResolvConf -> QueryControls
resolvQueryControls :: QueryControls
} deriving Int -> ResolvConf -> ShowS
[ResolvConf] -> ShowS
ResolvConf -> String
(Int -> ResolvConf -> ShowS)
-> (ResolvConf -> String)
-> ([ResolvConf] -> ShowS)
-> Show ResolvConf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvConf] -> ShowS
$cshowList :: [ResolvConf] -> ShowS
show :: ResolvConf -> String
$cshow :: ResolvConf -> String
showsPrec :: Int -> ResolvConf -> ShowS
$cshowsPrec :: Int -> ResolvConf -> ShowS
Show

-- | Return a default 'ResolvConf':
--
-- * 'resolvInfo' is 'RCFilePath' \"\/etc\/resolv.conf\".
-- * 'resolvTimeout' is 3,000,000 micro seconds.
-- * 'resolvRetry' is 3.
-- * 'resolvConcurrent' is False.
-- * 'resolvCache' is Nothing.
-- * 'resolvQueryControls' is an empty set of overrides.
defaultResolvConf :: ResolvConf
defaultResolvConf :: ResolvConf
defaultResolvConf = ResolvConf :: FileOrNumericHost
-> Int
-> Int
-> Bool
-> Maybe CacheConf
-> QueryControls
-> ResolvConf
ResolvConf {
    resolvInfo :: FileOrNumericHost
resolvInfo       = String -> FileOrNumericHost
RCFilePath String
"/etc/resolv.conf"
  , resolvTimeout :: Int
resolvTimeout    = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
  , resolvRetry :: Int
resolvRetry      = Int
3
  , resolvConcurrent :: Bool
resolvConcurrent = Bool
False
  , resolvCache :: Maybe CacheConf
resolvCache      = Maybe CacheConf
forall a. Maybe a
Nothing
  , resolvQueryControls :: QueryControls
resolvQueryControls = QueryControls
forall a. Monoid a => a
mempty
}

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

-- | Intermediate abstract data type for resolvers.
--   IP address information of DNS servers is generated
--   according to 'resolvInfo' internally.
--   This value can be safely reused for 'withResolver'.
--
--   The naming is confusing for historical reasons.
data ResolvSeed = ResolvSeed {
    ResolvSeed -> ResolvConf
resolvconf  :: ResolvConf
  , ResolvSeed -> NonEmpty AddrInfo
nameservers :: NonEmpty AddrInfo
}

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

-- | Abstract data type of DNS Resolver.
--   This includes newly seeded identifier generators for all
--   specified DNS servers and a cache database.
data Resolver = Resolver {
    Resolver -> ResolvSeed
resolvseed :: ResolvSeed
  , Resolver -> NonEmpty (IO Word16)
genIds     :: NonEmpty (IO Word16)
  , Resolver -> Maybe Cache
cache      :: Maybe Cache
}