From e20884198d8765d05b75db1db2cd785d3983649c Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Tue, 30 Aug 2011 12:18:12 +0900 Subject: using blaze-builder. --- Network/DNS/Query.hs | 65 +++++++++++++++++++++++----------------------- Network/DNS/StateBinary.hs | 27 +++++++++---------- dns.cabal | 4 +-- 3 files changed, 48 insertions(+), 48 deletions(-) diff --git a/Network/DNS/Query.hs b/Network/DNS/Query.hs index a431dbd..3c4852e 100644 --- a/Network/DNS/Query.hs +++ b/Network/DNS/Query.hs @@ -4,6 +4,10 @@ import qualified Data.ByteString.Lazy.Char8 as L import Data.Char import Network.DNS.StateBinary import Network.DNS.Internal +import Data.Monoid + +(+++) :: Monoid a => a -> a -> a +(+++) = mappend ---------------------------------------------------------------- @@ -22,52 +26,47 @@ composeQuery idt qs = runSPut (encodeQuery qry) ---------------------------------------------------------------- encodeQuery :: DNSFormat -> SPut -encodeQuery fmt = do - let hdr = header fmt - qs = question fmt - encodeHeader hdr - encodeQuestion qs - return () +encodeQuery fmt = encodeHeader hdr + +++ encodeQuestion qs + where + hdr = header fmt + qs = question fmt encodeHeader :: DNSHeader -> SPut -encodeHeader hdr = do - encodeIdentifier $ identifier hdr - encodeFlags $ flags hdr - decodeQdCount $ qdCount hdr - decodeAnCount $ anCount hdr - decodeNsCount $ nsCount hdr - decodeArCount $ arCount hdr +encodeHeader hdr = 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 + encodeIdentifier = putInt16 . fromIntegral + decodeQdCount = putInt16 . fromIntegral + decodeAnCount = putInt16 . fromIntegral + decodeNsCount = putInt16 . fromIntegral + decodeArCount = putInt16 . fromIntegral 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 +encodeQuestion qs = encodeDomain dom + +++ putInt16 (fromIntegral (typeToInt typ)) + +++ put16 1 + where + q = head qs + dom = qname q + typ = qtype q ---------------------------------------------------------------- encodeDomain :: Domain -> SPut -encodeDomain dom = do - let ss = split '.' dom - ls = map length ss - mapM_ encodeSubDomain $ zip ls ss - put8 0 +encodeDomain dom = foldr (+++) (put8 0) (map encodeSubDomain $ zip ls ss) where - encodeSubDomain (len,sub) = do - putInt8 len - mapM_ (putInt8 . ord) sub + ss = split '.' dom + ls = map length ss + encodeSubDomain (len,sub) = putInt8 (fromIntegral len) + +++ foldr (+++) mempty (map (putInt8 . fromIntegral . ord) sub) split :: Char -> String -> [String] split _ "" = [] diff --git a/Network/DNS/StateBinary.hs b/Network/DNS/StateBinary.hs index ffbf728..5099104 100644 --- a/Network/DNS/StateBinary.hs +++ b/Network/DNS/StateBinary.hs @@ -1,10 +1,11 @@ module Network.DNS.StateBinary where +import Blaze.ByteString.Builder 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.Int import Data.IntMap (IntMap) import qualified Data.IntMap as IM (insert, lookup, empty) import Data.Word @@ -36,25 +37,25 @@ x <$ y = y >> return x ---------------------------------------------------------------- -type SPut = Put +type SPut = Write put8 :: Word8 -> SPut -put8 = putWord8 +put8 = writeWord8 put16 :: Word16 -> SPut -put16 = putWord16be +put16 = writeWord16be put32 :: Word32 -> SPut -put32 = putWord32be +put32 = writeWord32be -putInt8 :: Int -> SPut -putInt8 = put8 . fromIntegral +putInt8 :: Int8 -> SPut +putInt8 = writeInt8 -putInt16 :: Int -> SPut -putInt16 = put16 . fromIntegral +putInt16 :: Int16 -> SPut +putInt16 = writeInt16be -putInt32 :: Int -> SPut -putInt32 = put32 . fromIntegral +putInt32 :: Int32 -> SPut +putInt32 = writeInt32be ---------------------------------------------------------------- @@ -105,5 +106,5 @@ initialState = IM.empty runSGet :: SGet DNSFormat -> L.ByteString -> DNSFormat runSGet res bs = fst $ runGet (runStateT res initialState) bs -runSPut :: Put -> L.ByteString -runSPut = runPut +runSPut :: SPut -> L.ByteString +runSPut = toLazyByteString . fromWrite diff --git a/dns.cabal b/dns.cabal index 7f71d37..316dcac 100644 --- a/dns.cabal +++ b/dns.cabal @@ -30,12 +30,12 @@ library Build-Depends: base >= 4 && < 5, binary, iproute, containers, mtl, bytestring, random, - network >= 2.3 + network >= 2.3, blaze-builder else Build-Depends: base >= 4 && < 5, binary, iproute, containers, mtl, bytestring, random, - network, network-bytestring + network, network-bytestring, blaze-builder Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/dns.git -- cgit v1.2.3