X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FDNS%2FNamed%2FResponseBuilder.hs;h=5201ce3e22ff4ba4e87edbf99d3dff1c66fc6f5b;hb=d19ee92905c9bf32fb53c9cc0841537c7b92901c;hp=487a6786bd7240c9c933e8e1dcc309366f4b9781;hpb=5015e5caa39e015e6ffa28a87fc5f189e7ba3c71;p=haskell-dns.git

diff --git a/Network/DNS/Named/ResponseBuilder.hs b/Network/DNS/Named/ResponseBuilder.hs
index 487a678..5201ce3 100644
--- a/Network/DNS/Named/ResponseBuilder.hs
+++ b/Network/DNS/Named/ResponseBuilder.hs
@@ -4,7 +4,9 @@ module Network.DNS.Named.ResponseBuilder
     , runBuilder
 
     , unauthorise
+    , setResponseCode
     , addAnswer
+    , addAnswerNonuniquely
     , addAuthority
     , addAdditional
     )
@@ -39,7 +41,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
 
@@ -60,6 +69,11 @@ addAnswer rr
              $ modify $ \ s ->
                  s { msgAnswers = msgAnswers s ++ [rr] }
 
+addAnswerNonuniquely :: SomeRR -> Builder ()
+addAnswerNonuniquely rr
+    = modify $ \ s ->
+      s { msgAnswers = msgAnswers s ++ [rr] }
+
 addAuthority :: SomeRR -> Builder ()
 addAuthority rr
     = do anss <- get msgAnswers
@@ -79,3 +93,7 @@ addAdditional rr
 
 unauthorise :: Builder ()
 unauthorise = modifyHeader (\ h -> h { hdIsAuthoritativeAnswer = False })
+
+setResponseCode :: ResponseCode -> Builder ()
+setResponseCode code
+    = modifyHeader (\ h -> h { hdResponseCode = code })