idnaparse (empty) → 1.0.0.0
raw patch · 5 files changed
+1043/−0 lines, 5 filesdep +basedep +bytestringdep +containers
Dependencies added: base, bytestring, containers, idna2008, optparse-applicative, streaming, streaming-bytestring, text
Files
- CHANGELOG.md +24/−0
- LICENSE +31/−0
- README.md +173/−0
- app/idnaparse.hs +749/−0
- idnaparse.cabal +66/−0
+ CHANGELOG.md view
@@ -0,0 +1,24 @@+# Changelog++## 0.1.0.0++Initial release as a standalone project, factored out of the+`dnsbase` library and rebased on the `idna2008` library.++- `idnaparse` CLI: reads UTF-8 presentation-form names from stdin+ (one per line) and emits one JSON record per name on stdout.+- Success rows report the canonical presentation form, the+ Unicode display form, and the set of label-form classifications+ (LDH, ALABEL, ULABEL, FAKEA, ATTRLEAF, OCTET, WILDLABEL).+- Failure rows report a structured error with the offending label+ index, the rule or codepoint that failed, and (for Bidi+ violations) the specific RFC 5893 rule.+- `--forms` selects the permitted label-form classes;+ `--opts` selects the IDNA validation flags, input mappings, and+ presentation policy. Both accept comma-separated tokens with+ `+`/`-` prefix arithmetic and the same vocabulary as the+ `idna2008` library's `parseLabelFormSet` and `parseIdnaFlags`.+- `--summary` emits a trailing summary record with per-class and+ per-error counters.+- `--explain-forms` and `--explain-opts` print the full+ vocabulary glossaries.
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2026 Viktor Dukhovni++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the author nor the names of his+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,173 @@+# idnaparse++An IDNA-aware DNS-name lint and reporter. Reads+presentation-form domain names from stdin (one per line) and+emits one JSON record per name on stdout.++Useful for sweeping a zone file or registrar feed for IDNA+conformance, summarising the label kinds present in a corpus, or+as a parsing front end for ad-hoc DNS-name analysis pipelines.++Built on the [`idna2008`](https://github.com/dnsbase/idna2008)+library; was previously bundled with `dnsbase` and is now a+standalone project so it can be used without pulling in the+broader DNS-message machinery.++## Quick start++```sh+$ cabal install idnaparse++$ printf '%s\n' 'www.example.com' 'müllers.example.de' '_25._tcp.example' |+ idnaparse --summary | jq+{+ "input": {+ "text": "www.example.com",+ "forms": [+ "LDH",+ "LDH",+ "LDH"+ ]+ },+ "presentation": "www.example.com",+ "output": {+ "text": "www.example.com",+ "forms": [+ "LDH",+ "LDH",+ "LDH"+ ]+ }+}+{+ "input": {+ "text": "müllers.example.de",+ "forms": [+ "ULABEL",+ "LDH",+ "LDH"+ ]+ },+ "presentation": "xn--mllers-kva.example.de",+ "output": {+ "text": "müllers.example.de",+ "forms": [+ "ULABEL",+ "LDH",+ "LDH"+ ]+ }+}+{+ "input": {+ "text": "_25._tcp.example",+ "forms": [+ "ATTRLEAF",+ "ATTRLEAF",+ "LDH"+ ]+ },+ "presentation": "_25._tcp.example",+ "output": {+ "text": "_25._tcp.example",+ "forms": [+ "ATTRLEAF",+ "ATTRLEAF",+ "LDH"+ ]+ }+}+{+ "summary": {+ "ok": 3,+ "fail": 0,+ "discard": {+ "overlong": 0,+ "badutf8": 0+ },+ "forms": {+ "ATTRLEAF": 1,+ "LDH": 3,+ "ULABEL": 1+ },+ "reasons": {}+ }+}+```++## Output schema++### Success rows++```json+{ "input" : { "text": "...", "forms": ["...", ...] },+ "presentation" : "...", // canonical RFC 1035 form+ "output" : { "text": "...", "forms": ["...", ...] },+ "fakes" : [{...}] // present iff a FAKEA label appeared+}+```++`input.forms` is the parser's per-label classification; `output.forms`+is the unparser's. With validation enabled (the default), an `ALABEL`+in `output.forms` signals BIDI-driven ASCII fallback: the label would+have decoded to Unicode if the cross-label rules had allowed it.++When input mappings are enabled (e.g. `--opts +map-width`), the+parser's classification reflects the *post-mapping* label, not the+raw input bytes. A label written in fullwidth Latin letters+(`０-９Ａ-Ｚａ-ｚ`) maps to plain ASCII and classifies as `LDH`,+even though the input bytes were non-ASCII. This is by design:+the mappings exist to correct input-method artefacts that produce+non-ASCII representations of what the user meant to type as ASCII.+It does mean `input.forms` may not be a faithful record of "did the+input have non-ASCII bytes" when mappings are active; if you need+that distinction, inspect `input.text` directly (or don't enable+"width" mappings).++### Failure rows++Two shapes, depending on where the failure happens:++```json+// Parse failure -- the input text did not parse.+{ "input": { "text": "...",+ "error": { "reason": "...", ... } } }++// Unparse failure -- the input parsed but the wire form could not be+// rendered under the given options (e.g. cross-label Bidi without+// ascii-fallback, or an admitted form set whose output classification+// is not also admitted).+{ "input" : { "text": "...", "forms": ["...", ...] },+ "presentation" : "...",+ "output" : { "error": { "reason": "...", ... } },+ "fakes" : [{...}] } // present iff a FAKEA label appeared+```++The `error` object carries the standard set of optional fields+(`label`, `cp`, `length`, `form`, `rule`).++Overlong input lines and ill-formed UTF-8 produce no row; they are+counted in the optional summary.++## Configuration++`--forms FORMS` permitted label-form tokens (e.g. `host`,+`+attrleaf`, `idn,wildlabel`). See `--explain-forms` for the+full vocabulary.++`--opts OPTS` IDNA option tokens (e.g. `default`, `+emoji-ok`,+`map,bidi-check`). See `--explain-opts` for the full vocabulary.++`--summary` emit a trailing summary record with per-class and+per-error counters.++`--no-rows` suppress per-row records (combine with `--summary`+when only aggregate output is wanted).++## Status++Initial release (`1.0.0.0`).++## License++BSD-3-Clause.
+ app/idnaparse.hs view
@@ -0,0 +1,749 @@+-- | idnaparse -- parse a stream of host-style domain names against the+-- IDNA-aware presentation parser and emit one JSON record per input.+--+-- Reads UTF-8 lines from stdin, one name per line. Each non-discarded+-- line produces a JSON object on stdout:+--+-- * Successful parse + unparse:+--+-- @{ "input" : { "text": ..., "forms": [...] }+-- , "presentation" : ... -- canonical RFC 1035 form+-- , "output" : { "text": ..., "forms": [...] }+-- , "fakes" : [...] -- present iff at least one FAKEA label appears+-- }@+--+-- @input.forms@ classifies the label forms seen on input (after mappings);+-- @output.forms@ classifies the labels produced on output.+-- A-labels in the input may become U-labels on output.+-- With crossl-label BIDI rule violations, and ASCII fallback enabled,+-- U-labels in the input may become A-labels on output.+--+-- * Parse failure:+--+-- @{ "input": { "text": ..., "error": {...} } }@+--+-- * Unparse failure (parse succeeded, unparse rejected):+--+-- @{ "input" : { "text": ..., "forms": [...] }+-- , "presentation" : ...+-- , "output" : { "error": {...} }+-- , "fakes" : [...] -- present iff at least one FAKEA label appears+-- }@+--+-- Discards (overlong lines, ill-formed UTF-8) produce no row; they are+-- counted in the optional summary.+--+-- See @--help@ for CLI flags.+module Main (main) where++import qualified Data.ByteString as BSStrict+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Char8 as BS+import qualified Data.Map.Strict as Map+import qualified Data.Text as T+import qualified Data.Text.Encoding as Enc+import qualified Streaming.ByteString.Char8 as Q+import qualified Streaming.Prelude as S+import Control.Monad ((>=>), unless, when)+import Data.Bits ((.&.), unsafeShiftR)+import qualified Data.List as List+import Data.IORef+import Data.Map.Strict (Map)+import Data.Word (Word8)+import Streaming (Stream, Of(..), inspect, lift)+import System.IO (BufferMode(..), hSetBinaryMode, hSetBuffering, stdin, stdout)++import Options.Applicative++import Text.IDNA2008+ ( AceReason(..)+ , BidiRuleViolation+ , IdnaError(..)+ , IdnaFlags(..)+ , LabelForm(..)+ , LabelFormSet+ , LabelReason(..)+ , defaultIdnaFlags+ , domainToAscii+ , getLabelForms+ , idnLabelForms+ , parseDomainOpts+ , parseIdnaFlagsStr+ , parseLabelFormSetStr+ , unparseDomainOpts+ , (<->)+ )++----------------------------------------------------------------------+-- Constants+----------------------------------------------------------------------++-- | Worst-case length of a presentation-form fully-qualified name+-- with maximal escaping.+nameLimit :: Int+nameLimit = 1024++----------------------------------------------------------------------+-- CLI+----------------------------------------------------------------------++data Options = Options+ { optForms :: !LabelFormSet+ , optFlags :: !IdnaFlags+ , optSummary :: !Bool+ , optNoRows :: !Bool+ }++optionsParser :: Parser Options+optionsParser = Options+ <$> option formsReader+ ( long "forms"+ <> metavar "FORMS"+ <> value idnLabelForms+ <> showDefault+ <> help formsHelp )+ <*> option idnaFlagsReader+ ( long "opts"+ <> metavar "OPTS"+ <> value defaultIdnaFlags+ <> showDefault+ <> help optsHelp )+ <*> switch+ ( long "summary"+ <> help "Emit a trailing summary record" )+ <*> switch+ ( long "no-rows"+ <> help "Suppress per-row records (combine with --summary)" )++formsHelp :: String+formsHelp =+ "Permitted label-form tokens (comma-separated, +/- prefix); \+ \see --explain-forms."++opts :: ParserInfo Options+opts = info (optionsParser <**> helper+ <**> explainFormsFlag+ <**> explainOptsFlag)+ ( fullDesc+ <> progDesc "Parse domain names from stdin (one per line) and emit \+ \one JSON record per name on stdout."+ <> header "idnaparse - IDNA-aware DNS-name lint and reporter" )++-- | --explain-forms: print the label-form glossary and exit. Kept+-- separate from --help so the default option list stays compact;+-- callers who want the full vocabulary opt in explicitly.+explainFormsFlag :: Parser (a -> a)+explainFormsFlag = infoOption formsExplainText+ ( long "explain-forms"+ <> help "Print the label-form glossary and exit" )++-- | --explain-opts: print the IDNA-options glossary and exit.+-- Covers validation checks, input mappings, the Bidi rule+-- mechanism, the emoji relaxation, and the ASCII fallback policy+-- in one place.+explainOptsFlag :: Parser (a -> a)+explainOptsFlag = infoOption optsExplainText+ ( long "explain-opts"+ <> help "Print the IDNA-options glossary and exit" )++formsExplainText :: String+formsExplainText = unlines+ [ "SYNTAX"+ , " Comma-separated tokens passed to --forms. Tokens are"+ , " case-insensitive; 3-character prefix matching is accepted"+ , " (e.g. 'alab' for 'alabel', 'wild' for 'wildlabel')."+ , " Default --forms value: \"default\"."+ , ""+ , " Sign prefixes: \"-X\" subtracts; \"+X\" or unprefixed \"X\""+ , " adds. If the FIRST token starts with \"+\" or \"-\", the"+ , " running result is seeded with \"default\" and your tokens"+ , " tweak it. Otherwise the running result starts empty and"+ , " your tokens replace the default."+ , ""+ , "PRESETS (composite tokens that expand to a fixed set of bits)"+ , " idn LDH | ALABEL | ULABEL (also: 'default' or 'strict')"+ , " host idn | RLDH | FAKEA"+ , " all host | ATTRLEAF | OCTET | WILDLABEL"+ , "LABEL FORMS"+ , " LDH Letter-Digit-Hyphen. Lowercase a-z, digits 0-9, and"+ , " '-'. No leading or trailing hyphen. The conventional"+ , " hostname alphabet."+ , " RLDH Reserved LDH. LDH-shaped label with '--' at positions"+ , " 3-4 that is NOT 'xn--'-prefixed. Reserved by RFC 5890;"+ , " typically these are pre-IDN registrations (such as,"+ , " \"cd--shelves\", \"l---l\") that happen to share the"+ , " 'X--Y' shape without being A-labels."+ , " ALABEL IDNA A-label: an 'xn--' label whose Punycode body"+ , " decodes to a valid U-label and re-encodes to the same"+ , " bytes (under alabel-check; without it, every well-formed"+ , " 'xn--' LDH label is an ALABEL). See --explain-opts."+ , " FAKEA 'xn--' LDH label that fails the strict A-label"+ , " round-trip test (bad Punycode, decoded form fails U-label"+ , " validation, or re-encoded form differs). Only produced"+ , " under alabel-check."+ , " ULABEL U-label: input contains at least one non-ASCII codepoint"+ , " admitted by IDNA2008; encoded to its A-label form on the"+ , " wire."+ , " ATTRLEAF LDH-shaped label whose first byte is '_'. Used for"+ , " RFC 8552 attribute-leaf names (such as, '_25._tcp.example')."+ , " OCTET A label that's not (R)LDH: either the bytes include non-LDH"+ , " values (control bytes, '_' outside an ATTRLEAF position,"+ , " bytes >= 0x80, ...), or the input used backslash escapes"+ , " to force literal interpretation of bytes that might"+ , " otherwise be LDH."+ , " WILDLABEL A label consisting of a single '*' byte. Distinct from"+ , " OCTET so that callers can admit or reject it"+ , " independently."+ , " LAXULABEL For debugging only, IDNA-disallowed Unicode label that"+ , " encodes to or decodes from a plausible-looking FAKEA label."+ , "REFERENCES"+ , " IDNA2008: RFC 5890-5895"+ , " Punycode: RFC 3492"+ , " Library: https://github.com/dnsbase/idna2008"+ ]++optsExplainText :: String+optsExplainText = unlines+ [ "IDNA OPTIONS"+ , " Comma-separated tokens passed to --opts. Tokens are"+ , " case-insensitive; 3-character prefix matching is accepted."+ , " Default --opts value: \"default\"."+ , ""+ , " Sign prefixes: \"-X\" subtracts; \"+X\" or unprefixed \"X\""+ , " adds (\"+\" is the implicit default for additive operations)."+ , " If the FIRST token starts with \"+\" or \"-\", the running"+ , " result is seeded with \"default\" and your tokens tweak it"+ , " (e.g. \"+emoji-ok\" means \"default plus emoji-ok\")."+ , " Otherwise the running result starts empty and your tokens"+ , " replace the default (e.g. \"map-case,map-nfc\" yields just"+ , " those two flags)."+ , ""+ , "VALIDATION CHECKS (on under \"default\")"+ , ""+ , " alabel-check (alias: xncheck)"+ , " Strict A-label round-trip. An \"xn--\"-prefixed label whose"+ , " Punycode body doesn't decode to a valid U-label and re-encode"+ , " to the same bytes is reported as FAKEA rather than ALABEL."+ , ""+ , " nfc-check"+ , " Require Unicode Normalization Form C on U-labels (RFC 5891"+ , " section 5.3). Labels with combining marks in non-canonical"+ , " order, or decomposed sequences with a precomposed equivalent,"+ , " are rejected."+ , ""+ , " bidi-check"+ , " Apply RFC 5893 Bidi rules. Right-to-left scripts (Hebrew,"+ , " Arabic, ...) carry a reading direction that bidirectional-"+ , " text engines honour when laying out a paragraph. Mixing"+ , " right-to-left labels with left-to-right ones in a single"+ , " domain name leaves room for visual reordering -- the rules"+ , " constrain what a domain may contain so the layout stays"+ , " unambiguous."+ , ""+ , " Per label: an individual right-to-left label must be"+ , " self-consistent (no stray left-to-right characters in the"+ , " middle, no mixing of European and Arabic-Indic digits, and"+ , " so on). Once any label in the name is right-to-left, every"+ , " other label -- including pure left-to-right ones -- must"+ , " also pass the rules. Catches mixtures like"+ , " \"_tcp.<arabic-label>.example\": \"_tcp\" is fine on its own,"+ , " but it starts with an underscore, and the rules forbid an"+ , " underscore-leading label in the same domain as a right-to-"+ , " left label."+ , ""+ , " Names that fail are reported as errors, with the offending"+ , " label index and the specific rule that failed (e.g."+ , " \"BidiRule1FirstNotLRAL\")."+ , ""+ , "INPUT MAPPINGS (RFC 5895; off under \"default\")"+ , ""+ , " map-dots"+ , " Treat the East Asian period characters (the ideographic"+ , " period and its fullwidth and halfwidth variants) as label"+ , " separators, just like '.'."+ , ""+ , " map-case"+ , " Lowercase the input. ASCII A-Z always, and also other"+ , " letters with a known lowercase form when they appear inside"+ , " a label that contains non-ASCII characters."+ , ""+ , " map-width"+ , " Convert fullwidth and halfwidth characters to their normal-"+ , " width form. Fullwidth Latin letters become ordinary ASCII"+ , " letters, and halfwidth katakana becomes regular katakana."+ , " Implies map-dots so the fullwidth and halfwidth period"+ , " characters act as separators."+ , ""+ , " map-nfc"+ , " Combine letter-and-accent sequences into single characters"+ , " where possible. Affects only labels with non-ASCII"+ , " characters."+ , ""+ , " Aliases: cmap = map-case, dmap = map-dots, nmap = map-nfc,"+ , " wmap = map-width."+ , ""+ , "RELAXATIONS"+ , ""+ , " emoji-ok"+ , " Admit non-ASCII codepoints carrying the Unicode Emoji property"+ , " even when otherwise disallowed by IDNA2008. Applies both at"+ , " parse time (the label classifies as ULABEL/ALABEL instead of"+ , " FAKEA) and at render time (a strictly-round-tripping ACE"+ , " label whose body decodes to emoji renders as the codepoint)."+ , " Useful when analysing real-world IDN data that includes emoji"+ , " registrations."+ , ""+ , "PRESENTATION POLICY"+ , ""+ , " ascii-fallback"+ , " Implies bidi-check. When the cross-label Bidi rules would"+ , " reject a name, render it in A-label form (every label as"+ , " ASCII) instead of erroring. Useful for display contexts"+ , " where the goal is \"show the user something readable\";"+ , " strict callers (registry tools, conformance validators)"+ , " should not enable this -- they want the error."+ , ""+ , " With validation enabled (the default), an ALABEL in"+ , " the \"renderedForms\" array is the signal that the"+ , " cross-label Bidi rules prevented the U-label form:"+ , " the renderer's Unicode-preferred tiebreak would have"+ , " picked ULABEL if the rules had not forced the fallback."+ , " Comparison against the \"forms\" array (parser-time"+ , " classification) identifies which specific labels were"+ , " originally Unicode."+ , ""+ , "PRESETS"+ , " default alabel-check, nfc-check, bidi-check. This is the"+ , " default value of --opts."+ , " map The four input mappings above."+ , ""+ , "REFERENCES"+ , " RFC 5891: https://www.rfc-editor.org/rfc/rfc5891 (IDNA protocol)"+ , " RFC 5893: https://www.rfc-editor.org/rfc/rfc5893 (Bidi rules)"+ , " RFC 5895: https://www.rfc-editor.org/rfc/rfc5895 (input mappings)"+ ]++----------------------------------------------------------------------+-- Forms / flags parsers (CLI value readers)+----------------------------------------------------------------------++formsReader :: ReadM LabelFormSet+formsReader = eitherReader (parseLabelFormSetStr idnLabelForms)++idnaFlagsReader :: ReadM IdnaFlags+idnaFlagsReader = eitherReader (parseIdnaFlagsStr defaultIdnaFlags)++optsHelp :: String+optsHelp =+ "IDNA option tokens (comma-separated, +/- prefix); \+ \see --explain-opts."++----------------------------------------------------------------------+-- Counters+----------------------------------------------------------------------++data Counters = Counters+ { cOk :: !(IORef Int)+ , cFail :: !(IORef Int)+ , cOverlong :: !(IORef Int)+ , cBadUtf8 :: !(IORef Int)+ , cForms :: !(IORef (Map BS.ByteString Int))+ , cReasons :: !(IORef (Map BS.ByteString Int))+ }++newCounters :: IO Counters+newCounters = Counters+ <$> newIORef 0 <*> newIORef 0 <*> newIORef 0 <*> newIORef 0+ <*> newIORef Map.empty <*> newIORef Map.empty++bumpInt :: IORef Int -> IO ()+bumpInt ref = modifyIORef' ref (+ 1)+{-# INLINE bumpInt #-}++bumpKey :: IORef (Map BS.ByteString Int) -> BS.ByteString -> IO ()+bumpKey ref k = modifyIORef' ref (Map.insertWith (+) k 1)+{-# INLINE bumpKey #-}++----------------------------------------------------------------------+-- LabelForm -> sorted list of name-strings+----------------------------------------------------------------------++-- | Render a single 'LabelForm' to its canonical name. Defers to+-- the library's 'Show' instance, which is authoritative -- a new+-- form constructor surfaces here without any app-side update.+formName :: LabelForm -> BS.ByteString+formName = BS.pack . show++-- | Per-row deduplicated form names. Used by the summary counter:+-- each distinct form contributes one bump per input row regardless+-- of how many labels carried it.+uniqueFormNames :: [LabelForm] -> [BS.ByteString]+uniqueFormNames = map formName . List.nub++----------------------------------------------------------------------+-- IdnaError / reason classification+----------------------------------------------------------------------++-- | Description of the @"error"@ object's payload: the @reason@+-- vocabulary and any auxiliary fields.+data ErrorRec = ErrorRec+ { erReason :: !BS.ByteString+ , erLabel :: !(Maybe Int)+ , erCp :: !(Maybe Int)+ , erLength :: !(Maybe Int)+ , erForm :: !(Maybe BS.ByteString)+ , erRule :: !(Maybe BS.ByteString)+ }++emptyError :: BS.ByteString -> ErrorRec+emptyError r = ErrorRec r Nothing Nothing Nothing Nothing Nothing++withLabel :: ErrorRec -> Int -> ErrorRec+withLabel e n = e { erLabel = Just n }++classifyErr :: IdnaError -> ErrorRec+classifyErr = \case+ ErrEmptyLabel loc ->+ emptyError "EmptyLabel" `withLabel` loc+ ErrLabelTooLong loc n ->+ (emptyError "LabelTooLong" `withLabel` loc)+ { erLength = Just n }+ ErrNameTooLong n ->+ (emptyError "NameTooLong") { erLength = Just n }+ ErrBadEscape loc _ ->+ emptyError "BadEscape" `withLabel` loc+ ErrInvalidUtf8 loc _ ->+ emptyError "InvalidUtf8" `withLabel` loc+ ErrCodepointTooLarge loc cp ->+ (emptyError "CodepointTooLarge" `withLabel` loc)+ { erCp = Just cp }+ ErrUnpresentableLabel loc ->+ emptyError "UnpresentableLabel" `withLabel` loc+ ErrFormNotAllowed loc fm ->+ (emptyError "FormNotAllowed" `withLabel` loc)+ { erForm = Just (BS.pack (show fm)) }+ ErrLabelInvalid loc r ->+ let er = classifyU r+ in er { erLabel = Just loc }+ ErrAceInvalid loc r ->+ let er = classifyA r+ in er { erLabel = Just loc }+ ErrPunycodeOverflow loc ->+ emptyError "PunycodeOverflow" `withLabel` loc+ ErrCrossLabelBidi i rule ->+ (emptyError "CrossLabelBidi" `withLabel` i)+ { erRule = Just (showBidiRule rule) }++classifyU :: LabelReason -> ErrorRec+classifyU = \case+ DisallowedCodepoint cp ->+ (emptyError "DisallowedCodepoint") { erCp = Just cp }+ ContextRule cp ->+ (emptyError "ContextRule") { erCp = Just cp }+ NotNFC -> emptyError "NotNFC"+ LabelBidi rule ->+ (emptyError "BidiViolation") { erRule = Just (showBidiRule rule) }+ HyphenViolation -> emptyError "HyphenViolation"+ LeadingCombiningMark cp ->+ (emptyError "LeadingCombiningMark") { erCp = Just cp }++classifyA :: AceReason -> ErrorRec+classifyA = \case+ BadPunycode -> emptyError "BadPunycode"+ RoundTripMismatch -> emptyError "RoundTripMismatch"+ DecodedInvalid r -> classifyU r++-- | Render a 'BidiRuleViolation' as the constructor name (e.g.+-- @\"BidiRule1FirstNotLRAL\"@), so JSON consumers can grep for+-- it without us having to coin our own vocabulary.+showBidiRule :: BidiRuleViolation -> BS.ByteString+showBidiRule = BS.pack . show++----------------------------------------------------------------------+-- main+----------------------------------------------------------------------++main :: IO ()+main = do+ o <- execParser opts+ hSetBinaryMode stdin True+ hSetBinaryMode stdout True+ hSetBuffering stdout (BlockBuffering Nothing)+ counters <- newCounters+ S.mapM_ (processOne counters o (optFlags o))+ (textLines counters Q.stdin)+ when (optSummary o) (emitSummary counters)++processOne :: Counters -> Options -> IdnaFlags -> T.Text -> IO ()+processOne !c !o !idnaFlags !name =+ case parseDomainOpts (optForms o) idnaFlags name of+ Left e -> emitParseFailure (classifyErr e)+ Right (dn, parseInfo) -> do+ let !inSeq = getLabelForms parseInfo+ !inFormNms = map formName inSeq+ !pres = domainToAscii dn+ -- Form counters reflect the parser's input characterisation;+ -- bump them on parse success regardless of whether the+ -- unparse step then succeeded. The FAKEA per-label+ -- diagnostic is gathered for the row's @fakes@ JSON field+ -- but does /not/ feed 'cReasons': FAKEA admitted on input+ -- is not a failure reason, and FAKEA rejected on input+ -- already surfaces under the parse-failure reason.+ mapM_ (bumpKey (cForms c)) (uniqueFormNames inSeq)+ let !mFake = if FAKEA `elem` inSeq+ then collectFake (optForms o) idnaFlags name+ else Nothing+ case unparseDomainOpts (optForms o) idnaFlags dn of+ Left e ->+ emitUnparseFailure inFormNms pres mFake (classifyErr e)+ Right (output, renderInfo) -> do+ -- 'inSeq' is the parser's per-label classification in+ -- label order; 'outSeq' is the unparser's. They+ -- differ when 'ASCIIFALLBACK' downgrades a U-label to+ -- its ACE form: 'input.forms' carries 'ULABEL',+ -- 'output.forms' carries 'ALABEL'.+ let !outSeq = getLabelForms renderInfo+ bumpInt (cOk c)+ unless (optNoRows o) $+ BB.hPutBuilder stdout+ (successRow name inFormNms pres+ output (map formName outSeq)+ mFake+ <> BB.char7 '\n')+ where+ emitParseFailure !er = do+ bumpInt (cFail c)+ bumpKey (cReasons c) (erReason er)+ unless (optNoRows o) $+ BB.hPutBuilder stdout (parseFailureRow name er <> BB.char7 '\n')++ emitUnparseFailure !inForms !pres !mFake !er = do+ bumpInt (cFail c)+ bumpKey (cReasons c) (erReason er)+ unless (optNoRows o) $+ BB.hPutBuilder stdout+ (unparseFailureRow name inForms pres mFake er <> BB.char7 '\n')++-- | If the original parse classified at least one label as @FAKEA@,+-- re-parse with @FAKEA@ stripped from the allowed set so the parser+-- surfaces the precise 'AceReason' via @ErrAceInvalid@. Returns+-- the first failing label's reason, or 'Nothing' on the (impossible)+-- case where the masked parse doesn't fail at all.+collectFake :: LabelFormSet -> IdnaFlags -> T.Text -> Maybe ErrorRec+collectFake forms idnaFlags name =+ case parseDomainOpts (forms <-> FAKEA) idnaFlags name of+ Left e@(ErrAceInvalid _ _) -> Just (classifyErr e)+ _ -> Nothing++----------------------------------------------------------------------+-- Row builders+----------------------------------------------------------------------++-- | Parse + unparse both succeeded. Both forms arrays carry the+-- per-label classification at the relevant phase; they differ when+-- 'ASCIIFALLBACK' fires (typically @ULABEL@ in @input.forms@,+-- @ALABEL@ in @output.forms@).+successRow :: T.Text+ -> [BS.ByteString] -- ^ Parser's per-label classification+ -> T.Text -- ^ Presentation form (canonical ASCII)+ -> T.Text -- ^ Rendered output text+ -> [BS.ByteString] -- ^ Unparser's per-label classification+ -> Maybe ErrorRec -- ^ FAKEA per-label diagnostic+ -> BB.Builder+successRow input inForms pres output outForms mFake =+ BB.byteString "{\"input\":" <> inputObject input inForms+ <> BB.byteString ",\"presentation\":" <> jsonString pres+ <> BB.byteString ",\"output\":" <> outputObject output outForms+ <> maybe mempty+ (\er -> BB.byteString ",\"fakes\":["+ <> errorObject er+ <> BB.byteString "]")+ mFake+ <> BB.char7 '}'++-- | Parse failed: only the input text and the error.+parseFailureRow :: T.Text -> ErrorRec -> BB.Builder+parseFailureRow input er =+ BB.byteString "{\"input\":{\"text\":"+ <> jsonString input+ <> BB.byteString ",\"error\":"+ <> errorObject er+ <> BB.byteString "}}"++-- | Parse succeeded but unparse failed (e.g. cross-label Bidi+-- without @ASCIIFALLBACK@). The input side carries the parser's+-- classification; the output side carries only the error. The+-- FAKEA per-label diagnostic, when present, comes through too --+-- it characterises the parsed input, which the unparse failure+-- doesn't invalidate.+unparseFailureRow :: T.Text+ -> [BS.ByteString] -- ^ Parser's per-label classification+ -> T.Text -- ^ Presentation form+ -> Maybe ErrorRec -- ^ FAKEA per-label diagnostic+ -> ErrorRec+ -> BB.Builder+unparseFailureRow input inForms pres mFake er =+ BB.byteString "{\"input\":" <> inputObject input inForms+ <> BB.byteString ",\"presentation\":" <> jsonString pres+ <> BB.byteString ",\"output\":{\"error\":"+ <> errorObject er+ <> BB.byteString "}"+ <> maybe mempty+ (\fake -> BB.byteString ",\"fakes\":["+ <> errorObject fake+ <> BB.byteString "]")+ mFake+ <> BB.char7 '}'++inputObject :: T.Text -> [BS.ByteString] -> BB.Builder+inputObject text forms =+ BB.byteString "{\"text\":" <> jsonString text+ <> BB.byteString ",\"forms\":" <> jsonStringArray forms+ <> BB.char7 '}'++outputObject :: T.Text -> [BS.ByteString] -> BB.Builder+outputObject text forms =+ BB.byteString "{\"text\":" <> jsonString text+ <> BB.byteString ",\"forms\":" <> jsonStringArray forms+ <> BB.char7 '}'++-- | Render an 'ErrorRec' as a JSON object @{ "reason":..., "label"?:..., ... }@.+-- Optional fields appear only when present.+errorObject :: ErrorRec -> BB.Builder+errorObject er =+ BB.byteString "{\"reason\":\""+ <> BB.byteString (erReason er)+ <> BB.char7 '"'+ <> maybe mempty intField (("label" ,) <$> erLabel er)+ <> maybe mempty intField (("cp" ,) <$> erCp er)+ <> maybe mempty intField (("length",) <$> erLength er)+ <> maybe mempty strField (("form" ,) <$> erForm er)+ <> maybe mempty strField (("rule" ,) <$> erRule er)+ <> BB.char7 '}'+ where+ intField (k, v) =+ BB.byteString ",\""+ <> BB.byteString k+ <> BB.byteString "\":"+ <> BB.intDec v+ strField (k, v) =+ BB.byteString ",\""+ <> BB.byteString k+ <> BB.byteString "\":\""+ <> BB.byteString v+ <> BB.char7 '"'++----------------------------------------------------------------------+-- Summary record+----------------------------------------------------------------------++emitSummary :: Counters -> IO ()+emitSummary c = do+ ok <- readIORef (cOk c)+ bad <- readIORef (cFail c)+ over <- readIORef (cOverlong c)+ badutf8 <- readIORef (cBadUtf8 c)+ formsM <- readIORef (cForms c)+ reasonsM <- readIORef (cReasons c)+ BB.hPutBuilder stdout+ ( BB.byteString "{\"summary\":{\"ok\":"+ <> BB.intDec ok+ <> BB.byteString ",\"fail\":"+ <> BB.intDec bad+ <> BB.byteString ",\"discard\":{\"overlong\":"+ <> BB.intDec over+ <> BB.byteString ",\"badutf8\":"+ <> BB.intDec badutf8+ <> BB.byteString "},\"forms\":"+ <> jsonIntMap formsM+ <> BB.byteString ",\"reasons\":"+ <> jsonIntMap reasonsM+ <> BB.byteString "}}\n")++-- | Render a @Map ByteString Int@ as a JSON object with sorted keys.+jsonIntMap :: Map BS.ByteString Int -> BB.Builder+jsonIntMap m+ | Map.null m = BB.byteString "{}"+ | otherwise =+ BB.char7 '{'+ <> mconcat (zipWith pair (Map.toAscList m) (False : repeat True))+ <> BB.char7 '}'+ where+ pair (k, v) sep =+ (if sep then BB.char7 ',' else mempty)+ <> BB.char7 '"'+ <> BB.byteString k+ <> BB.byteString "\":"+ <> BB.intDec v++----------------------------------------------------------------------+-- JSON encoding helpers+----------------------------------------------------------------------++jsonString :: T.Text -> BB.Builder+jsonString !t =+ BB.char7 '"' <> T.foldr step mempty t <> BB.char7 '"'+ where+ step !c !acc = escapeChar c <> acc++escapeChar :: Char -> BB.Builder+escapeChar !c+ | c == '"' = BB.byteString "\\\""+ | c == '\\' = BB.byteString "\\\\"+ | c == '\b' = BB.byteString "\\b"+ | c == '\t' = BB.byteString "\\t"+ | c == '\n' = BB.byteString "\\n"+ | c == '\f' = BB.byteString "\\f"+ | c == '\r' = BB.byteString "\\r"+ | fromEnum c < 0x20 = uHex (fromEnum c)+ | otherwise = BB.charUtf8 c++uHex :: Int -> BB.Builder+uHex !n =+ BB.byteString "\\u00"+ <> BB.word8 (hexNibble (n `unsafeShiftR` 4))+ <> BB.word8 (hexNibble (n .&. 0x0F))++hexNibble :: Int -> Word8+hexNibble !n+ | n < 10 = fromIntegral (0x30 + n) -- '0'..'9'+ | otherwise = fromIntegral (0x57 + n) -- 'a'..'f'++-- | Render a list of (already-ASCII) ByteStrings as a JSON array of+-- string literals. Used for the @forms@ field, which only contains+-- the canonical form names ("LDH", "ULABEL", etc.) -- no escaping+-- needed.+jsonStringArray :: [BS.ByteString] -> BB.Builder+jsonStringArray xs =+ BB.char7 '['+ <> mconcat (zipWith one xs (False : repeat True))+ <> BB.char7 ']'+ where+ one s sep =+ (if sep then BB.char7 ',' else mempty)+ <> BB.char7 '"'+ <> BB.byteString s+ <> BB.char7 '"'++----------------------------------------------------------------------+-- Stream<>line<>Text+----------------------------------------------------------------------++textLines :: Counters -> Q.ByteStream IO () -> Stream (Of T.Text) IO ()+textLines !c = decode . Q.lines+ where+ decode = go++ go = lift . inspect >=> \case+ Left _ -> pure ()+ Right l -> do+ (bs :> rest) <-+ lift $ Q.toStrict+ $ Q.drained+ $ Q.splitAt (fromIntegral (nameLimit + 1)) l+ if BSStrict.length bs > nameLimit+ then lift (bumpInt (cOverlong c))+ else case Enc.decodeUtf8' bs of+ Right t -> S.yield t+ Left _ -> lift (bumpInt (cBadUtf8 c))+ go rest
+ idnaparse.cabal view
@@ -0,0 +1,66 @@+cabal-version: 3.0++name: idnaparse+version: 1.0.0.0+synopsis: IDNA-aware DNS-name lint and reporter+description:+ @idnaparse@ reads a stream of presentation-form domain names+ (one per line on stdin) and emits one JSON record per name on+ stdout. Each record reports either a successful parse (with+ canonical presentation form, Unicode display form, and the+ set of label-form classifications -- LDH, ALABEL, ULABEL,+ FAKEA, ATTRLEAF, OCTET, WILDLABEL) or an error with enough+ detail to identify the offending label and the specific rule+ that failed.++ Built on the @idna2008@ library. Useful for sweeping a zone+ file or registrar feed for IDNA conformance, building a+ summary of the label kinds present in a corpus, or as the+ parsing front end for ad-hoc DNS-name analysis pipelines.++ See @idnaparse --help@, @idnaparse --explain-forms@, and+ @idnaparse --explain-opts@ for the full CLI vocabulary.++author: Viktor Dukhovni+maintainer: ietf-dane@dukhovni.org+copyright: 2026 Viktor Dukhovni+license: BSD-3-Clause+license-file: LICENSE+category: Network+homepage: https://github.com/dnsbase/idnaparse+bug-reports: https://github.com/dnsbase/idnaparse/issues+build-type: Simple+tested-with: GHC == 9.6.7+ , GHC == 9.8.4+ , GHC == 9.10.3+ , GHC == 9.12.3+ , GHC == 9.14.1++extra-doc-files:+ CHANGELOG.md+ README.md++source-repository head+ type: git+ location: https://github.com/dnsbase/idnaparse.git++executable idnaparse+ hs-source-dirs: app+ main-is: idnaparse.hs+ default-language: GHC2021+ default-extensions:+ BangPatterns+ BlockArguments+ LambdaCase+ OverloadedStrings+ PatternSynonyms+ ghc-options: -O2 -Wall+ build-depends:+ base >= 4.18 && < 5+ , bytestring >= 0.11 && < 0.13+ , containers >= 0.6 && < 0.9+ , idna2008 >= 1.0 && < 1.1+ , optparse-applicative >= 0.17 && < 0.20+ , streaming >= 0.2 && < 0.3+ , streaming-bytestring >= 0.3 && < 0.4+ , text >= 2.0 && < 2.2