diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,29 @@
+Copyright (c) 2009, IIJ Innovation Institute Inc.
+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 the copyright holders nor the names of its
+    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/Network/DNS.hs b/Network/DNS.hs
new file mode 100644
--- /dev/null
+++ b/Network/DNS.hs
@@ -0,0 +1,29 @@
+{-|
+  Thread-safe DNS library written in Haskell.
+
+  Currently, only resolver side is supported. This code is written in
+  Haskell, not using FFI. So, the \"-threaded\" option for GHC is not
+  necessary.
+
+  Sample code:
+
+@
+    import qualified Network.DNS as DNS (lookup)
+    import Network.DNS hiding (lookup)
+    main :: IO ()
+    main = do
+        rs <- makeResolvSeed defaultResolvConf
+        withResolver rs $ \\resolver -> do
+            DNS.lookup resolver \"www.example.com\" A >>= print
+@
+-}
+
+module Network.DNS (
+    module Network.DNS.Lookup
+  , module Network.DNS.Resolver
+  , module Network.DNS.Types
+  ) where
+
+import Network.DNS.Lookup
+import Network.DNS.Resolver
+import Network.DNS.Types
diff --git a/Network/DNS/Internal.hs b/Network/DNS/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Network/DNS/Internal.hs
@@ -0,0 +1,158 @@
+module Network.DNS.Internal where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Char
+import Data.IP
+import Data.Maybe
+
+----------------------------------------------------------------
+
+{-|
+  Type for domain.
+-}
+type Domain = String
+
+----------------------------------------------------------------
+
+{-|
+  Types for resource records.
+-}
+data TYPE = A | AAAA | NS | TXT | MX | CNAME | SOA
+          | UNKNOWN Int deriving (Eq, Show, Read)
+
+rrDB :: [(TYPE, Int)]
+rrDB = [
+    (A,      1)
+  , (NS,     2)
+  , (CNAME,  5)
+  , (SOA,    6)
+  , (MX,    15)
+  , (TXT,   16)
+  , (AAAA,  28)
+  ]
+
+rookup                  :: (Eq b) => b -> [(a,b)] -> Maybe a
+rookup _    []          =  Nothing
+rookup  key ((x,y):xys)
+  | key == y          =  Just x
+  | otherwise         =  rookup key xys
+
+intToType :: Int -> TYPE
+intToType n = fromMaybe (UNKNOWN n) $ rookup n rrDB
+typeToInt :: TYPE -> Int
+typeToInt (UNKNOWN x)  = x
+typeToInt t = fromMaybe 0 $ lookup t rrDB
+
+toType :: String -> TYPE
+toType = read . map toUpper
+
+----------------------------------------------------------------
+
+{-|
+  Raw data format for DNS Query and Response.
+-}
+data DNSFormat = DNSFormat {
+    header     :: DNSHeader
+  , question   :: [Question]
+  , answer     :: [ResourceRecord]
+  , authority  :: [ResourceRecord]
+  , additional :: [ResourceRecord]
+  } deriving (Eq, Show)
+
+{-|
+  Raw data format for the header of DNS Query and Response.
+-}
+data DNSHeader = DNSHeader {
+    identifier :: Int
+  , flags      :: DNSFlags
+  , qdCount    :: Int
+  , anCount    :: Int
+  , nsCount    :: Int
+  , arCount    :: Int
+  } deriving (Eq, Show)
+
+{-|
+  Raw data format for the flags of DNS Query and Response.
+-}
+data DNSFlags = DNSFlags {
+    qOrR         :: QorR
+  , opcode       :: OPCODE
+  , authAnswer   :: Bool
+  , trunCation   :: Bool
+  , recDesired   :: Bool
+  , recAvailable :: Bool
+  , rcode        :: RCODE
+  } deriving (Eq, Show)
+
+----------------------------------------------------------------
+
+data QorR = QR_Query | QR_Response deriving (Eq, Show)
+
+data OPCODE = OP_STD | OP_INV | OP_SSR deriving (Eq, Show, Enum)
+
+data RCODE = NoErr | FormatErr | ServFail | NameErr | NotImpl | Refused deriving (Eq, Show, Enum)
+
+----------------------------------------------------------------
+
+{-|
+  Raw data format for DNS questions.
+-}
+data Question = Question {
+    qname  :: Domain
+  , qtype  :: TYPE
+  } deriving (Eq, Show)
+
+{-|
+  Making "Question".
+-}
+makeQuestion :: Domain -> TYPE -> Question
+makeQuestion = Question
+
+----------------------------------------------------------------
+
+{-|
+  Raw data format for resource records.
+-}
+data ResourceRecord = ResourceRecord {
+    rrname :: Domain
+  , rrtype :: TYPE
+  , rrttl  :: Int
+  , rdlen  :: Int
+  , rdata  :: RDATA
+  } deriving (Eq, Show)
+
+{-|
+  Raw data format for each type.
+-}
+data RDATA = RD_NS Domain | RD_CNAME Domain | RD_MX Int Domain
+           | RD_SOA Domain Domain Int Int Int Int Int
+           | RD_A IPv4 | RD_AAAA IPv6 | RD_TXT L.ByteString
+           | RD_OTH [Int] deriving (Eq)
+
+instance Show RDATA where
+  show (RD_NS dom) = dom
+  show (RD_MX prf dom) = dom ++ " " ++ show prf
+  show (RD_CNAME dom) = dom
+  show (RD_A a) = show a
+  show (RD_AAAA aaaa) = show aaaa
+  show (RD_TXT txt) = L.unpack txt
+  show (RD_SOA mn _ _ _ _ _ mi) = mn ++ " " ++ show mi
+  show (RD_OTH is) = show is
+
+----------------------------------------------------------------
+
+defaultQuery :: DNSFormat
+defaultQuery = DNSFormat {
+    header = DNSHeader {
+       identifier = 0
+     , flags = undefined
+     , qdCount = 0
+     , anCount = 0
+     , nsCount = 0
+     , arCount = 0
+     }
+  , question   = []
+  , answer     = []
+  , authority  = []
+  , additional = []
+  }
diff --git a/Network/DNS/Lookup.hs b/Network/DNS/Lookup.hs
new file mode 100644
--- /dev/null
+++ b/Network/DNS/Lookup.hs
@@ -0,0 +1,85 @@
+{-|
+  Upper level DNS lookup functions.
+-}
+
+module Network.DNS.Lookup (
+    lookupA, lookupAAAA
+  , lookupMX, lookupAviaMX, lookupAAAAviaMX
+  , lookupTXT
+  ) where
+
+import Control.Applicative
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.IP
+import Data.Maybe
+import Network.DNS.Resolver as DNS
+import Network.DNS.Types
+
+----------------------------------------------------------------
+
+{-|
+  Resolving 'IPv4' by 'A'.
+-}
+lookupA :: Resolver -> Domain -> IO (Maybe [IPv4])
+lookupA rlv dom = toV4 <$> DNS.lookup rlv dom A
+  where
+    toV4 = maybe Nothing (Just . map unTag)
+    unTag (RD_A x) = x
+    unTag _ = error "lookupA"
+
+{-|
+  Resolving 'IPv6' by 'AAAA'.
+-}
+lookupAAAA :: Resolver -> Domain -> IO (Maybe [IPv6])
+lookupAAAA rlv dom = toV6 <$> DNS.lookup rlv dom AAAA
+  where
+    toV6 = maybe Nothing (Just . map unTag)
+    unTag (RD_AAAA x) = x
+    unTag _ = error "lookupAAAA"
+
+----------------------------------------------------------------
+
+{-|
+  Resolving 'Domain' and its preference by 'MX'.
+-}
+lookupMX :: Resolver -> Domain -> IO (Maybe [(Domain,Int)])
+lookupMX rlv dom = toMX <$> DNS.lookup rlv dom MX
+  where
+    toMX = maybe Nothing (Just . map unTag)
+    unTag (RD_MX pr dm) = (dm,pr)
+    unTag _ = error "lookupMX"
+
+{-|
+  Resolving 'IPv4' by 'A' via 'MX'.
+-}
+lookupAviaMX :: Resolver -> Domain -> IO (Maybe [IPv4])
+lookupAviaMX rlv dom = lookupXviaMX rlv dom (lookupA rlv)
+
+{-|
+  Resolving 'IPv6' by 'AAAA' via 'MX'.
+-}
+lookupAAAAviaMX :: Resolver -> Domain -> IO (Maybe [IPv6])
+lookupAAAAviaMX rlv dom = lookupXviaMX rlv dom (lookupAAAA rlv)
+
+lookupXviaMX :: Resolver -> Domain -> (Domain -> IO (Maybe [a])) -> IO (Maybe [a])
+lookupXviaMX rlv dom func = do
+    mdps <- lookupMX rlv dom
+    maybe (return Nothing) lookup' mdps
+  where
+    lookup' dps = do
+        as <- catMaybes <$> mapM (func . fst) dps
+        case as of
+          []  -> return Nothing
+          ass -> return $ Just (concat ass)
+
+----------------------------------------------------------------
+
+{-|
+  Resolving 'String' by 'TXT'.
+-}
+lookupTXT :: Resolver -> Domain -> IO (Maybe [L.ByteString])
+lookupTXT rlv dom = toTXT <$> DNS.lookup rlv dom TXT
+  where
+    toTXT = maybe Nothing (Just . map unTag)
+    unTag (RD_TXT x) = x
+    unTag _ = error "lookupTXT"
diff --git a/Network/DNS/Query.hs b/Network/DNS/Query.hs
new file mode 100644
--- /dev/null
+++ b/Network/DNS/Query.hs
@@ -0,0 +1,78 @@
+module Network.DNS.Query (composeQuery) where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Char
+import Network.DNS.StateBinary
+import Network.DNS.Internal
+
+----------------------------------------------------------------
+
+composeQuery :: Int -> [Question] -> L.ByteString
+composeQuery idt qs = runSPut (encodeQuery qry)
+  where
+    hdr = header defaultQuery
+    qry = defaultQuery {
+        header = hdr {
+           identifier = idt
+         , qdCount = length qs
+         }
+      , question = qs
+      }
+
+----------------------------------------------------------------
+
+encodeQuery :: DNSFormat -> SPut
+encodeQuery fmt = do
+  let hdr = header fmt
+      qs = question fmt
+  encodeHeader hdr
+  encodeQuestion qs
+  return ()
+
+encodeHeader :: DNSHeader -> SPut
+encodeHeader hdr = do
+    encodeIdentifier $ identifier hdr
+    encodeFlags $ flags hdr
+    decodeQdCount $ qdCount hdr
+    decodeAnCount $ anCount hdr
+    decodeNsCount $ nsCount hdr
+    decodeArCount $ arCount hdr
+  where
+    encodeIdentifier = putInt16
+    decodeQdCount = putInt16
+    decodeAnCount = putInt16
+    decodeNsCount = putInt16
+    decodeArCount = putInt16
+
+encodeFlags :: DNSFlags -> SPut
+encodeFlags _ = put16 0x0100 -- xxx
+
+encodeQuestion :: [Question] -> SPut
+encodeQuestion qs = do
+  let q = head qs
+      dom = qname q
+      typ = qtype q
+  encodeDomain dom
+  putInt16 . typeToInt $ typ
+  put16 1
+
+----------------------------------------------------------------
+
+encodeDomain :: Domain -> SPut
+encodeDomain dom = do
+    let ss = split '.' dom
+        ls = map length ss
+    mapM_ encodeSubDomain $ zip ls ss
+    put8 0
+  where
+    encodeSubDomain (len,sub) = do
+      putInt8 len
+      mapM_ (putInt8 . ord) sub
+
+split :: Char -> String -> [String]
+split _ "" = []
+split c cs
+  | null rest = s : split c rest
+  | otherwise = s : split c (tail rest)
+  where
+    (s,rest) = break (c ==) cs
diff --git a/Network/DNS/Resolver.hs b/Network/DNS/Resolver.hs
new file mode 100644
--- /dev/null
+++ b/Network/DNS/Resolver.hs
@@ -0,0 +1,182 @@
+{-|
+  DNS Resolver and lookup functions.
+
+  Sample code:
+
+@
+    import qualified Network.DNS as DNS (lookup)
+    import Network.DNS hiding (lookup)
+    main :: IO ()
+    main = do
+        rs <- makeResolvSeed defaultResolvConf
+        withResolver rs $ \\resolver -> do
+            DNS.lookup resolver \"www.example.com\" A >>= print
+@
+-}
+
+module Network.DNS.Resolver (
+  -- * Documentation
+  -- ** Configuration for resolver
+    FileOrNumericHost(..), ResolvConf(..), defaultResolvConf
+  -- ** Intermediate data type for resolver
+  , ResolvSeed, makeResolvSeed
+  -- ** Type and function for resolver
+  , Resolver, withResolver
+  -- ** Looking up functions
+  , lookup, lookupRaw
+  ) where
+
+import Control.Applicative
+import Control.Exception
+import Data.Char
+import Data.Int
+import Data.List hiding (find, lookup)
+import Network.BSD
+import Network.DNS.Query
+import Network.DNS.Response
+import Network.DNS.Types
+import Network.Socket hiding (send, sendTo, recv, recvFrom)
+import Network.Socket.ByteString.Lazy
+import Prelude hiding (lookup)
+import Random
+import System.Timeout
+
+----------------------------------------------------------------
+
+{-|
+  Union type for 'FilePath' and 'HostName'. Specify 'FilePath' to
+  \"resolv.conf\" or numeric IP address in 'String' form.
+-}
+data FileOrNumericHost = RCFilePath FilePath | RCHostName HostName
+
+{-|
+  Type for resolver configuration
+-}
+data ResolvConf = ResolvConf {
+    resolvInfo :: FileOrNumericHost
+  , resolvTimeout :: Int
+  , resolvBufsize :: Int64
+}
+
+{-|
+  Default 'ResolvConf'.
+  'resolvInfo' is 'RCFilePath' \"\/etc\/resolv.conf\".
+  'resolvTimeout' is 3,000,000 micro seconds.
+  'resolvBufsize' is 512.
+-}
+defaultResolvConf :: ResolvConf
+defaultResolvConf = ResolvConf {
+    resolvInfo = RCFilePath "/etc/resolv.conf"
+  , resolvTimeout = 3 * 1000 * 1000
+  , resolvBufsize = 512
+}
+
+----------------------------------------------------------------
+
+{-|
+  Abstract data type of DNS Resolver seed
+-}
+data ResolvSeed = ResolvSeed {
+    addrInfo :: AddrInfo
+  , rsTimeout :: Int
+  , rsBufsize :: Int64
+}
+
+{-|
+  Abstract data type of DNS Resolver
+-}
+data Resolver = Resolver {
+    genId   :: IO Int
+  , dnsSock :: Socket
+  , dnsTimeout :: Int
+  , dnsBufsize :: Int64
+}
+
+----------------------------------------------------------------
+
+{-|
+  Making 'ResolvSeed' from an IP address of a DNS cache server.
+-}
+makeResolvSeed :: ResolvConf -> IO ResolvSeed
+makeResolvSeed conf = ResolvSeed <$> addr
+                                 <*> pure (resolvTimeout conf)
+                                 <*> pure (resolvBufsize conf)
+  where
+    addr = case resolvInfo conf of
+        RCHostName numhost -> makeAddrInfo numhost
+        RCFilePath file -> toAddr <$> readFile file >>= makeAddrInfo
+    toAddr cs = let l:_ = filter ("nameserver" `isPrefixOf`) $ lines cs
+                in extract l
+    extract = reverse . dropWhile isSpace . reverse . dropWhile isSpace . drop 11
+
+makeAddrInfo :: HostName -> IO AddrInfo
+makeAddrInfo addr = do
+    proto <- getProtocolNumber "udp"
+    let hints = defaultHints {
+            addrFlags = [AI_ADDRCONFIG, AI_NUMERICHOST, AI_PASSIVE]
+          , addrSocketType = Datagram
+          , addrProtocol = proto
+          }
+    a:_ <- getAddrInfo (Just hints) (Just addr) (Just "domain")
+    return a
+
+----------------------------------------------------------------
+
+{-|
+  Giving a thread-safe 'Resolver' to the function of the second
+  argument. 'withResolver' should be passed to 'forkIO'.
+-}
+
+withResolver :: ResolvSeed -> (Resolver -> IO ()) -> IO ()
+withResolver seed func = do
+  let ai = addrInfo seed
+  sock <- socket (addrFamily ai) (addrSocketType ai) (addrProtocol ai)
+  connect sock (addrAddress ai)
+  let resolv = Resolver {
+          genId = getRandom
+        , dnsSock = sock
+        , dnsTimeout = rsTimeout seed
+        , dnsBufsize = rsBufsize seed
+        }
+  func resolv `finally` sClose sock
+
+getRandom :: IO Int
+getRandom = getStdRandom (randomR (0,65535))
+
+----------------------------------------------------------------
+
+{-|
+  Looking up resource records of a domain.
+-}
+lookup :: Resolver -> Domain -> TYPE -> IO (Maybe [RDATA])
+lookup rlv dom typ = (>>= toRDATA) <$> lookupRaw rlv dom typ
+  where
+    {- CNAME hack
+    dom' = if "." `isSuffixOf` dom
+           then dom
+           else dom ++ "."
+    correct r = rrname r == dom' && rrtype r == typ
+    -}
+    correct r = rrtype r == typ
+    listToMaybe [] = Nothing
+    listToMaybe xs = Just xs
+    toRDATA = listToMaybe . map rdata . filter correct . answer
+
+{-|
+  Looking up a domain and returning an entire DNS Response.
+-}
+lookupRaw :: Resolver -> Domain -> TYPE -> IO (Maybe DNSFormat)
+lookupRaw rlv dom typ = do
+    seqno <- genId rlv
+    sendAll sock (composeQuery seqno [q])
+    (>>= check seqno) <$> timeout tm (parseResponse <$> recv sock bufsize)
+  where
+    sock = dnsSock rlv
+    bufsize = dnsBufsize rlv
+    tm = dnsTimeout rlv
+    q = makeQuestion dom typ
+    check seqno res = do
+        let hdr = header res
+        if identifier hdr == seqno && anCount hdr /= 0
+            then Just res
+            else Nothing
diff --git a/Network/DNS/Response.hs b/Network/DNS/Response.hs
new file mode 100644
--- /dev/null
+++ b/Network/DNS/Response.hs
@@ -0,0 +1,155 @@
+module Network.DNS.Response (parseResponse) where
+
+import Control.Monad
+import Data.Bits
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Char
+import Data.IP
+import Data.Maybe
+import Network.DNS.Internal
+import Network.DNS.StateBinary
+
+----------------------------------------------------------------
+
+parseResponse :: L.ByteString -> DNSFormat
+parseResponse = runSGet decodeResponse
+
+----------------------------------------------------------------
+
+decodeResponse :: SGet DNSFormat
+decodeResponse = do
+    hd <- decodeHeader
+    DNSFormat hd <$> decodeQueries (qdCount hd)
+                 <*> decodeRRs (anCount hd)
+                 <*> decodeRRs (nsCount hd)
+                 <*> decodeRRs (arCount hd)
+
+----------------------------------------------------------------
+
+decodeFlags :: SGet DNSFlags
+decodeFlags = do
+  flgs <- get16
+  return $ DNSFlags (getQorR flgs)
+                    (getOpcode flgs)
+                    (getAuthAnswer flgs)
+                    (getTrunCation flgs)
+                    (getRecDesired flgs)
+                    (getRecAvailable flgs)
+                    (getRcode flgs)
+  where
+    getQorR w = if testBit w 15 then QR_Response else QR_Query
+    getOpcode w = toEnum $ fromIntegral $ shiftR w 11 .&. 0x0f
+    getAuthAnswer w = testBit w 10
+    getTrunCation w = testBit w 9
+    getRecDesired w = testBit w 8
+    getRecAvailable w = testBit w 7
+    getRcode w = toEnum $ fromIntegral $ w .&. 0x0f
+
+----------------------------------------------------------------
+
+decodeHeader :: SGet DNSHeader
+decodeHeader = DNSHeader <$> decodeIdentifier
+                         <*> decodeFlags
+                         <*> decodeQdCount
+                         <*> decodeAnCount
+                         <*> decodeNsCount
+                         <*> decodeArCount
+  where
+    decodeIdentifier = getInt16
+    decodeQdCount = getInt16
+    decodeAnCount = getInt16
+    decodeNsCount = getInt16
+    decodeArCount = getInt16
+
+----------------------------------------------------------------
+
+decodeQueries :: Int -> SGet [Question]
+decodeQueries n = replicateM n decodeQuery
+
+decodeType :: SGet TYPE
+decodeType = intToType <$> getInt16
+
+decodeQuery :: SGet Question
+decodeQuery = Question <$> decodeDomain
+                       <*> (decodeType <* ignoreClass)
+
+decodeRRs :: Int -> SGet [ResourceRecord]
+decodeRRs n = replicateM n decodeRR
+
+decodeRR :: SGet ResourceRecord
+decodeRR = do
+    Question dom typ <- decodeQuery
+    ttl <- decodeTTL
+    len <- decodeRLen
+    dat <- decodeRData typ len
+    return ResourceRecord { rrname = dom
+                          , rrtype = typ
+                          , rrttl  = ttl
+                          , rdlen  = len
+                          , rdata  = dat
+                          }
+  where
+    decodeTTL = fromIntegral <$> get32
+    decodeRLen = getInt16
+
+decodeRData :: TYPE -> Int -> SGet RDATA
+decodeRData NS _ = RD_NS <$> decodeDomain
+decodeRData MX _ = RD_MX <$> decodePreference <*> decodeDomain
+  where
+    decodePreference = getInt16
+decodeRData CNAME _ = RD_CNAME <$> decodeDomain
+decodeRData TXT len = (RD_TXT . ignoreLength) <$> getNByteString len
+  where
+    ignoreLength = L.tail
+decodeRData A len  = (RD_A . toIPv4) <$> getNBytes len
+decodeRData AAAA len  = (RD_AAAA . toIPv6 . combine) <$> getNBytes len
+  where
+    combine [] = []
+    combine [_] = error "combine"
+    combine (a:b:cs) =  a * 256 + b : combine cs
+decodeRData SOA _ = RD_SOA <$> decodeDomain
+                           <*> decodeDomain
+                           <*> decodeSerial
+                           <*> decodeRefesh
+                           <*> decodeRetry
+                           <*> decodeExpire
+                           <*> decodeMinumun
+  where
+    decodeSerial  = getInt32
+    decodeRefesh  = getInt32
+    decodeRetry   = getInt32
+    decodeExpire  = getInt32
+    decodeMinumun = getInt32
+
+decodeRData _  len = RD_OTH <$> getNBytes len
+
+----------------------------------------------------------------
+
+decodeDomain :: SGet Domain
+decodeDomain = do
+    pos <- getPosition
+    c <- getInt8
+    if c == 0
+      then return ""
+      else do
+        let n = getValue c
+        if isPointer c
+          then do
+            d <- getInt8
+            let offset = n * 256 + d
+            fromMaybe (error $ "decodeDomain: " ++ show offset) <$> pop offset
+          else do
+            hs <- decodeString n
+            ds <- decodeDomain
+            let dom = hs ++ "." ++ ds
+            push pos dom
+            return dom
+  where
+    getValue c = c .&. 0x3f
+    isPointer c = testBit c 7 && testBit c 6
+
+decodeString :: Int -> SGet String
+decodeString n = map chr <$> getNBytes n
+
+ignoreClass :: SGet ()
+ignoreClass = () <$ get16
diff --git a/Network/DNS/StateBinary.hs b/Network/DNS/StateBinary.hs
new file mode 100644
--- /dev/null
+++ b/Network/DNS/StateBinary.hs
@@ -0,0 +1,109 @@
+module Network.DNS.StateBinary where
+
+import Control.Monad.State
+import Data.Binary.Get
+import Data.Binary.Put
+import qualified Data.ByteString.Lazy.Char8 as L
+import Data.Char
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IM (insert, lookup, empty)
+import Data.Word
+import Network.DNS.Types
+import Prelude hiding (lookup)
+
+----------------------------------------------------------------
+
+type SGet = StateT PState Get
+
+type PState = IntMap Domain
+
+----------------------------------------------------------------
+
+(<$>) :: (Monad m) => (a -> b) -> m a -> m b
+(<$>) = liftM
+
+(<$) :: (Monad m) => b -> m a -> m b
+x <$ y = y >> return x
+
+(<*>) :: (Monad m) => m (a -> b) -> m a -> m b
+(<*>) = ap
+
+(<*) :: (Monad m) => m a -> m b -> m a
+(<*) ma mb = do
+    a <- ma
+    mb
+    return a
+
+----------------------------------------------------------------
+
+type SPut = Put
+
+put8 :: Word8 -> SPut
+put8  = putWord8
+
+put16 :: Word16 -> SPut
+put16 = putWord16be
+
+put32 :: Word32 -> SPut
+put32 = putWord32be
+
+putInt8 :: Int -> SPut
+putInt8  = put8  . fromIntegral
+
+putInt16 :: Int -> SPut
+putInt16 = put16 . fromIntegral
+
+putInt32 :: Int -> SPut
+putInt32 = put32 . fromIntegral
+
+----------------------------------------------------------------
+
+get8 :: SGet Word8
+get8  = lift getWord8
+
+get16 :: SGet Word16
+get16 = lift getWord16be
+
+get32 :: SGet Word32
+get32 = lift getWord32be
+
+getInt8 :: SGet Int
+getInt8 = fromIntegral <$> get8
+
+getInt16 :: SGet Int
+getInt16 = fromIntegral <$> get16
+
+getInt32 :: SGet Int
+getInt32 = fromIntegral <$> get32
+
+----------------------------------------------------------------
+
+getPosition :: SGet Int
+getPosition = fromIntegral <$> lift bytesRead
+
+getNBytes :: Int -> SGet [Int]
+getNBytes len = toInts <$> getNByteString len
+  where
+    toInts = map ord . L.unpack
+
+getNByteString :: Int -> SGet L.ByteString
+getNByteString len = lift . getLazyByteString . fromIntegral $ len
+
+----------------------------------------------------------------
+
+push :: Int -> Domain -> SGet ()
+push n d = modify (IM.insert n d)
+
+pop :: Int -> SGet (Maybe Domain)
+pop n = IM.lookup n <$> get
+
+----------------------------------------------------------------
+
+initialState :: IntMap Domain
+initialState = IM.empty
+
+runSGet :: SGet DNSFormat -> L.ByteString -> DNSFormat
+runSGet res bs = fst $ runGet (runStateT res initialState) bs
+
+runSPut :: Put -> L.ByteString
+runSPut = runPut
diff --git a/Network/DNS/Types.hs b/Network/DNS/Types.hs
new file mode 100644
--- /dev/null
+++ b/Network/DNS/Types.hs
@@ -0,0 +1,19 @@
+{-|
+  Data types for DNS Query and Response. For more information, see <http://www.ietf.org/rfc/rfc1035>.
+-}
+
+module Network.DNS.Types (
+    Domain
+  , TYPE (..), intToType, typeToInt, toType
+  , DNSFormat, header, question, answer, authority, additional
+  , DNSHeader, identifier, flags, qdCount, anCount, nsCount, arCount
+  , DNSFlags, qOrR, opcode, authAnswer, trunCation, recDesired, recAvailable, rcode
+  , QorR (..)
+  , OPCODE (..)
+  , RCODE (..)
+  , ResourceRecord, rrname, rrtype, rrttl, rdlen, rdata
+  , Question, qname, qtype, makeQuestion
+  , RDATA (..)
+  ) where
+
+import Network.DNS.Internal
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/Test.hs b/Test.hs
new file mode 100644
--- /dev/null
+++ b/Test.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Test where
+
+import Data.IP
+import Data.List
+import Network.DNS as DNS
+import Test.Framework (defaultMain, testGroup, Test)
+import Test.Framework.Providers.HUnit
+import Test.HUnit hiding (Test)
+
+tests :: [Test]
+tests = [
+    testGroup "Test case" [
+         testCase "lookupA" test_lookupA
+       , testCase "lookupAAAA" test_lookupAAAA
+       , testCase "lookupTXT" test_lookupTXT
+       , testCase "lookupAviaMX" test_lookupAviaMX
+       , testCase "lookupAviaCNAME" test_lookupAviaCNAME
+       ]
+  ]
+
+(?=) :: (Eq a, Show a) => IO a -> a -> IO ()
+a ?= b = a >>= (@?= b)
+
+test_lookupA :: IO ()
+test_lookupA = do
+    rs <- makeResolvSeed defaultResolvConf
+    withResolver rs $ \resolver ->
+        DNS.lookupA resolver "www.mew.org" ?= Just [toIPv4 [202,232,15,101]]
+
+(??=) :: (Ord a, Show a) => IO (Maybe [a]) -> [a] -> IO ()
+a ??= bs = do
+    mas <- a
+    case mas of
+        Nothing -> False @? "should be Nothing"
+        Just as -> sort as @?= sort bs
+
+test_lookupAAAA :: IO ()
+test_lookupAAAA = do
+    rs <- makeResolvSeed defaultResolvConf
+    withResolver rs $ \resolver -> do
+        DNS.lookupAAAA resolver "mew.org" ?= Nothing
+        DNS.lookupAAAA resolver "www.mew.org" ?= Just [read "2001:240:11e:c00::101"]
+
+test_lookupTXT :: IO ()
+test_lookupTXT = do
+    rs <- makeResolvSeed defaultResolvConf
+    withResolver rs $ \resolver ->
+        DNS.lookupTXT resolver "mew.org" ?= Just ["v=spf1 +mx -all"]
+
+test_lookupAviaMX :: IO ()
+test_lookupAviaMX = do
+    rs <- makeResolvSeed defaultResolvConf
+    withResolver rs $ \resolver ->
+        DNS.lookupAviaMX resolver "mixi.jp" ??= [read "202.32.29.4", read "202.32.29.5"]
+
+test_lookupAviaCNAME :: IO ()
+test_lookupAviaCNAME = do
+    rs <- makeResolvSeed defaultResolvConf
+    withResolver rs $ \resolver ->
+        DNS.lookupA resolver "foundry1.hongo.wide.ad.jp" ??= [read "203.178.135.1", read "203.178.138.230"]
+
+main :: IO ()
+main = defaultMain tests
diff --git a/dns.cabal b/dns.cabal
new file mode 100644
--- /dev/null
+++ b/dns.cabal
@@ -0,0 +1,35 @@
+Name:                   dns
+Version:                0.1.0
+Author:                 Kazu Yamamoto <kazu@iij.ad.jp>
+Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp>
+License:                BSD3
+License-File:           LICENSE
+Synopsis:               DNS libary in Haskell
+Description:            DNS libary. Currently only resolver side
+                        is supported. That is, this library includes
+                        a composer of DNS query and a parser of DNS
+                        response.
+Category:               Network
+Cabal-Version:          >= 1.6
+Build-Type:             Simple
+Extra-Source-Files:     Test.hs
+library
+  if impl(ghc >= 6.12)
+    GHC-Options:        -Wall -fno-warn-unused-do-bind
+  else
+    GHC-Options:        -Wall
+  Exposed-Modules:      Network.DNS
+                        Network.DNS.Lookup
+                        Network.DNS.Resolver
+                        Network.DNS.Types
+  Other-Modules:        Network.DNS.Internal
+                        Network.DNS.StateBinary
+                        Network.DNS.Query
+                        Network.DNS.Response
+  Build-Depends:        base >= 4 && < 5, haskell98,
+                        binary, iproute,
+                        containers, mtl, bytestring,
+                        network, network-bytestring
+Source-Repository head
+  Type:                 git
+  Location:             git://github.com/kazu-yamamoto/dns.git