Some utilities to work with dns package

dnsutils.hs

resolveA :: DNSCache -> String -> IO (Either T.Text HostAddress)
resolveA c d =
    handle Left $ checkDomain id d $ fmap errorStr $ resolve c (B.pack d)

resolveCachedA :: DNSCache -> String -> IO (Maybe (Either T.Text HostAddress))
resolveCachedA c d =
    handle (Just . Left) $ checkDomain Just d $ fmap (fmap errorStr) $ resolveCache c (B.pack d)

handle f a = a `E.catch` handleError f

handleError :: (T.Text -> a) -> E.SomeException -> IO a
handleError f e = return $ f $ T.concat ["Exception (badly configured or non-working local BIND?): ", T.pack (show e)]

checkDomain f domain act
    | any (`elem` (":/" :: [Char])) domain =
        return $ f $ Left "Invalid domain name"
    | length domain > 253 = return $ f $ Left "Domain name too long"
    | any (\ t -> T.length t > 63) (T.split (== '.') $ T.pack domain) =
        return $ f $ Left "Domain name or component too long"
    | any (\ t -> T.length t == 0) (T.split (== '.') $ T.pack domain) =
        return $ f $ Left "Illegal domain name (empty label)"
    | isIPAddr domain = return $ f $ Right $ ipToWord32 domain
    | otherwise = act

isIPAddr :: HostName -> Bool
isIPAddr hn = length groups == 4 && all ip groups
    where groups = T.split (== '.') $ T.pack hn
          ip x = T.length x <= 3 && T.length x > 0 &&
                 T.all (\ e -> e >= '0' && e <= '9') x &&
                 read (T.unpack x) <= (255 :: Int)

ipToWord32 :: String -> HostAddress
ipToWord32 = toHostAddress . read

errorStr (Left e) = Left $ case e of
    SequenceNumberMismatch -> "Sequence number mismatch?"
    TimeoutExpired -> "Timeout"
    UnexpectedRDATA -> "Unexpected RDATA (no domain found?)"
    IllegalDomain -> "Illegal domain name"
    FormatError -> "Name server was unable to interpret the query"
    ServerFailure -> "Name server returned failure"
    NameError -> "No such domain"
    NotImplemented -> "Not implemented (name server failuer)"
    OperationRefused -> "Name server refused operaion"
    BadOptRecord -> "Bad OPT record"
    RetryLimitExceeded -> "Retry limit exceeded"
errorStr (Right x) = Right $ case x of
    Hit a -> a
    Resolved a -> a
    Numeric a -> a