{-|
Module      : Net.DNSBase.Domain
Description : Domain/mailbox name data-type
Copyright   : (c) Viktor Dukhovni, 2020-2026
              (c) Peter Duchovni, 2020
License     : BSD-3-Clause
Maintainer  : ietf-dane@dukhovni.org
Stability   : unstable

The 'Domain' data type represents the /wire form/ of DNS domain
names or mailbox names.  The internal representation is not
exposed, but is basically a 'ShortByteString' containing a
sequence of length-prefixed A-labels, including a terminal empty
label.  The labels must not be longer than 63 octets, and the
total length of the /wire form/ must not exceed 255 bytes.

The distinction between domain names and mailbox names exists only
at the level of /presentation form/, and they are otherwise the
same.  The standard /presentation form/ of a 'Domain' uses @\'.\'@
as a label separator, escaping any (rare) literal @\'.\'@
characters that happen to be part of the label content, and a
terminal dot is appended to the last label.  As a matter of
convenience, this module introduces an ad hoc /mailbox
presentation form/ of a multi-label 'Domain', which uses @\'\@\'@
as the separator between the first and second labels, and any
literal @\'.\'@ characters in the first label are not escaped.  In
the mailbox presentation form, no terminal @\'.\'@ is appended to
the address.

As 'ShortByteString' values, labels are composed of arbitrary
'Word8' elements.  The only constraint is that each label is at
most 63 bytes.

This module implements Template Haskell /splices/ for literal
domain names in application source files.  Literal strings are
validated and converted to /wire form/ at compile-time.  The
IDN-aware splice (RFC 5890+, Punycode encoding of U-labels) is the
canonical 'dnLit'; the byte-level splice that accepts arbitrary
8-bit labels is available as 'dnLit8':

> let d = $$(dnLit mkDomain "m\x00fc\&nchen.example.com") :: Domain  -- IDN-aware
> let d = $$(dnLit8 "haskell.example.com") :: Domain   -- byte-level
> let m = $$(mbLit8 "some.user@example.com") :: Domain

'dnLit' takes the presentation-form parser as its first argument:
the @mkDomain@ used above comes from the companion @idna2008@
package, which is the usual choice when IDN labels are expected.
For names known to be 8-bit clean (typically just ASCII), the
'dnLit8' and 'mbLit8' splices skip IDN processing entirely.

The runtime equivalents are 'makeDomain8' and 'makeMbox8' (and
the matching 'makeDomain8Str' / 'makeMbox8Str' for 'String'
input).  They accept the RFC 1035 master-file syntax described
below and return either a 'Domain' or a 'Domain8Err' describing
why the input was rejected.

Escape handling matches RFC 1035 master-file syntax:

  * @\\C@ for any byte @C@ appends @C@ as a single byte (the byte
    after the backslash is taken literally, with one exception: a
    trailing backslash is rejected with 'D8BadEscape').
  * @\\DDD@ for three ASCII decimal digits with @DDD <= 255@
    appends the byte with that decimal value.

Validation:

  * Each label is 1..63 bytes (empty non-final labels are rejected
    as 'D8EmptyLabel'; a sole @\'.\'@ or empty input both denote
    the root domain).
  * The wire form (all labels plus the terminator) is at most 255
    bytes; an overflow is reported as 'D8WireTooLong'.
-}
{-# LANGUAGE TemplateHaskell #-}

module Net.DNSBase.Domain
    ( -- ** Domain data type
      Domain(RootDomain)
    , DnsTriple(..)
    , Host
    , fromHost
    , toHost
    , Mbox
    , fromMbox
    , toMbox
    -- ** Domain and mailbox name literals
    , dnLit
    , mbLit
    , dnLit8
    , mbLit8
    -- ** Conversions
    -- *** Validating import from wire form
    , wireToDomain
    -- *** From presentation form with pluggable parsers
    , decodePresentationDomain
    , decodePresentationMbox
    -- *** Decoders for 8-bit presentation forms
    , Domain8Err(..)
    , makeDomain8
    , makeDomain8Str
    , makeMbox8
    , makeMbox8Str
    -- *** Canonicalisation to lower case
    , canonicalise
    -- *** Working with labels
    , appendDomain
    , consDomain
    , unconsDomain
    , labelCount
    , fromLabels
    , toLabels
    , revLabels
    , commonSuffix
    -- ** Binary serialization functions
    , mbWireForm
    , shortBytes
    , wireBytes
    -- ** Predicates
    , isLDHName
    , isLDHLabel
    -- ** Sorting and comparison
    , compareWireHost
    , equalWireHost
    , canonicalNameOrder
    , sortDomains
    ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Unsafe as BU
import qualified Data.Char as Ch
import qualified Language.Haskell.TH.Syntax as TH
import Control.Monad.ST (ST, runST)
import Data.Primitive.ByteArray
    ( MutableByteArray
    , copyMutableByteArray
    , newByteArray
    , unsafeFreezeByteArray
    , writeByteArray
    )

import Net.DNSBase.Internal.Domain
import Net.DNSBase.Internal.Util

----------------------------------------------------------------------
-- Error type
----------------------------------------------------------------------

-- | Failure modes for the byte-level 8-bit presentation-form parser.
-- Intentionally coarse and position-free.  Callers that need richer
-- diagnostics should use the @idna2008@ parser.
data Domain8Err
    = D8LabelTooLong  -- ^ A label exceeds 63 bytes.
    | D8WireTooLong   -- ^ The wire form exceeds 255 bytes.
    | D8BadEscape     -- ^ A backslash escape is malformed: a trailing
                      --   @\\@, a truncated @\\DDD@, a non-digit in
                      --   @\\DDD@, or @\\DDD@ with value greater
                      --   than 255.
    | D8EmptyLabel    -- ^ An empty interior label (consecutive dots,
                      --   a leading dot followed by more input, or an
                      --   empty mailbox localpart with a non-empty
                      --   remainder after the unescaped @\@@).
    | D8Non8Bit       -- ^ ('String' input only) Source contained a
                      --   'Char' with codepoint above @0xFF@; the
                      --   8-bit path cannot encode it.
    | D8Non7Bit       -- ^ When parsing a mailbox presentation form, the
                      --   first label contained a non-ASCII byte.
    deriving (Domain8Err -> Domain8Err -> Bool
(Domain8Err -> Domain8Err -> Bool)
-> (Domain8Err -> Domain8Err -> Bool) -> Eq Domain8Err
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Domain8Err -> Domain8Err -> Bool
== :: Domain8Err -> Domain8Err -> Bool
$c/= :: Domain8Err -> Domain8Err -> Bool
/= :: Domain8Err -> Domain8Err -> Bool
Eq, Int -> Domain8Err -> ShowS
[Domain8Err] -> ShowS
Domain8Err -> String
(Int -> Domain8Err -> ShowS)
-> (Domain8Err -> String)
-> ([Domain8Err] -> ShowS)
-> Show Domain8Err
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Domain8Err -> ShowS
showsPrec :: Int -> Domain8Err -> ShowS
$cshow :: Domain8Err -> String
show :: Domain8Err -> String
$cshowList :: [Domain8Err] -> ShowS
showList :: [Domain8Err] -> ShowS
Show)

----------------------------------------------------------------------
-- Buffer sizes
----------------------------------------------------------------------

-- | Maximum wire form length, RFC 1035 section 3.1.
maxWireLen :: Int
maxWireLen :: Int
maxWireLen = Int
255

-- | Maximum wire octets in a single label.
maxLabelLen :: Int
maxLabelLen :: Int
maxLabelLen = Int
63

-- | Output buffer capacity (one extra byte over 'maxWireLen' so that
-- a transient @oPos == maxWireLen@ during dot-handling does not need
-- a guard before the next iteration's read picks up the overflow).
outBufSize :: Int
outBufSize :: Int
outBufSize = Int
maxWireLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

----------------------------------------------------------------------
-- Public entry points
----------------------------------------------------------------------

-- | Construct a 'Domain' object directly from a /presentation form/
-- 'ByteString'.
--
-- The bytes are not treated as UTF-8 content, and IDNA processing does not
-- apply.  Backslash-escape encoding aside, each 8-bit byte in the input is
-- copied verbatim into the wire-form domain.  For Unicode IDN domain support,
-- see the parsers in the @idna2008@ package.
--
-- ==== __Example__
-- >>> import qualified Data.ByteString.Char8 as BC
-- >>> dn = makeDomain8 $ BC.pack "www.corp.acme.example"
-- >>> dn
-- Right "www.corp.acme.example."
-- >>> toLabels <$> dn
-- Right ["www","corp","acme","example"]
--
makeDomain8 :: ByteString -> Either Domain8Err Domain
makeDomain8 :: ByteString -> Either Domain8Err Domain
makeDomain8 = (ShortByteString -> Domain)
-> Either Domain8Err ShortByteString -> Either Domain8Err Domain
forall a b. (a -> b) -> Either Domain8Err a -> Either Domain8Err b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShortByteString -> Domain
Domain_ (Either Domain8Err ShortByteString -> Either Domain8Err Domain)
-> (ByteString -> Either Domain8Err ShortByteString)
-> ByteString
-> Either Domain8Err Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Domain8Err ShortByteString
parseDomain8Wire

-- | Construct a 'Domain' object directly from a /presentation
-- form/ 'ByteString' representing a mailbox.  As a convenience to
-- users, the separator between the first and remaining labels is
-- optionally the first unescaped @\'\@\'@ character, in which
-- case prior @\'.\'@ characters in the first label do not need to
-- be escaped.
--
-- The first label must not contain any non-ASCII bytes (above 127),
-- or an error ('Left') is returned.
--
-- The 'toMbox' function can be used to coerce the resulting
-- 'Domain' to an 'Mbox' object whose presentation form uses an
-- @\'\@\'@ between the first and remaining labels and does not
-- escape dots in the first label.
--
-- ==== __Example__
-- >>> import qualified Data.ByteString.Char8 as BC
-- >>> dn = makeMbox8 $ BC.pack "john.smith@acme.example"
-- >>> dn
-- Right "john\\.smith.acme.example."
-- >>> toLabels <$> dn
-- Right ["john.smith","acme","example"]
-- >>> toMbox <$> dn
-- Right "john.smith@acme.example"
--
makeMbox8 :: ByteString -> Either Domain8Err Domain
makeMbox8 :: ByteString -> Either Domain8Err Domain
makeMbox8 = (ShortByteString -> Domain)
-> Either Domain8Err ShortByteString -> Either Domain8Err Domain
forall a b. (a -> b) -> Either Domain8Err a -> Either Domain8Err b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShortByteString -> Domain
Domain_ (Either Domain8Err ShortByteString -> Either Domain8Err Domain)
-> (ByteString -> Either Domain8Err ShortByteString)
-> ByteString
-> Either Domain8Err Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Domain8Err ShortByteString
parseMbox8Wire

-- | Same as 'makeDomain8', but the input is a 'String', and
-- an error ('Left') is also returned if any of the input
-- string's characters are outside the 8-bit range.
--
-- Note that UTF-8 encoding of names in the Latin-1 alphabet might
-- still produce surprising results.  For parsing IDN domain names,
-- see the @idna2008@ package.
--
-- ==== __Example__
-- >>> dn = makeDomain8Str "www.corp.acme.example"
-- >>> dn
-- Right "www.corp.acme.example."
-- >>> toLabels <$> dn
-- Right ["www","corp","acme","example"]
--
makeDomain8Str :: String -> Either Domain8Err Domain
makeDomain8Str :: String -> Either Domain8Err Domain
makeDomain8Str = String -> Either Domain8Err ByteString
safePack (String -> Either Domain8Err ByteString)
-> (ByteString -> Either Domain8Err Domain)
-> String
-> Either Domain8Err Domain
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ShortByteString -> Domain)
-> Either Domain8Err ShortByteString -> Either Domain8Err Domain
forall a b. (a -> b) -> Either Domain8Err a -> Either Domain8Err b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShortByteString -> Domain
Domain_ (Either Domain8Err ShortByteString -> Either Domain8Err Domain)
-> (ByteString -> Either Domain8Err ShortByteString)
-> ByteString
-> Either Domain8Err Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Domain8Err ShortByteString
parseDomain8Wire

-- | Same as 'makeMbox8', but the input is a 'String, and
-- an error ('Left why') is also returned if any of the input
-- string's characters are outside the 8-bit range.
--
-- The first label must not contain any non-ASCII bytes (above 127),
-- or an error ('Left') is returned.
--
-- Note that UTF-8 encoding of domain names in the Latin-1 alphabet
-- might still produce surprising results.  For parsing IDN domain
-- names, see the @idna2008@ package.
--
-- ==== __Example__
-- >>> dn = makeMbox8Str "john.smith@acme.example"
-- >>> dn
-- Right "john\\.smith.acme.example."
-- >>> toLabels <$> dn
-- Right ["john.smith","acme","example"]
-- >>> toMbox <$> dn
-- Right "john.smith@acme.example"
--
makeMbox8Str :: String -> Either Domain8Err Domain
makeMbox8Str :: String -> Either Domain8Err Domain
makeMbox8Str = String -> Either Domain8Err ByteString
safePack (String -> Either Domain8Err ByteString)
-> (ByteString -> Either Domain8Err Domain)
-> String
-> Either Domain8Err Domain
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ShortByteString -> Domain)
-> Either Domain8Err ShortByteString -> Either Domain8Err Domain
forall a b. (a -> b) -> Either Domain8Err a -> Either Domain8Err b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShortByteString -> Domain
Domain_ (Either Domain8Err ShortByteString -> Either Domain8Err Domain)
-> (ByteString -> Either Domain8Err ShortByteString)
-> ByteString
-> Either Domain8Err Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Domain8Err ShortByteString
parseMbox8Wire

----------------------------------------------------------------------
-- Wire-bytes parsers (internal byte-input variants)
----------------------------------------------------------------------

-- | Shared backbone: parse a 'ByteString' in /presentation form/ and
-- return the wire-form bytes (or a 'Domain8Err').
parseDomain8Wire :: ByteString -> Either Domain8Err ShortByteString
parseDomain8Wire :: ByteString -> Either Domain8Err ShortByteString
parseDomain8Wire !ByteString
bs = (forall s. ST s (Either Domain8Err ShortByteString))
-> Either Domain8Err ShortByteString
forall a. (forall s. ST s a) -> a
runST do
    outBuf <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
outBufSize
    let !inEnd = ByteString -> Int
B.length ByteString
bs
    res <- domainDriver bs inEnd outBuf 0 0 1
    finalise outBuf res

-- | Mailbox-form analogue of 'parseDomain8Wire'.
parseMbox8Wire :: ByteString -> Either Domain8Err ShortByteString
parseMbox8Wire :: ByteString -> Either Domain8Err ShortByteString
parseMbox8Wire !ByteString
bs =
    let !inEnd :: Int
inEnd = ByteString -> Int
B.length ByteString
bs
    in case ByteString -> Int -> Int -> Maybe Int
findAt8 ByteString
bs Int
0 Int
inEnd of
         Maybe Int
Nothing    -> ByteString -> Either Domain8Err ShortByteString
parseDomain8Wire ByteString
bs
         Just Int
sepAt -> (forall s. ST s (Either Domain8Err ShortByteString))
-> Either Domain8Err ShortByteString
forall a. (forall s. ST s a) -> a
runST do
            outBuf <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
outBufSize
            res <- mboxDriver bs inEnd outBuf sepAt
            finalise outBuf res

----------------------------------------------------------------------
-- Template-Haskell splices for compile-time literals
----------------------------------------------------------------------

-- | Template-Haskell splice for literal 'Domain' names that are
-- validated and converted from /presentation form/ to /wire form/
-- at compile-time.  Example:
--
-- > domain :: Domain
-- > domain = $$(dnLit8 "example.org")
--
-- This is the byte-level path: it accepts any 8-bit master-file
-- text but performs no IDN processing.  For IDN-aware literals (RFC
-- 5890+, Punycode A-label encoding) use 'dnLit' with a parser from
-- the companion @idna2008@ package.
dnLit8 :: forall m. (TH.Quote m, MonadFail m) => String -> TH.Code m Domain
dnLit8 :: forall (m :: * -> *).
(Quote m, MonadFail m) =>
String -> Code m Domain
dnLit8 String
s = m (Code m Domain) -> Code m Domain
forall (m :: * -> *) a. Monad m => m (Code m a) -> Code m a
TH.joinCode case String -> Either Domain8Err Domain
makeDomain8Str String
s of
    Left Domain8Err
why -> String -> m (Code m Domain)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Code m Domain)) -> String -> m (Code m Domain)
forall a b. (a -> b) -> a -> b
$ String
"Invalid literal domain " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Domain8Err -> String
forall a. Show a => a -> String
show Domain8Err
why
    Right Domain
dn -> Code m Domain -> m (Code m Domain)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain -> Code m Domain
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => Domain -> Code m Domain
TH.liftTyped Domain
dn)

-- | Template-Haskell splice for literal mailbox names.  Example:
--
-- > mbox :: Domain
-- > mbox = $$(mbLit8 "hostmaster@example.org")
--
-- Byte-level all the way through: the localpart and the domain
-- portion are both parsed by 'makeMbox8Str', which treats the
-- input as opaque 8-bit master-file text.  For EAI/UTF-8 localpart
-- semantics use 'mbLit' with an @idna2008@-style 'Text' parser.
mbLit8 :: forall m. (TH.Quote m, MonadFail m) => String -> TH.Code m Domain
mbLit8 :: forall (m :: * -> *).
(Quote m, MonadFail m) =>
String -> Code m Domain
mbLit8 String
s = m (Code m Domain) -> Code m Domain
forall (m :: * -> *) a. Monad m => m (Code m a) -> Code m a
TH.joinCode case String -> Either Domain8Err Domain
makeMbox8Str String
s of
    Left Domain8Err
why -> String -> m (Code m Domain)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Code m Domain)) -> String -> m (Code m Domain)
forall a b. (a -> b) -> a -> b
$ String
"Invalid mailbox literal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Domain8Err -> String
forall a. Show a => a -> String
show Domain8Err
why
    Right Domain
dn -> Code m Domain -> m (Code m Domain)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain -> Code m Domain
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => Domain -> Code m Domain
TH.liftTyped Domain
dn)

----------------------------------------------------------------------
-- Domain driver
----------------------------------------------------------------------

-- | Walk a slice of @bs@ as a presentation-form domain, writing the
-- wire form into @outBuf@ starting at length-byte position
-- @startLStart@ (so the first label's length byte goes to
-- @outBuf[startLStart]@ and its first content byte to
-- @outBuf[startLStart + 1]@).
--
-- On success returns @Right outLen@ where the terminator goes at
-- @outBuf[outLen]@ (and @finalLen = outLen + 1@); on any error
-- returns @Left e@ for the appropriate 'Domain8Err'.
--
-- The driver tracks two boundary cases via @startLStart@: a sole
-- @\'.\'@ representing the root domain, and an empty post-localpart
-- domain part in the mailbox case (e.g. @\"a\@.\"@).
domainDriver
    :: forall s
    .  ByteString
    -> Int                              -- ^ inEnd
    -> MutableByteArray s
    -> Int                              -- ^ startLStart
    -> Int                              -- ^ iPos
    -> Int                              -- ^ initial oPos == startLStart + 1
    -> ST s (Either Domain8Err Int)
domainDriver :: forall s.
ByteString
-> Int
-> MutableByteArray s
-> Int
-> Int
-> Int
-> ST s (Either Domain8Err Int)
domainDriver !ByteString
bs !Int
inEnd !MutableByteArray s
outBuf !Int
startLStart = Int -> Int -> Int -> ST s (Either Domain8Err Int)
go Int
startLStart
  where
    go :: Int -> Int -> Int -> ST s (Either Domain8Err Int)
    go :: Int -> Int -> Int -> ST s (Either Domain8Err Int)
go !Int
lStart !Int
iPos !Int
oPos
      | Int
iPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
inEnd = Int -> Int -> ST s (Either Domain8Err Int)
endOfInput Int
lStart Int
oPos
      | Bool
otherwise =
          let !b :: Word8
b = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
iPos
          in if | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x5C -> Int -> Int -> Int -> ST s (Either Domain8Err Int)
handleEsc Int
lStart Int
iPos Int
oPos
                | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2E -> Int -> Int -> Int -> ST s (Either Domain8Err Int)
handleDot Int
lStart Int
iPos Int
oPos
                | Bool
otherwise -> Word8 -> Int -> Int -> Int -> ST s (Either Domain8Err Int)
appendByte Word8
b Int
lStart (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
oPos

    appendByte :: Word8 -> Int -> Int -> Int -> ST s (Either Domain8Err Int)
    appendByte :: Word8 -> Int -> Int -> Int -> ST s (Either Domain8Err Int)
appendByte !Word8
b !Int
lStart !Int
iPos !Int
oPos
      | Int
oPos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lStart Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLabelLen = Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8LabelTooLong)
      | Int
oPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxWireLen          = Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8WireTooLong)
      | Bool
otherwise = do
          MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
outBuf Int
oPos Word8
b
          Int -> Int -> Int -> ST s (Either Domain8Err Int)
go Int
lStart Int
iPos (Int
oPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    handleEsc :: Int -> Int -> Int -> ST s (Either Domain8Err Int)
    handleEsc :: Int -> Int -> Int -> ST s (Either Domain8Err Int)
handleEsc !Int
lStart !Int
iPos !Int
oPos
      | Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
inEnd = Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8BadEscape)
      | Bool
otherwise =
          let !b1 :: Word8
b1 = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          in case Word8 -> Maybe Word8
asciiDigit Word8
b1 of
               Maybe Word8
Nothing -> Word8 -> Int -> Int -> Int -> ST s (Either Domain8Err Int)
appendByte Word8
b1 Int
lStart (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int
oPos
               Just !Word8
v1
                 | Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
inEnd -> Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8BadEscape)
                 | Bool
otherwise ->
                     let !b2 :: Word8
b2 = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
                         !b3 :: Word8
b3 = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3)
                     in case (Word8 -> Maybe Word8
asciiDigit Word8
b2, Word8 -> Maybe Word8
asciiDigit Word8
b3) of
                          (Just Word8
v2, Just Word8
v3)
                            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFF ->
                                Word8 -> Int -> Int -> Int -> ST s (Either Domain8Err Int)
appendByte (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Int
lStart
                                           (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
oPos
                            | Bool
otherwise -> Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8BadEscape)
                            where
                              !n :: Int
n =   Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v1
                                  Int -> Int -> Int
forall a. Num a => a -> a -> a
+   Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v2
                                  Int -> Int -> Int
forall a. Num a => a -> a -> a
+        Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v3 :: Int
                          (Maybe Word8, Maybe Word8)
_ -> Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8BadEscape)

    handleDot :: Int -> Int -> Int -> ST s (Either Domain8Err Int)
    handleDot :: Int -> Int -> Int -> ST s (Either Domain8Err Int)
handleDot !Int
lStart !Int
iPos !Int
oPos
      | Int
oPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 =
          -- Empty label.  Acceptable only as the root domain indicator
          -- at the very start of this driver call (no label has been
          -- emitted by us yet) and only when the dot is the last
          -- input byte.  Trailing dots after a real label hit the
          -- non-empty branch on the dot itself, then the
          -- end-of-input branch on the byte after.
          if Int
lStart Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
startLStart Bool -> Bool -> Bool
&& Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
inEnd
            then Int -> Int -> Int -> ST s (Either Domain8Err Int)
go Int
lStart (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
oPos
            else Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8EmptyLabel)
      | Bool
otherwise = do
          let !labelLen :: Int
labelLen = Int
oPos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lStart Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
outBuf Int
lStart (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
labelLen :: Word8)
          let !lStart' :: Int
lStart' = Int
oPos
              !oPos' :: Int
oPos'   = Int
lStart' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
          Int -> Int -> Int -> ST s (Either Domain8Err Int)
go Int
lStart' (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
oPos'

    endOfInput :: Int -> Int -> ST s (Either Domain8Err Int)
    endOfInput :: Int -> Int -> ST s (Either Domain8Err Int)
endOfInput !Int
lStart !Int
oPos
      | Int
oPos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 =
          -- Either no labels at all (lStart == startLStart) or a
          -- trailing dot just consumed (lStart > startLStart).  In
          -- both cases the terminator goes at outBuf[lStart].
          Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either Domain8Err Int
forall a b. b -> Either a b
Right Int
lStart)
      | Bool
otherwise = do
          let !labelLen :: Int
labelLen = Int
oPos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lStart Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
outBuf Int
lStart (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
labelLen :: Word8)
          Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either Domain8Err Int
forall a b. b -> Either a b
Right Int
oPos)

----------------------------------------------------------------------
-- Localpart driver
----------------------------------------------------------------------

-- | Walk a slice of @bs@ in @[lpStart..lpEnd)@ as a mailbox
-- localpart, writing the localpart wire bytes into
-- @outBuf[1..]@.  Returns the number of bytes written (i.e. the
-- localpart length) on success.
--
-- Localpart parsing differs from domain parsing: there is exactly
-- one label (no @\'.\'@ separators), and the byte @\'.\'@ is
-- therefore literal.  Backslash escapes work the same way (@\\C@
-- and @\\DDD@).  Non-ASCII bytes (> 127) are rejected as invalid.
--
localpartDriver
    :: forall s.  ByteString
    -> Int -- ^ lpEnd
    -> MutableByteArray s
    -> ST s (Either Domain8Err Int)
localpartDriver :: forall s.
ByteString
-> Int -> MutableByteArray s -> ST s (Either Domain8Err Int)
localpartDriver !ByteString
bs !Int
lpEnd !MutableByteArray s
outBuf = Int -> Int -> ST s (Either Domain8Err Int)
go Int
0 Int
1
  where
    go :: Int -> Int -> ST s (Either Domain8Err Int)
    go :: Int -> Int -> ST s (Either Domain8Err Int)
go !Int
iPos !Int
oPos
      | Int
iPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lpEnd = Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either Domain8Err Int
forall a b. b -> Either a b
Right (Int
oPos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
      | Bool
otherwise =
          let !b :: Word8
b = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
iPos
          in if | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x5C -> Int -> Int -> ST s (Either Domain8Err Int)
handleEsc Int
iPos Int
oPos
                | Bool
otherwise -> Word8 -> Int -> Int -> ST s (Either Domain8Err Int)
appendByte Word8
b (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
oPos

    appendByte :: Word8 -> Int -> Int -> ST s (Either Domain8Err Int)
    appendByte :: Word8 -> Int -> Int -> ST s (Either Domain8Err Int)
appendByte !Word8
b !Int
iPos !Int
oPos
      | Word8
b Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0x7F = Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8Non7Bit)
      | Int
oPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLabelLen = Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8LabelTooLong)
      | Bool
otherwise = do
          MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
outBuf Int
oPos Word8
b
          Int -> Int -> ST s (Either Domain8Err Int)
go Int
iPos (Int
oPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    handleEsc :: Int -> Int -> ST s (Either Domain8Err Int)
    handleEsc :: Int -> Int -> ST s (Either Domain8Err Int)
handleEsc !Int
iPos !Int
oPos
      | Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lpEnd = Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8BadEscape)
      | Word8
b1 <- ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      , Word8
v1 <- Word8
b1 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x30
      = if | Word8
v1 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
9 -> Word8 -> Int -> Int -> ST s (Either Domain8Err Int)
appendByte Word8
b1 (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Int
oPos
           | Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lpEnd -> Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8BadEscape)
           | Word8
v2 <- ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x30
           , Word8
v2 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
9
           , Word8
v3 <- ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x30
           , Word8
v3 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
9
           , !Word8
n <- (Word8
v1 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
100 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
v2 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
* Word8
10 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
v3)
           -> if | Word8
n Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0xFF -> Word8 -> Int -> Int -> ST s (Either Domain8Err Int)
appendByte (Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) (Int
iPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
oPos
                 | Bool
otherwise -> Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8BadEscape)
           | Bool
otherwise -> Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8BadEscape)

----------------------------------------------------------------------
-- Mailbox driver
----------------------------------------------------------------------

-- | Parse a mailbox in presentation form.  @sepAt@ is the byte
-- offset of the first unescaped @\'\@\'@ (already located by
-- 'findAt8').  Walks the localpart bytes @[0..sepAt)@, then
-- dispatches @[sepAt+1..inEnd)@ to 'domainDriver' for the
-- domain-side labels.
mboxDriver
    :: forall s
    .  ByteString
    -> Int                              -- ^ inEnd
    -> MutableByteArray s
    -> Int                              -- ^ sepAt
    -> ST s (Either Domain8Err Int)
mboxDriver :: forall s.
ByteString
-> Int -> MutableByteArray s -> Int -> ST s (Either Domain8Err Int)
mboxDriver !ByteString
bs !Int
inEnd !MutableByteArray s
outBuf !Int
sepAt = do
    res <- ByteString
-> Int -> MutableByteArray s -> ST s (Either Domain8Err Int)
forall s.
ByteString
-> Int -> MutableByteArray s -> ST s (Either Domain8Err Int)
localpartDriver ByteString
bs Int
sepAt MutableByteArray s
outBuf
    case res of
      Left Domain8Err
e -> Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
e)
      Right Int
lpLen
        | Int
lpLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
            -- Empty localpart.  Accepted only as a sole "@" denoting
            -- the root domain (matches the historical behaviour of
            -- the Builder-based parser); rejected when followed by
            -- anything else (the empty first label has no business
            -- next to additional content).
            if Int
sepAt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
inEnd
              then Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either Domain8Err Int
forall a b. b -> Either a b
Right Int
0)
              else Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8EmptyLabel)
        | Int
lpLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxLabelLen -> do
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray @Word8 MutableByteArray s
MutableByteArray (PrimState (ST s))
outBuf Int
0 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lpLen)
            let !lpEnd :: Int
lpEnd = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
lpLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            if Int
sepAt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
inEnd
              then Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Either Domain8Err Int
forall a b. b -> Either a b
Right Int
lpEnd)
              else ByteString
-> Int
-> MutableByteArray s
-> Int
-> Int
-> Int
-> ST s (Either Domain8Err Int)
forall s.
ByteString
-> Int
-> MutableByteArray s
-> Int
-> Int
-> Int
-> ST s (Either Domain8Err Int)
domainDriver ByteString
bs Int
inEnd MutableByteArray s
outBuf
                                Int
lpEnd (Int
sepAt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
lpEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise -> Either Domain8Err Int -> ST s (Either Domain8Err Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err Int
forall a b. a -> Either a b
Left Domain8Err
D8LabelTooLong)

-- | Single-pass scan for the first unescaped @\'\@\'@.  Returns the
-- byte offset of that @\'\@\'@, or 'Nothing' if none is present.
--
-- Backslash escapes are skipped in the same shape as the localpart
-- parser uses on input: @\\<digit>@ is the start of a 4-byte
-- @\\DDD@ form; @\\<other>@ is the 2-byte @\\C@ form.  A
-- structurally invalid escape (truncated) leaves the scan in
-- "no @ found" state, and the actual parse failure is reported by
-- 'parseDomain8Wire' (which the mailbox parser falls back to in the
-- no-@ case).
findAt8 :: ByteString -> Int -> Int -> Maybe Int
findAt8 :: ByteString -> Int -> Int -> Maybe Int
findAt8 !ByteString
bs !Int
p0 !Int
inEnd = Int -> Maybe Int
go Int
p0
  where
    go :: Int -> Maybe Int
go !Int
p
      | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
inEnd = Maybe Int
forall a. Maybe a
Nothing
      | Bool
otherwise =
          let !b :: Word8
b = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs Int
p
          in if | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x40 -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p
                | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x5C -> Int -> Maybe Int
skipEsc Int
p
                | Bool
otherwise -> Int -> Maybe Int
go (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    skipEsc :: Int -> Maybe Int
skipEsc !Int
p
      | Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
inEnd = Maybe Int
forall a. Maybe a
Nothing
      | Bool
otherwise =
          let !b1 :: Word8
b1 = ByteString -> Int -> Word8
BU.unsafeIndex ByteString
bs (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          in case Word8 -> Maybe Word8
asciiDigit Word8
b1 of
               Just Word8
_  -> Int -> Maybe Int
go (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)
               Maybe Word8
Nothing -> Int -> Maybe Int
go (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)

----------------------------------------------------------------------
-- Buffer finalisation
----------------------------------------------------------------------

-- | Common tail: append a terminator to @outBuf@ at @outLen@,
-- length-check, and freeze into the wire-form 'ShortByteString'.
finalise
    :: forall s
    .  MutableByteArray s
    -> Either Domain8Err Int
    -> ST s (Either Domain8Err ShortByteString)
finalise :: forall s.
MutableByteArray s
-> Either Domain8Err Int
-> ST s (Either Domain8Err ShortByteString)
finalise !MutableByteArray s
_ (Left Domain8Err
e) = Either Domain8Err ShortByteString
-> ST s (Either Domain8Err ShortByteString)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err ShortByteString
forall a b. a -> Either a b
Left Domain8Err
e)
finalise !MutableByteArray s
outBuf (Right Int
outLen) =
    let !finalLen :: Int
finalLen = Int
outLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    in if Int
finalLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxWireLen
         then Either Domain8Err ShortByteString
-> ST s (Either Domain8Err ShortByteString)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain8Err -> Either Domain8Err ShortByteString
forall a b. a -> Either a b
Left Domain8Err
D8WireTooLong)
         else do
           MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
outBuf Int
outLen (Word8
0 :: Word8)
           resBA <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray Int
finalLen
           copyMutableByteArray resBA 0 outBuf 0 finalLen
           frozen <- unsafeFreezeByteArray resBA
           pure (Right (baToShortByteString frozen))

----------------------------------------------------------------------
-- Tiny utilities
----------------------------------------------------------------------

-- | If @w@ is an ASCII decimal digit, return its numeric value
-- (0..9); otherwise 'Nothing'.
asciiDigit :: Word8 -> Maybe Word8
asciiDigit :: Word8 -> Maybe Word8
asciiDigit !Word8
w
    | Word8
d Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
9    = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
d
    | Bool
otherwise = Maybe Word8
forall a. Maybe a
Nothing
  where
    !d :: Word8
d = Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x30
{-# INLINE asciiDigit #-}

-- | Pack a 'String' into a 'ByteString', failing with 'D8Non8Bit' if
-- any character has codepoint above @0xFF@.
safePack :: String -> Either Domain8Err ByteString
safePack :: String -> Either Domain8Err ByteString
safePack String
s
    | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFF) (Int -> Bool) -> (Char -> Int) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
Ch.ord) String
s = ByteString -> Either Domain8Err ByteString
forall a b. b -> Either a b
Right (String -> ByteString
C8.pack String
s)
    | Bool
otherwise                  = Domain8Err -> Either Domain8Err ByteString
forall a b. a -> Either a b
Left Domain8Err
D8Non8Bit