concurrent-dns-cache-0.1.4: test/CacheSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module CacheSpec where

import Control.Concurrent.Async (concurrently)
import Network.DNS hiding (lookup)
import Network.DNS.Cache
import Prelude hiding (lookup)
import qualified Control.Exception as E
import qualified Network.Socket as N
import System.Timeout (timeout)
import Test.Hspec

cacheConf :: DNSCacheConf
cacheConf = DNSCacheConf {
    resolvConfs    = [
         defaultResolvConf { resolvInfo = RCHostName "8.8.8.8" }
       , defaultResolvConf { resolvInfo = RCHostName "8.8.4.4" }
       ]
  , maxConcurrency = 10
  , minTTL         = 60
  , maxTTL         = 300
  , negativeTTL    = 300
  }

-- A resolver which never answers.
silentConf :: N.PortNumber -> DNSCacheConf
silentConf port = cacheConf {
    resolvConfs = [ defaultResolvConf { resolvInfo = RCHostPort "127.0.0.1" port
                                      , resolvTimeout = 200000
                                      , resolvRetry = 1 } ]
  }

withSilentServer :: (N.PortNumber -> IO a) -> IO a
withSilentServer body = E.bracket open N.close $ \sk -> do
    N.SockAddrInet port _ <- N.getSocketName sk
    body port
  where
    open = do
        sk <- N.socket N.AF_INET N.Datagram N.defaultProtocol
        N.bind sk (N.SockAddrInet 0 (N.tupleToHostAddress (127,0,0,1)))
        return sk

spec :: Spec
spec = describe "withDnsCache" $ do
    it "parses numeric IPv4 addresses strictly" $ withDNSCache cacheConf $ \cache -> do
        resolveCache cache "1.2.3.4" `shouldReturn` Just (Right (Numeric 67305985))
        resolveCache cache "1..2.3" `shouldReturn` Nothing
        resolveCache cache "1.2.3." `shouldReturn` Nothing
        resolveCache cache "010.1.1.1" `shouldReturn` Nothing
    it "does not block after an interrupted resolution" $ withSilentServer $ \port ->
      withDNSCache (silentConf port) $ \cache -> do
        let dom = "www.example.com"
        _ <- timeout 50000 $ resolve cache dom
        r <- timeout 3000000 $ resolve cache dom
        r `shouldSatisfy` maybe False (const True)
    it "resolves domains and caches addresses" $ withDNSCache cacheConf $ \cache -> do
        let dom = "www.example.com"
            addr = 584628317
        resolve      cache dom `shouldReturn` Right (Resolved addr)
        resolveCache cache dom `shouldReturn` Just (Right (Hit addr))
        lookupCache  cache dom `shouldReturn` Just addr
        lookup       cache dom `shouldReturn` Just addr
    it "resolves domains and caches nagative" $ withDNSCache cacheConf $ \cache -> do
        let dom = "not-exist.com"
            err = UnexpectedRDATA
        resolve      cache dom `shouldReturn` Left err
        resolveCache cache dom `shouldReturn` Just (Left err)
        lookupCache  cache dom `shouldReturn` Nothing
        lookup       cache dom `shouldReturn` Nothing
    it "resolves domains and caches nagative" $ withDNSCache cacheConf $ \cache -> do
        let dom = "non-exist.org"
            err = NameError
        resolve      cache dom `shouldReturn` Left err
        resolveCache cache dom `shouldReturn` Just (Left err)
        lookupCache  cache dom `shouldReturn` Nothing
        lookup       cache dom `shouldReturn` Nothing
    it "waits for another query for the same domain" $ withDNSCache cacheConf $ \cache -> do
        let dom = "www.example.com"
            addr = 584628317
        (res1,res2) <- concurrently (resolve cache dom) (resolve cache dom)
        [res1,res2] `shouldContain` [Right (Resolved addr),Right (Hit addr)]
    it "just returns IP address" $ withDNSCache cacheConf $ \cache -> do
        let dom = "192.0.2.1"
            addr = 16908480
        resolve      cache dom `shouldReturn` Right (Numeric addr)