{-# LANGUAGE RecordWildCards #-}
module Network.DNS.LookupRaw (
lookup
, lookupAuth
, lookupRaw
, lookupRawCtl
, lookupRawCtlRecv
, fromDNSMessage
) where
import Data.Hourglass (timeAdd, Seconds)
import Prelude hiding (lookup)
import Time.System (timeCurrent)
import Network.Socket (Socket)
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 Resolver
rlv Domain
dom TYPE
typ
| Section
section 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 forall a b. (a -> b) -> a -> b
$ ResolvSeed -> ResolvConf
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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left DNSError
err
Right DNSMessage
ans -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. DNSMessage -> (DNSMessage -> a) -> Either DNSError a
fromDNSMessage DNSMessage
ans DNSMessage -> [RData]
toRData
where
correct :: ResourceRecord -> Bool
correct ResourceRecord{CLASS
TTL
Domain
TYPE
RData
rrname :: ResourceRecord -> Domain
rrtype :: ResourceRecord -> TYPE
rrclass :: ResourceRecord -> CLASS
rrttl :: ResourceRecord -> TTL
rdata :: ResourceRecord -> RData
rdata :: RData
rrttl :: TTL
rrclass :: CLASS
rrtype :: TYPE
rrname :: Domain
..} = TYPE
rrtype forall a. Eq a => a -> a -> Bool
== TYPE
typ
toRData :: DNSMessage -> [RData]
toRData = forall a b. (a -> b) -> [a] -> [b]
map ResourceRecord -> RData
rdata forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ResourceRecord -> Bool
correct 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 ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left DNSError
err
Right DNSMessage
ans -> do
let ex :: Either DNSError [ResourceRecord]
ex = 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 = 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 forall {b}. Either DNSError b
v DNSMessage
ans
forall (m :: * -> *) a. Monad m => a -> m a
return forall {b}. Either DNSError b
v
Left DNSError
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left DNSError
e
Right [] -> do
let v :: Either a [a]
v = forall a b. b -> Either a b
Right []
CacheConf
-> Cache -> Key -> Either DNSError [RData] -> DNSMessage -> IO ()
cacheNegative CacheConf
cconf Cache
c Key
key forall {a} {a}. Either a [a]
v DNSMessage
ans
forall (m :: * -> *) a. Monad m => a -> m a
return 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ResourceRecord -> RData
rdata [ResourceRecord]
rss
Just (Prio
_,Either DNSError [RData]
x) -> forall (m :: * -> *) a. Monad m => a -> m a
return Either DNSError [RData]
x
where
toRR :: DNSMessage -> [ResourceRecord]
toRR = forall a. (a -> Bool) -> [a] -> [a]
filter (TYPE
typ TYPE -> ResourceRecord -> Bool
`isTypeOf`) 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 forall a. Eq a => a -> a -> Bool
== TTL
0 = 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 (forall a b. b -> Either a b
Right [RData]
rds) TTL
ttl
where
rds :: [RData]
rds = forall a b. (a -> b) -> [a] -> [b]
map ResourceRecord -> RData
rdata [ResourceRecord]
rss
ttl :: TTL
ttl = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ 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
maximumTTL :: CacheConf -> TTL
pruningDelay :: CacheConf -> Int
pruningDelay :: Int
maximumTTL :: TTL
..} Cache
c Key
k Either DNSError [RData]
v TTL
ttl = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TTL
ttl forall a. Eq a => a -> a -> Bool
/= TTL
0) forall a b. (a -> b) -> a -> b
$ do
Prio
ctime <- IO Prio
timeCurrent
let tim :: Prio
tim = Prio
ctime 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (TTL
maximumTTL 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
[] -> 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 forall a b. (a -> b) -> a -> b
$ ResourceRecord -> TTL
rrttl ResourceRecord
soa
where
soas :: [ResourceRecord]
soas = forall a. (a -> Bool) -> [a] -> [a]
filter (TYPE
SOA TYPE -> ResourceRecord -> Bool
`isTypeOf`) 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
_ Cache
c Key
k Either DNSError [RData]
v TTL
ttl = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TTL
ttl forall a. Eq a => a -> a -> Bool
/= TTL
0) forall a b. (a -> b) -> a -> b
$ do
Prio
ctime <- IO Prio
timeCurrent
let tim :: Prio
tim = Prio
ctime 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 = 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
TYPE
RData
rdata :: RData
rrttl :: TTL
rrclass :: CLASS
rrtype :: TYPE
rrname :: Domain
rrname :: ResourceRecord -> Domain
rrtype :: ResourceRecord -> TYPE
rrclass :: ResourceRecord -> CLASS
rrttl :: ResourceRecord -> TTL
rdata :: ResourceRecord -> RData
..} = TYPE
rrtype 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 = Resolver
-> Domain
-> TYPE
-> QueryControls
-> IO (Either DNSError DNSMessage)
lookupRawCtl Resolver
rslv Domain
dom TYPE
typ 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 Resolver
rslv Domain
dom TYPE
typ QueryControls
ctls = Resolver -> Domain -> TYPE -> Rslv0
resolve Resolver
rslv Domain
dom TYPE
typ QueryControls
ctls Socket -> IO DNSMessage
receive
lookupRawCtlRecv :: Resolver
-> Domain
-> TYPE
-> QueryControls
-> (Socket -> IO DNSMessage)
-> IO (Either DNSError DNSMessage)
lookupRawCtlRecv :: Resolver -> Domain -> TYPE -> Rslv0
lookupRawCtlRecv = Resolver -> Domain -> TYPE -> Rslv0
resolve
fromDNSMessage :: DNSMessage -> (DNSMessage -> a) -> Either DNSError a
fromDNSMessage :: forall a. DNSMessage -> (DNSMessage -> a) -> Either DNSError a
fromDNSMessage DNSMessage
ans DNSMessage -> a
conv = case DNSMessage -> RCODE
errcode DNSMessage
ans of
RCODE
NoErr -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ DNSMessage -> a
conv DNSMessage
ans
RCODE
FormatErr -> forall a b. a -> Either a b
Left DNSError
FormatError
RCODE
ServFail -> forall a b. a -> Either a b
Left DNSError
ServerFailure
RCODE
NameErr -> forall a b. a -> Either a b
Left DNSError
NameError
RCODE
NotImpl -> forall a b. a -> Either a b
Left DNSError
NotImplemented
RCODE
Refused -> forall a b. a -> Either a b
Left DNSError
OperationRefused
RCODE
BadVers -> forall a b. a -> Either a b
Left DNSError
BadOptRecord
RCODE
BadRCODE -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> DNSError
DecodeError String
"Malformed EDNS message"
RCODE
_ -> forall a b. a -> Either a b
Left DNSError
UnknownDNSError
where
errcode :: DNSMessage -> RCODE
errcode = DNSFlags -> RCODE
rcode forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNSHeader -> DNSFlags
flags forall b c a. (b -> c) -> (a -> b) -> a -> c
. DNSMessage -> DNSHeader
header