dns 2.0.4 → 2.0.5

raw patch · 8 files changed

+89/−32 lines, 8 filesdep +bytestring-builderdep −blaze-builderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring-builder

Dependencies removed: blaze-builder

API changes (from Hackage documentation)

Files

• Network/DNS/Decode.hs +12/−0
• Network/DNS/Encode.hs +30/−5
• Network/DNS/Internal.hs +9/−0
• Network/DNS/Lookup.hs +1/−2
• Network/DNS/Resolver.hs +17/−8
• Network/DNS/StateBinary.hs +13/−13
• dns.cabal +5/−4
• test/EncodeSpec.hs +2/−0

@@ -98,6 +98,7 @@                         (getRecDesired flgs)                         (getRecAvailable flgs)                         rcode_+                        (getAuthenData flgs)     getQorR w = if testBit w 15 then QR_Response else QR_Query     getOpcode w = Safe.toEnumMay (fromIntegral (shiftR w 11 .&. 0x0f))     getAuthAnswer w = testBit w 10@@ -105,6 +106,7 @@     getRecDesired w = testBit w 8     getRecAvailable w = testBit w 7     getRcode w = Safe.toEnumMay (fromIntegral (w .&. 0x0f))+    getAuthenData w = testBit w 5  ---------------------------------------------------------------- @@ -229,6 +231,16 @@             optLen <- getInt16             dat <- decodeOData optCode optLen             (dat:) <$> decode' (l - optLen - 4)+--+decodeRData TLSA len = RD_TLSA <$> decodeUsage+                               <*> decodeSelector+                               <*> decodeMType+                               <*> decodeADF+  where+    decodeUsage    = getInt8+    decodeSelector = getInt8+    decodeMType    = getInt8+    decodeADF      = getNByteString (len - 3) decodeRData _  len = RD_OTH <$> getNByteString len  decodeOData :: OPTTYPE -> Int -> SGet OData

@@ -3,14 +3,16 @@ module Network.DNS.Encode (     encode   , composeQuery+  , composeQueryAD   ) where -import qualified Blaze.ByteString.Builder as BB import Control.Monad (when) import Control.Monad.State (State, modify, execState, gets) import Data.Binary (Word16) import Data.Bits ((.|.), bit, shiftL, setBit)+import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as BL import Data.ByteString.Lazy.Char8 (ByteString) import Data.IP (IP(..),fromIPv4, fromIPv6b) import Data.List (dropWhileEnd)@@ -37,6 +39,21 @@       , question = qs       } +composeQueryAD :: Int -> [Question] -> ByteString+composeQueryAD idt qs = encode qry+  where+      hdr = header defaultQuery+      flg = flags hdr+      qry = defaultQuery {+          header = hdr {+              identifier = idt,+              flags = flg {+                  authenData = True+              }+           }+        , question = qs+        }+ ----------------------------------------------------------------  -- | Composing DNS data.@@ -83,6 +100,7 @@     st :: State Word16 ()     st = sequence_               [ set (word16 rcode)+              , when authenData          $ set (bit 5)               , when recAvailable        $ set (bit 7)               , when recDesired          $ set (bit 8)               , when trunCation          $ set (bit 9)@@ -101,10 +119,11 @@ putRData :: RData -> SPut putRData rd = do     addPositionW 2 -- "simulate" putInt16-    rDataWrite <- encodeRDATA rd-    let rdataLength = fromIntegral . BS.length . BB.toByteString . BB.fromWrite $ rDataWrite-    let rlenWrite = BB.writeInt16be rdataLength-    return rlenWrite <> return rDataWrite+    rDataBuilder <- encodeRDATA rd+    -- fixmed: SPut must hold length+    let rdataLength = fromIntegral . BL.length . BB.toLazyByteString $ rDataBuilder+    let rlenBuilder = BB.int16BE rdataLength+    return rlenBuilder <> return rDataBuilder  encodeRR :: ResourceRecord -> SPut encodeRR ResourceRecord{..} = mconcat [ encodeDomain rrname@@ -149,6 +168,12 @@         , putInt16 weight         , putInt16 port         , encodeDomain dom+        ]+    (RD_TLSA u s m d) -> mconcat+        [ putInt8 u+        , putInt8 s+        , putInt8 m+        , putByteString d         ]  encodeOData :: OData -> SPut

@@ -5,6 +5,8 @@ import Control.Exception (Exception) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Builder as L+import qualified Data.ByteString.Lazy as L import Data.IP (IP, IPv4, IPv6) import Data.Maybe (fromMaybe) import Data.Typeable (Typeable)@@ -28,6 +30,7 @@           | SRV           | DNAME           | OPT+          | TLSA           | UNKNOWN Int deriving (Eq, Show, Read)  rrDB :: [(TYPE, Int)]@@ -43,6 +46,7 @@   , (SRV,   33)   , (DNAME, 39) -- RFC 2672   , (OPT,   41) -- RFC 6891+  , (TLSA,  52) -- RFC 6898   ]  data OPTTYPE = ClientSubnet@@ -137,6 +141,7 @@   , recDesired   :: Bool   , recAvailable :: Bool   , rcode        :: RCODE+  , authenData   :: Bool   } deriving (Eq, Show)  ----------------------------------------------------------------@@ -201,6 +206,7 @@            | RD_SRV Int Int Int Domain            | RD_OPT [OData]            | RD_OTH ByteString+           | RD_TLSA Int Int Int ByteString     deriving (Eq)  instance Show RData where@@ -216,6 +222,7 @@   show (RD_SRV pri wei prt dom) = show pri ++ " " ++ show wei ++ " " ++ show prt ++ BS.unpack dom   show (RD_OPT od) = show od   show (RD_OTH is) = show is+  show (RD_TLSA use sel mtype dgst) = show use ++ " " ++ show sel ++ " " ++ show mtype ++ " " ++ (BS.unpack $ L.toStrict . L.toLazyByteString . L.byteStringHex $ dgst)   data OData = OD_ClientSubnet Int Int IP@@ -236,6 +243,7 @@          , recDesired   = True          , recAvailable = False          , rcode        = NoErr+         , authenData   = False          }      }   , question   = []@@ -254,6 +262,7 @@               qOrR = QR_Response             , authAnswer = True             , recAvailable = True+            , authenData = False             }         }       }

@@ -197,8 +197,7 @@ lookupAAAAviaMX :: Resolver -> Domain -> IO (Either DNSError [IPv6]) lookupAAAAviaMX rlv dom = lookupXviaMX rlv dom (lookupAAAA rlv) -lookupXviaMX :: Show a-             => Resolver+lookupXviaMX :: Resolver              -> Domain              -> (Domain -> IO (Either DNSError [a]))              -> IO (Either DNSError [a])

@@ -14,6 +14,7 @@   , lookupAuth   -- ** Raw looking up function   , lookupRaw+  , lookupRawAD   , fromDNSMessage   , fromDNSFormat   ) where@@ -27,7 +28,7 @@ import Network.DNS.Encode import Network.DNS.Internal import qualified Data.ByteString.Char8 as BS-import Network.Socket (HostName, Socket, SocketType(Datagram), sClose, socket, connect)+import Network.Socket (HostName, Socket, SocketType(Datagram), close, socket, connect) import Network.Socket (AddrInfoFlag(..), AddrInfo(..), SockAddr(..), PortNumber(..), defaultHints, getAddrInfo) import Prelude hiding (lookup) import System.Random (getStdRandom, randomR)@@ -166,7 +167,7 @@ --   'Resolver'. If multiple 'Resolver's are necessary for --   concurrent purpose, use 'withResolvers'. withResolver :: ResolvSeed -> (Resolver -> IO a) -> IO a-withResolver seed func = bracket (openSocket seed) sClose $ \sock -> do+withResolver seed func = bracket (openSocket seed) close $ \sock -> do     connectSocket sock seed     func $ makeResolver seed sock @@ -181,7 +182,7 @@     func resolvs   where     openSockets = mapM openSocket seeds-    closeSockets = mapM sClose+    closeSockets = mapM close  openSocket :: ResolvSeed -> IO Socket openSocket seed = socket (addrFamily ai) (addrSocketType ai) (addrProtocol ai)@@ -291,7 +292,9 @@ --                                      trunCation = False, --                                      recDesired = True, --                                      recAvailable = True,---                                      rcode = NoErr },+--                                      rcode = NoErr,+--                                      authenData = False+--                                    }, --                        }, --             question = [Question { qname = \"www.example.com.\", --                                    qtype = A}],@@ -305,19 +308,25 @@ --  @ -- lookupRaw :: Resolver -> Domain -> TYPE -> IO (Either DNSError DNSMessage)-lookupRaw = lookupRawInternal receive+lookupRaw = lookupRawInternal receive False +lookupRawAD :: Resolver -> Domain -> TYPE -> IO (Either DNSError DNSMessage)+lookupRawAD = lookupRawInternal receive True+++ lookupRawInternal ::     (Socket -> IO DNSMessage)+    -> Bool     -> Resolver     -> Domain     -> TYPE     -> IO (Either DNSError DNSMessage)-lookupRawInternal _ _   dom _+lookupRawInternal _ _ _   dom _   | isIllegal dom     = return $ Left IllegalDomain-lookupRawInternal rcv rlv dom typ = do+lookupRawInternal rcv ad rlv dom typ = do     seqno <- genId rlv-    let query = composeQuery seqno [q]+    let query = (if ad then composeQueryAD else composeQuery) seqno [q]         checkSeqno = check seqno     loop query checkSeqno 0 False   where

@@ -1,8 +1,6 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP #-} module Network.DNS.StateBinary where -import Blaze.ByteString.Builder (Write)-import qualified Blaze.ByteString.Builder as BB import Control.Monad.State (State, StateT) import qualified Control.Monad.State as ST import Control.Monad.Trans.Resource (ResourceT)@@ -11,6 +9,8 @@ import qualified Data.Attoparsec.Types as T import Data.ByteString (ByteString) import qualified Data.ByteString as BS+import Data.ByteString.Builder (Builder)+import qualified Data.ByteString.Builder as BB import qualified Data.ByteString.Lazy as BL import Data.Conduit (Sink) import Data.Conduit.Attoparsec (sinkParser)@@ -28,7 +28,7 @@  ---------------------------------------------------------------- -type SPut = State WState Write+type SPut = State WState Builder  data WState = WState {     wsDomain :: Map Domain Int@@ -43,36 +43,36 @@     mappend a b = mconcat <$> sequence [a, b]  put8 :: Word8 -> SPut-put8 = fixedSized 1 BB.writeWord8+put8 = fixedSized 1 BB.word8  put16 :: Word16 -> SPut-put16 = fixedSized 2 BB.writeWord16be+put16 = fixedSized 2 BB.word16BE  put32 :: Word32 -> SPut-put32 = fixedSized 4 BB.writeWord32be+put32 = fixedSized 4 BB.word32BE  putInt8 :: Int -> SPut-putInt8 = fixedSized 1 (BB.writeInt8 . fromIntegral)+putInt8 = fixedSized 1 (BB.int8 . fromIntegral)  putInt16 :: Int -> SPut-putInt16 = fixedSized 2 (BB.writeInt16be . fromIntegral)+putInt16 = fixedSized 2 (BB.int16BE . fromIntegral)  putInt32 :: Int -> SPut-putInt32 = fixedSized 4 (BB.writeInt32be . fromIntegral)+putInt32 = fixedSized 4 (BB.int32BE . fromIntegral)  putByteString :: ByteString -> SPut-putByteString = writeSized BS.length BB.writeByteString+putByteString = writeSized BS.length BB.byteString  addPositionW :: Int -> State WState () addPositionW n = do     (WState m cur) <- ST.get     ST.put $ WState m (cur+n) -fixedSized :: Int -> (a -> Write) -> a -> SPut+fixedSized :: Int -> (a -> Builder) -> a -> SPut fixedSized n f a = do addPositionW n                       return (f a) -writeSized :: Show a => (a -> Int) -> (a -> Write) -> a -> SPut+writeSized :: (a -> Int) -> (a -> Builder) -> a -> SPut writeSized n f a = do addPositionW (n a)                       return (f a) @@ -176,4 +176,4 @@     toResult (AL.Fail _ _ err) = Left err  runSPut :: SPut -> BL.ByteString-runSPut = BB.toLazyByteString . BB.fromWrite . flip ST.evalState initialWState+runSPut = BB.toLazyByteString . flip ST.evalState initialWState

@@ -1,5 +1,5 @@ Name:                   dns-Version:                2.0.4+Version:                2.0.5 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -29,8 +29,8 @@     Build-Depends:      base >= 4 && < 5                       , attoparsec                       , binary-                      , blaze-builder                       , bytestring+                      , bytestring-builder                       , conduit >= 1.1                       , conduit-extra >= 1.1                       , containers@@ -44,8 +44,8 @@     Build-Depends:      base >= 4 && < 5                       , attoparsec                       , binary-                      , blaze-builder                       , bytestring+                      , bytestring-builder                       , conduit >= 1.1                       , conduit-extra >= 1.1                       , containers@@ -67,6 +67,7 @@   Build-Depends:        dns                       , base                       , bytestring+                      , bytestring-builder                       , hspec  Test-Suite spec@@ -80,8 +81,8 @@   Build-Depends:        base                       , attoparsec                       , binary-                      , blaze-builder                       , bytestring+                      , bytestring-builder                       , conduit >= 1.1                       , conduit-extra >= 1.1                       , containers

@@ -67,6 +67,7 @@          , recDesired = True          , recAvailable = True          , rcode = NoErr+         , authenData = False          }        }   , question = [Question {@@ -175,6 +176,7 @@          , recDesired = True          , recAvailable = True          , rcode = NoErr+         , authenData = False          }        }   , question = [Question {