{-# LANGUAGE RecordWildCards #-}
module Network.DNS.LookupRaw (
lookup
, lookupAuth
, lookupRaw
, lookupRawAD
, fromDNSMessage
, fromDNSFormat
) where
import Data.Time (getCurrentTime, addUTCTime)
import Prelude hiding (lookup)
import Network.DNS.IO
import Network.DNS.Imports hiding (lookup)
import Network.DNS.Memo
import Network.DNS.Transport
import Network.DNS.Types
import Network.DNS.Types.Internal
lookup :: Resolver -> Domain -> TYPE -> IO (Either DNSError [RData])
lookup :: Resolver -> Domain -> TYPE -> IO (Either DNSError [RData])
lookup = Section
-> Resolver -> Domain -> TYPE -> IO (Either DNSError [RData])
lookupSection Section
Answer
lookupAuth :: Resolver -> Domain -> TYPE -> IO (Either DNSError [RData])
lookupAuth :: Resolver -> Domain -> TYPE -> IO (Either DNSError [RData])
lookupAuth = Section
-> Resolver -> Domain -> TYPE -> IO (Either DNSError [RData])
lookupSection Section
Authority
lookupSection :: Section
-> Resolver
-> Domain
-> TYPE
-> IO (Either DNSError [RData])
lookupSection :: Section
-> Resolver -> Domain -> TYPE -> IO (Either DNSError [RData])
lookupSection Section
section Resolver
rlv Domain
dom TYPE
typ
| Section
section Section -> Section -> Bool
forall a. Eq a => a -> a -> Bool
== Section
Authority = Resolver
-> Domain -> TYPE -> Section -> IO (Either DNSError [RData])
lookupFreshSection Resolver
rlv Domain
dom TYPE
typ Section
section
| Bool
otherwise = case Maybe CacheConf
mcacheConf of
Maybe CacheConf
Nothing -> Resolver
-> Domain -> TYPE -> Section -> IO (Either DNSError [RData])
lookupFreshSection Resolver
rlv Domain
dom TYPE
typ Section
section
Just CacheConf
cacheconf -> Resolver
-> Domain -> TYPE -> CacheConf -> IO (Either DNSError [RData])
lookupCacheSection Resolver
rlv Domain
dom TYPE
typ CacheConf
cacheconf
where
mcacheConf :: Maybe CacheConf
mcacheConf = ResolvConf -> Maybe CacheConf
resolvCache (ResolvConf -> Maybe CacheConf) -> ResolvConf -> Maybe CacheConf
forall a b. (a -> b) -> a -> b
$ ResolvSeed -> ResolvConf
resolvconf (ResolvSeed -> ResolvConf) -> ResolvSeed -> ResolvConf
forall a b. (a -> b) -> a -> b
$ Resolver -> ResolvSeed
resolvseed Resolver
rlv
lookupFreshSection :: Resolver
-> Domain
-> TYPE
-> Section
-> IO (Either DNSError [RData])
lookupFreshSection :: Resolver
-> Domain -> TYPE -> Section -> IO (Either DNSError [RData])
lookupFreshSection Resolver
rlv Domain
dom TYPE
typ Section
section = do
Either DNSError DNSMessage
eans <- Resolver -> Domain -> TYPE -> IO (Either DNSError DNSMessage)
lookupRaw Resolver
rlv Domain
dom TYPE
typ
case Either DNSError DNSMessage
eans of
Left DNSError
err -> Either DNSError [RData] -> IO (Either DNSError [RData])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DNSError [RData] -> IO (Either DNSError [RData]))
-> Either DNSError [RData] -> IO (Either DNSError [RData])
forall a b. (a -> b) -> a -> b
$ DNSError -> Either DNSError [RData]
forall a b. a -> Either a b
Left DNSError
err
Right DNSMessage
ans -> Either DNSError [RData] -> IO (Either DNSError [RData])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DNSError [RData] -> IO (Either DNSError [RData]))
-> Either DNSError [RData] -> IO (Either DNSError [RData])
forall a b. (a -> b) -> a -> b
$ DNSMessage -> (DNSMessage -> [RData]) -> Either DNSError [RData]
forall a. DNSMessage -> (DNSMessage -> a) -> Either DNSError a
fromDNSMessage DNSMessage
ans DNSMessage -> [RData]
toRData
where
correct :: ResourceRecord -> Bool
correct ResourceRecord{CLASS
TTL
Domain
RData
TYPE
rdata :: ResourceRecord -> RData
rrttl :: ResourceRecord -> TTL
rrclass :: ResourceRecord -> CLASS
rrtype :: ResourceRecord -> TYPE
rrname :: ResourceRecord -> Domain
rdata :: RData
rrttl :: TTL
rrclass :: CLASS
rrtype :: TYPE
rrname :: Domain
..} = TYPE
rrtype TYPE -> TYPE -> Bool
forall a. Eq a => a -> a -> Bool
== TYPE
typ
toRData :: DNSMessage -> [RData]
toRData = (ResourceRecord -> RData) -> [ResourceRecord] -> [RData]
forall a b. (a -> b) -> [a] -> [b]
map ResourceRecord -> RData
rdata ([ResourceRecord] -> [RData])
-> (DNSMessage -> [ResourceRecord]) -> DNSMessage -> [RData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResourceRecord -> Bool) -> [ResourceRecord] -> [ResourceRecord]
forall a. (a -> Bool) -> [a] -> [a]
filter ResourceRecord -> Bool
correct ([ResourceRecord] -> [ResourceRecord])
-> (DNSMessage -> [ResourceRecord])
-> DNSMessage
-> [ResourceRecord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNSMessage -> [ResourceRecord]
sectionF
sectionF :: DNSMessage -> [ResourceRecord]
sectionF = case Section
section of
Section
Answer -> DNSMessage -> [ResourceRecord]
answer
Section
Authority -> DNSMessage -> [ResourceRecord]
authority
lookupCacheSection :: Resolver
-> Domain
-> TYPE
-> CacheConf
-> IO (Either DNSError [RData])
lookupCacheSection :: Resolver
-> Domain -> TYPE -> CacheConf -> IO (Either DNSError [RData])
lookupCacheSection Resolver
rlv Domain
dom TYPE
typ CacheConf
cconf = do
Maybe (Prio, Either DNSError [RData])
mx <- Key -> Cache -> IO (Maybe (Prio, Either DNSError [RData]))
lookupCache (Domain
dom,TYPE
typ) Cache
c
case Maybe (Prio, Either DNSError [RData])
mx of
Maybe (Prio, Either DNSError [RData])
Nothing -> do
Either DNSError DNSMessage
eans <- Resolver -> Domain -> TYPE -> IO (Either DNSError DNSMessage)
lookupRaw Resolver
rlv Domain
dom TYPE
typ
case Either DNSError DNSMessage
eans of
Left DNSError
err ->
Either DNSError [RData] -> IO (Either DNSError [RData])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DNSError [RData] -> IO (Either DNSError [RData]))
-> Either DNSError [RData] -> IO (Either DNSError [RData])
forall a b. (a -> b) -> a -> b
$ DNSError -> Either DNSError [RData]
forall a b. a -> Either a b
Left DNSError
err
Right DNSMessage
ans -> do
let ex :: Either DNSError [ResourceRecord]
ex = DNSMessage
-> (DNSMessage -> [ResourceRecord])
-> Either DNSError [ResourceRecord]
forall a. DNSMessage -> (DNSMessage -> a) -> Either DNSError a
fromDNSMessage DNSMessage
ans DNSMessage -> [ResourceRecord]
toRR
case Either DNSError [ResourceRecord]
ex of
Left DNSError
NameError -> do
let v :: Either DNSError b
v = DNSError -> Either DNSError b
forall a b. a -> Either a b
Left DNSError
NameError
CacheConf
-> Cache -> Key -> Either DNSError [RData] -> DNSMessage -> IO ()
cacheNegative CacheConf
cconf Cache
c Key
key Either DNSError [RData]
forall b. Either DNSError b
v DNSMessage
ans
Either DNSError [RData] -> IO (Either DNSError [RData])
forall (m :: * -> *) a. Monad m => a -> m a
return Either DNSError [RData]
forall b. Either DNSError b
v
Left DNSError
e -> Either DNSError [RData] -> IO (Either DNSError [RData])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DNSError [RData] -> IO (Either DNSError [RData]))
-> Either DNSError [RData] -> IO (Either DNSError [RData])
forall a b. (a -> b) -> a -> b
$ DNSError -> Either DNSError [RData]
forall a b. a -> Either a b
Left DNSError
e
Right [] -> do
let v :: Either a [a]
v = [a] -> Either a [a]
forall a b. b -> Either a b
Right []
CacheConf
-> Cache -> Key -> Either DNSError [RData] -> DNSMessage -> IO ()
cacheNegative CacheConf
cconf Cache
c Key
key Either DNSError [RData]
forall a a. Either a [a]
v DNSMessage
ans
Either DNSError [RData] -> IO (Either DNSError [RData])
forall (m :: * -> *) a. Monad m => a -> m a
return Either DNSError [RData]
forall a a. Either a [a]
v
Right [ResourceRecord]
rss -> do
CacheConf -> Cache -> Key -> [ResourceRecord] -> IO ()
cachePositive CacheConf
cconf Cache
c Key
key [ResourceRecord]
rss
Either DNSError [RData] -> IO (Either DNSError [RData])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DNSError [RData] -> IO (Either DNSError [RData]))
-> Either DNSError [RData] -> IO (Either DNSError [RData])
forall a b. (a -> b) -> a -> b
$ [RData] -> Either DNSError [RData]
forall a b. b -> Either a b
Right ([RData] -> Either DNSError [RData])
-> [RData] -> Either DNSError [RData]
forall a b. (a -> b) -> a -> b
$ (ResourceRecord -> RData) -> [ResourceRecord] -> [RData]
forall a b. (a -> b) -> [a] -> [b]
map ResourceRecord -> RData
rdata [ResourceRecord]
rss
Just (Prio
_,Either DNSError [RData]
x) -> Either DNSError [RData] -> IO (Either DNSError [RData])
forall (m :: * -> *) a. Monad m => a -> m a
return Either DNSError [RData]
x
where
toRR :: DNSMessage -> [ResourceRecord]
toRR = (ResourceRecord -> Bool) -> [ResourceRecord] -> [ResourceRecord]
forall a. (a -> Bool) -> [a] -> [a]
filter (TYPE
typ TYPE -> ResourceRecord -> Bool
`isTypeOf`) ([ResourceRecord] -> [ResourceRecord])
-> (DNSMessage -> [ResourceRecord])
-> DNSMessage
-> [ResourceRecord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNSMessage -> [ResourceRecord]
answer
Just Cache
c = Resolver -> Maybe Cache
cache Resolver
rlv
key :: Key
key = (Domain
dom,TYPE
typ)
cachePositive :: CacheConf -> Cache -> Key -> [ResourceRecord] -> IO ()
cachePositive :: CacheConf -> Cache -> Key -> [ResourceRecord] -> IO ()
cachePositive CacheConf
cconf Cache
c Key
key [ResourceRecord]
rss
| TTL
ttl TTL -> TTL -> Bool
forall a. Eq a => a -> a -> Bool
== TTL
0 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = CacheConf
-> Cache -> Key -> Either DNSError [RData] -> TTL -> IO ()
insertPositive CacheConf
cconf Cache
c Key
key ([RData] -> Either DNSError [RData]
forall a b. b -> Either a b
Right [RData]
rds) TTL
ttl
where
rds :: [RData]
rds = (ResourceRecord -> RData) -> [ResourceRecord] -> [RData]
forall a b. (a -> b) -> [a] -> [b]
map ResourceRecord -> RData
rdata [ResourceRecord]
rss
ttl :: TTL
ttl = [TTL] -> TTL
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([TTL] -> TTL) -> [TTL] -> TTL
forall a b. (a -> b) -> a -> b
$ (ResourceRecord -> TTL) -> [ResourceRecord] -> [TTL]
forall a b. (a -> b) -> [a] -> [b]
map ResourceRecord -> TTL
rrttl [ResourceRecord]
rss
insertPositive :: CacheConf -> Cache -> Key -> Entry -> TTL -> IO ()
insertPositive :: CacheConf
-> Cache -> Key -> Either DNSError [RData] -> TTL -> IO ()
insertPositive CacheConf{Int
TTL
pruningDelay :: CacheConf -> Int
maximumTTL :: CacheConf -> TTL
pruningDelay :: Int
maximumTTL :: TTL
..} Cache
c Key
k Either DNSError [RData]
v TTL
ttl = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TTL
ttl TTL -> TTL -> Bool
forall a. Eq a => a -> a -> Bool
/= TTL
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Prio
tim <- NominalDiffTime -> Prio -> Prio
addUTCTime NominalDiffTime
life (Prio -> Prio) -> IO Prio -> IO Prio
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Prio
getCurrentTime
Key -> Prio -> Either DNSError [RData] -> Cache -> IO ()
insertCache Key
k Prio
tim Either DNSError [RData]
v Cache
c
where
life :: NominalDiffTime
life = TTL -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TTL
maximumTTL TTL -> TTL -> TTL
forall a. Ord a => a -> a -> a
`min` TTL
ttl)
cacheNegative :: CacheConf -> Cache -> Key -> Entry -> DNSMessage -> IO ()
cacheNegative :: CacheConf
-> Cache -> Key -> Either DNSError [RData] -> DNSMessage -> IO ()
cacheNegative CacheConf
cconf Cache
c Key
key Either DNSError [RData]
v DNSMessage
ans = case [ResourceRecord]
soas of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ResourceRecord
soa:[ResourceRecord]
_ -> CacheConf
-> Cache -> Key -> Either DNSError [RData] -> TTL -> IO ()
insertNegative CacheConf
cconf Cache
c Key
key Either DNSError [RData]
v (TTL -> IO ()) -> TTL -> IO ()
forall a b. (a -> b) -> a -> b
$ ResourceRecord -> TTL
rrttl ResourceRecord
soa
where
soas :: [ResourceRecord]
soas = (ResourceRecord -> Bool) -> [ResourceRecord] -> [ResourceRecord]
forall a. (a -> Bool) -> [a] -> [a]
filter (TYPE
SOA TYPE -> ResourceRecord -> Bool
`isTypeOf`) ([ResourceRecord] -> [ResourceRecord])
-> [ResourceRecord] -> [ResourceRecord]
forall a b. (a -> b) -> a -> b
$ DNSMessage -> [ResourceRecord]
authority DNSMessage
ans
insertNegative :: CacheConf -> Cache -> Key -> Entry -> TTL -> IO ()
insertNegative :: CacheConf
-> Cache -> Key -> Either DNSError [RData] -> TTL -> IO ()
insertNegative CacheConf{Int
TTL
pruningDelay :: Int
maximumTTL :: TTL
pruningDelay :: CacheConf -> Int
maximumTTL :: CacheConf -> TTL
..} Cache
c Key
k Either DNSError [RData]
v TTL
ttl = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TTL
ttl TTL -> TTL -> Bool
forall a. Eq a => a -> a -> Bool
/= TTL
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Prio
tim <- NominalDiffTime -> Prio -> Prio
addUTCTime NominalDiffTime
life (Prio -> Prio) -> IO Prio -> IO Prio
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Prio
getCurrentTime
Key -> Prio -> Either DNSError [RData] -> Cache -> IO ()
insertCache Key
k Prio
tim Either DNSError [RData]
v Cache
c
where
life :: NominalDiffTime
life = TTL -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral TTL
ttl
isTypeOf :: TYPE -> ResourceRecord -> Bool
isTypeOf :: TYPE -> ResourceRecord -> Bool
isTypeOf TYPE
t ResourceRecord{CLASS
TTL
Domain
RData
TYPE
rdata :: RData
rrttl :: TTL
rrclass :: CLASS
rrtype :: TYPE
rrname :: Domain
rdata :: ResourceRecord -> RData
rrttl :: ResourceRecord -> TTL
rrclass :: ResourceRecord -> CLASS
rrtype :: ResourceRecord -> TYPE
rrname :: ResourceRecord -> Domain
..} = TYPE
rrtype TYPE -> TYPE -> Bool
forall a. Eq a => a -> a -> Bool
== TYPE
t
lookupRaw :: Resolver -> Domain -> TYPE -> IO (Either DNSError DNSMessage)
lookupRaw :: Resolver -> Domain -> TYPE -> IO (Either DNSError DNSMessage)
lookupRaw Resolver
rslv Domain
dom TYPE
typ = Domain -> TYPE -> Resolver -> Rslv0
resolve Domain
dom TYPE
typ Resolver
rslv Bool
False Socket -> IO DNSMessage
receive
lookupRawAD :: Resolver -> Domain -> TYPE -> IO (Either DNSError DNSMessage)
lookupRawAD :: Resolver -> Domain -> TYPE -> IO (Either DNSError DNSMessage)
lookupRawAD Resolver
rslv Domain
dom TYPE
typ = Domain -> TYPE -> Resolver -> Rslv0
resolve Domain
dom TYPE
typ Resolver
rslv Bool
True Socket -> IO DNSMessage
receive
fromDNSMessage :: DNSMessage -> (DNSMessage -> a) -> Either DNSError a
fromDNSMessage :: DNSMessage -> (DNSMessage -> a) -> Either DNSError a
fromDNSMessage DNSMessage
ans DNSMessage -> a
conv = case DNSMessage -> RCODE
errcode DNSMessage
ans of
RCODE
NoErr -> a -> Either DNSError a
forall a b. b -> Either a b
Right (a -> Either DNSError a) -> a -> Either DNSError a
forall a b. (a -> b) -> a -> b
$ DNSMessage -> a
conv DNSMessage
ans
RCODE
FormatErr -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
FormatError
RCODE
ServFail -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
ServerFailure
RCODE
NameErr -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
NameError
RCODE
NotImpl -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
NotImplemented
RCODE
Refused -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
OperationRefused
RCODE
BadOpt -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
BadOptRecord
RCODE
_ -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
UnknownDNSError
where
errcode :: DNSMessage -> RCODE
errcode = DNSFlags -> RCODE
rcode (DNSFlags -> RCODE)
-> (DNSMessage -> DNSFlags) -> DNSMessage -> RCODE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNSHeader -> DNSFlags
flags (DNSHeader -> DNSFlags)
-> (DNSMessage -> DNSHeader) -> DNSMessage -> DNSFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNSMessage -> DNSHeader
header
{-# DEPRECATED fromDNSFormat "Use fromDNSMessage instead" #-}
fromDNSFormat :: DNSMessage -> (DNSMessage -> a) -> Either DNSError a
fromDNSFormat :: DNSMessage -> (DNSMessage -> a) -> Either DNSError a
fromDNSFormat = DNSMessage -> (DNSMessage -> a) -> Either DNSError a
forall a. DNSMessage -> (DNSMessage -> a) -> Either DNSError a
fromDNSMessage