    {-# LANGUAGE
        BangPatterns
      , RecordWildCards
      , TransformListComp
      #-}

    -- | DNS Message builder.
    module Network.DNS.Encode.Builders (
        putDNSMessage
      , putDNSFlags
      , putHeader
      , putDomain
      , putMailbox
      , putResourceRecord
      ) where

    import Control.Monad.State (State, modify, execState, gets)
    import qualified Data.ByteString.Builder as BB
    import qualified Data.ByteString.Char8 as BS
    import qualified Data.ByteString.Lazy.Char8 as LBS
    import qualified Data.IP
    import Data.IP (IP(..), fromIPv4, fromIPv6b, makeAddrRange)
    import GHC.Exts (the, groupWith)

    import Network.DNS.Imports
    import Network.DNS.StateBinary
    import Network.DNS.Types.Internal

    ----------------------------------------------------------------

    putDNSMessage :: DNSMessage -> SPut
    putDNSMessage :: DNSMessage -> SPut
    putDNSMessage msg :: DNSMessage
    msg = DNSHeader -> SPut
    putHeader DNSHeader
    hd
                        SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> SPut
    putNums
                        SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat ((Question -> SPut) -> [Question] -> [SPut]
    forall a b. (a -> b) -> [a] -> [b]
    map Question -> SPut
    putQuestion [Question]
    qs)
                        SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat ((ResourceRecord -> SPut) -> [ResourceRecord] -> [SPut]
    forall a b. (a -> b) -> [a] -> [b]
    map ResourceRecord -> SPut
    putResourceRecord [ResourceRecord]
    an)
                        SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat ((ResourceRecord -> SPut) -> [ResourceRecord] -> [SPut]
    forall a b. (a -> b) -> [a] -> [b]
    map ResourceRecord -> SPut
    putResourceRecord [ResourceRecord]
    au)
                        SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat ((ResourceRecord -> SPut) -> [ResourceRecord] -> [SPut]
    forall a b. (a -> b) -> [a] -> [b]
    map ResourceRecord -> SPut
    putResourceRecord [ResourceRecord]
    ad)
      where
        putNums :: SPut
    putNums = [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat ([SPut] -> SPut) -> [SPut] -> SPut
    forall a b. (a -> b) -> a -> b
    $ (Int -> SPut) -> [Int] -> [SPut]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Int -> SPut
    putInt16 [ [Question] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Question]
    qs
                                          , [ResourceRecord] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ResourceRecord]
    an
                                          , [ResourceRecord] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ResourceRecord]
    au
                                          , [ResourceRecord] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ResourceRecord]
    ad
                                          ]
        hm :: DNSHeader
    hm = DNSMessage -> DNSHeader
    header DNSMessage
    msg
        fl :: DNSFlags
    fl = DNSHeader -> DNSFlags
    flags DNSHeader
    hm
        eh :: EDNSheader
    eh = DNSMessage -> EDNSheader
    ednsHeader DNSMessage
    msg
        qs :: [Question]
    qs = DNSMessage -> [Question]
    question DNSMessage
    msg
        an :: [ResourceRecord]
    an = DNSMessage -> [ResourceRecord]
    answer DNSMessage
    msg
        au :: [ResourceRecord]
    au = DNSMessage -> [ResourceRecord]
    authority DNSMessage
    msg
        hd :: DNSHeader
    hd = EDNSheader -> DNSHeader -> DNSHeader -> DNSHeader
    forall a. EDNSheader -> a -> a -> a
    ifEDNS EDNSheader
    eh DNSHeader
    hm (DNSHeader -> DNSHeader) -> DNSHeader -> DNSHeader
    forall a b. (a -> b) -> a -> b
    $ DNSHeader
    hm { flags :: DNSFlags
    flags = DNSFlags
    fl { rcode :: RCODE
    rcode = RCODE
    rc } }
        rc :: RCODE
    rc = EDNSheader -> RCODE -> RCODE -> RCODE
    forall a. EDNSheader -> a -> a -> a
    ifEDNS EDNSheader
    eh (RCODE -> RCODE -> RCODE)
    -> (RCODE -> RCODE) -> RCODE -> RCODE -> RCODE
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> RCODE -> RCODE
    forall a. a -> a
    id (RCODE -> RCODE -> RCODE) -> (RCODE -> RCODE) -> RCODE -> RCODE
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> RCODE -> RCODE
    nonEDNSrcode (RCODE -> RCODE) -> RCODE -> RCODE
    forall a b. (a -> b) -> a -> b
    $ DNSFlags -> RCODE
    rcode DNSFlags
    fl
          where
            nonEDNSrcode :: RCODE -> RCODE
    nonEDNSrcode code :: RCODE
    code | RCODE -> Word16
    fromRCODE RCODE
    code Word16 -> Word16 -> Bool
    forall a. Ord a => a -> a -> Bool
    < 16 = RCODE
    code
                              | Bool
    otherwise           = RCODE
    FormatErr
        ad :: [ResourceRecord]
    ad = [ResourceRecord] -> [ResourceRecord]
    prependOpt ([ResourceRecord] -> [ResourceRecord])
    -> [ResourceRecord] -> [ResourceRecord]
    forall a b. (a -> b) -> a -> b
    $ DNSMessage -> [ResourceRecord]
    additional DNSMessage
    msg
          where
            prependOpt :: [ResourceRecord] -> [ResourceRecord]
    prependOpt ads :: [ResourceRecord]
    ads = EDNSheader
    -> (EDNS -> [ResourceRecord])
    -> [ResourceRecord]
    -> [ResourceRecord]
    forall a. EDNSheader -> (EDNS -> a) -> a -> a
    mapEDNS EDNSheader
    eh ([ResourceRecord] -> Word16 -> EDNS -> [ResourceRecord]
    fromEDNS [ResourceRecord]
    ads (Word16 -> EDNS -> [ResourceRecord])
    -> Word16 -> EDNS -> [ResourceRecord]
    forall a b. (a -> b) -> a -> b
    $ RCODE -> Word16
    fromRCODE RCODE
    rc) [ResourceRecord]
    ads
              where
                fromEDNS :: AdditionalRecords -> Word16 -> EDNS -> AdditionalRecords
                fromEDNS :: [ResourceRecord] -> Word16 -> EDNS -> [ResourceRecord]
    fromEDNS rrs :: [ResourceRecord]
    rrs rc' :: Word16
    rc' edns :: EDNS
    edns = Domain -> TYPE -> Word16 -> TTL -> RData -> ResourceRecord
    ResourceRecord Domain
    name' TYPE
    type' Word16
    class' TTL
    ttl' RData
    rdata' ResourceRecord -> [ResourceRecord] -> [ResourceRecord]
    forall a. a -> [a] -> [a]
    : [ResourceRecord]
    rrs
                  where
                    name' :: Domain
    name'  = Char -> Domain
    BS.singleton '.'
                    type' :: TYPE
    type'  = TYPE
    OPT
                    class' :: Word16
    class' = Word16
    maxUdpSize Word16 -> Word16 -> Word16
    forall a. Ord a => a -> a -> a
    `min` (Word16
    minUdpSize Word16 -> Word16 -> Word16
    forall a. Ord a => a -> a -> a
    `max` EDNS -> Word16
    ednsUdpSize EDNS
    edns)
                    ttl0' :: TTL
    ttl0'  = Word16 -> TTL
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16
    rc' Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .&. 0xff0) TTL -> Int -> TTL
    forall a. Bits a => a -> Int -> a
    `shiftL` 20
                    vers' :: TTL
    vers'  = Word8 -> TTL
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (EDNS -> Word8
    ednsVersion EDNS
    edns) TTL -> Int -> TTL
    forall a. Bits a => a -> Int -> a
    `shiftL` 16
                    ttl' :: TTL
    ttl'
                      | EDNS -> Bool
    ednsDnssecOk EDNS
    edns = TTL
    ttl0' TTL -> Int -> TTL
    forall a. Bits a => a -> Int -> a
    `setBit` 15 TTL -> TTL -> TTL
    forall a. Bits a => a -> a -> a
    .|. TTL
    vers'
                      | Bool
    otherwise         = TTL
    ttl0' TTL -> TTL -> TTL
    forall a. Bits a => a -> a -> a
    .|. TTL
    vers'
                    rdata' :: RData
    rdata' = [OData] -> RData
    RD_OPT ([OData] -> RData) -> [OData] -> RData
    forall a b. (a -> b) -> a -> b
    $ EDNS -> [OData]
    ednsOptions EDNS
    edns

    putHeader :: DNSHeader -> SPut
    putHeader :: DNSHeader -> SPut
    putHeader hdr :: DNSHeader
    hdr = Word16 -> SPut
    putIdentifier (DNSHeader -> Word16
    identifier DNSHeader
    hdr)
                    SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> DNSFlags -> SPut
    putDNSFlags (DNSHeader -> DNSFlags
    flags DNSHeader
    hdr)
      where
        putIdentifier :: Word16 -> SPut
    putIdentifier = Word16 -> SPut
    put16

    putDNSFlags :: DNSFlags -> SPut
    putDNSFlags :: DNSFlags -> SPut
    putDNSFlags DNSFlags{..} = Word16 -> SPut
    put16 Word16
    word
      where
        set :: Word16 -> State Word16 ()
        set :: Word16 -> State Word16 ()
    set byte :: Word16
    byte = (Word16 -> Word16) -> State Word16 ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .|. Word16
    byte)

        st :: State Word16 ()
        st :: State Word16 ()
    st = [State Word16 ()] -> State Word16 ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_
                  [ Word16 -> State Word16 ()
    set (RCODE -> Word16
    fromRCODE RCODE
    rcode Word16 -> Word16 -> Word16
    forall a. Bits a => a -> a -> a
    .&. 0x0f)
                  , Bool -> State Word16 () -> State Word16 ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    chkDisable          (State Word16 () -> State Word16 ())
    -> State Word16 () -> State Word16 ()
    forall a b. (a -> b) -> a -> b
    $ Word16 -> State Word16 ()
    set (Int -> Word16
    forall a. Bits a => Int -> a
    bit 4)
                  , Bool -> State Word16 () -> State Word16 ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    authenData          (State Word16 () -> State Word16 ())
    -> State Word16 () -> State Word16 ()
    forall a b. (a -> b) -> a -> b
    $ Word16 -> State Word16 ()
    set (Int -> Word16
    forall a. Bits a => Int -> a
    bit 5)
                  , Bool -> State Word16 () -> State Word16 ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    recAvailable        (State Word16 () -> State Word16 ())
    -> State Word16 () -> State Word16 ()
    forall a b. (a -> b) -> a -> b
    $ Word16 -> State Word16 ()
    set (Int -> Word16
    forall a. Bits a => Int -> a
    bit 7)
                  , Bool -> State Word16 () -> State Word16 ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    recDesired          (State Word16 () -> State Word16 ())
    -> State Word16 () -> State Word16 ()
    forall a b. (a -> b) -> a -> b
    $ Word16 -> State Word16 ()
    set (Int -> Word16
    forall a. Bits a => Int -> a
    bit 8)
                  , Bool -> State Word16 () -> State Word16 ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    trunCation          (State Word16 () -> State Word16 ())
    -> State Word16 () -> State Word16 ()
    forall a b. (a -> b) -> a -> b
    $ Word16 -> State Word16 ()
    set (Int -> Word16
    forall a. Bits a => Int -> a
    bit 9)
                  , Bool -> State Word16 () -> State Word16 ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    authAnswer          (State Word16 () -> State Word16 ())
    -> State Word16 () -> State Word16 ()
    forall a b. (a -> b) -> a -> b
    $ Word16 -> State Word16 ()
    set (Int -> Word16
    forall a. Bits a => Int -> a
    bit 10)
                  , Word16 -> State Word16 ()
    set (OPCODE -> Word16
    fromOPCODE OPCODE
    opcode Word16 -> Int -> Word16
    forall a. Bits a => a -> Int -> a
    `shiftL` 11)
                  , Bool -> State Word16 () -> State Word16 ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (QorR
    qOrRQorR -> QorR -> Bool
    forall a. Eq a => a -> a -> Bool
    ==QorR
    QR_Response) (State Word16 () -> State Word16 ())
    -> State Word16 () -> State Word16 ()
    forall a b. (a -> b) -> a -> b
    $ Word16 -> State Word16 ()
    set (Int -> Word16
    forall a. Bits a => Int -> a
    bit 15)
                  ]

        word :: Word16
    word = State Word16 () -> Word16 -> Word16
    forall s a. State s a -> s -> s
    execState State Word16 ()
    st 0

    -- XXX: Use question class when implemented
    --
    putQuestion :: Question -> SPut
    putQuestion :: Question -> SPut
    putQuestion Question{..} = Domain -> SPut
    putDomain Domain
    qname
                               SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> Word16 -> SPut
    put16 (TYPE -> Word16
    fromTYPE TYPE
    qtype)
                               SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> Word16 -> SPut
    put16 Word16
    classIN

    putResourceRecord :: ResourceRecord -> SPut
    putResourceRecord :: ResourceRecord -> SPut
    putResourceRecord ResourceRecord{..} = [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat [
        Domain -> SPut
    putDomain Domain
    rrname
      , Word16 -> SPut
    put16 (TYPE -> Word16
    fromTYPE TYPE
    rrtype)
      , Word16 -> SPut
    put16 Word16
    rrclass
      , TTL -> SPut
    put32 TTL
    rrttl
      , RData -> SPut
    putResourceRData RData
    rdata
      ]
      where
        putResourceRData :: RData -> SPut
        putResourceRData :: RData -> SPut
    putResourceRData rd :: RData
    rd = do
            Int -> State WState ()
    addPositionW 2 -- "simulate" putInt16
            Builder
    rDataBuilder <- RData -> SPut
    putRData RData
    rd
            let rdataLength :: Int16
    rdataLength = Int64 -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int16) -> (Builder -> Int64) -> Builder -> Int16
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Int64
    LBS.length (ByteString -> Int64)
    -> (Builder -> ByteString) -> Builder -> Int64
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> ByteString
    BB.toLazyByteString (Builder -> Int16) -> Builder -> Int16
    forall a b. (a -> b) -> a -> b
    $ Builder
    rDataBuilder
            let rlenBuilder :: Builder
    rlenBuilder = Int16 -> Builder
    BB.int16BE Int16
    rdataLength
            Builder -> SPut
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Builder -> SPut) -> Builder -> SPut
    forall a b. (a -> b) -> a -> b
    $ Builder
    rlenBuilder Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    rDataBuilder

    putRData :: RData -> SPut
    putRData :: RData -> SPut
    putRData rd :: RData
    rd = case RData
    rd of
        RD_A                 address :: IPv4
    address -> [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat ([SPut] -> SPut) -> [SPut] -> SPut
    forall a b. (a -> b) -> a -> b
    $ (Int -> SPut) -> [Int] -> [SPut]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> SPut
    putInt8 (IPv4 -> [Int]
    fromIPv4 IPv4
    address)
        RD_NS                nsdname :: Domain
    nsdname -> Domain -> SPut
    putDomain Domain
    nsdname
        RD_CNAME               cname :: Domain
    cname -> Domain -> SPut
    putDomain Domain
    cname
        RD_SOA         a :: Domain
    a b :: Domain
    b c :: TTL
    c d :: TTL
    d e :: TTL
    e f :: TTL
    f g :: TTL
    g -> Domain -> Domain -> TTL -> TTL -> TTL -> TTL -> TTL -> SPut
    putSOA Domain
    a Domain
    b TTL
    c TTL
    d TTL
    e TTL
    f TTL
    g
        RD_NULL                bytes :: Domain
    bytes -> Domain -> SPut
    putByteString Domain
    bytes
        RD_PTR              ptrdname :: Domain
    ptrdname -> Domain -> SPut
    putDomain Domain
    ptrdname
        RD_MX              pref :: Word16
    pref exch :: Domain
    exch -> [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat [Word16 -> SPut
    put16 Word16
    pref, Domain -> SPut
    putDomain Domain
    exch]
        RD_TXT            textstring :: Domain
    textstring -> Domain -> SPut
    putTXT Domain
    textstring
        RD_AAAA              address :: IPv6
    address -> [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat ([SPut] -> SPut) -> [SPut] -> SPut
    forall a b. (a -> b) -> a -> b
    $ (Int -> SPut) -> [Int] -> [SPut]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> SPut
    putInt8 (IPv6 -> [Int]
    fromIPv6b IPv6
    address)
        RD_SRV       pri :: Word16
    pri wei :: Word16
    wei prt :: Word16
    prt tgt :: Domain
    tgt -> Word16 -> Word16 -> Word16 -> Domain -> SPut
    putSRV Word16
    pri Word16
    wei Word16
    prt Domain
    tgt
        RD_DNAME               dname :: Domain
    dname -> Domain -> SPut
    putDomain Domain
    dname
        RD_OPT               options :: [OData]
    options -> [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat ([SPut] -> SPut) -> [SPut] -> SPut
    forall a b. (a -> b) -> a -> b
    $ (OData -> SPut) -> [OData] -> [SPut]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap OData -> SPut
    putOData [OData]
    options
        RD_DS             kt :: Word16
    kt ka :: Word8
    ka dt :: Word8
    dt d :: Domain
    d -> Word16 -> Word8 -> Word8 -> Domain -> SPut
    putDS Word16
    kt Word8
    ka Word8
    dt Domain
    d
        RD_CDS            kt :: Word16
    kt ka :: Word8
    ka dt :: Word8
    dt d :: Domain
    d -> Word16 -> Word8 -> Word8 -> Domain -> SPut
    putDS Word16
    kt Word8
    ka Word8
    dt Domain
    d
        RD_RRSIG               rrsig :: RD_RRSIG
    rrsig -> RD_RRSIG -> SPut
    putRRSIG RD_RRSIG
    rrsig
        RD_NSEC           next :: Domain
    next types :: [TYPE]
    types -> Domain -> SPut
    putDomain Domain
    next SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> [TYPE] -> SPut
    putNsecTypes [TYPE]
    types
        RD_DNSKEY        f :: Word16
    f p :: Word8
    p alg :: Word8
    alg key :: Domain
    key -> Word16 -> Word8 -> Word8 -> Domain -> SPut
    putDNSKEY Word16
    f Word8
    p Word8
    alg Domain
    key
        RD_CDNSKEY       f :: Word16
    f p :: Word8
    p alg :: Word8
    alg key :: Domain
    key -> Word16 -> Word8 -> Word8 -> Domain -> SPut
    putDNSKEY Word16
    f Word8
    p Word8
    alg Domain
    key
        RD_NSEC3     a :: Word8
    a f :: Word8
    f i :: Word16
    i s :: Domain
    s h :: Domain
    h types :: [TYPE]
    types -> Word8 -> Word8 -> Word16 -> Domain -> Domain -> [TYPE] -> SPut
    putNSEC3 Word8
    a Word8
    f Word16
    i Domain
    s Domain
    h [TYPE]
    types
        RD_NSEC3PARAM  a :: Word8
    a f :: Word8
    f iter :: Word16
    iter salt :: Domain
    salt -> Word8 -> Word8 -> Word16 -> Domain -> SPut
    putNSEC3PARAM Word8
    a Word8
    f Word16
    iter Domain
    salt
        RD_TLSA           u :: Word8
    u s :: Word8
    s m :: Word8
    m dgst :: Domain
    dgst -> Word8 -> Word8 -> Word8 -> Domain -> SPut
    putTLSA Word8
    u Word8
    s Word8
    m Domain
    dgst
        UnknownRData           bytes :: Domain
    bytes -> Domain -> SPut
    putByteString Domain
    bytes
      where
        putSOA :: Domain -> Domain -> TTL -> TTL -> TTL -> TTL -> TTL -> SPut
    putSOA mn :: Domain
    mn mr :: Domain
    mr serial :: TTL
    serial refresh :: TTL
    refresh retry :: TTL
    retry expire :: TTL
    expire minttl :: TTL
    minttl = [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat
            [ Domain -> SPut
    putDomain Domain
    mn
            , Domain -> SPut
    putMailbox Domain
    mr
            , TTL -> SPut
    put32 TTL
    serial
            , TTL -> SPut
    put32 TTL
    refresh
            , TTL -> SPut
    put32 TTL
    retry
            , TTL -> SPut
    put32 TTL
    expire
            , TTL -> SPut
    put32 TTL
    minttl
            ]
        -- TXT record string fragments are at most 255 bytes
        putTXT :: Domain -> SPut
    putTXT textstring :: Domain
    textstring =
            let (!Domain
    h, !Domain
    t) = Int -> Domain -> (Domain, Domain)
    BS.splitAt 255 Domain
    textstring
             in Domain -> SPut
    putByteStringWithLength Domain
    h SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> if Domain -> Bool
    BS.null Domain
    t
                    then SPut
    forall a. Monoid a => a
    mempty
                    else Domain -> SPut
    putTXT Domain
    t
        putSRV :: Word16 -> Word16 -> Word16 -> Domain -> SPut
    putSRV priority :: Word16
    priority weight :: Word16
    weight port :: Word16
    port target :: Domain
    target = [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat
            [ Word16 -> SPut
    put16 Word16
    priority
            , Word16 -> SPut
    put16 Word16
    weight
            , Word16 -> SPut
    put16 Word16
    port
            , Domain -> SPut
    putDomain Domain
    target
            ]
        putDS :: Word16 -> Word8 -> Word8 -> Domain -> SPut
    putDS keytag :: Word16
    keytag keyalg :: Word8
    keyalg digestType :: Word8
    digestType digest :: Domain
    digest = [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat
            [ Word16 -> SPut
    put16 Word16
    keytag
            , Word8 -> SPut
    put8 Word8
    keyalg
            , Word8 -> SPut
    put8 Word8
    digestType
            , Domain -> SPut
    putByteString Domain
    digest
            ]
        putRRSIG :: RD_RRSIG -> SPut
    putRRSIG RDREP_RRSIG{..} = [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat
            [ Word16 -> SPut
    put16 (Word16 -> SPut) -> Word16 -> SPut
    forall a b. (a -> b) -> a -> b
    $ TYPE -> Word16
    fromTYPE TYPE
    rrsigType
            , Word8 -> SPut
    put8 Word8
    rrsigKeyAlg
            , Word8 -> SPut
    put8 Word8
    rrsigNumLabels
            , TTL -> SPut
    put32 TTL
    rrsigTTL
            , TTL -> SPut
    put32 (TTL -> SPut) -> TTL -> SPut
    forall a b. (a -> b) -> a -> b
    $ Int64 -> TTL
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    rrsigExpiration
            , TTL -> SPut
    put32 (TTL -> SPut) -> TTL -> SPut
    forall a b. (a -> b) -> a -> b
    $ Int64 -> TTL
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    rrsigInception
            , Word16 -> SPut
    put16 Word16
    rrsigKeyTag
            , Domain -> SPut
    putDomain Domain
    rrsigZone
            , Domain -> SPut
    putByteString Domain
    rrsigValue
            ]
        putDNSKEY :: Word16 -> Word8 -> Word8 -> Domain -> SPut
    putDNSKEY flags :: Word16
    flags protocol :: Word8
    protocol alg :: Word8
    alg key :: Domain
    key = [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat
            [ Word16 -> SPut
    put16 Word16
    flags
            , Word8 -> SPut
    put8 Word8
    protocol
            , Word8 -> SPut
    put8 Word8
    alg
            , Domain -> SPut
    putByteString Domain
    key
            ]
        putNSEC3 :: Word8 -> Word8 -> Word16 -> Domain -> Domain -> [TYPE] -> SPut
    putNSEC3 alg :: Word8
    alg flags :: Word8
    flags iterations :: Word16
    iterations salt :: Domain
    salt hash :: Domain
    hash types :: [TYPE]
    types = [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat
            [ Word8 -> SPut
    put8 Word8
    alg
            , Word8 -> SPut
    put8 Word8
    flags
            , Word16 -> SPut
    put16 Word16
    iterations
            , Domain -> SPut
    putByteStringWithLength Domain
    salt
            , Domain -> SPut
    putByteStringWithLength Domain
    hash
            , [TYPE] -> SPut
    putNsecTypes [TYPE]
    types
            ]
        putNSEC3PARAM :: Word8 -> Word8 -> Word16 -> Domain -> SPut
    putNSEC3PARAM alg :: Word8
    alg flags :: Word8
    flags iterations :: Word16
    iterations salt :: Domain
    salt = [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat
            [ Word8 -> SPut
    put8 Word8
    alg
            , Word8 -> SPut
    put8 Word8
    flags
            , Word16 -> SPut
    put16 Word16
    iterations
            , Domain -> SPut
    putByteStringWithLength Domain
    salt
            ]
        putTLSA :: Word8 -> Word8 -> Word8 -> Domain -> SPut
    putTLSA usage :: Word8
    usage selector :: Word8
    selector mtype :: Word8
    mtype assocData :: Domain
    assocData = [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat
            [ Word8 -> SPut
    put8 Word8
    usage
            , Word8 -> SPut
    put8 Word8
    selector
            , Word8 -> SPut
    put8 Word8
    mtype
            , Domain -> SPut
    putByteString Domain
    assocData
            ]

    -- | Encode DNSSEC NSEC type bits
    putNsecTypes :: [TYPE] -> SPut
    putNsecTypes :: [TYPE] -> SPut
    putNsecTypes types :: [TYPE]
    types = [Word16] -> SPut
    putTypeList ([Word16] -> SPut) -> [Word16] -> SPut
    forall a b. (a -> b) -> a -> b
    $ (TYPE -> Word16) -> [TYPE] -> [Word16]
    forall a b. (a -> b) -> [a] -> [b]
    map TYPE -> Word16
    fromTYPE [TYPE]
    types
      where
        putTypeList :: [Word16] -> SPut
        putTypeList :: [Word16] -> SPut
    putTypeList ts :: [Word16]
    ts =
            [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat [ Int -> [Int] -> SPut
    putWindow ([Int] -> Int
    forall a. Eq a => [a] -> a
    the [Int]
    top8) [Int]
    bot8 |
                      Word16
    t <- [Word16]
    ts,
                      let top8 :: Int
    top8 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    t Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` 8,
                      let bot8 :: Int
    bot8 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    t Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. 0xff,
                      then group by Int
    top8
                           using ((Int, Int) -> Int) -> [(Int, Int)] -> [[(Int, Int)]]
    forall b a. Ord b => (a -> b) -> [a] -> [[a]]
    groupWith ]

        putWindow :: Int -> [Int] -> SPut
        putWindow :: Int -> [Int] -> SPut
    putWindow top8 :: Int
    top8 bot8s :: [Int]
    bot8s =
            let blks :: Int
    blks = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [Int]
    bot8s Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` 3
             in Int -> SPut
    putInt8 Int
    top8
                SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> Word8 -> SPut
    put8 (1 Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    blks)
                SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> Int -> [(Int, Word8)] -> SPut
    putBits 0 [ ([Int] -> Int
    forall a. Eq a => [a] -> a
    the [Int]
    block, (Word8 -> Int -> Word8) -> Word8 -> [Int] -> Word8
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Word8 -> Int -> Word8
    forall a. Bits a => a -> Int -> a
    mergeBits 0 [Int]
    bot8) |
                               Int
    bot8 <- [Int]
    bot8s,
                               let block :: Int
    block = Int
    bot8 Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` 3,
                               then group by Int
    block
                                    using ((Int, Int) -> Int) -> [(Int, Int)] -> [[(Int, Int)]]
    forall b a. Ord b => (a -> b) -> [a] -> [[a]]
    groupWith ]
          where
            -- | Combine type bits in network bit order, i.e. bit 0 first.
            mergeBits :: a -> Int -> a
    mergeBits acc :: a
    acc b :: Int
    b = a -> Int -> a
    forall a. Bits a => a -> Int -> a
    setBit a
    acc (7 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    bInt -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&.0x07)

        putBits :: Int -> [(Int, Word8)] -> SPut
        putBits :: Int -> [(Int, Word8)] -> SPut
    putBits _ [] = Builder -> SPut
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Builder
    forall a. Monoid a => a
    mempty
        putBits n :: Int
    n ((block :: Int
    block, octet :: Word8
    octet) : rest :: [(Int, Word8)]
    rest) =
            Int -> Word8 -> SPut
    putReplicate (Int
    blockInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    n) 0
            SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> Word8 -> SPut
    put8 Word8
    octet
            SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> Int -> [(Int, Word8)] -> SPut
    putBits (Int
    block Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) [(Int, Word8)]
    rest

    -- | Encode EDNS OPTION consisting of a list of octets.
    putODWords :: Word16 -> [Word8] -> SPut
    putODWords :: Word16 -> [Word8] -> SPut
    putODWords code :: Word16
    code ws :: [Word8]
    ws =
         [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat [ Word16 -> SPut
    put16 Word16
    code
                 , Int -> SPut
    putInt16 (Int -> SPut) -> Int -> SPut
    forall a b. (a -> b) -> a -> b
    $ [Word8] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Word8]
    ws
                 , [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat ([SPut] -> SPut) -> [SPut] -> SPut
    forall a b. (a -> b) -> a -> b
    $ (Word8 -> SPut) -> [Word8] -> [SPut]
    forall a b. (a -> b) -> [a] -> [b]
    map Word8 -> SPut
    put8 [Word8]
    ws
                 ]

    -- | Encode an EDNS OPTION byte string.
    putODBytes :: Word16 -> ByteString -> SPut
    putODBytes :: Word16 -> Domain -> SPut
    putODBytes code :: Word16
    code bs :: Domain
    bs =
        [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat [ Word16 -> SPut
    put16 Word16
    code
                , Int -> SPut
    putInt16 (Int -> SPut) -> Int -> SPut
    forall a b. (a -> b) -> a -> b
    $ Domain -> Int
    BS.length Domain
    bs
                , Domain -> SPut
    putByteString Domain
    bs
                ]

    putOData :: OData -> SPut
    putOData :: OData -> SPut
    putOData (OD_NSID nsid :: Domain
    nsid) = Word16 -> Domain -> SPut
    putODBytes (OptCode -> Word16
    fromOptCode OptCode
    NSID) Domain
    nsid
    putOData (OD_DAU as :: [Word8]
    as) = Word16 -> [Word8] -> SPut
    putODWords (OptCode -> Word16
    fromOptCode OptCode
    DAU) [Word8]
    as
    putOData (OD_DHU hs :: [Word8]
    hs) = Word16 -> [Word8] -> SPut
    putODWords (OptCode -> Word16
    fromOptCode OptCode
    DHU) [Word8]
    hs
    putOData (OD_N3U hs :: [Word8]
    hs) = Word16 -> [Word8] -> SPut
    putODWords (OptCode -> Word16
    fromOptCode OptCode
    N3U) [Word8]
    hs
    putOData (OD_ClientSubnet srcBits :: Word8
    srcBits scpBits :: Word8
    scpBits ip :: IP
    ip) =
        -- https://tools.ietf.org/html/rfc7871#section-6
        --
        -- o  ADDRESS, variable number of octets, contains either an IPv4 or
        --    IPv6 address, depending on FAMILY, which MUST be truncated to the
        --    number of bits indicated by the SOURCE PREFIX-LENGTH field,
        --    padding with 0 bits to pad to the end of the last octet needed.
        --
        -- o  A server receiving an ECS option that uses either too few or too
        --    many ADDRESS octets, or that has non-zero ADDRESS bits set beyond
        --    SOURCE PREFIX-LENGTH, SHOULD return FORMERR to reject the packet,
        --    as a signal to the software developer making the request to fix
        --    their implementation.
        --
        let octets :: Int
    octets = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ (Word8
    srcBits Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + 7) Word8 -> Word8 -> Word8
    forall a. Integral a => a -> a -> a
    `div` 8
            prefix :: a -> a
    prefix addr :: a
    addr = AddrRange a -> a
    forall a. AddrRange a -> a
    Data.IP.addr (AddrRange a -> a) -> AddrRange a -> a
    forall a b. (a -> b) -> a -> b
    $ a -> Int -> AddrRange a
    forall a. Addr a => a -> Int -> AddrRange a
    makeAddrRange a
    addr (Int -> AddrRange a) -> Int -> AddrRange a
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    srcBits
            (family :: Word16
    family, raw :: [Int]
    raw) = case IP
    ip of
                            IPv4 ip4 :: IPv4
    ip4 -> (1, Int -> [Int] -> [Int]
    forall a. Int -> [a] -> [a]
    take Int
    octets ([Int] -> [Int]) -> [Int] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ IPv4 -> [Int]
    fromIPv4  (IPv4 -> [Int]) -> IPv4 -> [Int]
    forall a b. (a -> b) -> a -> b
    $ IPv4 -> IPv4
    forall a. Addr a => a -> a
    prefix IPv4
    ip4)
                            IPv6 ip6 :: IPv6
    ip6 -> (2, Int -> [Int] -> [Int]
    forall a. Int -> [a] -> [a]
    take Int
    octets ([Int] -> [Int]) -> [Int] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ IPv6 -> [Int]
    fromIPv6b (IPv6 -> [Int]) -> IPv6 -> [Int]
    forall a b. (a -> b) -> a -> b
    $ IPv6 -> IPv6
    forall a. Addr a => a -> a
    prefix IPv6
    ip6)
            dataLen :: Int
    dataLen = 2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    octets
         in [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat [ Word16 -> SPut
    put16 (Word16 -> SPut) -> Word16 -> SPut
    forall a b. (a -> b) -> a -> b
    $ OptCode -> Word16
    fromOptCode OptCode
    ClientSubnet
                    , Int -> SPut
    putInt16 Int
    dataLen
                    , Word16 -> SPut
    put16 Word16
    family
                    , Word8 -> SPut
    put8 Word8
    srcBits
                    , Word8 -> SPut
    put8 Word8
    scpBits
                    , [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat ([SPut] -> SPut) -> [SPut] -> SPut
    forall a b. (a -> b) -> a -> b
    $ (Int -> SPut) -> [Int] -> [SPut]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Int -> SPut
    putInt8 [Int]
    raw
                    ]
    putOData (OD_ECSgeneric family :: Word16
    family srcBits :: Word8
    srcBits scpBits :: Word8
    scpBits addr :: Domain
    addr) =
        [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat [ Word16 -> SPut
    put16 (Word16 -> SPut) -> Word16 -> SPut
    forall a b. (a -> b) -> a -> b
    $ OptCode -> Word16
    fromOptCode OptCode
    ClientSubnet
                , Int -> SPut
    putInt16 (Int -> SPut) -> Int -> SPut
    forall a b. (a -> b) -> a -> b
    $ 4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Domain -> Int
    BS.length Domain
    addr
                , Word16 -> SPut
    put16 Word16
    family
                , Word8 -> SPut
    put8 Word8
    srcBits
                , Word8 -> SPut
    put8 Word8
    scpBits
                , Domain -> SPut
    putByteString Domain
    addr
                ]
    putOData (UnknownOData code :: Word16
    code bs :: Domain
    bs) = Word16 -> Domain -> SPut
    putODBytes Word16
    code Domain
    bs

    -- In the case of the TXT record, we need to put the string length
    -- fixme : What happens with the length > 256 ?
    putByteStringWithLength :: BS.ByteString -> SPut
    putByteStringWithLength :: Domain -> SPut
    putByteStringWithLength bs :: Domain
    bs = Int -> SPut
    putInt8 (Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Domain -> Int
    BS.length Domain
    bs) -- put the length of the given string
                              SPut -> SPut -> SPut
    forall a. Semigroup a => a -> a -> a
    <> Domain -> SPut
    putByteString Domain
    bs

    ----------------------------------------------------------------

    rootDomain :: Domain
    rootDomain :: Domain
    rootDomain = String -> Domain
    BS.pack "."

    putDomain :: Domain -> SPut
    putDomain :: Domain -> SPut
    putDomain = Char -> Domain -> SPut
    putDomain' '.'

    putMailbox :: Mailbox -> SPut
    putMailbox :: Domain -> SPut
    putMailbox = Char -> Domain -> SPut
    putDomain' '@'

    putDomain' :: Char -> ByteString -> SPut
    putDomain' :: Char -> Domain -> SPut
    putDomain' sep :: Char
    sep dom :: Domain
    dom
        | Domain -> Bool
    BS.null Domain
    dom Bool -> Bool -> Bool
    || Domain
    dom Domain -> Domain -> Bool
    forall a. Eq a => a -> a -> Bool
    == Domain
    rootDomain = Word8 -> SPut
    put8 0
        | Bool
    otherwise = do
            Maybe Int
    mpos <- Domain -> State WState (Maybe Int)
    wsPop Domain
    dom
            Int
    cur <- (WState -> Int) -> StateT WState Identity Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets WState -> Int
    wsPosition
            case Maybe Int
    mpos of
                Just pos :: Int
    pos -> Int -> SPut
    putPointer Int
    pos
                Nothing  -> Domain -> Int -> State WState ()
    wsPush Domain
    dom Int
    cur State WState () -> SPut -> SPut
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                            [SPut] -> SPut
    forall a. Monoid a => [a] -> a
    mconcat [ Domain -> SPut
    putPartialDomain Domain
    hd
                                    , Char -> Domain -> SPut
    putDomain' '.' Domain
    tl
                                    ]
      where
        -- Try with the preferred separator if present, else fall back to '.'.
        (hd :: Domain
    hd, tl :: Domain
    tl) =
            let p :: (Domain, Domain)
    p = Word8 -> Domain -> (Domain, Domain)
    parseLabel (Char -> Word8
    c2w Char
    sep) Domain
    dom
             in if Char
    sep Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '.' Bool -> Bool -> Bool
    && Domain -> Bool
    BS.null ((Domain, Domain) -> Domain
    forall a b. (a, b) -> b
    snd (Domain, Domain)
    p)
                then Word8 -> Domain -> (Domain, Domain)
    parseLabel (Char -> Word8
    c2w Char
    '.') Domain
    dom
                else (Domain, Domain)
    p
        c2w :: Char -> Word8
    c2w = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    forall a. Enum a => a -> Int
    fromEnum

    putPointer :: Int -> SPut
    putPointer :: Int -> SPut
    putPointer pos :: Int
    pos = Int -> SPut
    putInt16 (Int
    pos Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .|. 0xc000)

    putPartialDomain :: Domain -> SPut
    putPartialDomain :: Domain -> SPut
    putPartialDomain = Domain -> SPut
    putByteStringWithLength