    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE TypeSynonymInstances #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE CPP #-}
    module Network.DNS.StateBinary (
        PState(..)
      , initialState
      , SPut
      , runSPut
      , put8
      , put16
      , put32
      , putInt8
      , putInt16
      , putInt32
      , putByteString
      , putReplicate
      , SGet
      , failSGet
      , fitSGet
      , runSGet
      , runSGetAt
      , runSGetWithLeftovers
      , runSGetWithLeftoversAt
      , get8
      , get16
      , get32
      , getInt8
      , getInt16
      , getInt32
      , getNByteString
      , sGetMany
      , getPosition
      , getInput
      , getAtTime
      , wsPop
      , wsPush
      , wsPosition
      , addPositionW
      , push
      , pop
      , getNBytes
      , getNoctets
      , skipNBytes
      , parseLabel
      , unparseLabel
      ) where

    import qualified Control.Exception as E
    import Control.Monad.State.Strict (State, StateT)
    import qualified Control.Monad.State.Strict as ST
    import qualified Data.Attoparsec.ByteString as A
    import qualified Data.Attoparsec.Types as T
    import qualified Data.ByteString as BS
    import Data.ByteString.Builder (Builder)
    import qualified Data.ByteString.Builder as BB
    import qualified Data.ByteString.Char8 as S8
    import qualified Data.ByteString.Lazy as LB
    import qualified Data.ByteString.Lazy.Char8 as LBS
    import Data.IntMap (IntMap)
    import qualified Data.IntMap as IM
    import Data.Map (Map)
    import qualified Data.Map as M
    import Data.Semigroup as Sem

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

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

    type SPut = State WState Builder

    data WState = WState {
        WState -> Map Domain Int
    wsDomain :: Map Domain Int
      , WState -> Int
    wsPosition :: Int
    }

    initialWState :: WState
    initialWState :: WState
    initialWState = Map Domain Int -> Int -> WState
    WState Map Domain Int
    forall k a. Map k a
    M.empty 0

    instance Sem.Semigroup SPut where
        p1 :: SPut
    p1 <> :: SPut -> SPut -> SPut
    <> p2 :: SPut
    p2 = Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    (Sem.<>) (Builder -> Builder -> Builder)
    -> SPut -> StateT WState Identity (Builder -> Builder)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SPut
    p1 StateT WState Identity (Builder -> Builder) -> SPut -> SPut
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> SPut
    p2

    instance Monoid SPut where
        mempty :: SPut
    mempty = Builder -> SPut
    forall (m :: * -> *) a. Monad m => a -> m a
    return Builder
    forall a. Monoid a => a
    mempty
    #if !(MIN_VERSION_base(4,11,0))
        mappend = (Sem.<>)
    #endif

    put8 :: Word8 -> SPut
    put8 :: Word8 -> SPut
    put8 = Int -> (Word8 -> Builder) -> Word8 -> SPut
    forall a. Int -> (a -> Builder) -> a -> SPut
    fixedSized 1 Word8 -> Builder
    BB.word8

    put16 :: Word16 -> SPut
    put16 :: Word16 -> SPut
    put16 = Int -> (Word16 -> Builder) -> Word16 -> SPut
    forall a. Int -> (a -> Builder) -> a -> SPut
    fixedSized 2 Word16 -> Builder
    BB.word16BE

    put32 :: Word32 -> SPut
    put32 :: Word32 -> SPut
    put32 = Int -> (Word32 -> Builder) -> Word32 -> SPut
    forall a. Int -> (a -> Builder) -> a -> SPut
    fixedSized 4 Word32 -> Builder
    BB.word32BE

    putInt8 :: Int -> SPut
    putInt8 :: Int -> SPut
    putInt8 = Int -> (Int -> Builder) -> Int -> SPut
    forall a. Int -> (a -> Builder) -> a -> SPut
    fixedSized 1 (Int8 -> Builder
    BB.int8 (Int8 -> Builder) -> (Int -> Int8) -> Int -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral)

    putInt16 :: Int -> SPut
    putInt16 :: Int -> SPut
    putInt16 = Int -> (Int -> Builder) -> Int -> SPut
    forall a. Int -> (a -> Builder) -> a -> SPut
    fixedSized 2 (Int16 -> Builder
    BB.int16BE (Int16 -> Builder) -> (Int -> Int16) -> Int -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral)

    putInt32 :: Int -> SPut
    putInt32 :: Int -> SPut
    putInt32 = Int -> (Int -> Builder) -> Int -> SPut
    forall a. Int -> (a -> Builder) -> a -> SPut
    fixedSized 4 (Int32 -> Builder
    BB.int32BE (Int32 -> Builder) -> (Int -> Int32) -> Int -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral)

    putByteString :: ByteString -> SPut
    putByteString :: Domain -> SPut
    putByteString = (Domain -> Int) -> (Domain -> Builder) -> Domain -> SPut
    forall a. (a -> Int) -> (a -> Builder) -> a -> SPut
    writeSized Domain -> Int
    BS.length Domain -> Builder
    BB.byteString

    putReplicate :: Int -> Word8 -> SPut
    putReplicate :: Int -> Word8 -> SPut
    putReplicate n :: Int
    n w :: Word8
    w =
        Int -> (ByteString -> Builder) -> ByteString -> SPut
    forall a. Int -> (a -> Builder) -> a -> SPut
    fixedSized Int
    n ByteString -> Builder
    BB.lazyByteString (ByteString -> SPut) -> ByteString -> SPut
    forall a b. (a -> b) -> a -> b
    $ Int64 -> Word8 -> ByteString
    LB.replicate (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n) Word8
    w

    addPositionW :: Int -> State WState ()
    addPositionW :: Int -> State WState ()
    addPositionW n :: Int
    n = do
        (WState m :: Map Domain Int
    m cur :: Int
    cur) <- StateT WState Identity WState
    forall s (m :: * -> *). MonadState s m => m s
    ST.get
        WState -> State WState ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    ST.put (WState -> State WState ()) -> WState -> State WState ()
    forall a b. (a -> b) -> a -> b
    $ Map Domain Int -> Int -> WState
    WState Map Domain Int
    m (Int
    curInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n)

    fixedSized :: Int -> (a -> Builder) -> a -> SPut
    fixedSized :: Int -> (a -> Builder) -> a -> SPut
    fixedSized n :: Int
    n f :: a -> Builder
    f a :: a
    a = do Int -> State WState ()
    addPositionW Int
    n
                          Builder -> SPut
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> Builder
    f a
    a)

    writeSized :: (a -> Int) -> (a -> Builder) -> a -> SPut
    writeSized :: (a -> Int) -> (a -> Builder) -> a -> SPut
    writeSized n :: a -> Int
    n f :: a -> Builder
    f a :: a
    a = do Int -> State WState ()
    addPositionW (a -> Int
    n a
    a)
                          Builder -> SPut
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> Builder
    f a
    a)

    wsPop :: Domain -> State WState (Maybe Int)
    wsPop :: Domain -> State WState (Maybe Int)
    wsPop dom :: Domain
    dom = do
        Map Domain Int
    doms <- (WState -> Map Domain Int)
    -> StateT WState Identity (Map Domain Int)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    ST.gets WState -> Map Domain Int
    wsDomain
        Maybe Int -> State WState (Maybe Int)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Int -> State WState (Maybe Int))
    -> Maybe Int -> State WState (Maybe Int)
    forall a b. (a -> b) -> a -> b
    $ Domain -> Map Domain Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Domain
    dom Map Domain Int
    doms

    wsPush :: Domain -> Int -> State WState ()
    wsPush :: Domain -> Int -> State WState ()
    wsPush dom :: Domain
    dom pos :: Int
    pos = do
        (WState m :: Map Domain Int
    m cur :: Int
    cur) <- StateT WState Identity WState
    forall s (m :: * -> *). MonadState s m => m s
    ST.get
        WState -> State WState ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    ST.put (WState -> State WState ()) -> WState -> State WState ()
    forall a b. (a -> b) -> a -> b
    $ Map Domain Int -> Int -> WState
    WState (Domain -> Int -> Map Domain Int -> Map Domain Int
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Domain
    dom Int
    pos Map Domain Int
    m) Int
    cur

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

    type SGet = StateT PState (T.Parser ByteString)

    data PState = PState {
        PState -> IntMap Domain
    psDomain :: IntMap Domain
      , PState -> Int
    psPosition :: Int
      , PState -> Domain
    psInput :: ByteString
      , PState -> Int64
    psAtTime  :: Int64
      }

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

    getPosition :: SGet Int
    getPosition :: SGet Int
    getPosition = (PState -> Int) -> SGet Int
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    ST.gets PState -> Int
    psPosition

    getInput :: SGet ByteString
    getInput :: SGet Domain
    getInput = (PState -> Domain) -> SGet Domain
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    ST.gets PState -> Domain
    psInput

    getAtTime :: SGet Int64
    getAtTime :: SGet Int64
    getAtTime = (PState -> Int64) -> SGet Int64
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    ST.gets PState -> Int64
    psAtTime

    addPosition :: Int -> SGet ()
    addPosition :: Int -> SGet ()
    addPosition n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0 = String -> SGet ()
    forall a. String -> SGet a
    failSGet "internal error: negative position increment"
                  | Bool
    otherwise = do
        PState dom :: IntMap Domain
    dom pos :: Int
    pos inp :: Domain
    inp t :: Int64
    t <- StateT PState (Parser Domain) PState
    forall s (m :: * -> *). MonadState s m => m s
    ST.get
        let !pos' :: Int
    pos' = Int
    pos Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n
        Bool -> SGet () -> SGet ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    pos' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Domain -> Int
    BS.length Domain
    inp) (SGet () -> SGet ()) -> SGet () -> SGet ()
    forall a b. (a -> b) -> a -> b
    $
            String -> SGet ()
    forall a. String -> SGet a
    failSGet "malformed or truncated input"
        PState -> SGet ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    ST.put (PState -> SGet ()) -> PState -> SGet ()
    forall a b. (a -> b) -> a -> b
    $ IntMap Domain -> Int -> Domain -> Int64 -> PState
    PState IntMap Domain
    dom Int
    pos' Domain
    inp Int64
    t

    push :: Int -> Domain -> SGet ()
    push :: Int -> Domain -> SGet ()
    push n :: Int
    n d :: Domain
    d = do
        PState dom :: IntMap Domain
    dom pos :: Int
    pos inp :: Domain
    inp t :: Int64
    t <- StateT PState (Parser Domain) PState
    forall s (m :: * -> *). MonadState s m => m s
    ST.get
        PState -> SGet ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    ST.put (PState -> SGet ()) -> PState -> SGet ()
    forall a b. (a -> b) -> a -> b
    $ IntMap Domain -> Int -> Domain -> Int64 -> PState
    PState (Int -> Domain -> IntMap Domain -> IntMap Domain
    forall a. Int -> a -> IntMap a -> IntMap a
    IM.insert Int
    n Domain
    d IntMap Domain
    dom) Int
    pos Domain
    inp Int64
    t

    pop :: Int -> SGet (Maybe Domain)
    pop :: Int -> SGet (Maybe Domain)
    pop n :: Int
    n = (PState -> Maybe Domain) -> SGet (Maybe Domain)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    ST.gets (Int -> IntMap Domain -> Maybe Domain
    forall a. Int -> IntMap a -> Maybe a
    IM.lookup Int
    n (IntMap Domain -> Maybe Domain)
    -> (PState -> IntMap Domain) -> PState -> Maybe Domain
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PState -> IntMap Domain
    psDomain)

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

    get8 :: SGet Word8
    get8 :: SGet Word8
    get8  = Parser Domain Word8 -> SGet Word8
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    ST.lift Parser Domain Word8
    A.anyWord8 SGet Word8 -> SGet () -> SGet Word8
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Int -> SGet ()
    addPosition 1

    get16 :: SGet Word16
    get16 :: SGet Word16
    get16 = Parser Domain Word16 -> SGet Word16
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    ST.lift Parser Domain Word16
    getWord16be SGet Word16 -> SGet () -> SGet Word16
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Int -> SGet ()
    addPosition 2
      where
        word8' :: Parser Domain Word16
    word8' = Word8 -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Word16) -> Parser Domain Word8 -> Parser Domain Word16
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser Domain Word8
    A.anyWord8
        getWord16be :: Parser Domain Word16
    getWord16be = do
            Word16
    a <- Parser Domain Word16
    word8'
            Word16
    b <- Parser Domain Word16
    word8'
            Word16 -> Parser Domain Word16
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word16 -> Parser Domain Word16) -> Word16 -> Parser Domain Word16
    forall a b. (a -> b) -> a -> b
    $ Word16
    a Word16 -> Word16 -> Word16
    forall a. Num a => a -> a -> a
    * 0x100 Word16 -> Word16 -> Word16
    forall a. Num a => a -> a -> a
    + Word16
    b

    get32 :: SGet Word32
    get32 :: SGet Word32
    get32 = Parser Domain Word32 -> SGet Word32
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    ST.lift Parser Domain Word32
    getWord32be SGet Word32 -> SGet () -> SGet Word32
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Int -> SGet ()
    addPosition 4
      where
        word8' :: Parser Domain Word32
    word8' = Word8 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Word32) -> Parser Domain Word8 -> Parser Domain Word32
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser Domain Word8
    A.anyWord8
        getWord32be :: Parser Domain Word32
    getWord32be = do
            Word32
    a <- Parser Domain Word32
    word8'
            Word32
    b <- Parser Domain Word32
    word8'
            Word32
    c <- Parser Domain Word32
    word8'
            Word32
    d <- Parser Domain Word32
    word8'
            Word32 -> Parser Domain Word32
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word32 -> Parser Domain Word32) -> Word32 -> Parser Domain Word32
    forall a b. (a -> b) -> a -> b
    $ Word32
    a Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * 0x1000000 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    b Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * 0x10000 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    c Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * 0x100 Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    d

    getInt8 :: SGet Int
    getInt8 :: SGet Int
    getInt8 = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> SGet Word8 -> SGet Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SGet Word8
    get8

    getInt16 :: SGet Int
    getInt16 :: SGet Int
    getInt16 = Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16 -> Int) -> SGet Word16 -> SGet Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SGet Word16
    get16

    getInt32 :: SGet Int
    getInt32 :: SGet Int
    getInt32 = Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word32 -> Int) -> SGet Word32 -> SGet Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SGet Word32
    get32

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

    overrun :: SGet a
    overrun :: SGet a
    overrun = String -> SGet a
    forall a. String -> SGet a
    failSGet "malformed or truncated input"

    getNBytes :: Int -> SGet [Int]
    getNBytes :: Int -> SGet [Int]
    getNBytes n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0     = SGet [Int]
    forall a. SGet a
    overrun
                | Bool
    otherwise = Domain -> [Int]
    toInts (Domain -> [Int]) -> SGet Domain -> SGet [Int]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> SGet Domain
    getNByteString Int
    n
      where
        toInts :: Domain -> [Int]
    toInts = (Word8 -> Int) -> [Word8] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ([Word8] -> [Int]) -> (Domain -> [Word8]) -> Domain -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Domain -> [Word8]
    BS.unpack

    getNoctets :: Int -> SGet [Word8]
    getNoctets :: Int -> SGet [Word8]
    getNoctets n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0     = SGet [Word8]
    forall a. SGet a
    overrun
                 | Bool
    otherwise = Domain -> [Word8]
    BS.unpack (Domain -> [Word8]) -> SGet Domain -> SGet [Word8]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> SGet Domain
    getNByteString Int
    n

    skipNBytes :: Int -> SGet ()
    skipNBytes :: Int -> SGet ()
    skipNBytes n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0     = SGet ()
    forall a. SGet a
    overrun
                 | Bool
    otherwise = Parser Domain Domain -> SGet Domain
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    ST.lift (Int -> Parser Domain Domain
    A.take Int
    n) SGet Domain -> SGet () -> SGet ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Int -> SGet ()
    addPosition Int
    n

    getNByteString :: Int -> SGet ByteString
    getNByteString :: Int -> SGet Domain
    getNByteString n :: Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0     = SGet Domain
    forall a. SGet a
    overrun
                     | Bool
    otherwise = Parser Domain Domain -> SGet Domain
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    ST.lift (Int -> Parser Domain Domain
    A.take Int
    n) SGet Domain -> SGet () -> SGet Domain
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Int -> SGet ()
    addPosition Int
    n

    fitSGet :: Int -> SGet a -> SGet a
    fitSGet :: Int -> SGet a -> SGet a
    fitSGet len :: Int
    len parser :: SGet a
    parser | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0   = SGet a
    forall a. SGet a
    overrun
                       | Bool
    otherwise = do
        Int
    pos0 <- SGet Int
    getPosition
        a
    ret <- SGet a
    parser
        Int
    pos' <- SGet Int
    getPosition
        if Int
    pos' Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    pos0 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len
        then a -> SGet a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> SGet a) -> a -> SGet a
    forall a b. (a -> b) -> a -> b
    $! a
    ret
        else if Int
    pos' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    pos0 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len
        then String -> SGet a
    forall a. String -> SGet a
    failSGet "element size exceeds declared size"
        else String -> SGet a
    forall a. String -> SGet a
    failSGet "element shorter than declared size"

    -- | Parse a list of elements that takes up exactly a given number of bytes.
    -- In order to avoid infinite loops, if an element parser succeeds without
    -- moving the buffer offset forward, an error will be returned.
    --
    sGetMany :: String -- ^ element type for error messages
             -> Int    -- ^ input buffer length
             -> SGet a -- ^ element parser
             -> SGet [a]
    sGetMany :: String -> Int -> SGet a -> SGet [a]
    sGetMany elemname :: String
    elemname len :: Int
    len parser :: SGet a
    parser | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0   = SGet [a]
    forall a. SGet a
    overrun
                                 | Bool
    otherwise = Int -> [a] -> SGet [a]
    go Int
    len []
      where
        go :: Int -> [a] -> SGet [a]
    go n :: Int
    n xs :: [a]
    xs
            | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0     = String -> SGet [a]
    forall a. String -> SGet a
    failSGet (String -> SGet [a]) -> String -> SGet [a]
    forall a b. (a -> b) -> a -> b
    $ String
    elemname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " longer than declared size"
            | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0    = [a] -> SGet [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([a] -> SGet [a]) -> [a] -> SGet [a]
    forall a b. (a -> b) -> a -> b
    $ [a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    xs
            | Bool
    otherwise = do
                Int
    pos0 <- SGet Int
    getPosition
                a
    x    <- SGet a
    parser
                Int
    pos1 <- SGet Int
    getPosition
                if Int
    pos1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    pos0
                then String -> SGet [a]
    forall a. String -> SGet a
    failSGet (String -> SGet [a]) -> String -> SGet [a]
    forall a b. (a -> b) -> a -> b
    $ "internal error: in-place success for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    elemname
                else Int -> [a] -> SGet [a]
    go (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    pos0 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    pos1) (a
    x a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    xs)

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

    -- | To get a broad range of correct RRSIG inception and expiration times
    -- without over or underflow, we choose a time half way between midnight PDT
    -- 2010-07-15 (the day the root zone was signed) and 2^32 seconds later on
    -- 2146-08-21.  Since 'decode' and 'runSGet' are pure, we can't peek at the
    -- current time while parsing.  Outside this date range the output is off by
    -- some non-zero multiple 2\^32 seconds.
    --
    dnsTimeMid :: Int64
    dnsTimeMid :: Int64
    dnsTimeMid = 3426660848

    initialState :: Int64 -> ByteString -> PState
    initialState :: Int64 -> Domain -> PState
    initialState t :: Int64
    t inp :: Domain
    inp = IntMap Domain -> Int -> Domain -> Int64 -> PState
    PState IntMap Domain
    forall a. IntMap a
    IM.empty 0 Domain
    inp Int64
    t

    -- Construct our own error message, without the unhelpful AttoParsec
    -- \"Failed reading: \" prefix.
    --
    failSGet :: String -> SGet a
    failSGet :: String -> SGet a
    failSGet msg :: String
    msg = Parser Domain a -> SGet a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    ST.lift (String -> Parser Domain a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "" Parser Domain a -> String -> Parser Domain a
    forall i a. Parser i a -> String -> Parser i a
    A.<?> String
    msg)

    runSGetAt :: Int64 -> SGet a -> ByteString -> Either DNSError (a, PState)
    runSGetAt :: Int64 -> SGet a -> Domain -> Either DNSError (a, PState)
    runSGetAt t :: Int64
    t parser :: SGet a
    parser inp :: Domain
    inp =
        Result (a, PState) -> Either DNSError (a, PState)
    forall r. Result r -> Either DNSError r
    toResult (Result (a, PState) -> Either DNSError (a, PState))
    -> Result (a, PState) -> Either DNSError (a, PState)
    forall a b. (a -> b) -> a -> b
    $ Parser (a, PState) -> Domain -> Result (a, PState)
    forall a. Parser a -> Domain -> Result a
    A.parse (SGet a -> PState -> Parser (a, PState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    ST.runStateT SGet a
    parser (PState -> Parser (a, PState)) -> PState -> Parser (a, PState)
    forall a b. (a -> b) -> a -> b
    $ Int64 -> Domain -> PState
    initialState Int64
    t Domain
    inp) Domain
    inp
      where
        toResult :: A.Result r -> Either DNSError r
        toResult :: Result r -> Either DNSError r
    toResult (A.Done _ r :: r
    r)        = r -> Either DNSError r
    forall a b. b -> Either a b
    Right r
    r
        toResult (A.Fail _ ctx :: [String]
    ctx msg :: String
    msg)  = DNSError -> Either DNSError r
    forall a b. a -> Either a b
    Left (DNSError -> Either DNSError r) -> DNSError -> Either DNSError r
    forall a b. (a -> b) -> a -> b
    $ String -> DNSError
    DecodeError (String -> DNSError) -> String -> DNSError
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall a. [a] -> a
    head ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [String]
    ctx [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    msg]
        toResult (A.Partial _)       = DNSError -> Either DNSError r
    forall a b. a -> Either a b
    Left (DNSError -> Either DNSError r) -> DNSError -> Either DNSError r
    forall a b. (a -> b) -> a -> b
    $ String -> DNSError
    DecodeError "incomplete input"

    runSGet :: SGet a -> ByteString -> Either DNSError (a, PState)
    runSGet :: SGet a -> Domain -> Either DNSError (a, PState)
    runSGet = Int64 -> SGet a -> Domain -> Either DNSError (a, PState)
    forall a. Int64 -> SGet a -> Domain -> Either DNSError (a, PState)
    runSGetAt Int64
    dnsTimeMid

    runSGetWithLeftoversAt :: Int64      -- ^ Reference time for DNS clock arithmetic
                           -> SGet a     -- ^ Parser
                           -> ByteString -- ^ Encoded message
                           -> Either DNSError ((a, PState), ByteString)
    runSGetWithLeftoversAt :: Int64 -> SGet a -> Domain -> Either DNSError ((a, PState), Domain)
    runSGetWithLeftoversAt t :: Int64
    t parser :: SGet a
    parser inp :: Domain
    inp =
        Result (a, PState) -> Either DNSError ((a, PState), Domain)
    forall r. Result r -> Either DNSError (r, Domain)
    toResult (Result (a, PState) -> Either DNSError ((a, PState), Domain))
    -> Result (a, PState) -> Either DNSError ((a, PState), Domain)
    forall a b. (a -> b) -> a -> b
    $ Parser (a, PState) -> Domain -> Result (a, PState)
    forall a. Parser a -> Domain -> Result a
    A.parse (SGet a -> PState -> Parser (a, PState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    ST.runStateT SGet a
    parser (PState -> Parser (a, PState)) -> PState -> Parser (a, PState)
    forall a b. (a -> b) -> a -> b
    $ Int64 -> Domain -> PState
    initialState Int64
    t Domain
    inp) Domain
    inp
      where
        toResult :: A.Result r -> Either DNSError (r, ByteString)
        toResult :: Result r -> Either DNSError (r, Domain)
    toResult (A.Done     i :: Domain
    i r :: r
    r) = (r, Domain) -> Either DNSError (r, Domain)
    forall a b. b -> Either a b
    Right (r
    r, Domain
    i)
        toResult (A.Partial  f :: Domain -> Result r
    f)   = Result r -> Either DNSError (r, Domain)
    forall r. Result r -> Either DNSError (r, Domain)
    toResult (Result r -> Either DNSError (r, Domain))
    -> Result r -> Either DNSError (r, Domain)
    forall a b. (a -> b) -> a -> b
    $ Domain -> Result r
    f Domain
    BS.empty
        toResult (A.Fail _ ctx :: [String]
    ctx e :: String
    e) = DNSError -> Either DNSError (r, Domain)
    forall a b. a -> Either a b
    Left (DNSError -> Either DNSError (r, Domain))
    -> DNSError -> Either DNSError (r, Domain)
    forall a b. (a -> b) -> a -> b
    $ String -> DNSError
    DecodeError (String -> DNSError) -> String -> DNSError
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall a. [a] -> a
    head ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [String]
    ctx [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    e]

    runSGetWithLeftovers :: SGet a -> ByteString -> Either DNSError ((a, PState), ByteString)
    runSGetWithLeftovers :: SGet a -> Domain -> Either DNSError ((a, PState), Domain)
    runSGetWithLeftovers = Int64 -> SGet a -> Domain -> Either DNSError ((a, PState), Domain)
    forall a.
    Int64 -> SGet a -> Domain -> Either DNSError ((a, PState), Domain)
    runSGetWithLeftoversAt Int64
    dnsTimeMid

    runSPut :: SPut -> ByteString
    runSPut :: SPut -> Domain
    runSPut = ByteString -> Domain
    LBS.toStrict (ByteString -> Domain) -> (SPut -> ByteString) -> SPut -> Domain
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Builder -> ByteString
    BB.toLazyByteString (Builder -> ByteString) -> (SPut -> Builder) -> SPut -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SPut -> WState -> Builder) -> WState -> SPut -> Builder
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip SPut -> WState -> Builder
    forall s a. State s a -> s -> a
    ST.evalState WState
    initialWState

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

    -- | Decode a domain name in A-label form to a leading label and a tail with
    -- 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 -> Domain -> (Domain, Domain)
    parseLabel sep :: Word8
    sep dom :: Domain
    dom =
        if (Word8 -> Bool) -> Domain -> Bool
    BS.any (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    bslash) Domain
    dom
        then IResult Domain Domain -> (Domain, Domain)
    toResult (IResult Domain Domain -> (Domain, Domain))
    -> IResult Domain Domain -> (Domain, Domain)
    forall a b. (a -> b) -> a -> b
    $ Parser Domain Domain -> Domain -> IResult Domain Domain
    forall a. Parser a -> Domain -> Result a
    A.parse (Word8 -> Domain -> Parser Domain Domain
    labelParser Word8
    sep Domain
    forall a. Monoid a => a
    mempty) Domain
    dom
        else (Domain, Domain) -> (Domain, Domain)
    check ((Domain, Domain) -> (Domain, Domain))
    -> (Domain, Domain) -> (Domain, Domain)
    forall a b. (a -> b) -> a -> b
    $ Domain -> Domain
    safeTail (Domain -> Domain) -> (Domain, Domain) -> (Domain, Domain)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Word8 -> Bool) -> Domain -> (Domain, Domain)
    BS.break (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    sep) Domain
    dom
      where
        toResult :: IResult Domain Domain -> (Domain, Domain)
    toResult (A.Partial c :: Domain -> IResult Domain Domain
    c)  = IResult Domain Domain -> (Domain, Domain)
    toResult (Domain -> IResult Domain Domain
    c Domain
    forall a. Monoid a => a
    mempty)
        toResult (A.Done tl :: Domain
    tl hd :: Domain
    hd) = (Domain, Domain) -> (Domain, Domain)
    check (Domain
    hd, Domain
    tl)
        toResult _ = (Domain, Domain)
    forall a. a
    bottom
        safeTail :: Domain -> Domain
    safeTail bs :: Domain
    bs | Domain -> Bool
    BS.null Domain
    bs = Domain
    forall a. Monoid a => a
    mempty
                    | Bool
    otherwise = Domain -> Domain
    BS.tail Domain
    bs
        check :: (Domain, Domain) -> (Domain, Domain)
    check r :: (Domain, Domain)
    r@(hd :: Domain
    hd, tl :: Domain
    tl) | Bool -> Bool
    not (Domain -> Bool
    BS.null Domain
    hd) Bool -> Bool -> Bool
    || Domain -> Bool
    BS.null Domain
    tl = (Domain, Domain)
    r
                         | Bool
    otherwise = (Domain, Domain)
    forall a. a
    bottom
        bottom :: a
    bottom = DNSError -> a
    forall a e. Exception e => e -> a
    E.throw (DNSError -> a) -> DNSError -> a
    forall a b. (a -> b) -> a -> b
    $ String -> DNSError
    DecodeError (String -> DNSError) -> String -> DNSError
    forall a b. (a -> b) -> a -> b
    $ "invalid domain: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Domain -> String
    S8.unpack Domain
    dom

    labelParser :: Word8 -> ByteString -> A.Parser ByteString
    labelParser :: Word8 -> Domain -> Parser Domain Domain
    labelParser sep :: Word8
    sep acc :: Domain
    acc = do
        Domain
    acc' <- Domain -> Domain -> Domain
    forall a. Monoid a => a -> a -> a
    mappend Domain
    acc (Domain -> Domain) -> Parser Domain Domain -> Parser Domain Domain
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Domain -> Parser Domain Domain -> Parser Domain Domain
    forall (f :: * -> *) a. Alternative f => a -> f a -> f a
    A.option Domain
    forall a. Monoid a => a
    mempty Parser Domain Domain
    simple
        Word8 -> Domain -> Parser Domain Domain
    labelEnd Word8
    sep Domain
    acc' Parser Domain Domain
    -> Parser Domain Domain -> Parser Domain Domain
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Parser Domain Word8
    escaped Parser Domain Word8
    -> (Word8 -> Parser Domain Domain) -> Parser Domain Domain
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Word8 -> Domain -> Parser Domain Domain
    labelParser Word8
    sep (Domain -> Parser Domain Domain)
    -> (Word8 -> Domain) -> Word8 -> Parser Domain Domain
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Domain -> Word8 -> Domain
    BS.snoc Domain
    acc')
      where
        simple :: Parser Domain Domain
    simple = (Domain, ()) -> Domain
    forall a b. (a, b) -> a
    fst ((Domain, ()) -> Domain)
    -> Parser Domain (Domain, ()) -> Parser Domain Domain
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser () -> Parser Domain (Domain, ())
    forall a. Parser a -> Parser (Domain, a)
    A.match Parser ()
    skipUnescaped
          where
            skipUnescaped :: Parser ()
    skipUnescaped = Parser Domain Word8 -> Parser ()
    forall (f :: * -> *) a. Alternative f => f a -> f ()
    A.skipMany1 (Parser Domain Word8 -> Parser ())
    -> Parser Domain Word8 -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ (Word8 -> Bool) -> Parser Domain Word8
    A.satisfy Word8 -> Bool
    notSepOrBslash
            notSepOrBslash :: Word8 -> Bool
    notSepOrBslash w :: Word8
    w = Word8
    w Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word8
    sep Bool -> Bool -> Bool
    && Word8
    w Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word8
    bslash

        escaped :: Parser Domain Word8
    escaped = do
            (Word8 -> Bool) -> Parser ()
    A.skip (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    bslash)
            (Word -> Parser Domain Word8)
    -> (Word8 -> Parser Domain Word8)
    -> Either Word Word8
    -> Parser Domain Word8
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Word -> Parser Domain Word8
    decodeDec Word8 -> Parser Domain Word8
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either Word Word8 -> Parser Domain Word8)
    -> Parser Domain (Either Word Word8) -> Parser Domain Word8
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Parser Domain Word
    -> Parser Domain Word8 -> Parser Domain (Either Word Word8)
    forall (f :: * -> *) a b.
    Alternative f =>
    f a -> f b -> f (Either a b)
    A.eitherP Parser Domain Word
    digit Parser Domain Word8
    A.anyWord8
          where
            digit :: Parser Domain Word
    digit = Word8 -> Word
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Word) -> Parser Domain Word8 -> Parser Domain Word
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Word8 -> Word8) -> (Word8 -> Bool) -> Parser Domain Word8
    forall a. (Word8 -> a) -> (a -> Bool) -> Parser a
    A.satisfyWith (\n :: Word8
    n -> Word8
    n Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    - Word8
    zero) (Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <=9)
            decodeDec :: Word -> Parser Domain Word8
    decodeDec d :: Word
    d =
                Word -> Parser Domain Word8
    safeWord8 (Word -> Parser Domain Word8)
    -> Parser Domain Word -> Parser Domain Word8
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Word -> Word -> Word -> Word
    trigraph Word
    d (Word -> Word -> Word)
    -> Parser Domain Word -> Parser Domain (Word -> Word)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser Domain Word
    digit Parser Domain (Word -> Word)
    -> Parser Domain Word -> Parser Domain Word
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Domain Word
    digit
              where
                trigraph :: Word -> Word -> Word -> Word
                trigraph :: Word -> Word -> Word -> Word
    trigraph x :: Word
    x y :: Word
    y z :: Word
    z = 100 Word -> Word -> Word
    forall a. Num a => a -> a -> a
    * Word
    x Word -> Word -> Word
    forall a. Num a => a -> a -> a
    + 10 Word -> Word -> Word
    forall a. Num a => a -> a -> a
    * Word
    y Word -> Word -> Word
    forall a. Num a => a -> a -> a
    + Word
    z

                safeWord8 :: Word -> A.Parser Word8
                safeWord8 :: Word -> Parser Domain Word8
    safeWord8 n :: Word
    n | Word
    n Word -> Word -> Bool
    forall a. Ord a => a -> a -> Bool
    > 255 = Parser Domain Word8
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
                            | Bool
    otherwise = Word8 -> Parser Domain Word8
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Word8 -> Parser Domain Word8) -> Word8 -> Parser Domain Word8
    forall a b. (a -> b) -> a -> b
    $ Word -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word
    n

    labelEnd :: Word8 -> ByteString -> A.Parser ByteString
    labelEnd :: Word8 -> Domain -> Parser Domain Domain
    labelEnd sep :: Word8
    sep acc :: Domain
    acc =
        (Word8 -> Bool) -> Parser Domain Word8
    A.satisfy (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    sep) Parser Domain Word8 -> Parser Domain Domain -> Parser Domain Domain
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Domain -> Parser Domain Domain
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Domain
    acc Parser Domain Domain
    -> Parser Domain Domain -> Parser Domain Domain
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
        Parser ()
    forall t. Chunk t => Parser t ()
    A.endOfInput       Parser () -> Parser Domain Domain -> Parser Domain Domain
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Domain -> Parser Domain Domain
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Domain
    acc

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

    -- | Convert a wire-form label to presentation-form by escaping
    -- the separator, special and non-printing characters.  For simple
    -- labels with no bytes that require escaping we get back the input
    -- bytestring asis with no copying or re-construction.
    --
    -- Note: the separator is required to be either \'.\' or \'\@\', but this
    -- constraint is the caller's responsibility and is not checked here.
    --
    unparseLabel :: Word8 -> ByteString -> ByteString
    unparseLabel :: Word8 -> Domain -> Domain
    unparseLabel sep :: Word8
    sep label :: Domain
    label =
        if (Word8 -> Bool) -> Domain -> Bool
    BS.all (Word8 -> Word8 -> Bool
    isPlain Word8
    sep) Domain
    label
        then Domain
    label
        else IResult Domain Domain -> Domain
    forall i p. Monoid i => IResult i p -> p
    toResult (IResult Domain Domain -> Domain)
    -> IResult Domain Domain -> Domain
    forall a b. (a -> b) -> a -> b
    $ Parser Domain Domain -> Domain -> IResult Domain Domain
    forall a. Parser a -> Domain -> Result a
    A.parse (Word8 -> Domain -> Parser Domain Domain
    labelUnparser Word8
    sep Domain
    forall a. Monoid a => a
    mempty) Domain
    label
      where
        toResult :: IResult i p -> p
    toResult (A.Partial c :: i -> IResult i p
    c) = IResult i p -> p
    toResult (i -> IResult i p
    c i
    forall a. Monoid a => a
    mempty)
        toResult (A.Done _ r :: p
    r) = p
    r
        toResult _ = DNSError -> p
    forall a e. Exception e => e -> a
    E.throw DNSError
    UnknownDNSError -- can't happen

    labelUnparser :: Word8 -> ByteString -> A.Parser ByteString
    labelUnparser :: Word8 -> Domain -> Parser Domain Domain
    labelUnparser sep :: Word8
    sep acc :: Domain
    acc = do
        Domain
    acc' <- Domain -> Domain -> Domain
    forall a. Monoid a => a -> a -> a
    mappend Domain
    acc (Domain -> Domain) -> Parser Domain Domain -> Parser Domain Domain
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Domain -> Parser Domain Domain -> Parser Domain Domain
    forall (f :: * -> *) a. Alternative f => a -> f a -> f a
    A.option Domain
    forall a. Monoid a => a
    mempty Parser Domain Domain
    asis
        Parser ()
    forall t. Chunk t => Parser t ()
    A.endOfInput Parser () -> Parser Domain Domain -> Parser Domain Domain
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Domain -> Parser Domain Domain
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Domain
    acc' Parser Domain Domain
    -> Parser Domain Domain -> Parser Domain Domain
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (Parser Domain Domain
    esc Parser Domain Domain
    -> (Domain -> Parser Domain Domain) -> Parser Domain Domain
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Word8 -> Domain -> Parser Domain Domain
    labelUnparser Word8
    sep (Domain -> Parser Domain Domain)
    -> (Domain -> Domain) -> Domain -> Parser Domain Domain
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Domain -> Domain -> Domain
    forall a. Monoid a => a -> a -> a
    mappend Domain
    acc')
      where
        -- Non-printables are escaped as decimal trigraphs, while printable
        -- specials just get a backslash prefix.
        esc :: Parser Domain Domain
    esc = do
            Word8
    w <- Parser Domain Word8
    A.anyWord8
            if Word8
    w Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 32 Bool -> Bool -> Bool
    || Word8
    w Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 127
            then let (q100 :: Word8
    q100, r100 :: Word8
    r100) = Word8
    w Word8 -> Word8 -> (Word8, Word8)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` 100
                     (q10 :: Word8
    q10, r10 :: Word8
    r10) = Word8
    r100 Word8 -> Word8 -> (Word8, Word8)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` 10
                  in Domain -> Parser Domain Domain
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Domain -> Parser Domain Domain) -> Domain -> Parser Domain Domain
    forall a b. (a -> b) -> a -> b
    $ [Word8] -> Domain
    BS.pack [ Word8
    bslash, Word8
    zero Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Word8
    q100, Word8
    zero Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Word8
    q10, Word8
    zero Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Word8
    r10 ]
            else Domain -> Parser Domain Domain
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Domain -> Parser Domain Domain) -> Domain -> Parser Domain Domain
    forall a b. (a -> b) -> a -> b
    $ [Word8] -> Domain
    BS.pack [ Word8
    bslash, Word8
    w ]

        -- Runs of plain bytes are recognized as a single chunk, which is then
        -- returned as-is.
        asis :: Parser Domain Domain
    asis = ((Domain, ()) -> Domain)
    -> Parser Domain (Domain, ()) -> Parser Domain Domain
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Domain, ()) -> Domain
    forall a b. (a, b) -> a
    fst (Parser Domain (Domain, ()) -> Parser Domain Domain)
    -> Parser Domain (Domain, ()) -> Parser Domain Domain
    forall a b. (a -> b) -> a -> b
    $ Parser () -> Parser Domain (Domain, ())
    forall a. Parser a -> Parser (Domain, a)
    A.match (Parser () -> Parser Domain (Domain, ()))
    -> Parser () -> Parser Domain (Domain, ())
    forall a b. (a -> b) -> a -> b
    $ Parser Domain Word8 -> Parser ()
    forall (f :: * -> *) a. Alternative f => f a -> f ()
    A.skipMany1 (Parser Domain Word8 -> Parser ())
    -> Parser Domain Word8 -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ (Word8 -> Bool) -> Parser Domain Word8
    A.satisfy ((Word8 -> Bool) -> Parser Domain Word8)
    -> (Word8 -> Bool) -> Parser Domain Word8
    forall a b. (a -> b) -> a -> b
    $ Word8 -> Word8 -> Bool
    isPlain Word8
    sep

    -- | In the presentation form of DNS labels, these characters are escaped by
    -- prepending a backlash. (They have special meaning in zone files). Whitespace
    -- and other non-printable or non-ascii characters are encoded via "\DDD"
    -- decimal escapes. The separator character is also quoted in each label. Note
    -- that '@' is quoted even when not the separator.
    escSpecials :: ByteString
    escSpecials :: Domain
    escSpecials = "\"$();@\\"

    -- | Is the given byte the separator or one of the specials?
    isSpecial :: Word8 -> Word8 -> Bool
    isSpecial :: Word8 -> Word8 -> Bool
    isSpecial sep :: Word8
    sep w :: Word8
    w = Word8
    w Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    sep Bool -> Bool -> Bool
    || Word8 -> Domain -> Maybe Int
    BS.elemIndex Word8
    w Domain
    escSpecials Maybe Int -> Maybe Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe Int
    forall a. Maybe a
    Nothing

    -- | Is the given byte a plain byte that reqires no escaping. The tests are
    -- ordered to succeed or fail quickly in the most common cases. The test
    -- ranges assume the expected numeric values of the named special characters.
    -- Note: the separator is assumed to be either '.' or '@' and so not matched by
    -- any of the first three fast-path 'True' cases.
    isPlain :: Word8 -> Word8 -> Bool
    isPlain :: Word8 -> Word8 -> Bool
    isPlain sep :: Word8
    sep w :: Word8
    w | Word8
    w Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 127                 = Bool
    False -- <DEL> + non-ASCII
                  | Word8
    w Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word8
    bslash               = Bool
    True  -- ']'..'_'..'a'..'z'..'~'
                  | Word8
    w Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Word8
    zero Bool -> Bool -> Bool
    && Word8
    w Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word8
    semi    = Bool
    True  -- '0'..'9'..':'
                  | Word8
    w Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word8
    atsign Bool -> Bool -> Bool
    && Word8
    w Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    < Word8
    bslash = Bool
    True  -- 'A'..'Z'..'['
                  | Word8
    w Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 32                  = Bool
    False -- non-printables
                  | Word8 -> Word8 -> Bool
    isSpecial Word8
    sep Word8
    w          = Bool
    False -- one of the specials
                  | Bool
    otherwise                = Bool
    True  -- plain punctuation

    -- | Some numeric byte constants.
    zero, semi, atsign, bslash :: Word8
    zero :: Word8
    zero = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    forall a. Enum a => a -> Int
    fromEnum '0'    -- 48
    semi :: Word8
    semi = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    forall a. Enum a => a -> Int
    fromEnum ';'    -- 59
    atsign :: Word8
    atsign = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    forall a. Enum a => a -> Int
    fromEnum '@'  -- 64
    bslash :: Word8
    bslash = Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    forall a. Enum a => a -> Int
    fromEnum '\\' -- 92