From ee8d2b9c69dd7dd4d47e5d88f47150770a15129a Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Mon, 24 Oct 2011 15:57:04 +0900
Subject: Supporting server side and brushing up.

---
 SimpleServer.hs | 31 +++++++++++++------------------
 1 file changed, 13 insertions(+), 18 deletions(-)

(limited to 'SimpleServer.hs')

diff --git a/SimpleServer.hs b/SimpleServer.hs
index 401e7f4..8e12a29 100644
--- a/SimpleServer.hs
+++ b/SimpleServer.hs
@@ -1,23 +1,20 @@
 {-# LANGUAGE RecordWildCards, OverloadedStrings #-}
 
-import System.Environment
-import Debug.Trace
-import Control.Monad
-import Control.Concurrent
 import Control.Applicative
-import Data.Monoid
-import Data.Maybe
+import Control.Concurrent
+import Control.Monad
 import qualified Data.ByteString as S
 import Data.ByteString.Lazy hiding (putStrLn, filter, length)
-import System.Timeout
+import Data.Default
+import Data.Maybe
+import Data.Monoid
+import Debug.Trace
 import Network.BSD
 import Network.DNS hiding (lookup)
-import Network.DNS.Response
-import Network.DNS.Query
 import Network.Socket hiding (recvFrom)
 import Network.Socket.ByteString
-import Network.Socket.Enumerator
-import Data.Default
+import System.Environment
+import System.Timeout
 
 data Conf = Conf {
     bufSize :: Int
@@ -42,11 +39,9 @@ proxyRequest :: Conf -> ResolvConf -> DNSFormat -> IO (Maybe DNSFormat)
 proxyRequest Conf{..} rc req = do
     let
       worker Resolver{..} = do
-        let packet = mconcat . toChunks $ composeDNSFormat req
+        let packet = mconcat . toChunks $ encode req
         sendAll dnsSock packet
-        let responseEnum = enumSocket dnsBufsize dnsSock
-        parseResponse responseEnum responseIter
-
+        receive dnsSock dnsBufsize
     rs <- makeResolvSeed rc
     withResolver rs $ \r ->
         (>>= check) <$> timeout' "proxy timeout" timeOut (worker r)
@@ -76,7 +71,7 @@ handleRequest conf rc req = maybe (proxyRequest conf rc req) (trace "return A re
             ]
 
 handlePacket :: Conf -> Socket -> SockAddr -> S.ByteString -> IO ()
-handlePacket conf@Conf{..} sock addr bs = case runDNSFormat_ (fromChunks [bs]) of
+handlePacket conf@Conf{..} sock addr bs = case decode (fromChunks [bs]) of
     Right req -> do
         print req
         let rc = defaultResolvConf { resolvInfo = RCHostName realDNS }
@@ -84,7 +79,7 @@ handlePacket conf@Conf{..} sock addr bs = case runDNSFormat_ (fromChunks [bs]) o
         print mrsp
         case mrsp of
             Just rsp ->
-                let packet = mconcat . toChunks $ composeDNSFormat rsp
+                let packet = mconcat . toChunks $ encode rsp
                 in  timeout' "send timeout" timeOut (sendAllTo sock packet addr) >>
                     print (S.length packet) >>
                     return ()
@@ -95,7 +90,7 @@ main :: IO ()
 main = withSocketsDo $ do
     dns <- fromMaybe (realDNS def) . listToMaybe <$> getArgs
     let conf = def { realDNS=dns }
-    addrinfos <- getAddrInfo 
+    addrinfos <- getAddrInfo
                    (Just (defaultHints {addrFlags = [AI_PASSIVE]}))
                    Nothing (Just "domain")
     addrinfo <- maybe (fail "no addr info") return (listToMaybe addrinfos)
-- 
cgit v1.2.3