module Network.DNS.Types (
ResourceRecord (..)
, Domain
, CLASS
, classIN
, TTL
, TYPE (
A
, NS
, CNAME
, SOA
, NULL
, PTR
, MX
, TXT
, AAAA
, SRV
, DNAME
, OPT
, DS
, RRSIG
, NSEC
, DNSKEY
, NSEC3
, NSEC3PARAM
, TLSA
, CDS
, CDNSKEY
, CSYNC
, ANY
)
, fromTYPE
, toTYPE
, RData (..)
, DNSMessage (..)
, defaultQuery
, defaultResponse
, DNSFormat
, DNSHeader (..)
, Identifier
, QorR (..)
, DNSFlags (..)
, OPCODE (..)
, RCODE (
NoErr
, FormatErr
, ServFail
, NameErr
, NotImpl
, Refused
, YXDomain
, YXRRSet
, NXRRSet
, NotAuth
, NotZone
, BadOpt
)
, fromRCODE
, toRCODE
, fromRCODEforHeader
, toRCODEforHeader
, Question (..)
, DNSError (..)
, EDNS0
, defaultEDNS0
, udpSize
, extRCODE
, dnssecOk
, options
, fromEDNS0
, toEDNS0
, OData (..)
, OptCode (
ClientSubnet
)
, fromOptCode
, toOptCode
, Mailbox
) where
import Control.Exception (Exception, IOException)
import Data.Bits ((.&.), (.|.), shiftR, shiftL, testBit, setBit)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base64 as B64 (encode)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Builder as L
import qualified Data.ByteString.Lazy as L
import Data.IP (IP, IPv4, IPv6)
import Data.Typeable (Typeable)
import Data.Word (Word8, Word16, Word32)
type Domain = ByteString
type Mailbox = ByteString
#if __GLASGOW_HASKELL__ >= 800
newtype TYPE = TYPE {
fromTYPE :: Word16
} deriving (Eq, Ord)
pattern A :: TYPE
pattern A = TYPE 1
pattern NS :: TYPE
pattern NS = TYPE 2
pattern CNAME :: TYPE
pattern CNAME = TYPE 5
pattern SOA :: TYPE
pattern SOA = TYPE 6
pattern NULL :: TYPE
pattern NULL = TYPE 10
pattern PTR :: TYPE
pattern PTR = TYPE 12
pattern MX :: TYPE
pattern MX = TYPE 15
pattern TXT :: TYPE
pattern TXT = TYPE 16
pattern AAAA :: TYPE
pattern AAAA = TYPE 28
pattern SRV :: TYPE
pattern SRV = TYPE 33
pattern DNAME :: TYPE
pattern DNAME = TYPE 39
pattern OPT :: TYPE
pattern OPT = TYPE 41
pattern DS :: TYPE
pattern DS = TYPE 43
pattern RRSIG :: TYPE
pattern RRSIG = TYPE 46
pattern NSEC :: TYPE
pattern NSEC = TYPE 47
pattern DNSKEY :: TYPE
pattern DNSKEY = TYPE 48
pattern NSEC3 :: TYPE
pattern NSEC3 = TYPE 50
pattern NSEC3PARAM :: TYPE
pattern NSEC3PARAM = TYPE 51
pattern TLSA :: TYPE
pattern TLSA = TYPE 52
pattern CDS :: TYPE
pattern CDS = TYPE 59
pattern CDNSKEY :: TYPE
pattern CDNSKEY = TYPE 60
pattern CSYNC :: TYPE
pattern CSYNC = TYPE 62
pattern ANY :: TYPE
pattern ANY = TYPE 255
instance Show TYPE where
show A = "A"
show NS = "NS"
show CNAME = "CNAME"
show SOA = "SOA"
show NULL = "NULL"
show PTR = "PTR"
show MX = "MX"
show TXT = "TXT"
show AAAA = "AAAA"
show SRV = "SRV"
show DNAME = "DNAME"
show OPT = "OPT"
show DS = "DS"
show RRSIG = "RRSIG"
show NSEC = "NSEC"
show DNSKEY = "DNSKEY"
show NSEC3 = "NSEC3"
show NSEC3PARAM = "NSEC3PARAM"
show TLSA = "TLSA"
show CDS = "CDS"
show CDNSKEY = "CDNSKEY"
show CSYNC = "CSYNC"
show ANY = "ANY"
show x = "TYPE " ++ (show $ fromTYPE x)
toTYPE :: Word16 -> TYPE
toTYPE = TYPE
#else
data TYPE = A
| NS
| CNAME
| SOA
| NULL
| PTR
| MX
| TXT
| AAAA
| SRV
| DNAME
| OPT
| DS
| RRSIG
| NSEC
| DNSKEY
| NSEC3
| NSEC3PARAM
| TLSA
| CDS
| CDNSKEY
| CSYNC
| ANY
| UnknownTYPE Word16
deriving (Eq, Ord, Show, Read)
fromTYPE :: TYPE -> Word16
fromTYPE A = 1
fromTYPE NS = 2
fromTYPE CNAME = 5
fromTYPE SOA = 6
fromTYPE NULL = 10
fromTYPE PTR = 12
fromTYPE MX = 15
fromTYPE TXT = 16
fromTYPE AAAA = 28
fromTYPE SRV = 33
fromTYPE DNAME = 39
fromTYPE OPT = 41
fromTYPE DS = 43
fromTYPE RRSIG = 46
fromTYPE NSEC = 47
fromTYPE DNSKEY = 48
fromTYPE NSEC3 = 50
fromTYPE NSEC3PARAM = 51
fromTYPE TLSA = 52
fromTYPE CDS = 59
fromTYPE CDNSKEY = 60
fromTYPE CSYNC = 62
fromTYPE ANY = 255
fromTYPE (UnknownTYPE x) = x
toTYPE :: Word16 -> TYPE
toTYPE 1 = A
toTYPE 2 = NS
toTYPE 5 = CNAME
toTYPE 6 = SOA
toTYPE 10 = NULL
toTYPE 12 = PTR
toTYPE 15 = MX
toTYPE 16 = TXT
toTYPE 28 = AAAA
toTYPE 33 = SRV
toTYPE 39 = DNAME
toTYPE 41 = OPT
toTYPE 43 = DS
toTYPE 46 = RRSIG
toTYPE 47 = NSEC
toTYPE 48 = DNSKEY
toTYPE 50 = NSEC3
toTYPE 51 = NSEC3PARAM
toTYPE 52 = TLSA
toTYPE 59 = CDS
toTYPE 60 = CDNSKEY
toTYPE 62 = CSYNC
toTYPE 255 = ANY
toTYPE x = UnknownTYPE x
#endif
data DNSError =
SequenceNumberMismatch
| RetryLimitExceeded
| TimeoutExpired
| UnexpectedRDATA
| IllegalDomain
| FormatError
| ServerFailure
| NameError
| NotImplemented
| OperationRefused
| BadOptRecord
| BadConfiguration
| NetworkFailure IOException
| UnknownDNSError
deriving (Eq, Show, Typeable)
instance Exception DNSError
data DNSMessage = DNSMessage {
header :: DNSHeader
, question :: [Question]
, answer :: [ResourceRecord]
, authority :: [ResourceRecord]
, additional :: [ResourceRecord]
} deriving (Eq, Show)
type DNSFormat = DNSMessage
type Identifier = Word16
data DNSHeader = DNSHeader {
identifier :: Identifier
, flags :: DNSFlags
} deriving (Eq, Show)
data DNSFlags = DNSFlags {
qOrR :: QorR
, opcode :: OPCODE
, authAnswer :: Bool
, trunCation :: Bool
, recDesired :: Bool
, recAvailable :: Bool
, rcode :: RCODE
, authenData :: Bool
} deriving (Eq, Show)
data QorR = QR_Query
| QR_Response
deriving (Eq, Show, Enum, Bounded)
data OPCODE
= OP_STD
| OP_INV
| OP_SSR
deriving (Eq, Show, Enum, Bounded)
#if __GLASGOW_HASKELL__ >= 800
newtype RCODE = RCODE {
fromRCODE :: Word16
} deriving (Eq)
instance Enum RCODE where
fromEnum = fromIntegral . fromRCODE
toEnum = RCODE . fromIntegral
pattern NoErr :: RCODE
pattern NoErr = RCODE 0
pattern FormatErr :: RCODE
pattern FormatErr = RCODE 1
pattern ServFail :: RCODE
pattern ServFail = RCODE 2
pattern NameErr :: RCODE
pattern NameErr = RCODE 3
pattern NotImpl :: RCODE
pattern NotImpl = RCODE 4
pattern Refused :: RCODE
pattern Refused = RCODE 5
pattern YXDomain :: RCODE
pattern YXDomain = RCODE 6
pattern YXRRSet :: RCODE
pattern YXRRSet = RCODE 7
pattern NXRRSet :: RCODE
pattern NXRRSet = RCODE 8
pattern NotAuth :: RCODE
pattern NotAuth = RCODE 9
pattern NotZone :: RCODE
pattern NotZone = RCODE 10
pattern BadOpt :: RCODE
pattern BadOpt = RCODE 16
instance Show RCODE where
show NoErr = "NoError"
show FormatErr = "FormErr"
show ServFail = "ServFail"
show NameErr = "NXDomain"
show NotImpl = "NotImp"
show Refused = "Refused"
show YXDomain = "YXDomain"
show YXRRSet = "YXRRSet"
show NotAuth = "NotAuth"
show NotZone = "NotZone"
show BadOpt = "BADVERS"
show x = "RCODE " ++ (show $ fromRCODE x)
toRCODE :: Word16 -> RCODE
toRCODE = RCODE
fromRCODEforHeader :: RCODE -> Word16
fromRCODEforHeader (RCODE w) = w .&. 0x0f
toRCODEforHeader :: Word16 -> RCODE
toRCODEforHeader w = RCODE (w .&. 0x0f)
#else
data RCODE
= NoErr
| FormatErr
| ServFail
| NameErr
| NotImpl
| Refused
| YXDomain
| YXRRSet
| NXRRSet
| NotAuth
| NotZone
| BadOpt
| UnknownRCODE Word16
deriving (Eq, Ord, Show)
fromRCODE :: RCODE -> Word16
fromRCODE NoErr = 0
fromRCODE FormatErr = 1
fromRCODE ServFail = 2
fromRCODE NameErr = 3
fromRCODE NotImpl = 4
fromRCODE Refused = 5
fromRCODE YXDomain = 6
fromRCODE YXRRSet = 7
fromRCODE NXRRSet = 8
fromRCODE NotAuth = 9
fromRCODE NotZone = 10
fromRCODE BadOpt = 16
fromRCODE (UnknownRCODE x) = x
toRCODE :: Word16 -> RCODE
toRCODE 0 = NoErr
toRCODE 1 = FormatErr
toRCODE 2 = ServFail
toRCODE 3 = NameErr
toRCODE 4 = NotImpl
toRCODE 5 = Refused
toRCODE 6 = YXDomain
toRCODE 7 = YXRRSet
toRCODE 8 = NXRRSet
toRCODE 9 = NotAuth
toRCODE 10 = NotZone
toRCODE 16 = BadOpt
toRCODE x = UnknownRCODE x
fromRCODEforHeader :: RCODE -> Word16
fromRCODEforHeader rc = fromRCODE rc .&. 0x0f
toRCODEforHeader :: Word16 -> RCODE
toRCODEforHeader w = toRCODE (w .&. 0x0f)
#endif
data Question = Question {
qname :: Domain
, qtype :: TYPE
} deriving (Eq, Show)
type CLASS = Word16
classIN :: CLASS
classIN = 1
type TTL = Word32
data ResourceRecord = ResourceRecord {
rrname :: Domain
, rrtype :: TYPE
, rrclass :: CLASS
, rrttl :: TTL
, rdata :: RData
} deriving (Eq,Show)
data RData = RD_A IPv4
| RD_NS Domain
| RD_CNAME Domain
| RD_SOA Domain Mailbox Word32 Word32 Word32 Word32 Word32
| RD_NULL
| RD_PTR Domain
| RD_MX Word16 Domain
| RD_TXT ByteString
| RD_AAAA IPv6
| RD_SRV Word16 Word16 Word16 Domain
| RD_DNAME Domain
| RD_OPT [OData]
| RD_DS Word16 Word8 Word8 ByteString
--RD_RRSIG
--RD_NSEC
| RD_DNSKEY Word16 Word8 Word8 ByteString
--RD_NSEC3
--RD_NSEC3PARAM
| RD_TLSA Word8 Word8 Word8 ByteString
--RD_CDS
--RD_CDNSKEY
--RD_CSYNC
| UnknownRData ByteString
deriving (Eq, Ord)
instance Show RData where
show (RD_NS dom) = BS.unpack dom
show (RD_MX prf dom) = show prf ++ " " ++ BS.unpack dom
show (RD_CNAME dom) = BS.unpack dom
show (RD_DNAME dom) = BS.unpack dom
show (RD_A a) = show a
show (RD_AAAA aaaa) = show aaaa
show (RD_TXT txt) = BS.unpack txt
show (RD_SOA mn mr serial refresh retry expire mi) = BS.unpack mn ++ " " ++ BS.unpack mr ++ " " ++
show serial ++ " " ++ show refresh ++ " " ++
show retry ++ " " ++ show expire ++ " " ++ show mi
show (RD_PTR dom) = BS.unpack dom
show (RD_SRV pri wei prt dom) = show pri ++ " " ++ show wei ++ " " ++ show prt ++ BS.unpack dom
show (RD_OPT od) = show od
show (UnknownRData is) = show is
show (RD_TLSA use sel mtype dgst) = show use ++ " " ++ show sel ++ " " ++ show mtype ++ " " ++ hexencode dgst
show (RD_DS t a dt dv) = show t ++ " " ++ show a ++ " " ++ show dt ++ " " ++ hexencode dv
show RD_NULL = "NULL"
show (RD_DNSKEY f p a k) = show f ++ " " ++ show p ++ " " ++ show a ++ " " ++ b64encode k
hexencode :: ByteString -> String
hexencode = BS.unpack . L.toStrict . L.toLazyByteString . L.byteStringHex
b64encode :: ByteString -> String
b64encode = BS.unpack . B64.encode
defaultQuery :: DNSMessage
defaultQuery = DNSMessage {
header = DNSHeader {
identifier = 0
, flags = DNSFlags {
qOrR = QR_Query
, opcode = OP_STD
, authAnswer = False
, trunCation = False
, recDesired = True
, recAvailable = False
, rcode = NoErr
, authenData = False
}
}
, question = []
, answer = []
, authority = []
, additional = []
}
defaultResponse :: DNSMessage
defaultResponse =
let hd = header defaultQuery
flg = flags hd
in defaultQuery {
header = hd {
flags = flg {
qOrR = QR_Response
, authAnswer = True
, recAvailable = True
, authenData = False
}
}
}
data EDNS0 = EDNS0 {
udpSize :: Word16
, extRCODE :: RCODE
, dnssecOk :: Bool
, options :: [OData]
} deriving (Eq, Show)
#if __GLASGOW_HASKELL__ >= 800
#else
#endif
defaultEDNS0 :: EDNS0
defaultEDNS0 = EDNS0 4096 NoErr False []
fromEDNS0 :: EDNS0 -> ResourceRecord
fromEDNS0 edns = ResourceRecord name' type' class' ttl' rdata'
where
name' = "."
type' = OPT
class' = udpSize edns
ttl0' = fromIntegral (fromRCODE (extRCODE edns) .&. 0x0ff0) `shiftL` 20
ttl'
| dnssecOk edns = ttl0' `setBit` 15
| otherwise = ttl0'
rdata' = RD_OPT $ options edns
toEDNS0 :: DNSFlags -> ResourceRecord -> Maybe EDNS0
toEDNS0 flgs (ResourceRecord "." OPT udpsiz ttl' (RD_OPT opts)) =
Just $ EDNS0 udpsiz (toRCODE erc) secok opts
where
lp = fromRCODEforHeader $ rcode flgs
up = shiftR (ttl' .&. 0xff000000) 20
erc = fromIntegral up .|. lp
secok = ttl' `testBit` 15
toEDNS0 _ _ = Nothing
#if __GLASGOW_HASKELL__ >= 800
newtype OptCode = OptCode {
fromOptCode :: Word16
} deriving (Eq,Ord)
pattern ClientSubnet :: OptCode
pattern ClientSubnet = OptCode 8
instance Show OptCode where
show ClientSubnet = "ClientSubnet"
show x = "OptCode " ++ (show $ fromOptCode x)
toOptCode :: Word16 -> OptCode
toOptCode = OptCode
#else
data OptCode = ClientSubnet
| UnknownOptCode Word16
deriving (Eq, Ord, Show)
fromOptCode :: OptCode -> Word16
fromOptCode ClientSubnet = 8
fromOptCode (UnknownOptCode x) = x
toOptCode :: Word16 -> OptCode
toOptCode 8 = ClientSubnet
toOptCode x = UnknownOptCode x
#endif
data OData = OD_ClientSubnet Word8 Word8 IP
| UnknownOData OptCode ByteString
deriving (Eq,Show,Ord)