{-# LANGUAGE RecordWildCards #-}
module Network.DNS.LookupRaw (
lookup
, lookupAuth
, lookupRaw
, lookupRawCtl
, fromDNSMessage
) where
import Data.Hourglass (timeAdd, Seconds)
import Prelude hiding (lookup)
import Time.System (timeCurrent)
import Network.DNS.IO
import Network.DNS.Imports hiding (lookup)
import Network.DNS.Memo
import Network.DNS.Transport
import Network.DNS.Types.Internal
import Network.DNS.Types.Resolver
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
section rlv :: Resolver
rlv dom :: Domain
dom typ :: 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
Nothing -> Resolver
-> Domain -> TYPE -> Section -> IO (Either DNSError [RData])
lookupFreshSection Resolver
rlv Domain
dom TYPE
typ Section
section
Just cacheconf :: 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 rlv :: Resolver
rlv dom :: Domain
dom typ :: TYPE
typ section :: 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 err :: 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 ans :: 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{..} = 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
Answer -> DNSMessage -> [ResourceRecord]
answer
Authority -> DNSMessage -> [ResourceRecord]
authority
lookupCacheSection :: Resolver
-> Domain
-> TYPE
-> CacheConf
-> IO (Either DNSError [RData])
lookupCacheSection :: Resolver
-> Domain -> TYPE -> CacheConf -> IO (Either DNSError [RData])
lookupCacheSection rlv :: Resolver
rlv dom :: Domain
dom typ :: TYPE
typ cconf :: 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
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 err :: 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 ans :: 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 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 e :: 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 rss :: [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 (_,x :: 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 c :: 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 cconf :: CacheConf
cconf c :: Cache
c key :: Key
key rss :: [ResourceRecord]
rss
| TTL
ttl TTL -> TTL -> Bool
forall a. Eq a => a -> a -> Bool
== 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{..} c :: Cache
c k :: Key
k v :: Either DNSError [RData]
v ttl :: 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
/= 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Prio
ctime <- IO Prio
timeCurrent
let tim :: Prio
tim = Prio
ctime Prio -> Seconds -> Prio
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
`timeAdd` Seconds
life
Key -> Prio -> Either DNSError [RData] -> Cache -> IO ()
insertCache Key
k Prio
tim Either DNSError [RData]
v Cache
c
where
life :: Seconds
life :: Seconds
life = TTL -> Seconds
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 cconf :: CacheConf
cconf c :: Cache
c key :: Key
key v :: Either DNSError [RData]
v ans :: DNSMessage
ans = case [ResourceRecord]
soas of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
soa :: ResourceRecord
soa:_ -> 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{..} c :: Cache
c k :: Key
k v :: Either DNSError [RData]
v ttl :: 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
/= 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Prio
ctime <- IO Prio
timeCurrent
let tim :: Prio
tim = Prio
ctime Prio -> Seconds -> Prio
forall t ti. (Time t, TimeInterval ti) => t -> ti -> t
`timeAdd` Seconds
life
Key -> Prio -> Either DNSError [RData] -> Cache -> IO ()
insertCache Key
k Prio
tim Either DNSError [RData]
v Cache
c
where
life :: Seconds
life :: Seconds
life = TTL -> Seconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral TTL
ttl
isTypeOf :: TYPE -> ResourceRecord -> Bool
isTypeOf :: TYPE -> ResourceRecord -> Bool
isTypeOf t :: TYPE
t ResourceRecord{..} = 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 rslv :: Resolver
rslv dom :: Domain
dom typ :: TYPE
typ = Resolver
-> Domain
-> TYPE
-> QueryControls
-> IO (Either DNSError DNSMessage)
lookupRawCtl Resolver
rslv Domain
dom TYPE
typ QueryControls
forall a. Monoid a => a
mempty
lookupRawCtl :: Resolver
-> Domain
-> TYPE
-> QueryControls
-> IO (Either DNSError DNSMessage)
lookupRawCtl :: Resolver
-> Domain
-> TYPE
-> QueryControls
-> IO (Either DNSError DNSMessage)
lookupRawCtl rslv :: Resolver
rslv dom :: Domain
dom typ :: TYPE
typ ctls :: QueryControls
ctls = Domain -> TYPE -> Resolver -> Rslv0
resolve Domain
dom TYPE
typ Resolver
rslv QueryControls
ctls Socket -> IO DNSMessage
receive
fromDNSMessage :: DNSMessage -> (DNSMessage -> a) -> Either DNSError a
fromDNSMessage :: DNSMessage -> (DNSMessage -> a) -> Either DNSError a
fromDNSMessage ans :: DNSMessage
ans conv :: DNSMessage -> a
conv = case DNSMessage -> RCODE
errcode DNSMessage
ans of
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
FormatErr -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
FormatError
ServFail -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
ServerFailure
NameErr -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
NameError
NotImpl -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
NotImplemented
Refused -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
OperationRefused
BadVers -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left DNSError
BadOptRecord
BadRCODE -> DNSError -> Either DNSError a
forall a b. a -> Either a b
Left (DNSError -> Either DNSError a) -> DNSError -> Either DNSError a
forall a b. (a -> b) -> a -> b
$ String -> DNSError
DecodeError "Malformed EDNS message"
_ -> 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