resolv-0.1.0.0: src-test/Tests1.hs

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 ]
                                  ])

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


assertJust :: String -> Maybe a -> IO a
assertJust msg Nothing  = E.throwIO (T.HUnitFailure 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 ()