diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Zesen Qian (c) 2016
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Zesen Qian nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/resolve.cabal b/resolve.cabal
new file mode 100644
--- /dev/null
+++ b/resolve.cabal
@@ -0,0 +1,60 @@
+name:                resolve
+version:             0.1.0.0
+synopsis:            A name resolusion library
+description:         Please see README.org
+homepage:            https://github.com/riaqn/resolve#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Zesen Qian
+maintainer:          haskell@riaqn.org
+copyright:           GPL3
+category:            Network
+build-type:          Simple
+-- extra-source-files:
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     Resolve.Types
+                     , Resolve.Timeout
+                     , Resolve.Retry
+                     , Resolve.Log
+                     , Resolve.DNS.TCP
+                     , Resolve.DNS.UDP
+                     , Resolve.DNS.Truncation
+                     , Resolve.DNS.LiveTCP
+                     , Resolve.DNS.Channel
+                     , Resolve.DNS.Decode
+                     , Resolve.DNS.Encode
+                     , Resolve.DNS.Types
+                     , Resolve.DNS.Helper.TCP
+                     , Resolve.DNS.Helper.UDP
+                     , Resolve.DNS.Helper.LiveTCP
+                     , Resolve.DNS.Helper.DNS
+                     , Resolve.DNS.Server.UDP
+                     , Resolve.DNS.Server.TCP
+                     , Resolve.DNS.Server.Types
+  build-depends:       base >= 4.7 && < 5
+                     , bytestring
+                     , attoparsec
+                     , attoparsec-binary
+                     , transformers
+                     , bv
+                     , hashmap
+                     , hashable
+                     , network
+                     , stm
+                     , stm-containers
+                     , parsec
+                     , hslogger
+                     , iproute
+  default-language:    Haskell2010
+  default-extensions:  BinaryLiterals
+                     , MultiParamTypeClasses
+                     , FunctionalDependencies
+                     , FlexibleInstances
+                     , GADTs
+                     
+source-repository head
+  type:     git
+  location: https://github.com/riaqn/resolve
diff --git a/src/Resolve/DNS/Channel.hs b/src/Resolve/DNS/Channel.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/Channel.hs
@@ -0,0 +1,152 @@
+{-# LANGUAGE Unsafe #-}
+module Resolve.DNS.Channel where
+
+import qualified Resolve.Types as T
+import Resolve.DNS.Types
+import qualified Resolve.DNS.Encode as E
+import qualified Resolve.DNS.Decode as D
+
+import Data.Word
+import Data.Hashable
+import Data.Either
+import Data.Maybe
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL
+
+import Control.Monad.STM
+import Control.Concurrent
+import Control.Exception
+import Control.Monad
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Reader
+import Control.Concurrent.STM.TVar
+import Control.Concurrent.STM.TMVar
+
+
+import Data.Typeable
+
+import System.Log.Logger
+
+
+import qualified STMContainers.Map as M
+
+nameM = "Resolve.DNS.Channel"
+
+type Send = ByteString -> IO ()
+type Recv = IO ByteString
+
+data EncodeError = EncodeError String 
+                 deriving (Typeable, Show)
+
+data Dead = Dead
+             deriving (Typeable, Show)
+
+instance Exception EncodeError where
+  toException = dnsExceptionToException
+  fromException = dnsExceptionFromException
+
+instance Exception Dead where
+  toException = dnsExceptionToException
+  fromException = dnsExceptionFromException
+
+data Config = Config { send :: Send
+                     , recv :: Recv
+                     , nick :: String
+                     }
+                
+data Resolver = Resolver { tid :: ThreadId
+                         , book :: M.Map Word16 (TMVar Message)
+                         , config :: Config
+                         , dead :: TVar Bool
+                       }
+
+new :: Config -> IO (T.Resolver Message Message)
+new c = do
+  b <- M.newIO
+  si <- newTVarIO False
+
+  bracketOnError
+    (forkIOWithUnmask $ \unmask -> unmask $ finally (forever $ runExceptT $ do  -- EitherT String IO ()
+        let nameF = nameM ++ ".recv"
+        bs <- lift $ recv c
+        m <- ExceptT $ return $ D.decodeMessage bs
+        lift $ debugM nameF $ (nick c) ++ " -> recvd " ++ (show m)
+        let ident' = (ident $ header $ m)
+        r <- lift $ atomically $ lookupAndDelete b ident'
+        case r of
+          Nothing -> throwE "ID not in book"
+          Just mvar -> lift $ atomically $ tryPutTMVar mvar m ) 
+      (do
+          debugM nameM $ (nick c) ++ " died"
+          atomically $ writeTVar si True))
+    killThread
+    (\t -> do 
+        let chan = Resolver { tid = t
+                            , book = b
+                            , config = c
+                            , dead = si
+                            }
+        debugM nameM $ (nick c) ++ " created"
+        return $ T.Resolver { T.delete = delete chan
+                            , T.resolve = resolve chan
+                            }
+    )
+    
+delete r = killThread (tid r)
+
+resolve r a = do
+  let nameF = nameM ++ ".resolve"
+  mvar <- newEmptyTMVarIO
+  bracketOnError
+    (atomically $ allocate (book r) (ident $ header $ a) mvar)
+    (\ident_ -> atomically $ lookupAndDelete (book r) ident_)
+    (\ident_ -> do 
+        let a_ = a { header = (header a) { ident = ident_ }}
+
+
+        bs <- case E.encode E.message a_ of
+          Left s -> throw $ EncodeError s
+          Right b -> return $ BSL.toStrict b
+
+
+        forkIO $ catch
+          (do
+              debugM nameF $ (nick $ config $ r) ++ " <- sending " ++ (show a_)
+              (send $ config $ r) bs
+              debugM nameF $ (nick $ config $ r) ++ " <- sent ")
+          (\e -> debugM nameF $ "exception when sending: " ++ show (e :: SomeException))
+            
+        x <- atomically $ do
+          a <- readTVar $ dead r
+          if a then tryTakeTMVar mvar
+            else 
+            Just <$> takeTMVar mvar
+        case x of
+          Nothing -> throwIO Dead
+          Just x -> return x
+    )
+    
+allocate :: (Eq i, Hashable i, Num i) => M.Map i a -> i -> a -> STM i
+allocate b i a = let loop i = do
+                       m <- do
+                         r <- M.lookup i b
+                         case r of
+                           Nothing -> do
+                             M.insert a i b
+                             return True
+                           Just _ -> return False
+                       if m then return i
+                         else loop (i + 1)
+                 in loop i
+
+lookupAndDelete :: (Eq i, Hashable i) => M.Map i a -> i -> STM (Maybe a)
+lookupAndDelete b i = do
+  mvar <- M.lookup i b
+  case mvar of
+    Nothing -> return Nothing
+    Just mvar -> do
+      M.delete i b
+      return $ Just mvar
diff --git a/src/Resolve/DNS/Decode.hs b/src/Resolve/DNS/Decode.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/Decode.hs
@@ -0,0 +1,189 @@
+module Resolve.DNS.Decode where
+
+import Prelude hiding (take)
+import Resolve.DNS.Types hiding (name, header, question, qname, qclass, qtype)
+import qualified Resolve.DNS.Types as T 
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import Data.Attoparsec.ByteString  (Parser, parse) 
+import Data.Attoparsec.Binary 
+import Data.Attoparsec.ByteString
+import Data.Word
+import Data.Bits
+import Data.Tuple
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Reader
+import Control.Monad
+import qualified Data.HashMap as HM
+import Data.BitVector hiding (not)
+
+import Data.IP
+
+toCLASS :: Word16 -> CLASS
+toCLASS c = case c of
+  1 -> IN
+  3 -> CH 
+  4 -> HS 
+  i -> OTHER i 
+
+toQCLASS :: Word16 -> QCLASS
+toQCLASS c = case toCLASS c of
+  OTHER i -> case i of
+               5 -> ANY
+               _ -> CLASS $ OTHER i
+  j -> CLASS $ j
+
+toQTYPE :: Word16   -> QTYPE 
+toQTYPE t = case t of
+  1 ->  Q_A 
+  2 -> Q_NS 
+  5 -> Q_CNAME 
+  6 ->   Q_SOA
+  12 ->   Q_PTR 
+  15 ->   Q_MX 
+  16 ->  Q_TXT 
+  i ->   Q_OTHER i 
+
+toOPCODE :: BitVector -> OPCODE 
+toOPCODE c = case c of
+  0 -> STD 
+  1 -> INV 
+  2 -> SSR 
+  
+toRCODE :: BitVector   -> RCODE 
+toRCODE c = case c of
+  0 ->  NoErr
+  1 ->  FormatErr
+  2 ->  ServFail
+  3 ->  NameErr
+  4 ->  NotImpl
+  5 ->  Refused
+  i ->  Other $ fromIntegral i
+
+toQR :: Bool -> QR
+toQR c = case c of
+  False -> Query 
+  True -> Response
+
+
+type SGet = ReaderT ByteString Parser
+
+decodeMessage :: ByteString -> Either String Message
+decodeMessage bs = parseOnly (runReaderT message bs) bs
+
+message :: SGet T.Message
+message = do
+    (h, qd, an, ns, ar) <- lift header
+    if tc h then
+      return $ T.Message h [] [] [] []
+      else
+      T.Message h
+      <$> count (fromIntegral qd) question
+      <*> count (fromIntegral an) rr
+      <*> count (fromIntegral ns) rr
+      <*> count (fromIntegral ar) rr
+      
+
+toBool :: (Eq a, Num a) => a -> Bool
+toBool = (/= 0)
+
+isEnd :: Word8 -> Bool
+isEnd c = (c == 0) || (testBit c 7) && (testBit c 8)
+
+extractNAME :: ByteString -> Int -> Either String T.NAME
+extractNAME m i = parseOnly (runReaderT name m) (BS.drop i m)
+                         
+name :: SGet T.NAME
+name = do
+  m <- ask
+  c <- lift anyWord8
+  if all (testBit c) [6,7] then do
+    c' <- lift anyWord8
+    let pos = ((fromIntegral (c .&. 0b111111) :: Word16) `shift` 8) .|. (fromIntegral c')
+    case extractNAME m (fromIntegral pos) of
+      Left e -> error e
+      Right r -> return r
+      
+    else if not (any (testBit c) [6,7]) then do
+    l <- lift $ take (fromIntegral c)
+    if c == 0 then return $ NAME [l]
+      else do 
+      (T.NAME tail) <- name
+      return $ NAME $ l : tail
+    else
+    error $ "NAME format not recognized"
+
+
+charString :: SGet ByteString
+charString = do
+  n <- lift anyWord8
+  lift $ take (fromIntegral n)
+
+rr :: SGet T.RR
+rr = do
+  n <- name
+  (c, t, ttl, rdata) <- lift $ do 
+    t <- anyWord16be
+    c_ <- anyWord16be
+    let c = toCLASS c_ 
+    ttl <- anyWord32be
+    rdlength <- anyWord16be
+    rdata <- take (fromIntegral rdlength)
+    return (c, t, ttl, rdata)
+  let p = case (t, c) of
+        (5, _) -> RR_COM c <$> CNAME <$> name
+        (15, _) -> RR_COM c <$> (MX <$> (lift anyWord16be) <*> name)
+        (2, _) -> RR_COM c <$> NS <$> name
+        (12, _) -> RR_COM c <$> PTR <$> name
+        (6, _) -> RR_COM c <$> (SOA <$> name <*> name <*> lift anyWord32be
+                    <*> lift anyWord32be <*> lift anyWord32be <*> lift anyWord32be <*> lift anyWord32be)
+        (16, _) -> RR_COM c <$> TXT <$> many1 charString
+        (1, IN) -> RR_A <$> (lift $ do
+                                ip <- count 4 anyWord8
+                                flag <- atEnd
+                                when (not flag) $ error "IPv4 is not 4B?"
+                                return $ toIPv4 $ map fromIntegral ip)
+        _ -> RR_OTHER c t <$> lift takeByteString
+  bs <- ask
+  case parseOnly (runReaderT p bs) rdata of
+    Left e -> error $ e ++ show (c, t, ttl, rdata)
+    Right r -> return $ RR n ttl r
+
+qname = Resolve.DNS.Decode.name
+
+qtype :: Parser T.QTYPE
+qtype = do
+  n <- anyWord16be
+  return $ toQTYPE n 
+
+qclass :: Parser T.QCLASS
+qclass = do
+  n <- anyWord16be
+  return $ toQCLASS n 
+    
+question :: SGet T.Question
+question = Question <$> qname
+                <*> lift qtype
+                <*> lift qclass
+
+header :: Parser (T.Header, Word16, Word16, Word16, Word16)
+header = do 
+  i <- anyWord16be
+  f_ <- anyWord16be
+  qd <- anyWord16be
+  an <- anyWord16be
+  ns <- anyWord16be
+  ar <- anyWord16be
+  let f = bitVec 16 f_
+  return $ (T.Header { T.ident = i
+                     , T.qr = toQR $ f @. 15
+                     , T.opcode = toOPCODE $ f @@ (14, 11)
+                     , T.aa = f @. 10
+                     , T.tc = f @. 9
+                     , T.rd = f @. 8
+                     , T.ra = f @. 7
+                     , T.zero = fromIntegral $ f @@ (6, 4)
+                     , T.rcode = toRCODE $ f @@ (3, 0)
+                     }
+           , qd, an, ns, ar)
diff --git a/src/Resolve/DNS/Encode.hs b/src/Resolve/DNS/Encode.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/Encode.hs
@@ -0,0 +1,156 @@
+module Resolve.DNS.Encode where
+
+import Control.Monad.Trans.State
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString as BS
+import Data.ByteString.Builder (Builder)
+import Data.ByteString.Builder 
+import Resolve.DNS.Types hiding (header, name, qtype, question, qclass)
+import qualified Resolve.DNS.Types as T 
+import Data.Monoid
+import Data.Word
+import Data.BitVector
+import qualified Data.HashMap as HM
+import Data.Maybe
+import Data.Hashable
+import Data.IP
+
+instance Hashable QCLASS where
+  hashWithSalt i a = i `xor` (fromIntegral $ fromQCLASS a)
+  
+instance Hashable QTYPE where
+  hashWithSalt i a = i `xor` (fromIntegral $ fromQTYPE a)
+
+fromCLASS :: CLASS -> Word16
+fromCLASS c = case c of
+  IN -> 1
+  CH -> 3
+  HS -> 4
+  OTHER i -> i 
+
+fromQCLASS :: QCLASS -> Word16
+fromQCLASS c = case c of
+  CLASS c' -> fromCLASS c'
+  ANY -> 5
+
+fromQTYPE :: QTYPE -> Word16  
+fromQTYPE t = case t of
+  Q_A -> 1
+  Q_NS -> 2
+  Q_CNAME -> 5
+  Q_SOA -> 6
+  Q_PTR -> 12
+  Q_MX -> 15
+  Q_TXT -> 16
+  Q_OTHER i -> i
+
+fromOPCODE :: OPCODE -> BitVector  
+fromOPCODE c = bitVec 4 $ case c of
+  STD -> 0
+  INV -> 1
+  SSR -> 2
+  
+fromRCODE :: RCODE -> BitVector  
+fromRCODE c = bitVec 4 $ case c of
+  NoErr -> 0
+  FormatErr -> 1
+  ServFail -> 2
+  NameErr -> 3
+  NotImpl -> 4
+  Refused -> 5
+  Other i -> i
+
+fromQR :: QR -> Bool
+fromQR c = case c of
+  Query -> False
+  Response -> True
+
+type SPut a = a -> Either String Builder
+type Put a = a -> Builder
+
+encode :: SPut a -> a -> Either String BSL.ByteString
+encode e a = case e a of
+  Left e -> Left e
+  Right b -> Right $ toLazyByteString b
+
+message :: SPut Message
+message m = fmap mconcat $ sequence [ Right $ header ( T.header m
+                                                     , fromIntegral $ length $ T.question m
+                                                     , fromIntegral $ length $ answer m
+                                                     , fromIntegral $ length $ authority m
+                                                     , fromIntegral $ length $ additional m)
+                                          , fmap mconcat  (mapM question $ T.question m)
+                                          , fmap mconcat (mapM rr $ answer m)
+                                          , fmap mconcat (mapM rr $ authority m)
+                                          , fmap mconcat (mapM rr $ additional m)]
+  
+header :: Put (Header, Word16, Word16, Word16, Word16)
+header (h, qd, an, ns, ar) =
+  (word16BE (ident h)) <>
+  (word16BE $ fromIntegral ((fromBool $ fromQR $ qr h) #
+                             (fromOPCODE $ opcode h) #
+                             (fromBool $ aa h) #
+                             (fromBool $ tc h) #
+                             (fromBool $ rd h) #
+                             (fromBool $ ra h) #
+                             (bitVec 3 $ zero h) #
+                             (fromRCODE $ rcode h))) <>
+  word16BE qd <>
+  word16BE an <>
+  word16BE ns <>
+  word16BE ar
+
+label :: SPut LABEL
+label l = if len < (fromIntegral (maxBound :: Word8)) then
+                  Right $ (word8 (fromIntegral len)) <> (byteString l)
+                else
+                  Left "Too long the LABEL"
+  where len = BS.length l
+
+name :: SPut NAME
+name (NAME n) = mconcat <$> mapM label n
+
+qtype :: Put QTYPE
+qtype t = word16BE $ fromQTYPE t
+
+qclass :: Put QCLASS
+qclass c = word16BE $ fromQCLASS c
+
+question :: SPut Question
+question q = mconcat <$> sequence [ name (qname q)
+                                  , Right $ qtype (T.qtype q)
+                                  , Right $ qclass (T.qclass q)]
+
+rr :: SPut RR
+rr rr = do
+  b <- d
+  let bs = toLazyByteString b
+  let len = BSL.length bs
+  if len < (fromIntegral (maxBound :: Word16)) then Right ()
+    else Left "too large the RDATA"
+    
+  mconcat <$> sequence [ name $ T.name rr
+                       , Right $ word16BE t
+                       , Right $ word16BE $ fromCLASS $ c
+                       , Right $ word32BE $ ttl rr
+                       , Right $ word16BE (fromIntegral len)
+                       , Right $ lazyByteString  bs]
+  where (c, t, d) = case rdata rr of
+          RR_COM c com -> case com of 
+            CNAME n -> (c, 5, name n)
+            NS n -> (c, 2, name n)
+            SOA mname rname serial refresh retry expire minimum ->
+              (c, 6, mconcat <$> sequence [ name mname
+                                          , name rname
+                                          , Right $ word32BE serial
+                                          , Right $ word32BE refresh
+                                          , Right $ word32BE retry
+                                          , Right $ word32BE expire
+                                          , Right $ word32BE minimum
+                                          ])
+            PTR n -> (c, 12, name n)
+            MX ref n -> (c, 15, mappend <$> (Right $ word16BE ref) <*> (name n))
+            TXT d -> (c, 16, Right $ mconcat $ map byteString d)
+          RR_A ip -> (IN, 1, Right $ mconcat $ map (word8 . fromIntegral) (fromIPv4 ip))
+          RR_OTHER c t d -> (c, t, Right $ byteString d)
diff --git a/src/Resolve/DNS/Helper/DNS.hs b/src/Resolve/DNS/Helper/DNS.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/Helper/DNS.hs
@@ -0,0 +1,35 @@
+module Resolve.DNS.Helper.DNS where
+
+import Network.Socket
+
+import Resolve.Types
+import Resolve.DNS.Types
+import qualified Resolve.DNS.Channel as C
+
+import qualified Resolve.DNS.Helper.UDP as UDP
+import qualified Resolve.DNS.Helper.LiveTCP as TCP
+
+import qualified Resolve.DNS.Truncation as T
+
+import Control.Exception
+
+
+data Config = Config { host :: HostName
+                     , port :: ServiceName
+                     }
+
+new :: Config -> IO (Resolver Message Message)
+new c = do
+  bracketOnError
+    (do
+        u <- UDP.new $ UDP.Config {UDP.host = host c, UDP.port = port c}
+        t <- TCP.new $ TCP.Config {TCP.host = host c, TCP.port = port c}
+        return $ Resolver { resolve = T.truncation $ T.Config {T.udp = resolve u, T.tcp = resolve t}
+                          , delete = do
+                              delete u
+                              delete t
+                          }
+    )
+    (\r -> delete r)
+    return
+  
diff --git a/src/Resolve/DNS/Helper/LiveTCP.hs b/src/Resolve/DNS/Helper/LiveTCP.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/Helper/LiveTCP.hs
@@ -0,0 +1,23 @@
+module Resolve.DNS.Helper.LiveTCP where
+
+import qualified Resolve.DNS.LiveTCP as TCP
+import Resolve.Types
+import Resolve.DNS.Types
+import System.Log.Logger
+
+import Network.Socket
+
+data Config = Config { host :: HostName
+                     , port :: ServiceName
+                     }
+
+lname = "Resolve.DNS.Helper.LiveTCP"              
+
+new :: Config -> IO (Resolver Message Message)
+new c = do
+  let hints = defaultHints { addrSocketType = Stream}
+  addr:_ <- getAddrInfo (Just hints) (Just $ host c) (Just $ port c)
+  TCP.new $ TCP.Config { TCP.family = addrFamily addr
+                       , TCP.protocol = addrProtocol addr
+                       , TCP.server = addrAddress addr
+                       }
diff --git a/src/Resolve/DNS/Helper/TCP.hs b/src/Resolve/DNS/Helper/TCP.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/Helper/TCP.hs
@@ -0,0 +1,19 @@
+module Resolve.DNS.Helper.TCP where
+
+import qualified Resolve.DNS.TCP as TCP
+import Resolve.Types
+import Resolve.DNS.Types
+
+import Network.Socket
+
+data Config = Config { host :: HostName
+                     , port :: ServiceName
+                     }
+
+new :: Config -> IO (Resolver Message Message)
+new c = do
+  let hints = defaultHints { addrSocketType = Stream}
+  addr:_ <- getAddrInfo (Just hints) (Just $ host c) (Just $ port c)
+  sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+  connect sock $ addrAddress addr
+  TCP.new $ TCP.Config { TCP.socket = sock}
diff --git a/src/Resolve/DNS/Helper/UDP.hs b/src/Resolve/DNS/Helper/UDP.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/Helper/UDP.hs
@@ -0,0 +1,19 @@
+module Resolve.DNS.Helper.UDP where
+
+import qualified Resolve.DNS.UDP as UDP
+import Resolve.Types
+import Resolve.DNS.Types
+
+import Network.Socket
+
+data Config = Config { host :: HostName
+                     , port :: ServiceName
+                     }
+
+new :: Config -> IO (Resolver Message Message)
+new c = do
+  let hints = defaultHints { addrSocketType = Datagram}
+  addr:_ <- getAddrInfo (Just hints) (Just $ host c) (Just $ port c)
+  sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+  UDP.new $ UDP.Config { UDP.socket = sock
+                       , UDP.server = addrAddress addr}
diff --git a/src/Resolve/DNS/LiveTCP.hs b/src/Resolve/DNS/LiveTCP.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/LiveTCP.hs
@@ -0,0 +1,97 @@
+module Resolve.DNS.LiveTCP where
+
+import qualified Resolve.DNS.TCP as TCP
+import Resolve.Types
+import qualified Resolve.DNS.Channel as C
+import Resolve.DNS.Types
+
+import Control.Monad
+import Control.Monad.STM
+import Control.Monad.Trans.Except
+import Control.Concurrent.STM.TMVar
+import Control.Concurrent
+
+import Data.Maybe
+import Data.Unique
+
+import Control.Exception
+
+
+import Network.Socket  hiding (Closed)
+
+import System.Log.Logger
+
+nameM = "Resolve.DNS.LiveTCP"
+
+data Config = Config { family :: Family
+                     , protocol :: ProtocolNumber
+                     , server :: SockAddr                       
+                     }
+              deriving (Show)
+
+data Record = Record { resolver :: Resolver Message Message
+                     , unique :: Unique
+                     , sock :: Socket
+                     }
+              
+new :: Config -> IO (Resolver Message Message)
+new c = do
+  res <- newEmptyTMVarIO
+  l <- newEmptyTMVarIO -- whoever holds the lock will reconnect
+
+  let del r = do
+        delete (resolver r)
+        close (sock r)
+        x <- atomically $ do
+          x <- tryReadTMVar res
+          case x of
+            Nothing -> return False
+            Just r' -> if ((unique r) == (unique r')) then (void $ takeTMVar res) >> return True
+                       else return False
+        when x $ debugM nameM $ (show c) ++ " connection closed, deleted"
+
+  let loop a = do
+        let nameF = nameM ++ ".resolve"
+        bracket
+          (atomically $ do
+              x <- tryReadTMVar res
+              when (isNothing x) $ putTMVar l ()
+              return x)
+          (\x -> atomically $ when (isNothing x) $ takeTMVar l)
+          (\x -> case x of
+              Just r -> do
+                b <- try (resolve (resolver r) a)
+                case b of
+                  Left C.Dead -> do
+                    del r
+                    loop a
+                  Right b' -> return b'
+              Nothing -> do
+                debugM nameF $ (show c) ++ " trying to reconnect"
+                bracketOnError
+                  (socket (family c) (Stream) (protocol c))
+                  (\s -> close s)
+                  (\s -> do 
+                      connect s (server c)
+                      debugM nameF $ (show c ) ++ " reconnected"
+                      bracketOnError 
+                        (TCP.new $ TCP.Config { TCP.socket = s})
+                        delete
+                        (\r -> do
+                            u <- newUnique
+                            atomically $ do 
+                              putTMVar res $ Record { resolver = r
+                                                    , unique = u
+                                                    , sock = s}
+                        )
+                  )
+                loop a)
+          
+  return $ Resolver { resolve = loop
+                    , delete = do
+                        x <- atomically $ tryReadTMVar res
+                        case x of
+                          Nothing -> return ()
+                          Just r -> del r
+                    }
+
diff --git a/src/Resolve/DNS/Server/TCP.hs b/src/Resolve/DNS/Server/TCP.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/Server/TCP.hs
@@ -0,0 +1,46 @@
+module Resolve.DNS.Server.TCP where
+
+import Resolve.Types
+
+import Resolve.DNS.Types
+import Resolve.DNS.Server.Types
+import Data.ByteString
+import qualified Data.ByteString.Lazy as BSL
+import Data.Typeable
+
+import qualified Resolve.DNS.Decode as D
+import qualified Resolve.DNS.Encode as E
+
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Except
+import Control.Exception
+
+
+
+data DecodeError = DecodeError String
+  deriving (Typeable, Show)
+
+instance Exception DecodeError where
+  toException = serverExceptionToException
+  fromException = serverExceptionFromException
+
+data EncodeError = EncodeError String
+  deriving (Typeable, Show)
+
+instance Exception EncodeError where
+  toException = serverExceptionToException
+  fromException = serverExceptionFromException
+
+encodeMessage :: Message -> BSL.ByteString
+encodeMessage m = case E.encode E.message m of
+  Left e -> throw $ EncodeError e
+  Right b -> b
+
+resolve :: Resolve Message Message -> Resolve BSL.ByteString BSL.ByteString
+resolve r a = do
+  a' <- case D.decodeMessage (BSL.toStrict a) of
+    Left e -> throw $ DecodeError e
+    Right a' -> return a'
+  b' <- r a'
+
+  return $ encodeMessage b'
diff --git a/src/Resolve/DNS/Server/Types.hs b/src/Resolve/DNS/Server/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/Server/Types.hs
@@ -0,0 +1,24 @@
+module Resolve.DNS.Server.Types where
+
+import Resolve.DNS.Types
+
+import Data.Typeable
+import Control.Exception
+
+data ServerException where
+  ServerException :: Exception e => e -> ServerException
+  deriving  (Typeable)
+
+instance Show ServerException where
+  show (ServerException e) = show e
+
+instance Exception ServerException where
+  toException = dnsExceptionToException
+  fromException = dnsExceptionFromException
+
+serverExceptionToException :: Exception e => e -> SomeException
+serverExceptionToException = toException . ServerException
+
+serverExceptionFromException x = do
+  ServerException a <- fromException x
+  cast a
diff --git a/src/Resolve/DNS/Server/UDP.hs b/src/Resolve/DNS/Server/UDP.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/Server/UDP.hs
@@ -0,0 +1,70 @@
+module Resolve.DNS.Server.UDP where
+
+import Resolve.Types
+
+import Resolve.DNS.Types
+import Resolve.DNS.Server.Types
+import Data.ByteString
+import qualified Data.ByteString.Lazy as BSL
+import Data.Typeable
+
+import qualified Resolve.DNS.Decode as D
+import qualified Resolve.DNS.Encode as E
+
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Except
+import Control.Exception
+
+
+
+
+data DecodeError = DecodeError String
+  deriving (Typeable, Show)
+
+instance Exception DecodeError where
+  toException = serverExceptionToException
+  fromException = serverExceptionFromException
+
+data EncodeError = EncodeError String
+  deriving (Typeable, Show)
+
+instance Exception EncodeError where
+  toException = serverExceptionToException
+  fromException = serverExceptionFromException
+
+data ResponseTooLong = ResponseTooLong
+  deriving (Typeable, Show)
+
+instance Exception ResponseTooLong where
+  toException = serverExceptionToException
+  fromException = serverExceptionFromException
+
+maxLength = 512
+
+encodeMessage :: Message -> BSL.ByteString
+encodeMessage m = case E.encode E.message m of
+  Left e -> throw $ EncodeError e
+  Right b -> b
+
+resolve :: Resolve Message Message -> Resolve ByteString ByteString
+resolve r a = do
+  a' <- case D.decodeMessage a of
+    Left e -> throw $ DecodeError e
+    Right a' -> return a'
+  b' <- r a'
+
+  let b = encodeMessage b'
+
+  BSL.toStrict <$> if (BSL.null $ BSL.drop maxLength b) then
+        return $ b
+    else do
+    let b_tc = encodeMessage $ b' { header = (header b') { tc = True }
+                                  , question = question b'
+                                  , answer = []
+                                  , authority = []
+                                  , additional = []
+                                 }
+    if (BSL.null $ BSL.drop maxLength b_tc) then
+      return $ b_tc
+      else
+      throw ResponseTooLong
diff --git a/src/Resolve/DNS/TCP.hs b/src/Resolve/DNS/TCP.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/TCP.hs
@@ -0,0 +1,117 @@
+module Resolve.DNS.TCP where
+
+import Resolve.Types
+import Resolve.DNS.Types
+import qualified Resolve.DNS.Channel as C
+
+import Data.Typeable
+import Data.ByteString.Builder
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL
+
+
+import Network.Socket hiding (recv, send, socket, Closed)
+import Network.Socket.ByteString
+
+import Data.Bits
+
+import Control.Monad
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Class
+import Control.Concurrent
+import Control.Exception
+import Control.Concurrent.STM.TMVar
+import Control.Concurrent.STM.TVar
+import Control.Monad.STM
+
+import System.Log.Logger
+
+nameM = "Resolve.DNS.TCP"
+
+data Config = Config { socket :: Socket
+                     }
+
+data Closed = Closed
+  deriving (Show, Typeable)
+
+instance Exception Closed where
+    toException = dnsExceptionToException
+    fromException = dnsExceptionFromException
+
+new :: Config -> IO (Resolver Message Message)
+new c = do
+  qi <- newEmptyTMVarIO
+  qo <- newEmptyTMVarIO
+  si <- newTVarIO True
+  so <- newTVarIO True
+  
+  bracketOnError
+    (do
+        chan <- C.new C.Config { C.send =  \a -> do
+                                   v <- atomically $ do
+                                     v <- readTVar so
+                                     when v $ putTMVar qo a
+                                     return v
+                                   when (not v) $ throw Closed
+                               , C.recv = do
+                                   v <- atomically $ do
+                                     v <- readTVar si
+                                     if v then do 
+                                       x <- takeTMVar qi
+                                       return $ Just x
+                                       else tryTakeTMVar qi
+                                   case v of
+                                     Nothing -> throw Closed
+                                     Just x -> return x
+                               , C.nick = "TCP<" ++ (show $ socket c) ++ ">"
+                               }
+
+        to <- forkIOWithUnmask $ \unmask -> unmask $ finally
+          (forever $ do
+              let nameF = nameM ++ ".send"
+              let sendAll bs = if BS.null bs then
+                                 return ()
+                               else do
+                    n <- send (socket c) bs
+                    sendAll (BS.drop n bs)
+              bs <- atomically $ takeTMVar qo
+              sendAll $ BSL.toStrict $ toLazyByteString $ word16BE $ fromIntegral $ BS.length bs
+              sendAll $ bs)
+          (do
+              debugM nameM "send died"
+              atomically $ writeTVar so False)
+
+    
+        ti <- forkIOWithUnmask $ \unmask -> unmask $ finally
+          (forever $ runExceptT $ do -- EitherT String IO ()
+              let nameF = nameM ++ ".recv"
+              let recvAll' n = if n == 0 then return mempty
+                    else do  -- IO ()
+                    bs <- recv (socket c) n
+
+                    when (BS.null bs) $ do
+                      throwTo to ThreadKilled
+                      throw ThreadKilled
+                    mappend (byteString bs) <$> (recvAll' $ n - (BS.length bs))
+                  recvAll n = do
+                    BSL.toStrict <$> toLazyByteString <$> recvAll' n
+              n <- lift $ recvAll 2
+              let n' = ((fromIntegral $ BS.index n 0) `shift` 8) .|. (fromIntegral $ BS.index n 1)
+              d <- lift $ recvAll $ n'
+              lift $ atomically $ putTMVar qi $ d)
+          (do
+              debugM nameM "recv died"
+              atomically $ writeTVar si False)
+        
+        return (resolve chan, do
+                   delete chan
+                   killThread ti
+                   killThread to
+               )
+    )
+    (\(_, d) -> d)
+    (\(r, d) -> return $ Resolver { resolve = r
+                                  , delete = d
+                                  }
+    )
diff --git a/src/Resolve/DNS/Truncation.hs b/src/Resolve/DNS/Truncation.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/Truncation.hs
@@ -0,0 +1,40 @@
+module Resolve.DNS.Truncation where
+
+import Resolve.Types
+import Resolve.DNS.Types
+import qualified Resolve.DNS.Channel as C
+import qualified Resolve.DNS.UDP as UDP
+import qualified Resolve.DNS.LiveTCP as TCP
+
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Class
+import Control.Exception
+
+import System.Log.Logger
+
+nameM = "Resolve.DNS.Truncation"
+
+
+data Config = Config { udp :: Resolve Message Message
+                     , tcp :: Resolve Message Message
+                     }
+
+truncation :: Config -> Resolve Message Message
+truncation c a = do
+  let nameF = nameM
+  b <- try (udp c a)
+  res <- case b of
+    Left UDP.QueryTooLong -> do 
+        debugM nameF "query too long"
+        return Nothing
+    Right b -> if tc $ header $ b then do
+      debugM nameF "response truncated"
+      return Nothing
+      else 
+      return $ Just b
+  case res of
+    Nothing -> do
+      debugM nameF "using TCP"
+      tcp c a
+    Just b -> return b
+
diff --git a/src/Resolve/DNS/Types.hs b/src/Resolve/DNS/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/Types.hs
@@ -0,0 +1,165 @@
+module Resolve.DNS.Types where
+
+import Data.Word
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.HashMap as HM
+import Data.Tuple (swap)
+import Data.Maybe
+import Data.Bits
+import Data.BitVector
+import Data.List
+import Data.IP
+import Data.Typeable
+
+
+import Resolve.Types
+
+import Control.Exception
+
+data DNSException where
+  DNSException :: Exception e => e -> DNSException
+  deriving (Typeable)
+
+instance Show DNSException where
+  show (DNSException e) = show e
+
+instance Exception DNSException where
+  toException = resolveExceptionToException
+  fromException = resolveExceptionFromException
+
+dnsExceptionToException :: Exception e => e -> SomeException
+dnsExceptionToException = toException . DNSException
+
+dnsExceptionFromException x = do
+  DNSException a <- fromException x
+  cast a
+
+type LABEL = ByteString
+newtype NAME = NAME [LABEL] deriving (Eq, Ord)
+
+qclass_word = map (\(a, b) -> (CLASS a, b)) class_word
+              ++ [(ANY, 5)]
+              :: [(QCLASS, Word16)]
+
+class_word = [ (IN, 1)
+             , (CH, 3)
+             , (HS, 4)
+             ] :: [(CLASS, Word16)]
+
+qtype_word = [ (Q_A, 1 :: Word16)
+             , (Q_NS, 2)
+             , (Q_CNAME, 5)
+             , (Q_SOA, 6)
+             , (Q_PTR, 12)
+             , (Q_MX, 15)
+             , (Q_TXT, 16)
+             ]
+
+opcode_word = map (\(a, b) -> (a, bitVec 4 b))
+  [ (STD, bitVec 4 0)
+  , (INV, bitVec 4 1)
+  , (SSR, bitVec 4 2)
+  ]
+
+rcode_word = map (\(a, b) -> (a, bitVec 4 b))
+  [ (NoErr, 0)
+  , (FormatErr, 1)
+  , (ServFail, 2)
+  , (NameErr, 3)
+  , (NotImpl, 4)
+  , (Refused, 5)
+  ]
+
+qr_word = [ (Query, False)
+          , (Response, True)]
+             
+data Message = Message {
+    header     :: Header
+  , question   :: [Question]
+  , answer     :: [RR]
+  , authority  :: [RR]
+  , additional :: [RR]
+  } deriving (Eq, Show)
+
+data Header = Header { ident :: Word16
+                     , qr     :: QR
+                     , opcode :: OPCODE
+                     , aa     :: Bool
+                     , tc     :: Bool
+                     , rd     :: Bool
+                     , ra     :: Bool
+                     , zero   :: Word8 -- should be Word3
+                     , rcode  :: RCODE
+                     } deriving (Eq, Show)
+
+data QR = Query | Response deriving (Eq, Show)
+
+toBool :: QR -> Bool
+toBool Query = False
+toBool Response = True
+
+data OPCODE
+  = STD
+  | INV
+  | SSR
+  deriving (Eq, Show, Bounded)
+
+data RCODE
+  = NoErr
+  | FormatErr
+  | ServFail
+  | NameErr
+  | NotImpl
+  | Refused
+  | Other Word8 -- actually should be Word4
+  deriving (Eq, Ord, Show)
+
+data CLASS = IN
+           | CH
+           | HS
+           | OTHER Word16
+           deriving (Eq, Show, Ord)
+
+data QCLASS = CLASS CLASS
+            | ANY
+            deriving (Eq, Show, Ord)
+
+data QTYPE = Q_A
+           | Q_NS
+           | Q_CNAME
+           | Q_SOA
+           | Q_PTR
+           | Q_MX
+           | Q_TXT
+           | Q_AXFR
+           | Q_ALL
+           | Q_OTHER Word16
+           deriving (Eq, Show, Ord)
+
+data Question = Question { qname  :: NAME
+                         , qtype :: QTYPE
+                         , qclass :: QCLASS
+                         } deriving (Eq, Show)
+
+data RR = RR { name :: NAME
+             , ttl  :: Word32
+             , rdata  :: RDATA
+             }
+        deriving (Eq, Show)
+
+data RDATA_COM = CNAME NAME
+               | MX Word16 NAME
+               | NS NAME
+               | PTR NAME
+               | SOA NAME NAME Word32 Word32 Word32 Word32 Word32
+               | TXT [ByteString]
+               deriving (Eq, Ord, Show)
+
+data RDATA = RR_COM CLASS RDATA_COM
+           | RR_A IPv4
+           | RR_OTHER CLASS Word16 ByteString
+    deriving (Eq, Ord, Show)
+
+instance Show NAME where
+  show (NAME xs) = intercalate "." (map BS.unpack xs)
diff --git a/src/Resolve/DNS/UDP.hs b/src/Resolve/DNS/UDP.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/DNS/UDP.hs
@@ -0,0 +1,55 @@
+module Resolve.DNS.UDP where
+
+import qualified Resolve.DNS.Channel as C
+import Resolve.Types
+
+import Resolve.DNS.Types
+import Network.Socket hiding (send, sendTo, recv, recvFrom, socket)
+import Network.Socket.ByteString
+import qualified Data.ByteString as BS
+
+import Data.Typeable
+
+import Control.Exception
+import Control.Monad
+
+import System.Log.Logger
+
+nameM = "Resolve.DNS.UDP"
+
+
+data Config = Config { socket :: Socket
+                     , server :: SockAddr
+                     }
+
+data QueryTooLong = QueryTooLong
+           deriving (Typeable, Show)
+
+instance Exception QueryTooLong where
+    toException = dnsExceptionToException
+    fromException = dnsExceptionFromException
+
+maxLength = 512
+
+new :: Config -> IO (Resolver Message Message)
+new c = do
+  chan <- C.new C.Config { C.send = \a -> do
+                             let nameF = nameM ++ ".send"
+                             if BS.length a > maxLength then
+                               throw QueryTooLong
+                               else do
+                               void $ sendTo (socket c) a (server c)
+
+                
+                         , C.recv = let loop = do
+                                          let nameF = nameM ++ ".recv"
+                                          (bs, sa) <- (recvFrom (socket c) maxLength)
+                                          if sa /= (server c) then loop
+                                            else return bs
+                                    in
+                                      loop
+                         , C.nick = "UDP<" ++ (show $ socket $ c) ++ ">" ++ (show $ server $ c)
+                         }
+  return $ Resolver { resolve = resolve chan
+                    , delete = delete chan
+                    }
diff --git a/src/Resolve/Log.hs b/src/Resolve/Log.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/Log.hs
@@ -0,0 +1,17 @@
+module Resolve.Log where
+
+import Resolve.Types
+import Control.Exception
+
+log :: (Show a, Show b) => (String -> IO()) -> (String -> IO()) -> Resolve a b -> Resolve a b
+log error info r a = do
+  catch 
+    (do
+        b <- r a
+        info $ show a ++ "->" ++ show b
+        return b
+    )
+    (\e -> do
+        error $ show a ++ "->" ++ show (e :: SomeException)
+        throw e
+    )
diff --git a/src/Resolve/Retry.hs b/src/Resolve/Retry.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/Retry.hs
@@ -0,0 +1,23 @@
+module Resolve.Retry where
+
+import Resolve.Types
+
+import Data.Typeable
+import Control.Exception
+
+data RetryOut = RetryOut
+  deriving (Show, Typeable)
+
+instance Exception RetryOut
+
+retry :: Int -> Resolve a b -> Resolve a b
+retry n r a =
+  let loop n = if n == 0 then throw RetryOut
+        else do
+        m <- try (r a)
+        case m of
+          Left e -> do
+            let x = e :: SomeException
+            loop (n - 1)
+          Right b -> return b
+  in loop n
diff --git a/src/Resolve/Timeout.hs b/src/Resolve/Timeout.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/Timeout.hs
@@ -0,0 +1,25 @@
+module Resolve.Timeout where
+
+import Resolve.Types
+import Control.Concurrent
+import Control.Exception
+
+import Data.Typeable
+
+import Data.Unique
+
+data Timeout = Timeout
+  deriving (Show)
+
+instance Exception Timeout where
+  toException = resolveExceptionToException
+  fromException = resolveExceptionFromException
+
+timeout :: Int -> Resolve a b -> Resolve a b
+timeout n r a = do 
+  pid <- myThreadId
+  bracket
+    (forkIOWithUnmask $ \unmask ->
+        unmask $ threadDelay n >> throwTo pid Timeout)
+    (uninterruptibleMask_ . killThread)
+    (\_ -> r a)
diff --git a/src/Resolve/Types.hs b/src/Resolve/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Resolve/Types.hs
@@ -0,0 +1,25 @@
+module Resolve.Types where
+
+import Data.Typeable
+import Control.Exception
+
+type Resolve a b = a -> IO b
+data Resolver a b = Resolver { resolve :: Resolve a b
+                             , delete :: IO ()
+                             }
+
+data ResolveException where
+  ResolveException :: Exception e => e -> ResolveException
+  deriving (Typeable)
+
+instance Show ResolveException where
+  show (ResolveException e) = show e
+
+instance Exception ResolveException
+
+resolveExceptionToException :: Exception e => e -> SomeException
+resolveExceptionToException = toException . ResolveException
+
+resolveExceptionFromException x = do
+  ResolveException a <- fromException x
+  cast a