1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Applicative as A
import qualified Control.Exception as E
import Control.Monad
import qualified Data.ByteString as BS
import System.Directory (getDirectoryContents, removeFile)
import System.FilePath (dropExtension, takeExtension, (<.>),
(</>))
import qualified Test.Tasty as T
import qualified Test.Tasty.HUnit as T
import qualified Network.DNS as DNS
main :: IO ()
main = do
msgfiles <- filter ((== ".bin") . takeExtension) <$> getDirectoryContents "testdata/msg"
let tests1 = [ msgFileTest1 (dropExtension fn) | fn <- msgfiles ]
tests2 = [ msgFileTest2 (dropExtension fn) | fn <- msgfiles ]
T.defaultMain (T.testGroup "" [ T.testGroup "decode" tests1
, T.testGroup "enc/dec" tests2
, T.testGroup "Type/TypeSym"
[ testTypeToFromSym1, testTypeToFromSym2 ]
, T.testGroup "mkQueryRaw" [ mkQueryRawText1 ]
])
testTypeToFromSym1 :: T.TestTree
testTypeToFromSym1 = T.testCase "testTypeToFromSym1" $ do
forM_ [minBound..maxBound] $ \sym -> do
T.assertEqual "" (Just sym) (DNS.typeToSym . DNS.typeFromSym $ sym)
testTypeToFromSym2 :: T.TestTree
testTypeToFromSym2 = T.testCase "testTypeToFromSym2" $ do
forM_ (map DNS.Type [minBound..maxBound]) $ \ty ->
case DNS.typeToSym ty of
Nothing -> pure ()
Just sym -> T.assertEqual "" (DNS.typeFromSym sym) ty
msgFileTest1 :: FilePath -> T.TestTree
msgFileTest1 fn = T.testCase fn $ do
bs <- BS.readFile ("testdata" </> "msg" </> fn <.> "bin")
msg1 <- assertJust "failed to decode message" $ DNS.decodeMessage bs
-- load reference value
let refFn = "testdata" </> "msg" </> fn <.> "show"
writeFile (refFn ++ "~") (show (msg1 :: DNS.Msg DNS.Name))
msg0 <- read <$> readFile refFn
assertEqShow (pure ()) msg0 msg1
removeFile (refFn ++ "~")
msgFileTest2 :: FilePath -> T.TestTree
msgFileTest2 fn = T.testCase fn $ do
-- use this as reference message
bs <- BS.readFile ("testdata" </> "msg" </> fn <.> "bin")
msg0 <- assertJust "failed to decode stored message" $ DNS.decodeMessage bs
-- print msg0
-- encode it now again
let Just msg0bin = DNS.encodeMessage (msg0 :: DNS.Msg DNS.Labels)
msg1 <- assertJust "failed to decode re-encoded message" $ DNS.decodeMessage msg0bin
assertEqShow (pure ()) msg0 msg1
mkQueryRawText1 :: T.TestTree
mkQueryRawText1 = T.testCase "mkQueryRawText1" $ do
msgraw <- DNS.mkQueryRaw DNS.classIN (DNS.Name "www.google.com") (DNS.typeFromSym DNS.TypeA)
let Just msg = DNS.decodeMessage msgraw
assertEqShow (pure ()) (head (DNS.msgQD msg)) (DNS.MsgQuestion (DNS.Name "www.google.com.") (DNS.Type 1) (DNS.Class 1))
assertJust :: String -> Maybe a -> IO a
assertJust msg Nothing = T.assertFailure msg
assertJust _ (Just v) = A.pure v
assertEqShow :: Show a => IO () -> a -> a -> T.Assertion
assertEqShow onFail ref cur
| show ref /= show cur = do
onFail
T.assertFailure ("expected: " ++ show ref ++ "\n but got: " ++ show cur)
| otherwise = A.pure ()
|
