content: {-# LANGUAGE OverloadedStrings #-}
  
  module DecodeSpec where
  
  import Data.ByteString.Internal (ByteString(..), unsafeCreate)
  import qualified Data.ByteString.Char8 as BC
  import Data.Word8
  import Foreign.ForeignPtr (withForeignPtr)
  import Foreign.Ptr (plusPtr)
  import Foreign.Storable (peek, poke, peekByteOff)
  import Test.Hspec
  
  import Network.DNS
  import Network.DNS.Imports
  
  ----------------------------------------------------------------
  
  test_doublePointer :: ByteString
  test_doublePointer = "f7eb8500000100010007000404736563330561706e696303636f6d0000010001c00c0001000100001c200004ca0c1c8cc0110002000100001c20000f036e73310561706e6963036e657400c0300002000100001c200006036e7333c040c0300002000100001c200006036e7334c040c0300002000100001c20001004736563310561706e696303636f6d00c0300002000100001c20001704736563310761757468646e730472697065036e657400c0300002000100001c20001004736563320561706e696303636f6d00c0300002000100001c2000070473656333c0bfc07b0001000100001c200004ca0c1d3bc07b001c000100001c20001020010dc02001000a4608000000000059c0ba0001000100001c200004ca0c1d3cc0d6001c000100001c20001020010dc0000100004777000000000140"
  -- DNSMessage {header = DNSHeader {identifier = 63467, flags = DNSFlags {qOrR = QR_Response, opcode = OP_STD, authAnswer = True, trunCation = False, recDesired = True, recAvailable = False, rcode = NoErr, authenData = False}}, question = [Question {qname = "sec3.apnic.com.", qtype = A}], answer = [ResourceRecord {rrname = "sec3.apnic.com.", rrtype = A, rrttl = 7200, rdata = 202.12.28.140}], authority = [ResourceRecord {rrname = "apnic.com.", rrtype = NS, rrttl = 7200, rdata = ns1.apnic.net.},ResourceRecord {rrname = "apnic.com.", rrtype = NS, rrttl = 7200, rdata = ns3.apnic.net.},ResourceRecord {rrname = "apnic.com.", rrtype = NS, rrttl = 7200, rdata = ns4.apnic.net.},ResourceRecord {rrname = "apnic.com.", rrtype = NS, rrttl = 7200, rdata = sec1.apnic.com.},ResourceRecord {rrname = "apnic.com.", rrtype = NS, rrttl = 7200, rdata = sec1.authdns.ripe.net.},ResourceRecord {rrname = "apnic.com.", rrtype = NS, rrttl = 7200, rdata = sec2.apnic.com.},ResourceRecord {rrname = "apnic.com.", rrtype = NS, rrttl = 7200, rdata = sec3.apnic.com.}], additional = [ResourceRecord {rrname = "sec1.apnic.com.", rrtype = A, rrttl = 7200, rdata = 202.12.29.59},ResourceRecord {rrname = "sec1.apnic.com.", rrtype = AAAA, rrttl = 7200, rdata = 2001:dc0:2001:a:4608::59},ResourceRecord {rrname = "sec2.apnic.com.", rrtype = A, rrttl = 7200, rdata = 202.12.29.60},ResourceRecord {rrname = "sec3.apnic.com.", rrtype = AAAA, rrttl = 7200, rdata = 2001:dc0:1:0:4777::140}]})
  
  test_txt :: ByteString
  test_txt = "463181800001000100000000076e69636f6c6173046b766462076e647072696d6102696f0000100001c00c0010000100000e10000d0c6e69636f6c61732e6b766462"
  -- DNSMessage {header = DNSHeader {identifier = 17969, flags = DNSFlags {qOrR = QR_Response, opcode = OP_STD, authAnswer = False, trunCation = False, recDesired = True, recAvailable = True, rcode = NoErr, authenData = False}}
  --              , question = [Question {qname = "nicolas.kvdb.ndprima.io.", qtype = TXT}]
  --              , answer = [ResourceRecord {rrname = "nicolas.kvdb.ndprima.io.", rrtype = TXT, rrttl = 3600, rdata = nicolas.kvdb}]
  --              , authority = []
  --              , additional = []})
  
  test_dname :: ByteString
  test_dname = "b3c0818000010005000200010377777706376b616e616c02636f02696c0000010001c0100027000100000003000c0769737261656c3702727500c00c0005000100000003000603777777c02ec046000500010000255b0002c02ec02e000100010000003d000451daf938c02e000100010000003d0004c33ce84ac02e000200010005412b000c036e7332026137036f726700c02e000200010005412b0006036e7331c08a0000291000000000000000"
  -- DNSMessage {header = DNSHeader {identifier = 46016, flags = DNSFlags {qOrR = QR_Response, opcode = OP_STD, authAnswer = False, trunCation = False, recDesired = True, recAvailable = True, rcode = NoErr, authenData = False}}, question = [Question {qname = "www.7kanal.co.il.", qtype = A}], answer = [ResourceRecord {rrname = "7kanal.co.il.", rrtype = DNAME, rrttl = 3, rdata = israel7.ru.},ResourceRecord {rrname = "www.7kanal.co.il.", rrtype = CNAME, rrttl = 3, rdata = www.israel7.ru.},ResourceRecord {rrname = "www.israel7.ru.", rrtype = CNAME, rrttl = 9563, rdata = israel7.ru.},ResourceRecord {rrname = "israel7.ru.", rrtype = A, rrttl = 61, rdata = 81.218.249.56},ResourceRecord {rrname = "israel7.ru.", rrtype = A, rrttl = 61, rdata = 195.60.232.74}], authority = [ResourceRecord {rrname = "israel7.ru.", rrtype = NS, rrttl = 344363, rdata = ns2.a7.org.},ResourceRecord {rrname = "israel7.ru.", rrtype = NS, rrttl = 344363, rdata = ns1.a7.org.}], additional = [OptRecord {orudpsize = 4096, ordnssecok = False, orversion = 0, rdata = []}]})
  
  test_mx :: ByteString
  test_mx = "f03681800001000100000001036d6577036f726700000f0001c00c000f000100000df10009000a046d61696cc00c0000291000000000000000"
  -- DNSMessage {header = DNSHeader {identifier = 61494, flags = DNSFlags {qOrR = QR_Response, opcode = OP_STD, authAnswer = False, trunCation = False, recDesired = True, recAvailable = True, rcode = NoErr, authenData = False}}
  --              , question = [Question {qname = "mew.org.", qtype = MX}]
  --              , answer = [ResourceRecord {rrname = "mew.org.", rrtype = MX, rrttl = 3569, rdata = 10 mail.mew.org.}]
  --              , 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." "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 compressed encoding of the 'test_soa' message
  test_soa_bytes :: ByteString
  test_soa_bytes = "0000858000010000000100000a686f73746d6173746572076578616d706c6503636f6d0000010001c0170006000100000e10001c036e7331c017c00c0000000000000000000000000000000000000000"
  
  ----------------------------------------------------------------
  
  spec :: Spec
  spec = do
      describe "decode" $ do
          it "decodes double pointers correctly" $
              tripleDecodeTest test_doublePointer
          it "decodes dname" $
              tripleDecodeTest test_dname
          it "decodes txt" $
              tripleDecodeTest test_txt
          it "decodes mx" $
              tripleDecodeTest test_mx
          it "detect excess" $
              case decode (encode defaultQuery <> "\0") of
                  Left (DecodeError {}) -> True
                  _ -> error "Excess input not detected"
          it "detect truncation" $
              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 =
      ecase (decode $ fromHexString hexbs) fail' $ \ x1 ->
          ecase (decode $ encode x1) fail' $ \ x2 ->
              ecase (decode $ encode x2) fail' $ \ x3 ->
                  x3 `shouldBe` x2
    where
      fail' (DecodeError err) = fail err
      fail' _                 = error "fail'"
  
  ecase :: Either a b -> (a -> c) -> (b -> c) -> c
  ecase (Left  a) f _ = f a
  ecase (Right b) _ g = g b
  
  ----------------------------------------------------------------
  
  fromHexString :: ByteString -> ByteString
  fromHexString (PS fptr off len) = unsafeCreate size $ \dst ->
      withForeignPtr fptr $ \src -> go (src `plusPtr` off) dst 0
    where
      size = len `div` 2
      go from to bytes
        | bytes == size = return ()
        | otherwise    = do
            w1 <- peek from
            w2 <- peekByteOff from 1
            let w = hex2w (w1,w2)
            poke to w
            go (from `plusPtr` 2) (to `plusPtr` 1) (bytes + 1)
  
  hex2w :: (Word8, Word8) -> Word8
  hex2w (w1,w2) = h2w w1 * 16 + h2w w2
  
  h2w :: Word8 -> Word8
  h2w w
    | isDigit w = w - _0
    | otherwise = w - _a + 10
  