Script 'mail_helper' called by obssrc
Hello community,

here is the log from the commit of package ghc-dns for openSUSE:Factory checked 
in at 2022-10-13 15:41:44
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-dns (Old)
 and      /work/SRC/openSUSE:Factory/.ghc-dns.new.2275 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Package is "ghc-dns"

Thu Oct 13 15:41:44 2022 rev:3 rq:1008455 version:4.1.0

Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-dns/ghc-dns.changes  2020-12-22 
11:38:46.189458574 +0100
+++ /work/SRC/openSUSE:Factory/.ghc-dns.new.2275/ghc-dns.changes        
2022-10-13 15:41:51.934705174 +0200
@@ -1,0 +2,9 @@
+Tue Aug  9 04:58:03 UTC 2022 - Peter Simons <[email protected]>
+
+- Update dns to version 4.1.0.
+  Upstream has edited the change log file since the last release in
+  a non-trivial way, i.e. they did more than just add a new entry
+  at the top. You can review the file at:
+  http://hackage.haskell.org/package/dns-4.1.0/src/Changelog.md
+
+-------------------------------------------------------------------

Old:
----
  dns-4.0.1.tar.gz

New:
----
  dns-4.1.0.tar.gz

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Other differences:
------------------
++++++ ghc-dns.spec ++++++
--- /var/tmp/diff_new_pack.csw4t6/_old  2022-10-13 15:41:52.514706306 +0200
+++ /var/tmp/diff_new_pack.csw4t6/_new  2022-10-13 15:41:52.522706321 +0200
@@ -1,7 +1,7 @@
 #
 # spec file for package ghc-dns
 #
-# Copyright (c) 2020 SUSE LLC
+# Copyright (c) 2022 SUSE LLC
 #
 # All modifications and additions to the file contributed by third parties
 # remain the property of their copyright owners, unless otherwise agreed
@@ -20,7 +20,7 @@
 %global has_internal_sub_libraries 1
 %bcond_with tests
 Name:           ghc-%{pkg_name}
-Version:        4.0.1
+Version:        4.1.0
 Release:        0
 Summary:        DNS library in Haskell
 License:        BSD-3-Clause

++++++ dns-4.0.1.tar.gz -> dns-4.1.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/Changelog.md new/dns-4.1.0/Changelog.md
--- old/dns-4.0.1/Changelog.md  2019-11-20 01:39:27.000000000 +0100
+++ new/dns-4.1.0/Changelog.md  2001-09-09 03:46:40.000000000 +0200
@@ -1,4 +1,32 @@
-# 4.0.1
+# ChangeLog
+
+## 4.1.0
+
+- Breaking change: GHC 7.x and earlier no longer supported.
+  We now require support for PatternSynonyms, available since
+  GHC 8.0.
+- Feature: relaxed lookup-raw interface
+  [#167](https://github.com/kazu-yamamoto/dns/pull/167)
+- Using "53" instead of "domain".
+  [#166](ttps://github.com/kazu-yamamoto/dns/pull/166)
+- UDP ReceiveFrom, sendTo with SockAddr
+  [#165](https://github.com/kazu-yamamoto/dns/pull/165)
+- Feature: Support for RP resource record type
+  [#161](https://github.com/kazu-yamamoto/dns/pull/161)
+- Feature: New `splitDomain` function splits a domain name
+  at the first label break, unescaping the first label to
+  a raw ByteString.
+- Feature: New `splitMailbox` function splits a domain name
+  at the first label break, unescaping the first label to
+  a raw ByteString.
+  [#155](https://github.com/kazu-yamamoto/dns/pull/155)
+- Bugfix: Encoding of large packets could produce invalid
+  compression pointers.
+  [#156](https://github.com/kazu-yamamoto/dns/pull/156)
+- Bugfix: SRV record presentation form (RD_SRV show instance)
+  was missing a space between the port and the target.
+
+## 4.0.1
 
 - Bugfix: Retry without EDNS on empty FormatErr responses. Non-EDNS resolvers
   may return a FormErr response with an empty question section. Such a response
@@ -21,7 +49,7 @@
   Cabal 2.0 or later features to expose internal modules only to the test
   executables.
 
-# 4.0.0
+## 4.0.0
 
 - Breaking change: when `Domain` name ByteStrings are
   parsed as a sequence of DNS labels, backslashed escapes
@@ -156,26 +184,26 @@
 - New OP codes: OP\_NOTIFY and OP\_UPDATE.
   [#113](https://github.com/kazu-yamamoto/dns/pull/113)
 
-# 3.0.4
+## 3.0.4
 
 - Drop unexpected UDP answers 
[#112](https://github.com/kazu-yamamoto/dns/pull/112)
 
-# 3.0.3
+## 3.0.3
 
 - Implementing NSEC3PARAM [#109](https://github.com/kazu-yamamoto/dns/pull/109)
 - Fixing an example of DNS server.
 - Improving DNS decoder [#111](https://github.com/kazu-yamamoto/dns/pull/111)
 
-# 3.0.2
+## 3.0.2
 
 - Supporting conduit 1.3 [#105](https://github.com/kazu-yamamoto/dns/pull/105)
 - Supporting GHC 8.4 with semigroup hack.
 
-# 3.0.1
+## 3.0.1
 
 - Supporting GHC 7.8 again.
 
-# 3.0.0
+## 3.0.0
 
 - The version introduces some breaking changes internally. But upper layer 
APIs in the `Lookup` module remain the same.
 - Breaking change: `Network.DNS.Types` is redesigned. `ResourceRecord` is not 
a sum type anymore. It holds only normal RRs. For EDNS0, a new scheme is 
implemented. [#63](https://github.com/kazu-yamamoto/dns/issues/63)
@@ -188,52 +216,52 @@
 - Some constructors such as ANY are added in the `Types` module.
 - Some bug fixes and code clean-up.
 
-# 2.0.13
+## 2.0.13
 - Testing with AppVeyor.
 - Detecting a default DNS server on Windows.
 - Fixing sendAll on Windows [#72](https://github.com/kazu-yamamoto/dns/pull/72)
 
-# 2.0.12
+## 2.0.12
 - Fixing Windows build again
 
-# 2.0.11
+## 2.0.11
 - Fixing the StateBinary.get32 parser 
[#57](https://github.com/kazu-yamamoto/dns/pull/57)
 - Removing bytestring-builder dependency 
[#61](https://github.com/kazu-yamamoto/dns/pull/61)
 - Fixing Windows build [#62](https://github.com/kazu-yamamoto/dns/pull/62)
 
-# 2.0.10
+## 2.0.10
 - Cleaning up the code. [#47](https://github.com/kazu-yamamoto/dns/pull/47)
 
-# 2.0.9
+## 2.0.9
 - Implemented TCP fallback after a truncated UDP response. 
[#46](https://github.com/kazu-yamamoto/dns/pull/46)
 
-# 2.0.8
+## 2.0.8
 - Better handling of encoding and decoding the "root" domain ".". 
[#45](https://github.com/kazu-yamamoto/dns/pull/45)
 
-# 2.0.7
+## 2.0.7
 - Add length checks for A and AAAA records. 
[#43](https://github.com/kazu-yamamoto/dns/pull/43)
 
-# 2.0.6
+## 2.0.6
 - Adding Ord instance. [#41](https://github.com/kazu-yamamoto/dns/pull/41)
 - Adding DNSSEC-related RRTYPEs 
[#40](https://github.com/kazu-yamamoto/dns/pull/40)
 
-# 2.0.5
+## 2.0.5
 - Supporting DNS-SEC AD (authenticated data). 
[#38](https://github.com/kazu-yamamoto/dns/pull/38)
 - Removing the dependency to blaze-builder.
 
-# 2.0.4
+## 2.0.4
 - Renaming a variable to fix preprocessor conflicts 
[#37](https://github.com/kazu-yamamoto/dns/pull/37)
 
-# 2.0.3
+## 2.0.3
 - Handle invalid opcodes gracefully. 
[#36](https://github.com/kazu-yamamoto/dns/pull/36)
 
-# 2.0.2
+## 2.0.2
 - Providing a new API: decodeMany.
 
-# 2.0.1
+## 2.0.1
 - Updating document.
 
-# 2.0.0
+## 2.0.0
 - DNSMessage is now monomorphic
 - RDATA is now monomorphic
 - Removed traversal instance for DNSMessage
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/Network/DNS/IO.hs 
new/dns-4.1.0/Network/DNS/IO.hs
--- old/dns-4.0.1/Network/DNS/IO.hs     2019-11-20 01:39:27.000000000 +0100
+++ new/dns-4.1.0/Network/DNS/IO.hs     2001-09-09 03:46:40.000000000 +0200
@@ -1,12 +1,13 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Network.DNS.IO (
     -- * Receiving DNS messages
     receive
+  , receiveFrom
   , receiveVC
     -- * Sending pre-encoded messages
   , send
+  , sendTo
   , sendVC
   , sendAll
     -- ** Encoding queries for transmission
@@ -25,8 +26,8 @@
 import Data.IP (IPv4, IPv6)
 import Time.System (timeCurrent)
 import Time.Types (Elapsed(..), Seconds(..))
-import Network.Socket (Socket)
-import Network.Socket.ByteString (recv)
+import Network.Socket (Socket, SockAddr)
+import Network.Socket.ByteString (recv, recvFrom)
 import qualified Network.Socket.ByteString as Socket
 import System.IO.Error
 
@@ -37,10 +38,11 @@
 
 ----------------------------------------------------------------
 
--- | Receive and decode a single 'DNSMessage' from a UDP 'Socket'.  Messages
--- longer than 'maxUdpSize' are silently truncated, but this should not occur
--- in practice, since we cap the advertised EDNS UDP buffer size limit at the
--- same value.  A 'DNSError' is raised if I/O or message decoding fails.
+-- | Receive and decode a single 'DNSMessage' from a UDP 'Socket', throwing 
away
+-- the client address.  Messages longer than 'maxUdpSize' are silently
+-- truncated, but this should not occur in practice, since we cap the 
advertised
+-- EDNS UDP buffer size limit at the same value.  A 'DNSError' is raised if I/O
+-- or message decoding fails.
 --
 receive :: Socket -> IO DNSMessage
 receive sock = do
@@ -51,6 +53,20 @@
         Left  e   -> E.throwIO e
         Right msg -> return msg
 
+-- | Receive and decode a single 'DNSMessage' from a UDP 'Socket'.  Messages
+-- longer than 'maxUdpSize' are silently truncated, but this should not occur
+-- in practice, since we cap the advertised EDNS UDP buffer size limit at the
+-- same value.  A 'DNSError' is raised if I/O or message decoding fails.
+--
+receiveFrom :: Socket -> IO (DNSMessage, SockAddr)
+receiveFrom sock = do
+    let bufsiz = fromIntegral maxUdpSize
+    (bs, client) <- recvFrom sock bufsiz `E.catch` \e -> E.throwIO $ 
NetworkFailure e
+    Elapsed (Seconds now) <- timeCurrent
+    case decodeAt now bs of
+        Left  e   -> E.throwIO e
+        Right msg -> return (msg, client)
+
 -- | Receive and decode a single 'DNSMesage' from a virtual-circuit (TCP).  It
 -- is up to the caller to implement any desired timeout. An 'DNSError' is
 -- raised if I/O or message decoding fails.
@@ -105,6 +121,15 @@
 send = (void .). Socket.send
 {-# INLINE send #-}
 
+-- | Send an encoded 'DNSMessage' datagram over UDP to a given address.  The
+-- message length is implicit in the size of the UDP datagram.  With TCP you
+-- must use 'sendVC', because TCP does not have message boundaries, and each
+-- message needs to be prepended with an explicit length.
+--
+sendTo :: Socket -> ByteString -> SockAddr -> IO ()
+sendTo sock str addr = Socket.sendTo sock str addr >> return ()
+{-# INLINE sendTo #-}
+
 -- | Send a single encoded 'DNSMessage' over TCP.  An explicit length is
 -- prepended to the encoded buffer before transmission.  If you want to
 -- send a batch of multiple encoded messages back-to-back over a single
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/Network/DNS/Lookup.hs 
new/dns-4.1.0/Network/DNS/Lookup.hs
--- old/dns-4.0.1/Network/DNS/Lookup.hs 2019-11-20 01:39:27.000000000 +0100
+++ new/dns-4.1.0/Network/DNS/Lookup.hs 2001-09-09 03:46:40.000000000 +0200
@@ -95,7 +95,7 @@
 --
 --   >>> rs <- makeResolvSeed defaultResolvConf
 --   >>> withResolver rs $ \resolver -> lookupA resolver "www.kame.net"
---   Right [203.178.141.194]
+--   Right [210.155.141.200]
 --
 lookupA :: Resolver -> Domain -> IO (Either DNSError [IPv4])
 lookupA rlv dom = do
@@ -116,7 +116,7 @@
 --
 --   >>> rs <- makeResolvSeed defaultResolvConf
 --   >>> withResolver rs $ \resolver -> lookupAAAA resolver "www.wide.ad.jp"
---   Right [2001:200:dff:fff1:216:3eff:fe4b:651c]
+--   Right [2001:200:0:180c:20c:29ff:fec9:9d61]
 --
 lookupAAAA :: Resolver -> Domain -> IO (Either DNSError [IPv6])
 lookupAAAA rlv dom = do
@@ -183,7 +183,7 @@
 --   >>> rs <- makeResolvSeed defaultResolvConf
 --   >>> ips <- withResolver rs $ \resolver -> lookupAviaMX resolver 
"wide.ad.jp"
 --   >>> fmap sort ips
---   Right [133.138.10.39,203.178.136.30]
+--   Right [203.178.136.30]
 --
 --   Since there is more than one result, it is necessary to sort the
 --   list in order to check for equality.
@@ -353,7 +353,7 @@
 --   210.130.137.80, i.e., 80.137.130.210.in-addr.arpa:
 --
 --   >>> rs <- makeResolvSeed defaultResolvConf
---   >>> withResolver rs $ \resolver -> lookupPTR resolver 
"164.2.232.202.in-addr.arpa"
+--   >>> withResolver rs $ \resolver -> lookupPTR resolver 
"180.2.232.202.in-addr.arpa"
 --   Right ["www.iij.ad.jp."]
 --
 --   The 'lookupRDNS' function is more suited to this particular task.
@@ -378,7 +378,7 @@
 --   address directly:
 --
 --   >>> rs <- makeResolvSeed defaultResolvConf
---   >>> withResolver rs $ \resolver -> lookupRDNS resolver "202.232.2.164"
+--   >>> withResolver rs $ \resolver -> lookupRDNS resolver "202.232.2.180"
 --   Right ["www.iij.ad.jp."]
 --
 lookupRDNS :: Resolver -> Domain -> IO (Either DNSError [Domain])
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/Network/DNS/LookupRaw.hs 
new/dns-4.1.0/Network/DNS/LookupRaw.hs
--- old/dns-4.0.1/Network/DNS/LookupRaw.hs      2019-11-20 01:39:27.000000000 
+0100
+++ new/dns-4.1.0/Network/DNS/LookupRaw.hs      2001-09-09 03:46:40.000000000 
+0200
@@ -7,6 +7,7 @@
   -- * Lookups returning DNS Messages
   , lookupRaw
   , lookupRawCtl
+  , lookupRawCtlRecv
   -- * DNS Message procesing
   , fromDNSMessage
   ) where
@@ -14,6 +15,7 @@
 import Data.Hourglass (timeAdd, Seconds)
 import Prelude hiding (lookup)
 import Time.System (timeCurrent)
+import Network.Socket (Socket)
 
 import Network.DNS.IO
 import Network.DNS.Imports hiding (lookup)
@@ -150,7 +152,7 @@
     soas = filter (SOA `isTypeOf`) $ authority ans
 
 insertNegative :: CacheConf -> Cache -> Key -> Entry -> TTL -> IO ()
-insertNegative CacheConf{..} c k v ttl = when (ttl /= 0) $ do
+insertNegative _ c k v ttl = when (ttl /= 0) $ do
     ctime <- timeCurrent
     let tim = ctime `timeAdd` life
     insertCache k tim v c
@@ -253,7 +255,20 @@
              -> TYPE          -- ^ Query RRtype
              -> QueryControls -- ^ Query flag and EDNS overrides
              -> IO (Either DNSError DNSMessage)
-lookupRawCtl rslv dom typ ctls = resolve dom typ rslv ctls receive
+lookupRawCtl rslv dom typ ctls = resolve rslv dom typ ctls receive
+
+-- | Similar to 'lookupRawCtl', but the recv action can be replaced with
+-- something other than `Network.DNS.IO.receive`.
+-- For example, in an environment where frequent retrieval of the current time
+-- is a performance issue, you can pass the time from outside instead of
+-- having `Network.DNS.IO.receive` retrieve the current time.
+lookupRawCtlRecv :: Resolver                  -- ^ Resolver obtained via 
'withResolver'
+                 -> Domain                    -- ^ Query domain
+                 -> TYPE                      -- ^ Query RRtype
+                 -> QueryControls             -- ^ Query flag and EDNS 
overrides
+                 -> (Socket -> IO DNSMessage) -- ^ Action to receive message 
from socket
+                 -> IO (Either DNSError DNSMessage)
+lookupRawCtlRecv = resolve
 
 ----------------------------------------------------------------
 
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/Network/DNS/Resolver.hs 
new/dns-4.1.0/Network/DNS/Resolver.hs
--- old/dns-4.0.1/Network/DNS/Resolver.hs       2019-11-20 01:39:27.000000000 
+0100
+++ new/dns-4.1.0/Network/DNS/Resolver.hs       2001-09-09 03:46:40.000000000 
+0200
@@ -67,12 +67,12 @@
 
 makeAddrInfo :: HostName -> Maybe PortNumber -> IO AddrInfo
 makeAddrInfo addr mport = do
-    let flgs = [AI_ADDRCONFIG, AI_NUMERICHOST, AI_PASSIVE]
-        hints = defaultHints {
-            addrFlags = if isJust mport then AI_NUMERICSERV : flgs else flgs
+    let hints = defaultHints {
+            addrFlags = [AI_ADDRCONFIG, AI_NUMERICHOST, AI_NUMERICSERV, 
AI_PASSIVE]
           , addrSocketType = Datagram
           }
-        serv = maybe "domain" show mport
+        -- 53 is the standard port number for domain name servers as assigned 
by IANA
+        serv = maybe "53" show mport
     head <$> getAddrInfo (Just hints) (Just addr) (Just serv)
 
 ----------------------------------------------------------------
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/Network/DNS/Transport.hs 
new/dns-4.1.0/Network/DNS/Transport.hs
--- old/dns-4.0.1/Network/DNS/Transport.hs      2019-11-20 01:39:27.000000000 
+0100
+++ new/dns-4.1.0/Network/DNS/Transport.hs      2001-09-09 03:46:40.000000000 
+0200
@@ -78,8 +78,8 @@
 -- This function merges the query flag overrides from the resolver
 -- configuration with any additional overrides from the caller.
 --
-resolve :: Domain -> TYPE -> Resolver -> Rslv0
-resolve dom typ rlv qctls rcv
+resolve :: Resolver -> Domain -> TYPE -> Rslv0
+resolve rlv dom typ qctls rcv
   | isIllegal dom = return $ Left IllegalDomain
   | typ == AXFR   = return $ Left InvalidAXFRLookup
   | onlyOne       = resolveOne        (head nss) (head gens) q tm retry ctls 
rcv
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/Network/DNS/Utils.hs 
new/dns-4.1.0/Network/DNS/Utils.hs
--- old/dns-4.0.1/Network/DNS/Utils.hs  2019-11-20 01:39:27.000000000 +0100
+++ new/dns-4.1.0/Network/DNS/Utils.hs  2001-09-09 03:46:40.000000000 +0200
@@ -4,12 +4,15 @@
     normalize
   , normalizeCase
   , normalizeRoot
+  , splitDomain
+  , splitMailbox
   ) where
 
 import qualified Data.ByteString.Char8 as BS
 import Data.Char (toLower)
 
-import Network.DNS.Types.Internal (Domain)
+import Network.DNS.Types.Internal (DNSError, Domain, Mailbox)
+import Network.DNS.StateBinary (parseLabel)
 
 
 -- | Perform both 'normalizeCase' and 'normalizeRoot' on the given
@@ -130,3 +133,45 @@
   | otherwise = d `BS.append` trailing_dot
     where
       trailing_dot = BS.pack "."
+
+-- | Split a domain name in A-label form into its initial label and the rest of
+-- the domain.  Returns an error if the initial label is malformed.  When no
+-- more labels remain, the initial label will satisfy 'BS.null'.
+--
+-- This also decodes any escaped characters in the initial label, which may
+-- therefore contain whitespace, binary data, or unescaped internal dots.  To
+-- reconstruct the original domain, the initial label may sometimes require
+-- correct escaping of special characters.
+--
+-- ==== __Examples__
+--
+-- >>> import Data.ByteString.Char8 as BS
+-- >>> splitDomain $ BS.pack "abc\\.def.xyz"
+-- Right ("abc.def","xyz")
+--
+-- >>> splitDomain $ BS.pack ".abc.def.xyz"
+-- Left (DecodeError "invalid domain: .abc.def.xyz")
+--
+splitDomain :: Domain -> Either DNSError (BS.ByteString, Domain)
+splitDomain = parseLabel 0x2e
+
+-- | Split a 'Mailbox' in A-label form into its initial label 'BS.ByteString'
+-- (the /localpart/ of the email address) and the remaining 'Domain' (the
+-- /domainpart/ of the email address, with a possible trailing @'.'@).  Returns
+-- an error if the initial label is malformed.  When no more labels remain, the
+-- initial label will satisfy 'BS.null'.  The remaining labels can be obtained
+-- by applying 'splitDomain' the returned domain part.
+--
+-- This also decodes any escaped characters in the initial label, which may
+-- therefore contain whitespace, binary data, or unescaped internal dots.  To
+-- reconstruct the original mailbox, the initial label may sometimes require
+-- correct escaping of special characters.
+--
+-- ==== __Example__
+--
+-- >>> import Data.ByteString.Char8 as BS
+-- >>> splitMailbox $ BS.pack "[email protected]."
+-- Right ("Joe.Admin","example.com.")
+--
+splitMailbox :: Mailbox -> Either DNSError (BS.ByteString, Domain)
+splitMailbox = parseLabel 0x40
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/dns.cabal new/dns-4.1.0/dns.cabal
--- old/dns-4.0.1/dns.cabal     2019-11-20 01:39:27.000000000 +0100
+++ new/dns-4.1.0/dns.cabal     2001-09-09 03:46:40.000000000 +0200
@@ -1,5 +1,5 @@
 Name:                   dns
-Version:                4.0.1
+Version:                4.1.0
 Author:                 Kazu Yamamoto <[email protected]>
 Maintainer:             Kazu Yamamoto <[email protected]>
 License:                BSD3
@@ -97,6 +97,7 @@
                       , base
                       , hspec
                       , network
+  Build-Tool-Depends:   hspec-discover:hspec-discover
 
 Test-Suite spec-tests
   Type:                 exitcode-stdio-1.0
@@ -115,6 +116,7 @@
                       , hspec
                       , iproute >= 1.3.2
                       , word8
+  Build-Tool-Depends:   hspec-discover:hspec-discover
 
 Test-Suite doctests
   Type:                 exitcode-stdio-1.0
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/internal/Network/DNS/Decode/Internal.hs 
new/dns-4.1.0/internal/Network/DNS/Decode/Internal.hs
--- old/dns-4.0.1/internal/Network/DNS/Decode/Internal.hs       2019-11-20 
01:39:27.000000000 +0100
+++ new/dns-4.1.0/internal/Network/DNS/Decode/Internal.hs       2001-09-09 
03:46:40.000000000 +0200
@@ -36,7 +36,7 @@
 decodeDomain :: ByteString -> Either DNSError Domain
 decodeDomain bs = fst <$> runSGet getDomain bs
 
--- | Decode a mailbox name (the SOA record /mrname/ field).  Since DNS names
+-- | Decode a mailbox name (e.g. the SOA record /rname/ field).  Since DNS 
names
 -- may use name compression, it is not generally possible to decode the names
 -- separately from the enclosing DNS message.  This is an internal function.
 --
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/internal/Network/DNS/Decode/Parsers.hs 
new/dns-4.1.0/internal/Network/DNS/Decode/Parsers.hs
--- old/dns-4.0.1/internal/Network/DNS/Decode/Parsers.hs        2019-11-20 
01:39:27.000000000 +0100
+++ new/dns-4.1.0/internal/Network/DNS/Decode/Parsers.hs        2001-09-09 
03:46:40.000000000 +0200
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, OverloadedStrings #-}
+{-# LANGUAGE BangPatterns, LambdaCase, OverloadedStrings #-}
 
 module Network.DNS.Decode.Parsers (
     getResponse
@@ -172,6 +172,10 @@
     decodePriority = get16
     decodeWeight   = get16
     decodePort     = get16
+--
+getRData RP _   = RD_RP <$> getMailbox
+                        <*> getDomain
+--
 getRData OPT len   = RD_OPT <$> getOpts len
 --
 getRData TLSA len = RD_TLSA <$> decodeUsage
@@ -451,6 +455,23 @@
     let n = getValue c
     getdomain pos c n
   where
+    -- Reprocess the same ByteString starting at the pointer
+    -- target (offset).
+    getPtr pos offset = do
+        msg <- getInput
+        let parser = skipNBytes offset >> getDomain' sep1 offset
+        case runSGet parser msg of
+            Left (DecodeError err) -> failSGet err
+            Left err               -> fail $ show err
+            Right o                -> do
+                -- Cache only the presentation form decoding of domain names,
+                -- mailboxes (e.g. SOA rname) are less frequently reused, and
+                -- have a different presentation form, so must not share the
+                -- same cache.
+                when (sep1 == dot) $
+                    push pos (fst o)
+                return (fst o)
+
     getdomain pos c n
       | c == 0 = return "." -- Perhaps the root domain?
       | isPointer c = do
@@ -458,18 +479,11 @@
           let offset = n * 256 + d
           when (offset >= ptrLimit) $
               failSGet "invalid name compression pointer"
-          mo <- pop offset
-          case mo of
-              Nothing -> do
-                  msg <- getInput
-                  -- Reprocess the same ByteString starting at the pointer
-                  -- target (offset).
-                  let parser = skipNBytes offset >> getDomain' sep1 offset
-                  case runSGet parser msg of
-                      Left (DecodeError err) -> failSGet err
-                      Left err               -> fail $ show err
-                      Right o  -> push pos (fst o) >> return (fst o)
-              Just o -> push pos o >> return o
+          if sep1 /= dot
+              then getPtr pos offset
+              else pop offset >>= \case
+                  Nothing -> getPtr pos offset
+                  Just o  -> return o
       -- As for now, extended labels have no use.
       -- This may change some time in the future.
       | isExtLabel c = return ""
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/internal/Network/DNS/Encode/Builders.hs 
new/dns-4.1.0/internal/Network/DNS/Encode/Builders.hs
--- old/dns-4.0.1/internal/Network/DNS/Encode/Builders.hs       2019-11-20 
01:39:27.000000000 +0100
+++ new/dns-4.1.0/internal/Network/DNS/Encode/Builders.hs       2001-09-09 
03:46:40.000000000 +0200
@@ -15,6 +15,7 @@
   ) where
 
 import Control.Monad.State (State, modify, execState, gets)
+import qualified Control.Exception as E
 import qualified Data.ByteString.Builder as BB
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as LBS
@@ -131,6 +132,7 @@
     RD_PTR              ptrdname -> putDomain ptrdname
     RD_MX              pref exch -> mconcat [put16 pref, putDomain exch]
     RD_TXT            textstring -> putTXT textstring
+    RD_RP             mbox dname -> putMailbox mbox <> putDomain dname
     RD_AAAA              address -> mconcat $ map putInt8 (fromIPv6b address)
     RD_SRV       pri wei prt tgt -> putSRV pri wei prt tgt
     RD_DNAME               dname -> putDomain dname
@@ -328,17 +330,21 @@
         cur <- gets wsPosition
         case mpos of
             Just pos -> putPointer pos
-            Nothing  -> wsPush dom cur >>
+            Nothing  -> do
+                        -- Pointers are limited to 14-bits!
+                        when (cur <= 0x3fff) $ wsPush dom cur
                         mconcat [ putPartialDomain hd
                                 , putDomain' '.' tl
                                 ]
   where
     -- Try with the preferred separator if present, else fall back to '.'.
-    (hd, tl) =
-        let p = parseLabel (c2w sep) dom
-         in if sep /= '.' && BS.null (snd p)
-            then parseLabel (c2w '.') dom
-            else p
+    (hd, tl) = loop (c2w sep)
+      where
+        loop w = case parseLabel w dom of
+            Right p | w /= 0x2e && BS.null (snd p) -> loop 0x2e
+                    | otherwise -> p
+            Left e -> E.throw e
+
     c2w = fromIntegral . fromEnum
 
 putPointer :: Int -> SPut
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/internal/Network/DNS/Encode/Internal.hs 
new/dns-4.1.0/internal/Network/DNS/Encode/Internal.hs
--- old/dns-4.0.1/internal/Network/DNS/Encode/Internal.hs       2019-11-20 
01:39:27.000000000 +0100
+++ new/dns-4.1.0/internal/Network/DNS/Encode/Internal.hs       2001-09-09 
03:46:40.000000000 +0200
@@ -28,7 +28,7 @@
 
 -- | Encode a mailbox name.  The first label is separated from the remaining
 -- labels by an @'\@'@ rather than a @.@.  This is used for the contact
--- address in the @SOA@ record.
+-- address in the @SOA@ and @RP@ records.
 --
 encodeMailbox :: Mailbox -> ByteString
 encodeMailbox = runSPut . putMailbox
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/internal/Network/DNS/Memo.hs 
new/dns-4.1.0/internal/Network/DNS/Memo.hs
--- old/dns-4.0.1/internal/Network/DNS/Memo.hs  2019-11-20 01:39:27.000000000 
+0100
+++ new/dns-4.1.0/internal/Network/DNS/Memo.hs  2001-09-09 03:46:40.000000000 
+0200
@@ -64,6 +64,7 @@
 copy (RD_NULL bytes)      = RD_NULL $ B.copy bytes
 copy (RD_MX prf dom)      = RD_MX prf $ B.copy dom
 copy (RD_TXT txt)         = RD_TXT $ B.copy txt
+copy (RD_RP mbox dname)   = RD_RP (B.copy mbox) (B.copy dname)
 copy r@(RD_AAAA _)        = r
 copy (RD_SRV a b c dom)   = RD_SRV a b c $ B.copy dom
 copy (RD_DNAME dom)       = RD_DNAME $ B.copy dom
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/internal/Network/DNS/StateBinary.hs 
new/dns-4.1.0/internal/Network/DNS/StateBinary.hs
--- old/dns-4.0.1/internal/Network/DNS/StateBinary.hs   2019-11-20 
01:39:27.000000000 +0100
+++ new/dns-4.1.0/internal/Network/DNS/StateBinary.hs   2001-09-09 
03:46:40.000000000 +0200
@@ -323,10 +323,7 @@
 -- the remaining labels, unescaping backlashed chars and decimal triples along
 -- the way. Any  U-label conversion belongs at the layer above this code.
 --
--- This function is pure, but is not total, it throws an error when presented
--- with malformed input
---
-parseLabel :: Word8 -> ByteString -> (ByteString, ByteString)
+parseLabel :: Word8 -> ByteString -> Either DNSError (ByteString, ByteString)
 parseLabel sep dom =
     if BS.any (== bslash) dom
     then toResult $ A.parse (labelParser sep mempty) dom
@@ -337,9 +334,9 @@
     toResult _ = bottom
     safeTail bs | BS.null bs = mempty
                 | otherwise = BS.tail bs
-    check r@(hd, tl) | not (BS.null hd) || BS.null tl = r
+    check r@(hd, tl) | not (BS.null hd) || BS.null tl = Right r
                      | otherwise = bottom
-    bottom = E.throw $ DecodeError $ "invalid domain: " ++ S8.unpack dom
+    bottom = Left $ DecodeError $ "invalid domain: " ++ S8.unpack dom
 
 labelParser :: Word8 -> ByteString -> A.Parser ByteString
 labelParser sep acc = do
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/internal/Network/DNS/Types/Internal.hs 
new/dns-4.1.0/internal/Network/DNS/Types/Internal.hs
--- old/dns-4.0.1/internal/Network/DNS/Types/Internal.hs        2019-11-20 
01:39:27.000000000 +0100
+++ new/dns-4.1.0/internal/Network/DNS/Types/Internal.hs        2001-09-09 
03:46:40.000000000 +0200
@@ -59,7 +59,8 @@
 -- periods that are not label separators. Therefore, in mailboxes \@ is used as
 -- the separator between the first and second labels, and any \'.\' characters
 -- in the first label are not escaped.  The encoding is otherwise the same as
--- 'Domain' above. This is most commonly seen in the /mrname/ of @SOA@ records.
+-- 'Domain' above. This is most commonly seen in the /rname/ of @SOA@ records,
+-- and is also employed in the @mbox-dname@ field of @RP@ records.
 -- On input, if there is no unescaped \@ character in the 'Mailbox', it is
 -- reparsed with \'.\' as the first label separator. Thus the traditional
 -- format with all labels separated by dots is also accepted, but decoding from
@@ -75,7 +76,6 @@
 
 ----------------------------------------------------------------
 
-#if __GLASGOW_HASKELL__ >= 800
 -- | Types for resource records.
 newtype TYPE = TYPE {
     -- | From type to number.
@@ -108,6 +108,9 @@
 -- | Text strings
 pattern TXT :: TYPE
 pattern TXT        = TYPE  16
+-- | Responsible Person
+pattern RP :: TYPE
+pattern RP         = TYPE  17
 -- | IPv6 Address
 pattern AAAA :: TYPE
 pattern AAAA       = TYPE  28
@@ -163,95 +166,6 @@
 -- | From number to type.
 toTYPE :: Word16 -> TYPE
 toTYPE = TYPE
-#else
--- | Types for resource records.
-data TYPE = A          -- ^ IPv4 address
-          | NS         -- ^ An authoritative name serve
-          | CNAME      -- ^ The canonical name for an alias
-          | SOA        -- ^ Marks the start of a zone of authority
-          | NULL       -- ^ A null RR (EXPERIMENTAL)
-          | PTR        -- ^ A domain name pointer
-          | MX         -- ^ Mail exchange
-          | TXT        -- ^ Text strings
-          | AAAA       -- ^ IPv6 Address
-          | SRV        -- ^ Server Selection (RFC2782)
-          | DNAME      -- ^ DNAME (RFC6672)
-          | OPT        -- ^ OPT (RFC6891)
-          | DS         -- ^ Delegation Signer (RFC4034)
-          | RRSIG      -- ^ RRSIG (RFC4034)
-          | NSEC       -- ^ NSEC (RFC4034)
-          | DNSKEY     -- ^ DNSKEY (RFC4034)
-          | NSEC3      -- ^ NSEC3 (RFC5155)
-          | NSEC3PARAM -- ^ NSEC3PARAM (RFC5155)
-          | TLSA       -- ^ TLSA (RFC6698)
-          | CDS        -- ^ Child DS (RFC7344)
-          | CDNSKEY    -- ^ DNSKEY(s) the Child wants reflected in DS (RFC7344)
-          | CSYNC      -- ^ Child-To-Parent Synchronization (RFC7477)
-          | AXFR       -- ^ Zone transfer (RFC5936)
-          | ANY        -- ^ A request for all records the server/cache
-                       --   has available
-          | CAA        -- ^ Certification Authority Authorization (RFC6844)
-          | UnknownTYPE Word16  -- ^ Unknown type
-          deriving (Eq, Ord, Read)
-
--- | From type to number.
-fromTYPE :: TYPE -> Word16
-fromTYPE A          =  1
-fromTYPE NS         =  2
-fromTYPE CNAME      =  5
-fromTYPE SOA        =  6
-fromTYPE NULL       = 10
-fromTYPE PTR        = 12
-fromTYPE MX         = 15
-fromTYPE TXT        = 16
-fromTYPE AAAA       = 28
-fromTYPE SRV        = 33
-fromTYPE DNAME      = 39
-fromTYPE OPT        = 41
-fromTYPE DS         = 43
-fromTYPE RRSIG      = 46
-fromTYPE NSEC       = 47
-fromTYPE DNSKEY     = 48
-fromTYPE NSEC3      = 50
-fromTYPE NSEC3PARAM = 51
-fromTYPE TLSA       = 52
-fromTYPE CDS        = 59
-fromTYPE CDNSKEY    = 60
-fromTYPE CSYNC      = 62
-fromTYPE AXFR       = 252
-fromTYPE ANY        = 255
-fromTYPE CAA        = 257
-fromTYPE (UnknownTYPE x) = x
-
--- | From number to type.
-toTYPE :: Word16 -> TYPE
-toTYPE  1 = A
-toTYPE  2 = NS
-toTYPE  5 = CNAME
-toTYPE  6 = SOA
-toTYPE 10 = NULL
-toTYPE 12 = PTR
-toTYPE 15 = MX
-toTYPE 16 = TXT
-toTYPE 28 = AAAA
-toTYPE 33 = SRV
-toTYPE 39 = DNAME
-toTYPE 41 = OPT
-toTYPE 43 = DS
-toTYPE 46 = RRSIG
-toTYPE 47 = NSEC
-toTYPE 48 = DNSKEY
-toTYPE 50 = NSEC3
-toTYPE 51 = NSEC3PARAM
-toTYPE 52 = TLSA
-toTYPE 59 = CDS
-toTYPE 60 = CDNSKEY
-toTYPE 62 = CSYNC
-toTYPE 252 = AXFR
-toTYPE 255 = ANY
-toTYPE 257 = CAA
-toTYPE x   = UnknownTYPE x
-#endif
 
 instance Show TYPE where
     show A          = "A"
@@ -262,6 +176,7 @@
     show PTR        = "PTR"
     show MX         = "MX"
     show TXT        = "TXT"
+    show RP         = "RP"
     show AAAA       = "AAAA"
     show SRV        = "SRV"
     show DNAME      = "DNAME"
@@ -825,7 +740,6 @@
 
 ----------------------------------------------------------------
 
-#if __GLASGOW_HASKELL__ >= 800
 -- | EDNS extended 12-bit response code.  Non-EDNS messages use only the low 4
 -- bits.  With EDNS this stores the combined error code from the DNS header and
 -- and the EDNS psuedo-header. See 'EDNSheader' for more detail.
@@ -952,112 +866,6 @@
 -- are reserved for private use.
 toRCODE :: Word16 -> RCODE
 toRCODE = RCODE
-#else
--- | EDNS extended 12-bit response code.  Non-EDNS messages use only the low 4
--- bits.  With EDNS this stores the combined error code from the DNS header and
--- and the EDNS psuedo-header. See 'EDNSheader' for more detail.
-data RCODE
-  = NoErr     -- ^ No error condition.
-  | FormatErr -- ^ Format error - The name server was
-              --   unable to interpret the query.
-  | ServFail  -- ^ Server failure - The name server was
-              --   unable to process this query due to a
-              --   problem with the name server.
-  | NameErr   -- ^ Name Error - Meaningful only for
-              --   responses from an authoritative name
-              --   server, this code signifies that the
-              --   domain name referenced in the query does
-              --   not exist.
-  | NotImpl   -- ^ Not Implemented - The name server does
-              --   not support the requested kind of query.
-  | Refused   -- ^ Refused - The name server refuses to
-              --   perform the specified operation for
-              --   policy reasons.  For example, a name
-              --   server may not wish to provide the
-              --   information to the particular requester,
-              --   or a name server may not wish to perform
-              --   a particular operation (e.g., zone
-              --   transfer) for particular data.
-  | YXDomain  -- ^ Dynamic update response, a pre-requisite
-              --   domain that should not exist, does exist.
-  | YXRRSet   -- ^ Dynamic update response, a pre-requisite
-              --   RRSet that should not exist, does exist.
-  | NXRRSet   -- ^ Dynamic update response, a pre-requisite
-              --   RRSet that should exist, does not exist.
-  | NotAuth   -- ^ Dynamic update response, the server is not
-              --   authoritative for the zone named in the Zone Section.
-  | NotZone   -- ^ Dynamic update response, a name used in the
-              --   Prerequisite or Update Section is not within the zone
-              --   denoted by the Zone Section.
-  | BadVers   -- ^ Bad OPT Version (RFC 6891)
-  | BadKey    -- ^ Key not recognized [RFC2845]
-  | BadTime   -- ^ Signature out of time window [RFC2845]
-  | BadMode   -- ^ Bad TKEY Mode [RFC2930]
-  | BadName   -- ^ Duplicate key name [RFC2930]
-  | BadAlg    -- ^ Algorithm not supported [RFC2930]
-  | BadTrunc  -- ^ Bad Truncation [RFC4635]
-  | BadCookie -- ^ Bad/missing Server Cookie [RFC7873]
-  | BadRCODE  -- ^ Malformed (peer) EDNS message, no RCODE available.  This is
-              -- not an RCODE that can be sent by a peer.  It lies outside the
-              -- 12-bit range expressible via EDNS.  The low bits are chosen to
-              -- coincide with 'FormatErr'.  When an EDNS message is malformed,
-              -- and we're unable to extract the extended RCODE, the header
-              -- 'rcode' is set to 'BadRCODE'.
-  | UnknownRCODE Word16
-  deriving (Eq, Ord, Show)
-
--- | Convert an 'RCODE' to its numeric value.
-fromRCODE :: RCODE -> Word16
-fromRCODE NoErr     =  0
-fromRCODE FormatErr =  1
-fromRCODE ServFail  =  2
-fromRCODE NameErr   =  3
-fromRCODE NotImpl   =  4
-fromRCODE Refused   =  5
-fromRCODE YXDomain  =  6
-fromRCODE YXRRSet   =  7
-fromRCODE NXRRSet   =  8
-fromRCODE NotAuth   =  9
-fromRCODE NotZone   = 10
-fromRCODE BadVers   = 16
-fromRCODE BadKey    = 17
-fromRCODE BadTime   = 18
-fromRCODE BadMode   = 19
-fromRCODE BadName   = 20
-fromRCODE BadAlg    = 21
-fromRCODE BadTrunc  = 22
-fromRCODE BadCookie = 23
-fromRCODE BadRCODE  = 0x1001
-fromRCODE (UnknownRCODE x) = x
-
--- | Convert a numeric value to a corresponding 'RCODE'.  The behaviour
--- is undefined for values outside the range @[0 .. 0xFFF]@ since the
--- EDNS extended RCODE is a 12-bit value.  Values in the range
--- @[0xF01 .. 0xFFF]@ are reserved for private use.
---
-toRCODE :: Word16 -> RCODE
-toRCODE  0 = NoErr
-toRCODE  1 = FormatErr
-toRCODE  2 = ServFail
-toRCODE  3 = NameErr
-toRCODE  4 = NotImpl
-toRCODE  5 = Refused
-toRCODE  6 = YXDomain
-toRCODE  7 = YXRRSet
-toRCODE  8 = NXRRSet
-toRCODE  9 = NotAuth
-toRCODE 10 = NotZone
-toRCODE 16 = BadVers
-toRCODE 17 = BadKey
-toRCODE 18 = BadTime
-toRCODE 19 = BadMode
-toRCODE 20 = BadName
-toRCODE 21 = BadAlg
-toRCODE 22 = BadTrunc
-toRCODE 23 = BadCookie
-toRCODE 0x1001 = BadRCODE
-toRCODE  x = UnknownRCODE x
-#endif
 
 ----------------------------------------------------------------
 
@@ -1169,6 +977,7 @@
            | RD_PTR Domain       -- ^ A domain name pointer
            | RD_MX Word16 Domain -- ^ Mail exchange
            | RD_TXT ByteString   -- ^ Text strings
+           | RD_RP Mailbox Domain -- ^ Responsible Person (RFC1183)
            | RD_AAAA IPv6        -- ^ IPv6 Address
            | RD_SRV Word16 Word16 Word16 Domain
                                  -- ^ Server Selection (RFC2782)
@@ -1203,6 +1012,7 @@
       RD_PTR               ptrdname -> showDomain ptrdname
       RD_MX               pref exch -> showMX pref exch
       RD_TXT             textstring -> showTXT textstring
+      RD_RP              mbox dname -> showRP mbox dname
       RD_AAAA               address -> show address
       RD_SRV        pri wei prt tgt -> showSRV pri wei prt tgt
       RD_DNAME               target -> showDomain target
@@ -1221,8 +1031,8 @@
       showSalt ""    = "-"
       showSalt salt  = _b16encode salt
       showDomain = BS.unpack
-      showSOA mname mrname serial refresh retry expire minttl =
-          showDomain mname ++ " " ++ showDomain mrname ++ " " ++
+      showSOA mname rname serial refresh retry expire minttl =
+          showDomain mname ++ " " ++ showDomain rname ++ " " ++
           show serial ++ " " ++ show refresh ++ " " ++
           show retry ++ " " ++ show expire ++ " " ++ show minttl
       showMX preference exchange =
@@ -1242,9 +1052,10 @@
               let (q100, r100) = divMod (fromIntegral c) 100
                   (q10, r10) = divMod r100 10
                in intToDigit q100 : intToDigit q10 : intToDigit r10 : s
+      showRP mbox dname = showDomain mbox ++ " " ++ showDomain dname
       showSRV priority weight port target =
           show priority ++ " " ++ show weight ++ " " ++
-          show port ++ BS.unpack target
+          show port ++ " " ++ BS.unpack target
       showDS keytag alg digestType digest =
           show keytag ++ " " ++ show alg ++ " " ++
           show digestType ++ " " ++ _b16encode digest
@@ -1486,7 +1297,6 @@
 
 ----------------------------------------------------------------
 
-#if __GLASGOW_HASKELL__ >= 800
 -- | EDNS Option Code (RFC 6891).
 newtype OptCode = OptCode {
     -- | From option code to number.
@@ -1520,34 +1330,6 @@
 -- | From number to option code.
 toOptCode :: Word16 -> OptCode
 toOptCode = OptCode
-#else
--- | Option Code (RFC 6891).
-data OptCode = NSID                  -- ^ Name Server Identifier (RFC5001)
-             | DAU                   -- ^ DNSSEC Algorithm understood (RFC6975)
-             | DHU                   -- ^ DNSSEC Hash Understood (RFC6975)
-             | N3U                   -- ^ NSEC3 Hash Understood (RFC6975)
-             | ClientSubnet          -- ^ Client subnet (RFC7871)
-             | UnknownOptCode Word16 -- ^ Unknown option code
-    deriving (Eq, Ord, Show)
-
--- | From option code to number.
-fromOptCode :: OptCode -> Word16
-fromOptCode NSID         = 3
-fromOptCode DAU          = 5
-fromOptCode DHU          = 6
-fromOptCode N3U          = 7
-fromOptCode ClientSubnet = 8
-fromOptCode (UnknownOptCode x) = x
-
--- | From number to option code.
-toOptCode :: Word16 -> OptCode
-toOptCode 3 = NSID
-toOptCode 5 = DAU
-toOptCode 6 = DHU
-toOptCode 7 = N3U
-toOptCode 8 = ClientSubnet
-toOptCode x = UnknownOptCode x
-#endif
 
 ----------------------------------------------------------------
 
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/test/DecodeSpec.hs 
new/dns-4.1.0/test/DecodeSpec.hs
--- old/dns-4.0.1/test/DecodeSpec.hs    2019-11-20 01:39:27.000000000 +0100
+++ new/dns-4.1.0/test/DecodeSpec.hs    2001-09-09 03:46:40.000000000 +0200
@@ -1,12 +1,9 @@
-{-# LANGUAGE OverloadedStrings, CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module DecodeSpec where
 
 import Data.ByteString.Internal (ByteString(..), unsafeCreate)
 import qualified Data.ByteString.Char8 as BC
-#if !MIN_VERSION_bytestring(0,10,0)
-import qualified Data.ByteString as BS
-#endif
 import Data.Word8
 import Foreign.ForeignPtr (withForeignPtr)
 import Foreign.Ptr (plusPtr)
@@ -42,6 +39,28 @@
 --              , authority = []
 --              , additional = [OptRecord {orudpsize = 4096, ordnssecok = 
False, orversion = 0, rdata = []}]})
 
+-- Message with question domain == SOA rname, testing correct decoding of
+-- of the rname to presentation form when it encoded in compressed form
+-- as a pointer to the question domain.
+test_soa_in :: DNSMessage
+test_soa_in =
+    let soard = RD_SOA "ns1.example.com." "hostmaster.example.com." 0 0 0 0 0
+        soarr = ResourceRecord "example.com." SOA 1 3600 soard
+     in defaultResponse { question = [Question "hostmaster.example.com." A]
+                        , authority = [soarr] }
+
+-- Expected decoded presentation form of the 'test_soa' message.
+test_soa_out :: DNSMessage
+test_soa_out =
+    let soard = RD_SOA "ns1.example.com." "[email protected]." 0 0 0 0 0
+        soarr = ResourceRecord "example.com." SOA 1 3600 soard
+     in defaultResponse { question = [Question "hostmaster.example.com." A]
+                        , authority = [soarr] }
+
+-- Expected compressed encoding of the 'test_soa' message
+test_soa_bytes :: ByteString
+test_soa_bytes = 
"0000858000010000000100000a686f73746d6173746572076578616d706c6503636f6d0000010001c0170006000100000e10001c036e7331c017c00c0000000000000000000000000000000000000000"
+
 ----------------------------------------------------------------
 
 spec :: Spec
@@ -63,6 +82,15 @@
             case decode (BC.init $ encode defaultQuery) of
                 Left (DecodeError {}) -> True
                 _ -> error "Excess input not detected"
+        it "soa mailbox presentation form" $
+            case encode test_soa_in of
+                enc | enc /= fromHexString test_soa_bytes
+                    -> error "Unexpected test_soa encoding"
+                    | otherwise -> case decode enc of
+                        Left err  -> error $ "Error decoding test_soa: " ++ 
show err
+                        Right m | m /= test_soa_out
+                                  -> error $ "Wrong decode of test_soa: " ++ 
show m
+                                | otherwise -> True
 
 tripleDecodeTest :: ByteString -> IO ()
 tripleDecodeTest hexbs =
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/test/RoundTripSpec.hs 
new/dns-4.1.0/test/RoundTripSpec.hs
--- old/dns-4.0.1/test/RoundTripSpec.hs 2019-11-20 01:39:27.000000000 +0100
+++ new/dns-4.1.0/test/RoundTripSpec.hs 2001-09-09 03:46:40.000000000 +0200
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, CPP, TransformListComp #-}
+{-# LANGUAGE OverloadedStrings, TransformListComp #-}
 
 module RoundTripSpec where
 
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/test2/IOSpec.hs 
new/dns-4.1.0/test2/IOSpec.hs
--- old/dns-4.0.1/test2/IOSpec.hs       2019-11-20 01:39:27.000000000 +0100
+++ new/dns-4.1.0/test2/IOSpec.hs       2001-09-09 03:46:40.000000000 +0200
@@ -2,7 +2,7 @@
 
 module IOSpec where
 
-import Network.Socket
+import Network.Socket hiding (send)
 import Test.Hspec
 
 import Network.DNS.IO as DNS
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/test2/LookupSpec.hs 
new/dns-4.1.0/test2/LookupSpec.hs
--- old/dns-4.0.1/test2/LookupSpec.hs   2019-11-20 01:39:27.000000000 +0100
+++ new/dns-4.1.0/test2/LookupSpec.hs   2001-09-09 03:46:40.000000000 +0200
@@ -26,7 +26,7 @@
     it "lookupAAAA with emty result" $ do
         rs <- makeResolvSeed defaultResolvConf
         withResolver rs $ \resolver -> do
-            addrs <- DNS.lookupAAAA resolver "mew.org"
+            addrs <- DNS.lookupAAAA resolver "ipv4.tlund.se"
             -- mew.org does not have any IPv6 addresses
             fmap null addrs `shouldBe` Right True
 
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/dns-4.0.1/test2/doctests.hs 
new/dns-4.1.0/test2/doctests.hs
--- old/dns-4.0.1/test2/doctests.hs     2019-11-20 01:39:27.000000000 +0100
+++ new/dns-4.1.0/test2/doctests.hs     2001-09-09 03:46:40.000000000 +0200
@@ -17,6 +17,8 @@
 modules =
   [ "-XOverloadedStrings"
   , "-XCPP"
+  , "-XLambdaCase"
+  , "-XPatternSynonyms"
   , "-i","-i.","-iinternal"
   , "-threaded"
   , "-package=dns"

Reply via email to