Farewell to the Sanity.hs

[haskell-dns.git] / Network / DNS / Named / ResponseBuilder.hs

diff --git a/Network/DNS/Named/ResponseBuilder.hs b/Network/DNS/Named/ResponseBuilder.hs
index 487a6786bd7240c9c933e8e1dcc309366f4b9781..4f08c401f2d6ea1b0627eae1eedadab5b013e7c1 100644 (file)
--- a/Network/DNS/Named/ResponseBuilder.hs
+++ b/Network/DNS/Named/ResponseBuilder.hs
@@ -4,6 +4,7 @@ module Network.DNS.Named.ResponseBuilder
     , runBuilder
 
     , unauthorise
+    , setResponseCode
     , addAnswer
     , addAuthority
     , addAdditional
@@ -39,7 +40,14 @@ runBuilder query builder
                                 , hdIsRecursionAvailable  = False
                                 , hdResponseCode          = NoError
                                 }
-          (_, result)  = unB (modHeader' >> builder) initialReply
+          setNameError = do aa   <- get (hdIsRecursionAvailable . msgHeader)
+                            rc   <- get (hdResponseCode . msgHeader)
+                            anss <- get msgAnswers
+
+                            when (aa && rc == NoError && null anss)
+                                $ setResponseCode NameError
+
+          (_, result)  = unB (modHeader' >> builder >> setNameError) initialReply
       in
         result
 
@@ -79,3 +87,7 @@ addAdditional rr
 
 unauthorise :: Builder ()
 unauthorise = modifyHeader (\ h -> h { hdIsAuthoritativeAnswer = False })
+
+setResponseCode :: ResponseCode -> Builder ()
+setResponseCode code
+    = modifyHeader (\ h -> h { hdResponseCode = code })