diff --git a/Network/DNS/Lookup.hs b/Network/DNS/Lookup.hs --- a/Network/DNS/Lookup.hs +++ b/Network/DNS/Lookup.hs @@ -5,6 +5,7 @@ module Network.DNS.Lookup ( lookupA, lookupAAAA , lookupMX, lookupAviaMX, lookupAAAAviaMX + , lookupNS , lookupTXT , lookupPTR , lookupSRV @@ -72,6 +73,18 @@ check as = case as of [] -> Nothing ass -> Just (concat ass) + +---------------------------------------------------------------- + +{-| + Resolving 'Domain' by 'NS'. +-} +lookupNS :: Resolver -> Domain -> IO (Maybe [Domain]) +lookupNS rlv dom = toNS <$> DNS.lookup rlv dom NS + where + toNS = fmap (map unTag) + unTag (RD_NS dm) = dm + unTag _ = error "lookupNS" ---------------------------------------------------------------- diff --git a/Test.hs b/Test.hs deleted file mode 100644 --- a/Test.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE OverloadedStrings, TemplateHaskell #-} - -module Test where - -import qualified Data.ByteString.Char8 as BS -import Data.List -import Network.DNS as DNS -import Test.Framework.Providers.HUnit -import Test.Framework.TH.Prime -import Test.HUnit - ----------------------------------------------------------------- - -main :: IO () -main = $(defaultMainGenerator) - ----------------------------------------------------------------- - -(?=) :: (Eq a, Show a) => IO a -> a -> IO () -a ?= b = a >>= (@?= b) - -case_lookupA :: Assertion -case_lookupA = do - rs <- makeResolvSeed defaultResolvConf - withResolver rs $ \resolver -> - DNS.lookupA resolver "www.mew.org" ?= Just ["202.232.15.101"] - -(??=) :: (Ord a, Show a) => IO (Maybe [a]) -> [a] -> Assertion -a ??= bs = do - mas <- a - case mas of - Nothing -> False @? "should be Nothing" - Just as -> sort as @?= sort bs - -case_lookupAAAA :: Assertion -case_lookupAAAA = do - rs <- makeResolvSeed defaultResolvConf - withResolver rs $ \resolver -> do - DNS.lookupAAAA resolver "mew.org" ?= Nothing - DNS.lookupAAAA resolver "www.mew.org" ?= Just ["2001:240:11e:c00::101"] - -case_lookupTXT :: Assertion -case_lookupTXT = do - rs <- makeResolvSeed defaultResolvConf - withResolver rs $ \resolver -> - DNS.lookupTXT resolver "mew.org" ?= Just ["v=spf1 +mx -all"] - -case_lookupAviaMX :: Assertion -case_lookupAviaMX = do - rs <- makeResolvSeed defaultResolvConf - withResolver rs $ \resolver -> - DNS.lookupAviaMX resolver "mixi.jp" ??= ["202.32.29.4", "202.32.29.5"] - -case_lookupAviaCNAME :: Assertion -case_lookupAviaCNAME = do - rs <- makeResolvSeed defaultResolvConf - withResolver rs $ \resolver -> - DNS.lookupA resolver "ghs.google.com" ??= ["72.14.203.121"] - -case_lookupPTR :: Assertion -case_lookupPTR = do - rs <- makeResolvSeed defaultResolvConf - withResolver rs $ \resolver -> - DNS.lookupPTR resolver rev ?= Just ["www-v4.iij.ad.jp."] - where - target = "210.130.137.80" - rev = BS.intercalate "." (reverse (BS.split '.' target)) - `BS.append` ".in-addr.arpa" - -case_lookupSRV :: Assertion -case_lookupSRV = do - rs <- makeResolvSeed defaultResolvConf - withResolver rs $ \resolver -> - DNS.lookupSRV resolver "_sip._tcp.cisco.com" ?= Just [(1,0,5060,"vcsgw.cisco.com.")] diff --git a/TestProtocol.hs b/TestProtocol.hs deleted file mode 100644 --- a/TestProtocol.hs +++ /dev/null @@ -1,160 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module TestProtocol where - -import Data.IP -import Network.DNS -import Network.DNS.Internal -import Test.Framework (defaultMain, testGroup, Test) -import Test.Framework.Providers.HUnit -import Test.HUnit hiding (Test) - -tests :: [Test] -tests = - [ testGroup "Test case" - [ testCase "QueryA" (test_Format testQueryA) - , testCase "QueryAAAA" (test_Format testQueryAAAA) - , testCase "ResponseA" (test_Format testResponseA) - ] - ] - -defaultHeader :: DNSHeader -defaultHeader = header defaultQuery - -testQueryA :: DNSFormat -testQueryA = defaultQuery - { header = defaultHeader - { identifier = 1000 - , qdCount = 1 - } - , question = [makeQuestion "www.mew.org." A] - } - -testQueryAAAA :: DNSFormat -testQueryAAAA = defaultQuery - { header = defaultHeader - { identifier = 1000 - , qdCount = 1 - } - , question = [makeQuestion "www.mew.org." AAAA] - } - -testResponseA :: DNSFormat -testResponseA = DNSFormat { header = DNSHeader { identifier = 61046 - , flags = DNSFlags { qOrR = QR_Response - , opcode = OP_STD - , authAnswer = False - , trunCation = False - , recDesired = True - , recAvailable = True - , rcode = NoErr - } - , qdCount = 1 - , anCount = 8 - , nsCount = 2 - , arCount = 4 - } - , question = [Question {qname = "492056364.qzone.qq.com.", qtype = A}] - , answer = [ ResourceRecord { rrname = "492056364.qzone.qq.com." - , rrtype = A - , rrttl = 568 - , rdlen = 4 - , rdata = RD_A $ toIPv4 [119, 147, 15, 122] - } - , ResourceRecord { rrname = "492056364.qzone.qq.com." - , rrtype = A - , rrttl = 568 - , rdlen = 4 - , rdata = RD_A $ toIPv4 [119, 147, 79, 106] - } - , ResourceRecord { rrname = "492056364.qzone.qq.com." - , rrtype = A - , rrttl = 568 - , rdlen = 4 - , rdata = RD_A $ toIPv4 [183, 60, 55, 43] - } - , ResourceRecord { rrname = "492056364.qzone.qq.com." - , rrtype = A - , rrttl = 568 - , rdlen = 4 - , rdata = RD_A $ toIPv4 [183, 60, 55, 107] - } - , ResourceRecord { rrname = "492056364.qzone.qq.com." - , rrtype = A - , rrttl = 568 - , rdlen = 4 - , rdata = RD_A $ toIPv4 [113, 108, 7, 172] - } - , ResourceRecord { rrname = "492056364.qzone.qq.com." - , rrtype = A - , rrttl = 568 - , rdlen = 4 - , rdata = RD_A $ toIPv4 [113, 108, 7, 174] - } - , ResourceRecord { rrname = "492056364.qzone.qq.com." - , rrtype = A - , rrttl = 568 - , rdlen = 4 - , rdata = RD_A $ toIPv4 [113, 108, 7, 175] - } - , ResourceRecord { rrname = "492056364.qzone.qq.com." - , rrtype = A - , rrttl = 568 - , rdlen = 4 - , rdata = RD_A $ toIPv4 [119, 147, 15, 100] - } - ] - , authority = [ ResourceRecord { rrname = "qzone.qq.com." - , rrtype = NS - , rrttl = 45919 - , rdlen = 10 - , rdata = RD_NS "ns-tel2.qq.com." - } - , ResourceRecord { rrname = "qzone.qq.com." - , rrtype = NS - , rrttl = 45919 - , rdlen = 10 - , rdata = RD_NS "ns-tel1.qq.com." - } - ] - , additional = [ ResourceRecord { rrname = "ns-tel1.qq.com." - , rrtype = A - , rrttl = 46520 - , rdlen = 4 - , rdata = RD_A $ toIPv4 [121, 14, 73, 115] - } - , ResourceRecord { rrname = "ns-tel2.qq.com." - , rrtype = A - , rrttl = 2890 - , rdlen = 4 - , rdata = RD_A $ toIPv4 [222, 73, 76, 226] - } - , ResourceRecord { rrname = "ns-tel2.qq.com." - , rrtype = A - , rrttl = 2890 - , rdlen = 4 - , rdata = RD_A $ toIPv4 [183, 60, 3, 202] - } - , ResourceRecord { rrname = "ns-tel2.qq.com." - , rrtype = A - , rrttl = 2890 - , rdlen = 4 - , rdata = RD_A $ toIPv4 [218, 30, 72, 180] - } - ] - } - -assertEither :: (a -> String) -> Either a b -> IO () -assertEither f = either (assertFailure . f) (const $ return ()) - -test_Format :: DNSFormat -> IO () -test_Format fmt = do - assertEither id result - let (Right fmt') = result - assertEqual "fail" fmt fmt' - where - bs = encode fmt - result = decode bs - -main :: IO () -main = defaultMain tests diff --git a/dns.cabal b/dns.cabal --- a/dns.cabal +++ b/dns.cabal @@ -1,5 +1,5 @@ Name: dns -Version: 0.3.6 +Version: 0.3.7 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -7,10 +7,11 @@ Synopsis: DNS library in Haskell Description: DNS library for clients and servers. Category: Network -Cabal-Version: >= 1.6 +Cabal-Version: >= 1.10 Build-Type: Simple -Extra-Source-Files: Test.hs, TestProtocol.hs -library + +Library + Default-Language: Haskell2010 GHC-Options: -Wall Exposed-Modules: Network.DNS Network.DNS.Lookup @@ -49,6 +50,31 @@ , network-bytestring , network-conduit , random + +Test-Suite spec + Type: exitcode-stdio-1.0 + Default-Language: Haskell2010 + Hs-Source-Dirs: test, . + Ghc-Options: -Wall + Main-Is: Spec.hs + Other-Modules: EncodeSpec + LookupSpec + Build-Depends: base + , attoparsec + , attoparsec-conduit + , binary + , blaze-builder + , bytestring + , conduit >= 0.5 + , containers + , dns + , hspec + , iproute >= 1.2.4 + , mtl + , network >= 2.3 + , network-conduit + , random + Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/dns.git diff --git a/test/EncodeSpec.hs b/test/EncodeSpec.hs new file mode 100644 --- /dev/null +++ b/test/EncodeSpec.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE OverloadedStrings #-} + +module EncodeSpec where + +import Data.IP +import Network.DNS +import Network.DNS.Internal (defaultQuery, makeQuestion) +import Test.Hspec + +spec :: Spec +spec = do + describe "encode" $ do + it "encodes DNSFormat correctly" $ do + check1 testQueryA + check1 testQueryAAAA + check1 testResponseA + + describe "decode" $ do + it "decodes DNSFormat correctly" $ do + check2 testQueryA + check2 testQueryAAAA + check2 testResponseA + +check1 :: DNSFormat -> Expectation +check1 inp = out `shouldBe` Right inp + where + bs = encode inp + out = decode bs + +check2 :: DNSFormat -> Expectation +check2 inp = bs' `shouldBe` bs + where + bs = encode inp + Right out = decode bs + bs' = encode out + +defaultHeader :: DNSHeader +defaultHeader = header defaultQuery + +testQueryA :: DNSFormat +testQueryA = defaultQuery { + header = defaultHeader { + identifier = 1000 + , qdCount = 1 + } + , question = [makeQuestion "www.mew.org." A] + } + +testQueryAAAA :: DNSFormat +testQueryAAAA = defaultQuery { + header = defaultHeader { + identifier = 1000 + , qdCount = 1 + } + , question = [makeQuestion "www.mew.org." AAAA] + } + +testResponseA :: DNSFormat +testResponseA = DNSFormat { + header = DNSHeader { + identifier = 61046 + , flags = DNSFlags { + qOrR = QR_Response + , opcode = OP_STD + , authAnswer = False + , trunCation = False + , recDesired = True + , recAvailable = True + , rcode = NoErr + } + , qdCount = 1 + , anCount = 8 + , nsCount = 2 + , arCount = 4 + } + , question = [Question { + qname = "492056364.qzone.qq.com." + , qtype = A + } + ] + , answer = [ResourceRecord { + rrname = "492056364.qzone.qq.com." + , rrtype = A + , rrttl = 568 + , rdlen = 4 + , rdata = RD_A $ toIPv4 [119, 147, 15, 122] + } + , ResourceRecord { + rrname = "492056364.qzone.qq.com." + , rrtype = A + , rrttl = 568 + , rdlen = 4 + , rdata = RD_A $ toIPv4 [119, 147, 79, 106] + } + , ResourceRecord { + rrname = "492056364.qzone.qq.com." + , rrtype = A + , rrttl = 568 + , rdlen = 4 + , rdata = RD_A $ toIPv4 [183, 60, 55, 43] + } + , ResourceRecord { + rrname = "492056364.qzone.qq.com." + , rrtype = A + , rrttl = 568 + , rdlen = 4 + , rdata = RD_A $ toIPv4 [183, 60, 55, 107] + } + , ResourceRecord { + rrname = "492056364.qzone.qq.com." + , rrtype = A + , rrttl = 568 + , rdlen = 4 + , rdata = RD_A $ toIPv4 [113, 108, 7, 172] + } + , ResourceRecord { + rrname = "492056364.qzone.qq.com." + , rrtype = A + , rrttl = 568 + , rdlen = 4 + , rdata = RD_A $ toIPv4 [113, 108, 7, 174] + } + , ResourceRecord { + rrname = "492056364.qzone.qq.com." + , rrtype = A + , rrttl = 568 + , rdlen = 4 + , rdata = RD_A $ toIPv4 [113, 108, 7, 175] + } + , ResourceRecord { + rrname = "492056364.qzone.qq.com." + , rrtype = A + , rrttl = 568 + , rdlen = 4 + , rdata = RD_A $ toIPv4 [119, 147, 15, 100] + } + ] + , authority = [ ResourceRecord { + rrname = "qzone.qq.com." + , rrtype = NS + , rrttl = 45919 + , rdlen = 10 + , rdata = RD_NS "ns-tel2.qq.com." + } + , ResourceRecord { + rrname = "qzone.qq.com." + , rrtype = NS + , rrttl = 45919 + , rdlen = 10 + , rdata = RD_NS "ns-tel1.qq.com." + } + ] + , additional = [ ResourceRecord { + rrname = "ns-tel1.qq.com." + , rrtype = A + , rrttl = 46520 + , rdlen = 4 + , rdata = RD_A $ toIPv4 [121, 14, 73, 115] + } + , ResourceRecord { + rrname = "ns-tel2.qq.com." + , rrtype = A + , rrttl = 2890 + , rdlen = 4 + , rdata = RD_A $ toIPv4 [222, 73, 76, 226] + } + , ResourceRecord { + rrname = "ns-tel2.qq.com." + , rrtype = A + , rrttl = 2890 + , rdlen = 4 + , rdata = RD_A $ toIPv4 [183, 60, 3, 202] + } + , ResourceRecord { + rrname = "ns-tel2.qq.com." + , rrtype = A + , rrttl = 2890 + , rdlen = 4 + , rdata = RD_A $ toIPv4 [218, 30, 72, 180] + } + ] + } diff --git a/test/LookupSpec.hs b/test/LookupSpec.hs new file mode 100644 --- /dev/null +++ b/test/LookupSpec.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} + +module LookupSpec where + +import Control.Applicative +import qualified Data.ByteString.Char8 as BS +import Data.List +import Network.DNS as DNS +import Test.Hspec + +spec :: Spec +spec = do + describe "lookupA" $ do + it "gets IPv4 addresses" $ do + rs <- makeResolvSeed defaultResolvConf + withResolver rs $ \resolver -> + DNS.lookupA resolver "www.mew.org" `shouldReturn` Just ["202.232.15.101"] + + it "gets IPv4 addresses via CNAME" $ do + rs <- makeResolvSeed defaultResolvConf + withResolver rs $ \resolver -> + DNS.lookupA resolver "www.kame.net" `shouldReturn` Just ["203.178.141.194"] + + describe "lookupAAAA" $ do + it "gets IPv6 addresses" $ do + rs <- makeResolvSeed defaultResolvConf + withResolver rs $ \resolver -> do + DNS.lookupAAAA resolver "mew.org" `shouldReturn` Nothing + DNS.lookupAAAA resolver "www.mew.org" `shouldReturn` Just ["2001:240:11e:c00::101"] + + describe "lookupNS" $ do + it "gets NS" $ do + rs <- makeResolvSeed defaultResolvConf + withResolver rs $ \resolver -> do + actual <- DNS.lookupNS resolver "mew.org" + let expected = Just ["ns1.mew.org.", "ns2.mew.org."] + -- The order of NS records is variable, so we sort the + -- result. + sort <$> actual `shouldBe` expected + + describe "lookupTXT" $ do + it "gets TXT" $ do + rs <- makeResolvSeed defaultResolvConf + withResolver rs $ \resolver -> + DNS.lookupTXT resolver "mew.org" `shouldReturn` Just ["v=spf1 +mx -all"] + + describe "lookupAviaMX" $ do + it "gets IPv4 addresses via MX" $ do + rs <- makeResolvSeed defaultResolvConf + withResolver rs $ \resolver -> do + as <- DNS.lookupAviaMX resolver "mixi.jp" + sort <$> as `shouldBe` Just ["202.32.29.4", "202.32.29.5"] + + describe "lookupPTR" $ do + it "gets PTR" $ do + rs <- makeResolvSeed defaultResolvConf + withResolver rs $ \resolver -> do + let target = "210.130.137.80" + rev = BS.intercalate "." (reverse (BS.split '.' target)) + `BS.append` ".in-addr.arpa" + DNS.lookupPTR resolver rev `shouldReturn` Just ["www-v4.iij.ad.jp."] + + describe "lookupSRV" $ do + it "gets SRV" $ do + rs <- makeResolvSeed defaultResolvConf + withResolver rs $ \resolver -> + DNS.lookupSRV resolver "_sip._tcp.cisco.com" `shouldReturn` Just [(1,0,5060,"vcsgw.cisco.com.")] diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}