From 510f31b3e1de263a2da95217cc9a8b440a769691 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Wed, 17 Mar 2010 17:31:12 +0900 Subject: making data abstract --- Network/DNS.hs | 7 +++- Network/DNS/Internal.hs | 109 ++++++++++++++++++++++++++++++++++++++++++++++++ Network/DNS/Query.hs | 2 +- Network/DNS/Response.hs | 2 +- Network/DNS/Types.hs | 107 +++++++---------------------------------------- 5 files changed, 132 insertions(+), 95 deletions(-) create mode 100644 Network/DNS/Internal.hs (limited to 'Network') diff --git a/Network/DNS.hs b/Network/DNS.hs index 223c72d..0f6de02 100644 --- a/Network/DNS.hs +++ b/Network/DNS.hs @@ -1,4 +1,9 @@ -module Network.DNS (parseResponse, composeQuery) where +module Network.DNS ( + module Network.DNS.Types + , module Network.DNS.Query + , module Network.DNS.Response + ) where +import Network.DNS.Types import Network.DNS.Query import Network.DNS.Response diff --git a/Network/DNS/Internal.hs b/Network/DNS/Internal.hs new file mode 100644 index 0000000..ceedb2b --- /dev/null +++ b/Network/DNS/Internal.hs @@ -0,0 +1,109 @@ +module Network.DNS.Internal where + +import Data.Maybe +import Data.IP + +---------------------------------------------------------------- + +data TYPE = A | AAAA | NS | TXT | MX | UNKNOWN deriving (Eq, Show, Read) + +rrDB :: [(TYPE, Int)] +rrDB = [ + (A, 1) + , (NS, 2) + , (MX, 15) + , (TXT, 16) + , (AAAA, 28) + ] + +rookup :: (Eq b) => b -> [(a,b)] -> Maybe a +rookup _ [] = Nothing +rookup key ((x,y):xys) + | key == y = Just x + | otherwise = rookup key xys + +intToType :: Int -> TYPE +intToType n = maybe UNKNOWN id $ rookup n rrDB +typeToInt :: TYPE -> Int +typeToInt t = maybe 0 id $ lookup t rrDB + +---------------------------------------------------------------- + +data QorR = QR_Query | QR_Response deriving (Eq, Show) + +data OPCODE = OP_STD | OP_INV | OP_SSR deriving (Eq, Show, Enum) + +data RCODE = NoErr | FormatErr | ServFail | NameErr | NotImpl | Refused deriving (Eq, Show, Enum) + +---------------------------------------------------------------- + +type Domain = String + +---------------------------------------------------------------- + +data Question = Question { + qname :: Domain + , qtype :: TYPE + } deriving (Eq, Show) + +makeQuestion :: Domain -> TYPE -> Question +makeQuestion dom typ = Question dom typ + +---------------------------------------------------------------- + +data ResourceRecord = ResourceRecord { + rrname :: Domain + , rrtype :: TYPE + , rrttl :: Int + , rdlen :: Int + , rdata :: RDATA + } deriving (Eq, Show) + +data RDATA = RD_NS Domain | RD_A IPv4 | RD_AAAA IPv6 | RD_OTH [Int] deriving (Eq, Show) + +---------------------------------------------------------------- + +data DNSFlags = DNSFlags { + qOrR :: QorR + , opcode :: OPCODE + , authAnswer :: Bool + , trunCation :: Bool + , recDesired :: Bool + , recAvailable :: Bool + , rcode :: RCODE + } deriving (Eq, Show) + +data DNSHeader = DNSHeader { + identifier :: Int + , flags :: DNSFlags + , qdCount :: Int + , anCount :: Int + , nsCount :: Int + , arCount :: Int + } deriving (Eq, Show) + +data DNSFormat = DNSFormat { + header :: DNSHeader + , question :: [Question] + , answer :: [ResourceRecord] + , authority :: [ResourceRecord] + , additional :: [ResourceRecord] + } deriving (Eq, Show) + +---------------------------------------------------------------- + +defaultQuery :: DNSFormat +defaultQuery = DNSFormat { + header = DNSHeader { + identifier = 0 + , flags = undefined + , qdCount = 0 + , anCount = 0 + , nsCount = 0 + , arCount = 0 + } + , question = [] + , answer = [] + , authority = [] + , additional = [] + } diff --git a/Network/DNS/Query.hs b/Network/DNS/Query.hs index 8fcf694..db30bd8 100644 --- a/Network/DNS/Query.hs +++ b/Network/DNS/Query.hs @@ -3,7 +3,7 @@ module Network.DNS.Query (composeQuery) where import Data.ByteString.Lazy (ByteString) import Data.Char import Network.DNS.StateBinary -import Network.DNS.Types +import Network.DNS.Internal ---------------------------------------------------------------- diff --git a/Network/DNS/Response.hs b/Network/DNS/Response.hs index c6e0410..d3a7a22 100644 --- a/Network/DNS/Response.hs +++ b/Network/DNS/Response.hs @@ -6,7 +6,7 @@ import Data.ByteString.Lazy (ByteString) import Data.Char import Data.IP import Network.DNS.StateBinary -import Network.DNS.Types +import Network.DNS.Internal ---------------------------------------------------------------- diff --git a/Network/DNS/Types.hs b/Network/DNS/Types.hs index aa32431..fe1f1be 100644 --- a/Network/DNS/Types.hs +++ b/Network/DNS/Types.hs @@ -1,92 +1,15 @@ -module Network.DNS.Types where - -import Data.Maybe -import Data.IP - -data TYPE = A | AAAA | NS | TXT | MX | UNKNOWN deriving (Eq, Show) - -rrDB :: [(TYPE, Int)] -rrDB = [ - (A, 1) - , (NS, 2) - , (MX, 15) - , (TXT, 16) - , (AAAA, 28) - ] - -rookup :: (Eq b) => b -> [(a,b)] -> Maybe a -rookup _ [] = Nothing -rookup key ((x,y):xys) - | key == y = Just x - | otherwise = rookup key xys - -intToType :: Int -> TYPE -intToType n = maybe UNKNOWN id $ rookup n rrDB -typeToInt :: TYPE -> Int -typeToInt t = maybe 0 id $ lookup t rrDB - -data QorR = QR_Query | QR_Response deriving (Eq, Show) - -data OPCODE = OP_STD | OP_INV | OP_SSR deriving (Eq, Show, Enum) - -data RCODE = NoErr | FormatErr | ServFail | NameErr | NotImpl | Refused deriving (Eq, Show, Enum) - -type Domain = String - -data Question = Question { - qname :: Domain - , qtype :: TYPE - } deriving (Eq, Show) - -data ResourceRecord = ResourceRecord { - rrname :: Domain - , rrtype :: TYPE - , rrttl :: Int - , rdlen :: Int - , rdata :: RDATA - } deriving (Eq, Show) - -data RDATA = RD_NS Domain | RD_A IPv4 | RD_AAAA IPv6 | RD_OTH [Int] deriving (Eq, Show) - -data DNSFlags = DNSFlags { - qOrR :: QorR - , opcode :: OPCODE - , authAnswer :: Bool - , trunCation :: Bool - , recDesired :: Bool - , recAvailable :: Bool - , rcode :: RCODE - } deriving (Eq, Show) - -data DNSHeader = DNSHeader { - identifier :: Int - , flags :: DNSFlags - , qdCount :: Int - , anCount :: Int - , nsCount :: Int - , arCount :: Int - } deriving (Eq, Show) - -data DNSFormat = DNSFormat { - header :: DNSHeader - , question :: [Question] - , answer :: [ResourceRecord] - , authority :: [ResourceRecord] - , additional :: [ResourceRecord] - } deriving (Eq, Show) - -defaultQuery :: DNSFormat -defaultQuery = DNSFormat { - header = DNSHeader { - identifier = 0 - , flags = undefined - , qdCount = 0 - , anCount = 0 - , nsCount = 0 - , arCount = 0 - } - , question = [] - , answer = [] - , authority = [] - , additional = [] - } +module Network.DNS.Types ( + TYPE (..), intToType, typeToInt + , QorR (..) + , OPCODE (..) + , RCODE (..) + , Domain + , Question (qname,qtype), makeQuestion + , ResourceRecord (rrname,rrtype,rrttl,rdlen,rdata) + , RDATA (..) + , DNSFlags (qOrR,opcode,authAnswer,trunCation,recDesired,recAvailable,rcode) + , DNSHeader (identifier,flags,qdCount,anCount,nsCount,arCount) + , DNSFormat (header,question,answer,authority,additional) + ) where + +import Network.DNS.Internal -- cgit v1.2.3