The server started somewhat working...

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

diff --git a/Network/DNS/Named/Responder.hs b/Network/DNS/Named/Responder.hs
index 5148f2ba74361e2885edb0158660f6f1efc59a0e..b94b7ca43a48a5c3841d026fa58bcbf2aabbda26 100644 (file)
--- a/Network/DNS/Named/Responder.hs
+++ b/Network/DNS/Named/Responder.hs
@@ -19,7 +19,7 @@ import Network.DNS.Message
 import Network.DNS.Named.Sanity
 
 
-data ResponderState qt qc
+data (QueryType qt, QueryClass qc) => ResponderState qt qc
     = ResponderState {
         rsQuestion :: !(Question qt qc)
       , rsAnswers  :: ![SomeRR]
@@ -31,13 +31,13 @@ newtype (QueryType qt, QueryClass qc) => Responder qt qc a
       }
     deriving Typeable
 
-instance (RecordType qt dt, RecordClass qc) => Monad (Responder qt qc) where
+instance (QueryType qt, QueryClass qc) => Monad (Responder qt qc) where
     return a = Responder $ \ s -> return (a, s)
     m >>= k  = Responder $ \ s -> do (a, s') <- unR m s
                                      unR (k a) s'
     fail err = Responder $ \ _ -> fail err
 
-instance (RecordType qt dt, RecordClass qc) => MonadIO (Responder qt qc) where
+instance (QueryType qt, QueryClass qc) => MonadIO (Responder qt qc) where
     liftIO m = Responder $ \ s -> do a <- m
                                      return (a, s)
 
@@ -66,16 +66,16 @@ runResponder' q (SomeResponder r)
         Just m
             -> runResponder q m
 
-getQuestion :: (RecordType qt dt, RecordClass qc) => Responder qt qc (Question qt qc)
+getQuestion :: (QueryType qt, QueryClass qc) => Responder qt qc (Question qt qc)
 getQuestion = Responder $ \ s ->
               return (rsQuestion s, s)
 
-getQueryName :: (RecordType qt dt, RecordClass qc) => Responder qt qc DomainName
+getQueryName :: (QueryType qt, QueryClass qc) => Responder qt qc DomainName
 getQueryName = liftM qName getQuestion
 
 respond :: ( SaneAnswerType qt at, SaneAnswerClass qc ac
            , QueryType qt, RecordType at dt
-           , RecordClass qc, RecordClass ac
+           , QueryClass qc, RecordClass ac
            ) =>
            ResourceRecord at ac dt
         -> Responder qt qc ()
@@ -89,7 +89,7 @@ respond rr
 data SomeResponder
     = forall qt qc. (Typeable qt, Typeable qc) => SomeResponder (Responder qt qc ())
 
-wrapResponder :: (RecordType qt dt, RecordClass qc) =>
+wrapResponder :: (QueryType qt, QueryClass qc) =>
                  Responder qt qc a
               -> SomeResponder
 wrapResponder m