X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=haskell-dns.git;a=blobdiff_plain;f=Network%2FDNS%2FNamed%2FResponseBuilder.hs;fp=Network%2FDNS%2FNamed%2FResponseBuilder.hs;h=4f08c401f2d6ea1b0627eae1eedadab5b013e7c1;hp=487a6786bd7240c9c933e8e1dcc309366f4b9781;hb=957d3f466cea2fa642f67f477ec4ad9a0d535a9b;hpb=68e58e5c4aaf0279f041c251e73e4aaccf616286

diff --git a/Network/DNS/Named/ResponseBuilder.hs b/Network/DNS/Named/ResponseBuilder.hs
index 487a678..4f08c40 100644
--- 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 })