diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,16 @@ # Changelog +## 1.0.2.0 + +* Bundled record pattern field selectors with the X_ + type, for easier import. Users may need to import both + X_name(..), and the T_specific type synonym. Made sure + this is reflected clearly in the documentation. + +## 1.0.1.0 + +* Exported SVCB modules that should have been public + ## 1.0.0.0 First public release on Hackage. See [`README.md`](README.md) for diff --git a/dnsbase.cabal b/dnsbase.cabal --- a/dnsbase.cabal +++ b/dnsbase.cabal @@ -1,6 +1,6 @@ cabal-version: 3.12 name: dnsbase -version: 1.0.1.0 +version: 1.0.2.0 build-type: Simple synopsis: Stub DNS resolver with a typed RData model and value-based extension API diff --git a/internal/Net/DNSBase/RData/Internal/XNAME.hs b/internal/Net/DNSBase/RData/Internal/XNAME.hs --- a/internal/Net/DNSBase/RData/Internal/XNAME.hs +++ b/internal/Net/DNSBase/RData/Internal/XNAME.hs @@ -26,7 +26,8 @@ ( -- * Domain-name-valued RR types. -- ** Well-known (from RFC1035) X_domain(T_NS, T_CNAME, T_PTR, T_MB, T_MD, T_MF, T_MG, T_MR) - , type XdomainConName, T_ns, T_cname, T_ptr, T_mb, T_md, T_mf, T_mg, T_mr + , T_ns, T_cname, T_ptr, T_mb, T_md, T_mf, T_mg, T_mr + , type XdomainConName -- ** @DNAME@ , T_dname(..) ) where diff --git a/src/Net/DNSBase/RData/Dnssec.hs b/src/Net/DNSBase/RData/Dnssec.hs --- a/src/Net/DNSBase/RData/Dnssec.hs +++ b/src/Net/DNSBase/RData/Dnssec.hs @@ -26,37 +26,55 @@ too, alongside the re-export of "Net.DNSBase.RData.NSEC" for the denial-of-existence records. -} +{-# OPTIONS_GHC -Wno-duplicate-exports #-} {-# LANGUAGE MagicHash , RecordWildCards , UndecidableInstances #-} module Net.DNSBase.RData.Dnssec - ( -- * DS and DNSKEY + ( -- * DS, DNSKEY and RRSIG -- ** DS resource records - X_ds(.., T_DS, T_CDS) - , type XdsConName, T_ds, T_cds - -- *** DS fields + X_ds(.., T_DS, T_CDS + , dsKtag, dsKalg, dsHalg, dsHval + , cdsKtag, cdsKalg, cdsHalg, cdsHval) + , type XdsConName + -- **** @T_DS@ record pattern synonym fields + , T_ds , dsKtag, dsKalg, dsHalg, dsHval - -- *** CDS fields + -- **** @T_CDS@ record pattern synonym fields + , T_cds , cdsKtag, cdsKalg, cdsHalg, cdsHval -- ** DNSKEY resource records - , X_key(.., T_KEY, T_DNSKEY, T_CDNSKEY) - , type XkeyConName, T_key, T_dnskey, T_cdnskey - -- *** KEY fields - , keyFlags, keyProto, keyAlgor, keyValue - -- *** DNSKEY fields + , X_key(.., T_DNSKEY, T_CDNSKEY, T_KEY + , dnskeyFlags, dnskeyProto, dnskeyAlgor, dnskeyValue + , cdnskeyFlags, cdnskeyProto, cdnskeyAlgor, cdnskeyValue + , keyFlags, keyProto, keyAlgor, keyValue) + , type XkeyConName + -- *** @DNSKEY@ record pattern synonym fields + , T_dnskey , dnskeyFlags, dnskeyProto, dnskeyAlgor, dnskeyValue - -- *** CDNSKEY fields - , cdnskeyFlags, cdnskeyProto, cdnskeyAlgor, cdnskeyValue + -- **** Compute a DNSKey tag , keytag - -- * RRSIGs - , X_sig(.., T_SIG, T_RRSIG) - , type XsigConName, T_rrsig, T_sig - -- ** RRSIG fields + -- *** @CDNSKEY@ record pattern synonym fields + , T_cdnskey + , cdnskeyFlags, cdnskeyProto, cdnskeyAlgor, cdnskeyValue + -- *** @KEY@ record pattern synonym fields + , T_key + , keyFlags, keyProto, keyAlgor, keyValue + -- ** RRSIG resource records + , X_sig(.., T_RRSIG, T_SIG + , rrsigType, rrsigKeyAlg, rrsigNumLabels, rrsigTTL + , rrsigExpiration, rrsigInception, rrsigKeyTag, rrsigZone, rrsigValue + , sigType, sigKeyAlg, sigNumLabels, sigTTL + , sigExpiration, sigInception, sigKeyTag, sigZone, sigValue) + , type XsigConName + -- *** @RRSIG@ record pattern synonym fields + , T_rrsig , rrsigType, rrsigKeyAlg, rrsigNumLabels, rrsigTTL , rrsigExpiration, rrsigInception, rrsigKeyTag, rrsigZone, rrsigValue - -- ** SIG fields + -- *** @SIG@ record pattern synonym fields + , T_sig , sigType, sigKeyAlg, sigNumLabels, sigTTL , sigExpiration, sigInception, sigKeyTag, sigZone, sigValue -- * IPSECKEY resource records @@ -113,8 +131,27 @@ :<>: TL.Text " is not a SIG or RRSIG RRTYPE" ) -- | X_ds specialised to @DS@ records. +-- +-- Note that @T_ds@ is just a type alias! The 'T_DS' record pattern +-- synonym and its fields are bundled with the underlying 'X_ds' +-- data type. In many cases it is sufficient to import just +-- @X_ds(..)@, but if you also need the type alias, it needs to be +-- imported separately: +-- +-- > import Net.DNSBase (X_ds(..), T_ds) +-- type T_ds = X_ds N_ds + -- | X_ds specialised to @CDS@ records. +-- +-- Note that @T_cds@ is just a type alias! The 'T_CDS' record pattern +-- synonym and its fields are bundled with the underlying 'X_ds' +-- data type. In many cases it is sufficient to import just +-- @X_ds(..)@, but if you also need the type alias it needs to be +-- imported separately: +-- +-- > import Net.DNSBase (X_ds(..), T_cds) +-- type T_cds = X_ds N_cds -- | Record pattern synonym viewing the shared 'X_ds' record as a @@ -141,26 +178,41 @@ = (X_DS cdsKtag cdsKalg cdsHalg cdsHval :: T_cds) {-# COMPLETE T_CDS #-} --- | X_key specialised to @KEY@ records. -type T_key = X_key N_key -- | X_key specialised to @DNSKEY@ records. +-- +-- Note that @T_dnskey@ is just a type alias! The 'T_DNSKEY' +-- record pattern synonym and its fields are bundled with the +-- underlying 'X_key' data type. In many cases it is sufficient +-- to import just @X_key(..)@, but if you also need the type +-- alias, it needs to be imported separately: +-- +-- > import Net.DNSBase (X_key(..), T_dnskey) +-- type T_dnskey = X_key N_dnskey + -- | X_key specialised to @CDNSKEY@ records. +-- +-- Note that @T_cdnskey@ is just a type alias! The 'T_CDNSKEY' +-- record pattern synonym and its fields are bundled with the +-- underlying 'X_key' data type. In many cases it is sufficient +-- to import just @X_key(..)@, but if you also need the type +-- alias, it needs to be imported separately: +-- +-- > import Net.DNSBase (X_key(..), T_cdnskey) +-- type T_cdnskey = X_key N_cdnskey --- | Record pattern synonym viewing the shared 'X_key' record as a --- legacy @KEY@ record (RFC 2535, section 3), still used by SIG(0) --- transaction authentication. Fields: 'keyFlags', 'keyProto', --- 'keyAlgor', 'keyValue'. Coercible to/from 'T_dnskey' and --- 'T_cdnskey'. -pattern T_KEY :: Word16 -- ^ Flags - -> Word8 -- ^ Protocol selector; for DNSKEY the only valid value is 3 (RFC 4034 section 2.1.2), other values appear in legacy KEY records - -> DNSKEYAlg -- ^ Algorithm - -> ShortByteString -- ^ Public Key - -> T_key -pattern T_KEY { keyFlags, keyProto, keyAlgor, keyValue } - = (X_KEY keyFlags keyProto keyAlgor keyValue :: T_key) -{-# COMPLETE T_KEY #-} +-- | X_key specialised to @KEY@ records. +-- +-- Note that @T_key@ is just a type alias! The 'T_KEY' record +-- pattern synonym and its fields are bundled with the underlying +-- 'X_key' data type. In many cases it is sufficient to import +-- just @X_key(..)@, but if you also need the type alias, it needs +-- to be imported separately: +-- +-- > import Net.DNSBase (X_key(..), T_key) +-- +type T_key = X_key N_key -- | Record pattern synonym viewing the shared 'X_key' record as a -- DNSSEC @DNSKEY@ (RFC 4034, section 2). Fields: 'dnskeyFlags', @@ -189,36 +241,46 @@ = (X_KEY cdnskeyFlags cdnskeyProto cdnskeyAlgor cdnskeyValue :: T_cdnskey) {-# COMPLETE T_CDNSKEY #-} --- | X_sig specialised to @SIG@ / @SIG(0)@ records. -type T_sig = X_sig N_sig +-- | Record pattern synonym viewing the shared 'X_key' record as a +-- legacy @KEY@ record (RFC 2535, section 3), still used by SIG(0) +-- transaction authentication. Fields: 'keyFlags', 'keyProto', +-- 'keyAlgor', 'keyValue'. Coercible to/from 'T_dnskey' and +-- 'T_cdnskey'. +pattern T_KEY :: Word16 -- ^ Flags + -> Word8 -- ^ Protocol selector; + -- for DNSKEY the only valid value is 3 + -- (RFC 4034 section 2.1.2), other values + -- appear in legacy KEY records + -> DNSKEYAlg -- ^ Algorithm + -> ShortByteString -- ^ Public Key + -> T_key +pattern T_KEY { keyFlags, keyProto, keyAlgor, keyValue } + = (X_KEY keyFlags keyProto keyAlgor keyValue :: T_key) +{-# COMPLETE T_KEY #-} + -- | X_sig specialised to @RRSIG@ records. +-- +-- Note that @T_rrsig@ is just a type alias! The 'T_RRSIG' record +-- pattern synonym and its fields are bundled with the underlying +-- 'X_sig' data type. In many cases it is sufficient to import +-- just @X_sig(..)@, but if you also need the type alias, it needs +-- to be imported separately: +-- +-- > import Net.DNSBase (X_sig(..), T_rrsig) +-- type T_rrsig = X_sig N_rrsig --- | Record pattern synonym viewing the shared 'X_sig' record as a --- legacy @SIG@ record (RFC 2535, section 4.1) or @SIG(0)@ --- transaction authenticator (RFC 2931). Fields: 'sigType', --- 'sigKeyAlg', 'sigNumLabels', 'sigTTL', 'sigExpiration', --- 'sigInception', 'sigKeyTag', 'sigZone', 'sigValue'. 'Eq' and --- 'Ord' compare the signer name in canonical wire form --- (via 'equalWireHost' / 'compareWireHost'); see 'X_sig' for why --- 'T_sig' and 'T_rrsig' are not coercible. -pattern T_SIG :: RRTYPE -- ^ Type Covered - -> DNSKEYAlg -- ^ Algorithm - -> Word8 -- ^ Number of labels in the signed owner name, excluding any leading wildcard ('*') and the trailing root (RFC 4034 section 3.1.3) - -> Word32 -- ^ Original TTL - -> Int64 -- ^ Signature expiration as absolute 'Int64' time; 32-bit serial-number arithmetic on the wire (see 'X_sig' for the conversion) - -> Int64 -- ^ Signature inception as absolute 'Int64' time; same serial-number caveat as 'sigExpiration' - -> Word16 -- ^ Key Tag - -> Domain -- ^ Signer's Name - -> ShortByteString -- ^ Signature - -> T_sig -pattern T_SIG - { sigType, sigKeyAlg, sigNumLabels, sigTTL - , sigExpiration, sigInception, sigKeyTag, sigZone, sigValue - } = ( X_SIG sigType sigKeyAlg sigNumLabels sigTTL - sigExpiration sigInception sigKeyTag sigZone sigValue - :: T_sig ) -{-# COMPLETE T_SIG #-} +-- | X_sig specialised to @SIG@ / @SIG(0)@ records. +-- +-- Note that @T_sig@ is just a type alias! The 'T_SIG' record +-- pattern synonym and its fields are bundled with the underlying +-- 'X_sig' data type. In many cases it is sufficient to import +-- just @X_sig(..)@, but if you also need the type alias, it needs +-- to be imported separately: +-- +-- > import Net.DNSBase (X_sig(..), T_sig) +-- +type T_sig = X_sig N_sig -- | Record pattern synonym viewing the shared 'X_sig' record as a -- DNSSEC @RRSIG@ (RFC 4034, section 3). Fields: 'rrsigType', @@ -245,6 +307,32 @@ :: T_rrsig ) {-# COMPLETE T_RRSIG #-} +-- | Record pattern synonym viewing the shared 'X_sig' record as a +-- legacy @SIG@ record (RFC 2535, section 4.1) or @SIG(0)@ +-- transaction authenticator (RFC 2931). Fields: 'sigType', +-- 'sigKeyAlg', 'sigNumLabels', 'sigTTL', 'sigExpiration', +-- 'sigInception', 'sigKeyTag', 'sigZone', 'sigValue'. 'Eq' and +-- 'Ord' compare the signer name in canonical wire form +-- (via 'equalWireHost' / 'compareWireHost'); see 'X_sig' for why +-- 'T_sig' and 'T_rrsig' are not coercible. +pattern T_SIG :: RRTYPE -- ^ Type Covered + -> DNSKEYAlg -- ^ Algorithm + -> Word8 -- ^ Number of labels in the signed owner name, excluding any leading wildcard ('*') and the trailing root (RFC 4034 section 3.1.3) + -> Word32 -- ^ Original TTL + -> Int64 -- ^ Signature expiration as absolute 'Int64' time; 32-bit serial-number arithmetic on the wire (see 'X_sig' for the conversion) + -> Int64 -- ^ Signature inception as absolute 'Int64' time; same serial-number caveat as 'sigExpiration' + -> Word16 -- ^ Key Tag + -> Domain -- ^ Signer's Name + -> ShortByteString -- ^ Signature + -> T_sig +pattern T_SIG + { sigType, sigKeyAlg, sigNumLabels, sigTTL + , sigExpiration, sigInception, sigKeyTag, sigZone, sigValue + } = ( X_SIG sigType sigKeyAlg sigNumLabels sigTTL + sigExpiration sigInception sigKeyTag sigZone sigValue + :: T_sig ) +{-# COMPLETE T_SIG #-} + ------------------- -- RData structure Definitions @@ -253,14 +341,6 @@ -- ([RFC 4034 section 5.1](https://datatracker.ietf.org/doc/html/rfc4034#section-5.1)) -- and the child-side @CDS@ announcement -- ([RFC 7344 section 3.1](https://www.rfc-editor.org/rfc/rfc7344.html#section-3.1)). --- The type parameter @n@ (either 'N_ds' or 'N_cds') determines --- the RR type. Each has its own type synonym ('T_ds', 'T_cds') --- and matching record pattern synonym ('T_DS', 'T_CDS') with the --- corresponding field-name prefix (@ds@, @cds@). The wire format --- is identical and the type role of @n@ is @phantom@, so 'T_ds' --- and 'T_cds' are mutually coercible — useful for promoting a --- child-side CDS announcement into a parent-side DS without --- rebuilding the value. -- -- > 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 -- > 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 @@ -272,6 +352,24 @@ -- > / / -- > +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -- +-- The type parameter @n@ (either 'N_ds' or 'N_cds') determines +-- the RR type. Each has its own type synonym ('T_ds', 'T_cds') +-- and matching record pattern synonym ('T_DS', 'T_CDS') with the +-- corresponding field-name prefix (@ds@, @cds@). +-- +-- The wire format is identical and the type role of @n@ is +-- @phantom@, so 'T_ds' and 'T_cds' are mutually coercible — +-- useful for promoting a child-side CDS announcement into a +-- parent-side DS without rebuilding the value. +-- +-- Note that @T_ds@ and @T_cds@ are just type aliases! The 'T_DS' +-- and 'T_CDS' record pattern synonyms and their fields are +-- bundled with the underlying 'X_ds' data type. In many cases it +-- is sufficient to import just @X_ds(..)@, but if you also need +-- the type aliases, they need to be imported separately: +-- +-- > import Net.DNSBase (X_ds(..), T_ds, T_cds) +-- -- No embedded domain field, so derived 'Ord' agrees with the -- canonical wire-form octet ordering -- ([RFC 4034 section 6.2](https://datatracker.ietf.org/doc/html/rfc4034#section-6.2)). @@ -295,13 +393,14 @@ -- underscore-prefixed selectors on the shared 'X_ds' record: -- -- > hashTypeVal :: forall n. X_ds n -> (Word8, ShortByteString) --- > hashTypeVal = (,) <$> _dsHalg <*> _dsHval +-- > hashTypeVal = (,) <$> x_dsHalg <*> x_dsHval +-- type X_ds :: Nat -> Type data X_ds n = X_DS - { _dsKtag :: Word16 -- ^ Key Tag - , _dsKalg :: DNSKEYAlg -- ^ Algorithm - , _dsHalg :: DSHashAlg -- ^ Digest Type - , _dsHval :: ShortByteString -- ^ Digest + { x_dsKtag :: Word16 -- ^ Key Tag + , x_dsKalg :: DNSKEYAlg -- ^ Algorithm + , x_dsHalg :: DSHashAlg -- ^ Digest Type + , x_dsHval :: ShortByteString -- ^ Digest } deriving instance (KnownSymbol (XdsConName n)) => Eq (X_ds n) deriving instance (KnownSymbol (XdsConName n)) => Ord (X_ds n) @@ -309,19 +408,19 @@ instance (Nat16 n, KnownSymbol (XdsConName n)) => Show (X_ds n) where showsPrec p X_DS{..} = showsP p $ showString (symbolVal' (proxy# @(XdsConName n))) . showChar ' ' - . shows' _dsKtag . showChar ' ' - . shows' _dsKalg . showChar ' ' - . shows' _dsHalg . showChar ' ' - . showHv _dsHval + . shows' x_dsKtag . showChar ' ' + . shows' x_dsKalg . showChar ' ' + . shows' x_dsHalg . showChar ' ' + . showHv x_dsHval where showHv = shows @Bytes16 . coerce instance (KnownSymbol (XdsConName n)) => Presentable (X_ds n) where present X_DS{..} = - present _dsKtag - . presentSp _dsKalg - . presentSp _dsHalg - . presentHv _dsHval + present x_dsKtag + . presentSp x_dsKalg + . presentSp x_dsHalg + . presentHv x_dsHval where presentHv = presentSp @Bytes16 . coerce @@ -329,15 +428,15 @@ rdType _ = RRTYPE $ natToWord16 n {-# INLINE rdType #-} rdEncode X_DS{..} = putSizedBuilder $! - mbWord16 _dsKtag - <> coerce mbWord8 _dsKalg - <> coerce mbWord8 _dsHalg - <> mbShortByteString _dsHval + mbWord16 x_dsKtag + <> coerce mbWord8 x_dsKalg + <> coerce mbWord8 x_dsHalg + <> mbShortByteString x_dsHval rdDecode _ _ = const do - _dsKtag <- get16 - _dsKalg <- DNSKEYAlg <$> get8 - _dsHalg <- DSHashAlg <$> get8 - _dsHval <- getShortByteString + x_dsKtag <- get16 + x_dsKalg <- DNSKEYAlg <$> get8 + x_dsHalg <- DSHashAlg <$> get8 + x_dsHval <- getShortByteString pure $ RData (X_DS{..} :: X_ds n) -- | Shared wire-format representation for DNSSEC signing-key @@ -350,15 +449,7 @@ -- @KEY@ record -- ([RFC 2535 section 3.1](https://datatracker.ietf.org/doc/html/rfc2535#section-3.1)) -- still used by SIG(0) transaction authentication and otherwise --- effectively unused in modern deployments. The type parameter --- @n@ (one of 'N_key', 'N_dnskey', 'N_cdnskey') determines the --- RR type. Each has its own type synonym ('T_key', 'T_dnskey', --- 'T_cdnskey') and matching record pattern synonym ('T_KEY', --- 'T_DNSKEY', 'T_CDNSKEY') with the corresponding field-name --- prefix (@key@, @dnskey@, @cdnskey@). The wire format is --- identical across all three and the type role of @n@ is --- @phantom@, so the types are mutually coercible; the practical --- pairing is DNSKEY \<-\> CDNSKEY (mirroring DS \<-\> CDS). +-- effectively unused in modern deployments. -- -- > 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 -- > 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 @@ -370,6 +461,25 @@ -- > / / -- > +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -- +-- The type parameter @n@ (one of 'N_dnskey', 'N_cdnskey', +-- 'N_key') determines the RR type. Each has its own type synonym +-- ('T_dnskey', 'T_cdnskey', 'T_key') and matching record pattern +-- synonym ('T_DNSKEY', 'T_CDNSKEY', 'T_KEY') with the +-- corresponding field-name prefix (@dnskey@, @cdnskey@, @key@). +-- The wire format is identical across all three and the type role +-- of @n@ is @phantom@, so the types are mutually coercible; the +-- practical pairing is DNSKEY \<-\> CDNSKEY (mirroring DS \<-\> +-- CDS). +-- +-- Note that @T_dnskey@, @T_cdnskey@ and @T_key@ are just type +-- aliases! The 'T_DNSKEY', 'T_CDNSKEY' and 'T_KEY' record +-- pattern synonyms and their fields are bundled with the +-- underlying 'X_key' data type. In many cases it is sufficient +-- to import just @X_key(..)@, but if you also need the type +-- aliases, they need to be imported separately: +-- +-- > import Net.DNSBase (X_key(..), T_dnskey, T_cdnskey, T_key) +-- -- No embedded domain field, so derived 'Ord' agrees with the -- canonical wire-form octet ordering -- ([RFC 4034 section 6.2](https://datatracker.ietf.org/doc/html/rfc4034#section-6.2)). @@ -392,14 +502,14 @@ -- underscore-prefixed selectors on the shared 'X_key' record: -- -- > keyAlgVal :: forall n. X_key n -> (DNSKEYAlg, ShortByteString) --- > keyAlgVal = (,) <$> _keyAlgor <*> _keyValue +-- > keyAlgVal = (,) <$> x_keyAlgor <*> x_keyValue type role X_key phantom type X_key :: Nat -> Type data X_key n = X_KEY - { _keyFlags :: Word16 -- ^ Flags - , _keyProto :: Word8 -- ^ Protocol - , _keyAlgor :: DNSKEYAlg -- ^ Algorithm - , _keyValue :: ShortByteString -- ^ Public Key + { x_keyFlags :: Word16 -- ^ Flags + , x_keyProto :: Word8 -- ^ Protocol + , x_keyAlgor :: DNSKEYAlg -- ^ Algorithm + , x_keyValue :: ShortByteString -- ^ Public Key } deriving instance (KnownSymbol (XkeyConName n)) => Eq (X_key n) deriving instance (KnownSymbol (XkeyConName n)) => Ord (X_key n) @@ -407,19 +517,19 @@ instance (Nat16 n, KnownSymbol (XkeyConName n)) => Show (X_key n) where showsPrec p X_KEY{..} = showsP p $ showString (symbolVal' (proxy# @(XkeyConName n))) . showChar ' ' - . shows' _keyFlags . showChar ' ' - . shows' _keyProto . showChar ' ' - . shows' _keyAlgor . showChar ' ' - . showKv _keyValue + . shows' x_keyFlags . showChar ' ' + . shows' x_keyProto . showChar ' ' + . shows' x_keyAlgor . showChar ' ' + . showKv x_keyValue where showKv = shows @Bytes64 . coerce instance (KnownSymbol (XkeyConName n)) => Presentable (X_key n) where present X_KEY{..} = - present _keyFlags - . presentSp _keyProto - . presentSp _keyAlgor - . presentKv _keyValue + present x_keyFlags + . presentSp x_keyProto + . presentSp x_keyAlgor + . presentKv x_keyValue where presentKv = presentSp @Bytes64 . coerce @@ -427,15 +537,15 @@ rdType _ = RRTYPE $ natToWord16 n {-# INLINE rdType #-} rdEncode X_KEY{..} = putSizedBuilder $! - mbWord16 _keyFlags - <> mbWord8 _keyProto - <> coerce mbWord8 _keyAlgor - <> mbShortByteString _keyValue + mbWord16 x_keyFlags + <> mbWord8 x_keyProto + <> coerce mbWord8 x_keyAlgor + <> mbShortByteString x_keyValue rdDecode _ _ = const do - _keyFlags <- get16 - _keyProto <- get8 - _keyAlgor <- DNSKEYAlg <$> get8 - _keyValue <- getShortByteString + x_keyFlags <- get16 + x_keyProto <- get8 + x_keyAlgor <- DNSKEYAlg <$> get8 + x_keyValue <- getShortByteString pure $ RData (X_KEY{..} :: X_key n) -- | Shared wire-format representation for DNSSEC signature @@ -445,15 +555,6 @@ -- ([RFC 2535 section 4.1](https://datatracker.ietf.org/doc/html/rfc2535#section-4.1)) -- and its @SIG(0)@ transaction-authentication use -- ([RFC 2931 section 3](https://datatracker.ietf.org/doc/html/rfc2931#section-3)). --- The type parameter @n@ (either 'N_sig' or 'N_rrsig') determines --- the RR type. Each has its own type synonym ('T_sig', 'T_rrsig') --- and matching record pattern synonym ('T_SIG', 'T_RRSIG') with --- the corresponding field-name prefix (@sig@, @rrsig@). The --- wire format is shared, but the type role of @n@ is @nominal@: --- a 'T_sig' value cannot be used where a 'T_rrsig' is expected. --- This is deliberate — SIG(0) signs a single transaction while --- RRSIG signs an RRSet, and conflating them at the type level --- would be unsafe. -- -- > 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 -- > 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 @@ -475,6 +576,24 @@ -- > / / -- > +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -- +-- The type parameter @n@ (either 'N_rrsig' or 'N_sig') determines +-- the RR type. Each has its own type synonym ('T_rrsig', 'T_sig') +-- and matching record pattern synonym ('T_RRSIG', 'T_SIG') with +-- the corresponding field-name prefix (@rrsig@, @sig@). The +-- wire format is shared, but the type role of @n@ is @nominal@: +-- a 'T_sig' value cannot be used where a 'T_rrsig' is expected. +-- This is deliberate — SIG(0) signs a single transaction while +-- RRSIG signs an RRSet, and conflating them at the type level +-- would be unsafe. +-- +-- Note that @T_rrsig@ and @T_sig@ are just type aliases! The 'T_RRSIG' and +-- 'T_SIG' record pattern synonyms and their fields are bundled +-- with the underlying 'X_sig' data type. In many cases it is +-- sufficient to import just @X_sig(..)@, but if you also need the +-- type aliases, they need to be imported separately: +-- +-- > import Net.DNSBase (X_sig(..), T_rrsig, T_sig) +-- -- As noted in -- [Section 3.1.5 of RFC 4034](https://tools.ietf.org/html/rfc4034#section-3.1.5) -- the RRsig inception and expiration times use serial number arithmetic. As a @@ -511,67 +630,67 @@ type role X_sig nominal type X_sig :: Nat -> Type data X_sig n = X_SIG - { _sigType :: RRTYPE -- ^ Type Covered - , _sigKeyAlg :: DNSKEYAlg -- ^ Algorithm - , _sigNumLabels :: Word8 -- ^ Labels - , _sigTTL :: Word32 -- ^ Original TTL - , _sigExpiration :: Int64 -- ^ Signature Expiration - , _sigInception :: Int64 -- ^ Signature Inception - , _sigKeyTag :: Word16 -- ^ Key Tag - , _sigZone :: Domain -- ^ Signer's Name - , _sigValue :: ShortByteString -- ^ Signature + { x_sigType :: RRTYPE -- ^ Type Covered + , x_sigKeyAlg :: DNSKEYAlg -- ^ Algorithm + , x_sigNumLabels :: Word8 -- ^ Labels + , x_sigTTL :: Word32 -- ^ Original TTL + , x_sigExpiration :: Int64 -- ^ Signature Expiration + , x_sigInception :: Int64 -- ^ Signature Inception + , x_sigKeyTag :: Word16 -- ^ Key Tag + , x_sigZone :: Domain -- ^ Signer's Name + , x_sigValue :: ShortByteString -- ^ Signature } instance (Nat16 n, KnownSymbol (XsigConName n)) => Show (X_sig n) where showsPrec p X_SIG{..} = showsP p $ showString (symbolVal' (proxy# @(XsigConName n))) . showChar ' ' - . shows' _sigType . showChar ' ' - . shows' _sigKeyAlg . showChar ' ' - . shows' _sigNumLabels . showChar ' ' - . shows' _sigTTL . showChar ' ' - . shows' _sigExpiration . showChar ' ' - . shows' _sigInception . showChar ' ' - . shows' _sigKeyTag . showChar ' ' - . shows' _sigZone . showChar ' ' - . showSv _sigValue + . shows' x_sigType . showChar ' ' + . shows' x_sigKeyAlg . showChar ' ' + . shows' x_sigNumLabels . showChar ' ' + . shows' x_sigTTL . showChar ' ' + . shows' x_sigExpiration . showChar ' ' + . shows' x_sigInception . showChar ' ' + . shows' x_sigKeyTag . showChar ' ' + . shows' x_sigZone . showChar ' ' + . showSv x_sigValue where showSv = shows @Bytes64 . coerce -- | Equality of signer names is case-insensitive. instance (KnownSymbol (XsigConName n)) => Eq (X_sig n) where - a == b = (_sigType a) == (_sigType b) - && (_sigKeyAlg a) == (_sigKeyAlg b) - && (_sigNumLabels a) == (_sigNumLabels b) - && (_sigTTL a) == (_sigTTL b) - && (_sigExpiration a) == (_sigExpiration b) - && (_sigInception a) == (_sigInception b) - && (_sigKeyTag a) == (_sigKeyTag b) - && (_sigZone a) `equalWireHost` (_sigZone b) - && (_sigValue a) == (_sigValue b) + a == b = (x_sigType a) == (x_sigType b) + && (x_sigKeyAlg a) == (x_sigKeyAlg b) + && (x_sigNumLabels a) == (x_sigNumLabels b) + && (x_sigTTL a) == (x_sigTTL b) + && (x_sigExpiration a) == (x_sigExpiration b) + && (x_sigInception a) == (x_sigInception b) + && (x_sigKeyTag a) == (x_sigKeyTag b) + && (x_sigZone a) `equalWireHost` (x_sigZone b) + && (x_sigValue a) == (x_sigValue b) -- | Comparison of signer names is case-insensitive. instance (KnownSymbol (XsigConName n)) => Ord (X_sig n) where - a `compare` b = (_sigType a) `compare` (_sigType b) - <> (_sigKeyAlg a) `compare` (_sigKeyAlg b) - <> (_sigNumLabels a) `compare` (_sigNumLabels b) - <> (_sigTTL a) `compare` (_sigTTL b) - <> (_sigExpiration a) `compare` (_sigExpiration b) - <> (_sigInception a) `compare` (_sigInception b) - <> (_sigKeyTag a) `compare` (_sigKeyTag b) - <> (_sigZone a) `compareWireHost` (_sigZone b) - <> (_sigValue a) `compare` (_sigValue b) + a `compare` b = (x_sigType a) `compare` (x_sigType b) + <> (x_sigKeyAlg a) `compare` (x_sigKeyAlg b) + <> (x_sigNumLabels a) `compare` (x_sigNumLabels b) + <> (x_sigTTL a) `compare` (x_sigTTL b) + <> (x_sigExpiration a) `compare` (x_sigExpiration b) + <> (x_sigInception a) `compare` (x_sigInception b) + <> (x_sigKeyTag a) `compare` (x_sigKeyTag b) + <> (x_sigZone a) `compareWireHost` (x_sigZone b) + <> (x_sigValue a) `compare` (x_sigValue b) instance (KnownSymbol (XsigConName n)) => Presentable (X_sig n) where present X_SIG{..} = - present _sigType - . presentSp _sigKeyAlg - . presentSp _sigNumLabels - . presentSp _sigTTL - . presentEp _sigExpiration - . presentEp _sigInception - . presentSp _sigKeyTag - . presentSp _sigZone - . presentSv _sigValue + present x_sigType + . presentSp x_sigKeyAlg + . presentSp x_sigNumLabels + . presentSp x_sigTTL + . presentEp x_sigExpiration + . presentEp x_sigInception + . presentSp x_sigKeyTag + . presentSp x_sigZone + . presentSv x_sigValue where presentEp = presentSp @Epoch64 . coerce presentSv = presentSp @Bytes64 . coerce @@ -580,41 +699,41 @@ rdType _ = RRTYPE $ natToWord16 n {-# INLINE rdType #-} rdEncode X_SIG{..} = putSizedBuilder $ - coerce mbWord16 _sigType - <> coerce mbWord8 _sigKeyAlg - <> mbWord8 _sigNumLabels - <> mbWord32 _sigTTL - <> coerce clock _sigExpiration - <> coerce clock _sigInception - <> mbWord16 _sigKeyTag - <> mbWireForm _sigZone - <> mbShortByteString _sigValue + coerce mbWord16 x_sigType + <> coerce mbWord8 x_sigKeyAlg + <> mbWord8 x_sigNumLabels + <> mbWord32 x_sigTTL + <> coerce clock x_sigExpiration + <> coerce clock x_sigInception + <> mbWord16 x_sigKeyTag + <> mbWireForm x_sigZone + <> mbShortByteString x_sigValue where clock :: Int64 -> SizedBuilder clock = mbWord32 . fromIntegral cnEncode X_SIG{..} = putSizedBuilder $ - coerce mbWord16 _sigType - <> coerce mbWord8 _sigKeyAlg - <> mbWord8 _sigNumLabels - <> mbWord32 _sigTTL - <> coerce clock _sigExpiration - <> coerce clock _sigInception - <> mbWord16 _sigKeyTag - <> mbWireForm (canonicalise _sigZone) + coerce mbWord16 x_sigType + <> coerce mbWord8 x_sigKeyAlg + <> mbWord8 x_sigNumLabels + <> mbWord32 x_sigTTL + <> coerce clock x_sigExpiration + <> coerce clock x_sigInception + <> mbWord16 x_sigKeyTag + <> mbWireForm (canonicalise x_sigZone) -- | Canonical encoding of the RRSIG omits the signature value. where clock :: Int64 -> SizedBuilder clock = mbWord32 . fromIntegral rdDecode _ _ = const do - _sigType <- RRTYPE <$> get16 - _sigKeyAlg <- DNSKEYAlg <$> get8 - _sigNumLabels <- get8 - _sigTTL <- get32 - _sigExpiration <- getDnsTime - _sigInception <- getDnsTime - _sigKeyTag <- get16 - _sigZone <- getDomainNC - _sigValue <- getShortByteString + x_sigType <- RRTYPE <$> get16 + x_sigKeyAlg <- DNSKEYAlg <$> get8 + x_sigNumLabels <- get8 + x_sigTTL <- get32 + x_sigExpiration <- getDnsTime + x_sigInception <- getDnsTime + x_sigKeyTag <- get16 + x_sigZone <- getDomainNC + x_sigValue <- getShortByteString pure $ RData (X_SIG{..} :: X_sig n) -- | The @ZONEMD@ resource record @@ -848,17 +967,17 @@ go :: X_key n -> Word32 go X_KEY{..} | alg /= 1 = tag where - (DNSKEYAlg alg) = _keyAlgor - !z = lo _keyFlags + hi _keyProto + lo alg - ws32 = zipWith ($) (cycle [hi, lo]) $ SB.unpack _keyValue + (DNSKEYAlg alg) = x_keyAlgor + !z = lo x_keyFlags + hi x_keyProto + lo alg + ws32 = zipWith ($) (cycle [hi, lo]) $ SB.unpack x_keyValue !raw = foldl' (+) z ws32 !tag = (raw + (raw `shiftR` 16)) .&. 0xffff go X_KEY{..} | Just !tag <- c32 = tag | otherwise = 0 where - len = SB.length _keyValue - c32 = (+) <$> (hi <$.> SB.indexMaybe _keyValue (len - 3)) - <*> (lo <$.> SB.indexMaybe _keyValue (len - 2)) + len = SB.length x_keyValue + c32 = (+) <$> (hi <$.> SB.indexMaybe x_keyValue (len - 3)) + <*> (lo <$.> SB.indexMaybe x_keyValue (len - 2)) hi, lo :: Integral a => a -> Word32 lo = fromIntegral diff --git a/src/Net/DNSBase/RData/SRV.hs b/src/Net/DNSBase/RData/SRV.hs --- a/src/Net/DNSBase/RData/SRV.hs +++ b/src/Net/DNSBase/RData/SRV.hs @@ -16,6 +16,7 @@ domain field treat it case-sensitively in canonical form per RFC 6840 section 5.1. -} +{-# OPTIONS_GHC -Wno-duplicate-exports #-} {-# LANGUAGE MagicHash , RecordWildCards @@ -23,19 +24,22 @@ #-} module Net.DNSBase.RData.SRV - ( T_mx(..) + ( -- * MX, SRV, AFSDB and NAPTR + T_mx(..) , T_srv(..) , T_afsdb(..) , T_naptr(..) -- * NID and L64 - , X_nid(.., T_NID, T_L64) - , type XnidConName, T_nid, T_l64 - -- *** 'T_NID' fields - , nidPref - , nidAddr - -- *** 'T_L64' fields - , l64Pref - , l64Addr + , X_nid(.., T_NID, T_L64 + , nidPref, nidAddr + , l64Pref, l64Addr) + , type XnidConName + -- *** @T_NID@ record pattern synonym fields + , T_nid + , nidPref, nidAddr + -- *** @T_L64@ record pattern synonym fields + , T_l64 + , l64Pref, l64Addr -- * L32 , T_l32(..) -- * LP @@ -74,8 +78,27 @@ :<>: TL.Text " is not a NID or L64 RRTYPE" ) -- | X_nid specialised to @NID@ records. +-- +-- Note that @T_nid@ is just a type alias! The 'T_NID' record pattern +-- synonym and its fields are bundled with the underlying 'X_nid' +-- data type. In many cases it is sufficient to import just +-- @X_nid(..)@, but if you also need the type alias, it needs to be +-- imported separately: +-- +-- > import Net.DNSBase (X_nid(..), T_nid) +-- type T_nid = X_nid N_nid + -- | X_nid specialised to @L64@ records. +-- +-- Note that @T_l64@ is just a type alias! The 'T_L64' record pattern +-- synonym and its fields are bundled with the underlying 'X_nid' +-- data type. In many cases it is sufficient to import just +-- @X_nid(..)@, but if you also need the type alias, it needs to be +-- imported separately: +-- +-- > import Net.DNSBase (X_nid(..), T_l64) +-- type T_l64 = X_nid N_l64 -- | Record pattern synonym viewing the shared 'X_nid' record as an @@ -363,17 +386,7 @@ -- ([RFC 6742 section 2.1.1](https://www.rfc-editor.org/rfc/rfc6742.html#section-2.1.1)) -- carries a 64-bit Node-ID, and @L64@ -- ([RFC 6742 section 2.3.1](https://www.rfc-editor.org/rfc/rfc6742.html#section-2.3.1)) --- carries a 64-bit IPv6 locator prefix. The type parameter @n@ --- (either 'N_nid' or 'N_l64') determines the RR type. Each has --- its own type synonym ('T_nid', 'T_l64') and matching record --- pattern synonym ('T_NID', 'T_L64') with the corresponding --- field-name prefix (@nid@, @l64@). The role of 'X_nid' is --- /nominal/: the 64-bit payload means different things in each, --- so 'T_nid' and 'T_l64' are not coercible. --- --- Derived 'Ord' is canonical: no embedded domain, fields compared --- in wire-encoding order. See 'T_l32' and 'T_lp' for the rest --- of the ILNP record family. +-- carries a 64-bit IPv6 locator prefix. -- -- > 0 1 2 3 -- > 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 @@ -385,11 +398,31 @@ -- > | | -- > +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -- +-- The type parameter @n@ (either 'N_nid' or 'N_l64') determines +-- the RR type. Each has its own type synonym ('T_nid', 'T_l64') +-- and matching record pattern synonym ('T_NID', 'T_L64') with the +-- corresponding field-name prefix (@nid@, @l64@). The role of +-- 'X_nid' is /nominal/: the 64-bit payload means different things +-- in each, so 'T_nid' and 'T_l64' are not coercible. +-- +-- Note that @T_nid@ and @T_l64@ are just type aliases! The +-- 'T_NID' and 'T_L64' record pattern synonyms and their fields +-- are bundled with the underlying 'X_nid' data type. In many +-- cases it is sufficient to import just @X_nid(..)@, but if you +-- also need the type aliases, they need to be imported +-- separately: +-- +-- > import Net.DNSBase (X_nid(..), T_nid, T_l64) +-- +-- Derived 'Ord' is canonical: no embedded domain, fields compared +-- in wire-encoding order. See 'T_l32' and 'T_lp' for the rest +-- of the ILNP record family. +-- type X_nid :: Nat -> Type type role X_nid nominal data X_nid n = X_NID - { _nidPref :: Word16 -- ^ Preference - , _nidAddr :: Word64 -- ^ Node ID or 64-bit IPv6 prefix + { x_nidPref :: Word16 -- ^ Preference + , x_nidAddr :: Word64 -- ^ Node ID or 64-bit IPv6 prefix } deriving instance (KnownSymbol (XnidConName n)) => Eq (X_nid n) deriving instance (KnownSymbol (XnidConName n)) => Ord (X_nid n) @@ -397,27 +430,27 @@ instance (Nat16 n, KnownSymbol (XnidConName n)) => Show (X_nid n) where showsPrec p X_NID{..} = showsP p $ showString (symbolVal' (proxy# @(XnidConName n))) - . showChar ' ' . shows' _nidPref - . showChar ' ' . shows' _nidAddr + . showChar ' ' . shows' x_nidPref + . showChar ' ' . shows' x_nidAddr instance (KnownSymbol (XnidConName n)) => Presentable (X_nid n) where present X_NID{..} = - present _nidPref + present x_nidPref . \k -> bld ' ' 48 <> bld ':' 32 <> bld ':' 16 <> bld ':' 0 <> k where bld :: Char -> Int -> Builder bld sep shft = char8 sep <> - (word16HexFixed $ fromIntegral $ _nidAddr `shiftR` shft) + (word16HexFixed $ fromIntegral $ x_nidAddr `shiftR` shft) instance (Nat16 n, KnownSymbol (XnidConName n)) => KnownRData (X_nid n) where rdType _ = RRTYPE $ natToWord16 n {-# INLINE rdType #-} rdEncode X_NID{..} = putSizedBuilder $ - mbWord16 _nidPref - <> mbWord64 _nidAddr + mbWord16 x_nidPref + <> mbWord64 x_nidAddr rdDecode _ _ = const do - _nidPref <- get16 - _nidAddr <- get64 + x_nidPref <- get16 + x_nidAddr <- get64 pure $ RData (X_NID{..} :: X_nid n) -- | The @L32@ resource record diff --git a/src/Net/DNSBase/RData/SVCB.hs b/src/Net/DNSBase/RData/SVCB.hs --- a/src/Net/DNSBase/RData/SVCB.hs +++ b/src/Net/DNSBase/RData/SVCB.hs @@ -43,19 +43,17 @@ module Net.DNSBase.RData.SVCB ( -- * SVCB and HTTPS - X_svcb(.., T_SVCB, T_HTTPS) + X_svcb(.., T_SVCB, T_HTTPS + , httpsPriority, httpsTarget, httpsParamValues + , svcPriority, svcTarget, svcParamValues) , type XsvcbConName - , T_svcb + -- *** @T_HTTPS@ pattern record synonym fields , T_https - -- *** 'T_SVCB' fields - , svcPriority - , svcTarget - , svcParamValues - -- *** 'T_HTTPS' fields - , httpsPriority - , httpsTarget - , httpsParamValues - -- * Service parameter values + , httpsPriority, httpsTarget, httpsParamValues + -- *** @T_SVCB@ pattern record synonym fields + , T_svcb + , svcPriority, svcTarget, svcParamValues + -- ** Service parameter values , KnownSVCParamValue(..) , SPVSet(..) , spvLookup @@ -102,22 +100,29 @@ -- type SPVDecoderMap = IntMap (Int -> SGet SVCParamValue) --- | X_svcb specialised to @SVCB@ records. -type T_svcb = X_svcb N_svcb -- | X_svcb specialised to @HTTPS@ records. +-- +-- Note that @T_https@ is just a type alias! The 'T_HTTPS' record pattern +-- synonym and its fields are bundled with the underlying 'X_svcb' +-- data type. In many cases it is sufficient to import just +-- @X_svcb(..)@, but if you also need the type alias, it needs to be +-- imported separately: +-- +-- > import Net.DNSBase (X_svcb(..), T_https) +-- type T_https = X_svcb N_https --- | Record pattern synonym viewing the shared 'X_svcb' record as a --- generic SVCB service-binding record (RFC 9460). Fields: --- 'svcPriority', 'svcTarget', 'svcParamValues'. See 'X_svcb' for --- why 'T_svcb' and 'T_https' are not coercible. -pattern T_SVCB :: Word16 -- ^ SvcPriority - -> Domain -- ^ TargetName - -> SPVSet -- ^ SvcParams - -> T_svcb -pattern T_SVCB { svcPriority, svcTarget, svcParamValues } - = (X_SVCB svcPriority svcTarget svcParamValues :: T_svcb) -{-# COMPLETE T_SVCB #-} +-- | X_svcb specialised to @SVCB@ records. +-- +-- Note that @T_svcb@ is just a type alias! The 'T_SCVB' record pattern +-- synonym and its fields are bundled with the underlying 'X_svcb' +-- data type. In many cases it is sufficient to import just +-- @X_svcb(..)@, but if you also need the type alias, it needs to be +-- imported separately: +-- +-- > import Net.DNSBase (X_svcb(..), T_svcb) +-- +type T_svcb = X_svcb N_svcb -- | Record pattern synonym viewing the shared 'X_svcb' record as -- an HTTPS service-binding record (RFC 9460). Fields: @@ -130,20 +135,23 @@ = (X_SVCB httpsPriority httpsTarget httpsParamValues :: T_https) {-# COMPLETE T_HTTPS #-} +-- | Record pattern synonym viewing the shared 'X_svcb' record as a +-- generic SVCB service-binding record (RFC 9460). Fields: +-- 'svcPriority', 'svcTarget', 'svcParamValues'. See 'X_svcb' for +-- why 'T_svcb' and 'T_https' are not coercible. +pattern T_SVCB :: Word16 -- ^ SvcPriority + -> Domain -- ^ TargetName + -> SPVSet -- ^ SvcParams + -> T_svcb +pattern T_SVCB { svcPriority, svcTarget, svcParamValues } + = (X_SVCB svcPriority svcTarget svcParamValues :: T_svcb) +{-# COMPLETE T_SVCB #-} + -- | Shared wire-format representation for the @SVCB@ service -- binding record -- ([RFC 9460 section 2](https://datatracker.ietf.org/doc/html/rfc9460#section-2)) -- and its HTTPS-specific variant -- ([RFC 9460 section 9](https://datatracker.ietf.org/doc/html/rfc9460#section-9)). --- The type parameter @n@ (either 'N_svcb' or 'N_https') determines --- the RR type. Each has its own type synonym ('T_svcb', --- 'T_https') and matching record pattern synonym ('T_SVCB', --- 'T_HTTPS') with the corresponding field-name prefix (@svc@, --- @https@). The wire format is shared, but the type role of --- @n@ is @nominal@: a 'T_svcb' value cannot be used where a --- 'T_https' is expected. This is deliberate — the two RR types --- serve different transports, and future SvcParamKeys may apply --- to only one of them. -- -- > 1 1 1 1 1 1 -- > 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 @@ -157,6 +165,24 @@ -- > / / -- > +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ -- +-- The type parameter @n@ (either 'N_https' or 'N_svcb') +-- determines the RR type. Each has its own type synonym +-- ('T_https', 'T_svcb') and matching record pattern synonym +-- ('T_HTTPS', 'T_SVCB') with the corresponding field-name prefix +-- (@https@, @svcb@). The wire format is shared, but the type +-- role of @n@ is @nominal@: a 'T_svcb' value cannot be used where +-- a 'T_https' is expected. This is deliberate — the two RR types +-- serve different transports, and future SvcParamKeys may apply +-- to only one of them. +-- +-- Note that @T_https@ and @T_svcb@ are just type aliases! The 'T_HTTPS' +-- and 'T_SVCB' record pattern synonyms and their fields are +-- bundled with the underlying 'X_svcb' data type. In many cases it +-- is sufficient to import just @X_svcb(..)@, but if you also need +-- the type aliases, they need to be imported separately: +-- +-- > import Net.DNSBase (X_svcb(..), T_https, T_svcb) +-- -- The target field is not subject to wire-form name compression -- ([RFC 3597 section 4](https://datatracker.ietf.org/doc/html/rfc3597#section-4)) -- and is /not/ in the @@ -204,14 +230,14 @@ -- underscore-prefixed selectors on the shared 'X_svcb' record: -- -- > aliasDomain :: forall n. X_svcb n -> Maybe Domain --- > aliasDomain r | _svcPriority r == 0 = Just $ _svcTarget r +-- > aliasDomain r | x_svcPriority r == 0 = Just $ x_svcTarget r -- > | otherwise = Nothing type X_svcb :: Nat -> Type type role X_svcb nominal data X_svcb n = X_SVCB - { _svcPriority :: Word16 -- ^ SvcPriority - , _svcTarget :: Domain -- ^ TargetName - , _svcParamValues :: SPVSet -- ^ SvcParams + { x_svcPriority :: Word16 -- ^ SvcPriority + , x_svcTarget :: Domain -- ^ TargetName + , x_svcParamValues :: SPVSet -- ^ SvcParams } deriving instance Eq (X_svcb n) @@ -219,16 +245,16 @@ instance (KnownSymbol (XsvcbConName n)) => Show (X_svcb n) where showsPrec p X_SVCB{..} = showsP p $ showString (symbolVal' (proxy# @(XsvcbConName n))) . showChar ' ' - . shows' _svcPriority . showChar ' ' - . shows' _svcTarget . showChar ' ' - . shows' _svcParamValues + . shows' x_svcPriority . showChar ' ' + . shows' x_svcTarget . showChar ' ' + . shows' x_svcParamValues instance Ord (X_svcb n) where - a `compare` b = (_svcPriority a) `compare` (_svcPriority b) - <> (_svcTarget a) `compare` (_svcTarget b) + a `compare` b = (x_svcPriority a) `compare` (x_svcPriority b) + <> (x_svcTarget a) `compare` (x_svcTarget b) <> (spvs a) `compare` (spvs b) where - spvs = toList . _svcParamValues + spvs = toList . x_svcParamValues instance Presentable (X_svcb n) where present (X_SVCB p d vs) = @@ -251,11 +277,11 @@ -- and can be extended at runtime as part of resolver configuration. rdDecode _ sdm len = do pos0 <- getPosition - _svcPriority <- get16 - _svcTarget <- getDomainNC + x_svcPriority <- get16 + x_svcTarget <- getDomainNC pos1 <- getPosition vals <- decodeSVCFieldValues (len - (pos1 - pos0)) - let _svcParamValues = spvSetFromMonoList $ reverse vals + let x_svcParamValues = spvSetFromMonoList $ reverse vals pure $ RData $ (X_SVCB{..} :: X_svcb n) where decodeSVCFieldValues :: Int -> SGet [SVCParamValue] diff --git a/src/Net/DNSBase/RData/SVCB/SVCParamValue.hs b/src/Net/DNSBase/RData/SVCB/SVCParamValue.hs --- a/src/Net/DNSBase/RData/SVCB/SVCParamValue.hs +++ b/src/Net/DNSBase/RData/SVCB/SVCParamValue.hs @@ -46,12 +46,7 @@ -- | The class of types representing the value side of a service -- parameter inside an @SVCB@ or @HTTPS@ record. Each instance -- corresponds to a specific 'SVCParamKey'; the 'encodeSPV' and --- 'decodeSPV' methods handle only the value bytes. The --- surrounding @(key, length)@ frame is owned by the SVCB-record --- encoder: 'encodeSPV' writes just the payload, and the framework --- wraps the result in the 2-byte length prefix. --- For value-less parameters this means 'encodeSPV' is just --- @pure ()@. +-- 'decodeSPV' methods handle only the value bytes. -- -- The 'Presentable' instance builds the RFC 9460 zone-file -- presentation form: the key name followed (where the value is @@ -63,9 +58,23 @@ spvKey :: forall b -> b ~ a => SVCParamKey -- | CPS presentation form builder for the key spvKeyPres :: forall b -> b ~ a => Builder -> Builder - -- | Encode value to wire form + + -- | Encode value to wire form. + -- The surrounding @(key, length)@ frame is owned by the + -- SVCB-record encoder: 'encodeSPV' writes just the payload, + -- and the framework wraps the result in the 2-byte length + -- prefix. For valueless parameters this means 'encodeSPV' + -- is just @pure ()@. + -- encodeSPV :: forall r s. ErrorContext r => a -> SPut s r - -- | Decode value from wire form + + -- | Decode value from wire form. + -- The overall SVCB RData decoder gives each parameter decoder + -- a view into a buffer of exactly the indicated length, and + -- makes sure exactly that many bytes are consumed. The + -- length argument is only needed in decoders that read + -- variable-length fields that run to the end of the record. + -- decodeSPV :: forall b -> b ~ a => Int -> SGet SVCParamValue -- | Override to get user-friendly output for runtime-added types. diff --git a/src/Net/DNSBase/RData/TLSA.hs b/src/Net/DNSBase/RData/TLSA.hs --- a/src/Net/DNSBase/RData/TLSA.hs +++ b/src/Net/DNSBase/RData/TLSA.hs @@ -14,6 +14,7 @@ fingerprints. 'T_openpgpkey' (RFC 7929) carries an OpenPGP transferable public key. -} +{-# OPTIONS_GHC -Wno-duplicate-exports #-} {-# LANGUAGE MagicHash , RecordWildCards @@ -22,18 +23,16 @@ module Net.DNSBase.RData.TLSA ( -- * TLSA and SMIMEA - X_tlsa(.., T_TLSA, T_SMIMEA) - , type XtlsaConName, T_tlsa, T_smimea - -- *** 'T_TLSA' fields - , tlsaUsage - , tlsaSelector - , tlsaMtype - , tlsaAssocData - -- *** 'T_SMIMEA' fields - , smimeaUsage - , smimeaSelector - , smimeaMtype - , smimeaAssocData + X_tlsa(.., T_TLSA, T_SMIMEA + , tlsaUsage, tlsaSelector, tlsaMtype, tlsaAssocData + , smimeaUsage, smimeaSelector, smimeaMtype, smimeaAssocData) + , type XtlsaConName + -- *** @T_TLSA@ record pattern synonym fields + , T_tlsa + , tlsaUsage, tlsaSelector, tlsaMtype, tlsaAssocData + -- *** @T_SMIMEA@ record pattern synonym fields + , T_smimea + , smimeaUsage, smimeaSelector, smimeaMtype, smimeaAssocData -- * SSHFP , T_sshfp(..) -- * OPENPGPKEY @@ -64,8 +63,27 @@ :<>: TL.Text " is not a TLSA or SMIMEA RRTYPE" ) -- | X_tlsa specialised to @TLSA@ records. +-- +-- Note that @T_tlsa@ is just a type alias! The 'T_TLSA' record pattern +-- synonym and its fields are bundled with the underlying 'X_tlsa' +-- data type. In many cases it is sufficient to import just +-- @X_tlsa(..)@, but if you also need the type alias, it needs to be +-- imported separately: +-- +-- > import Net.DNSBase (X_tlsa(..), T_tlsa) +-- type T_tlsa = X_tlsa N_tlsa + -- | X_tlsa specialised to @SMIMEA@ records. +-- +-- Note that @T_smimea@ is just a type alias! The 'T_SMIMEA' record pattern +-- synonym and its fields are bundled with the underlying 'X_tlsa' +-- data type. In many cases it is sufficient to import just +-- @X_tlsa(..)@, but if you also need the type alias, it needs to be +-- imported separately: +-- +-- > import Net.DNSBase (X_tlsa(..), T_smimea) +-- type T_smimea = X_tlsa N_smimea -- | Record pattern synonym viewing the shared 'X_tlsa' record as a @@ -101,13 +119,7 @@ -- ([RFC 6698 section 2.1](https://tools.ietf.org/html/rfc6698#section-2.1), -- DANE for TLS) and the @SMIMEA@ record -- ([RFC 8162 section 2](https://tools.ietf.org/html/rfc8162#section-2), --- DANE for S/MIME). The type parameter @n@ (either 'N_tlsa' or --- 'N_smimea') determines the RR type. Each has its own type synonym --- ('T_tlsa', 'T_smimea') and matching record pattern synonym --- ('T_TLSA', 'T_SMIMEA') with the corresponding field-name prefix --- (@tlsa@, @smimea@). The role of 'X_tlsa' is /nominal/: the wire --- format is shared but the two RR types bind to different protocols, --- so 'T_tlsa' and 'T_smimea' are not coercible. +-- DANE for S/MIME). -- -- > 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 -- > 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 @@ -119,6 +131,23 @@ -- > / / -- > +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -- +-- The type parameter @n@ (either 'N_tlsa' or 'N_smimea') +-- determines the RR type. Each has its own type synonym +-- ('T_tlsa', 'T_smimea') and matching record pattern synonym +-- ('T_TLSA', 'T_SMIMEA') with the corresponding field-name prefix +-- (@tlsa@, @smimea@). The role of 'X_tlsa' is /nominal/: the +-- wire format is shared but the two RR types bind to different +-- protocols, so 'T_tlsa' and 'T_smimea' are not coercible. +-- +-- Note that @T_tlsa@ and @T_smime@ are just type aliases! The +-- 'T_TLSA' and 'T_SMIMEA' record pattern synonyms and their +-- fields are bundled with the underlying 'X_tlsa' data type. In +-- many cases it is sufficient to import just @X_tlsa(..)@, but if +-- you also need the type aliases, they need to be imported +-- separately: +-- +-- > import Net.DNSBase (X_tlsa(..), T_tlsa, T_smimea) +-- -- If a received message carries a payload shorter than 3 bytes the -- record is returned as an opaque RData of the corresponding -- RRTYPE with the truncated bytes as its value; DANE validators @@ -133,10 +162,10 @@ type X_tlsa :: Nat -> Type type role X_tlsa nominal data X_tlsa n = X_TLSA - { _tlsaUsage :: Word8 -- ^ Certificate Usage - , _tlsaSelector :: Word8 -- ^ Selector - , _tlsaMtype :: Word8 -- ^ Matching Type - , _tlsaAssocData :: ShortByteString -- ^ Certificate Association Data + { x_tlsaUsage :: Word8 -- ^ Certificate Usage + , x_tlsaSelector :: Word8 -- ^ Selector + , x_tlsaMtype :: Word8 -- ^ Matching Type + , x_tlsaAssocData :: ShortByteString -- ^ Certificate Association Data } deriving instance (KnownSymbol (XtlsaConName n)) => Eq (X_tlsa n) deriving instance (KnownSymbol (XtlsaConName n)) => Ord (X_tlsa n) @@ -144,19 +173,19 @@ instance (Nat16 n, KnownSymbol (XtlsaConName n)) => Show (X_tlsa n) where showsPrec p X_TLSA{..} = showsP p $ showString (symbolVal' (proxy# @(XtlsaConName n))) . showChar ' ' - . shows' _tlsaUsage . showChar ' ' - . shows' _tlsaSelector . showChar ' ' - . shows' _tlsaMtype . showChar ' ' - . showAd _tlsaAssocData + . shows' x_tlsaUsage . showChar ' ' + . shows' x_tlsaSelector . showChar ' ' + . shows' x_tlsaMtype . showChar ' ' + . showAd x_tlsaAssocData where showAd = shows @Bytes16 . coerce instance (KnownSymbol (XtlsaConName n)) => Presentable (X_tlsa n) where present X_TLSA{..} = - present _tlsaUsage - . presentSp _tlsaSelector - . presentSp _tlsaMtype - . presentAd _tlsaAssocData + present x_tlsaUsage + . presentSp x_tlsaSelector + . presentSp x_tlsaMtype + . presentAd x_tlsaAssocData where presentAd = presentSp @Bytes16 . coerce @@ -164,15 +193,15 @@ rdType _ = RRTYPE $ natToWord16 n {-# INLINE rdType #-} rdEncode X_TLSA{..} = putSizedBuilder $ - mbWord8 _tlsaUsage - <> mbWord8 _tlsaSelector - <> mbWord8 _tlsaMtype - <> mbShortByteString _tlsaAssocData + mbWord8 x_tlsaUsage + <> mbWord8 x_tlsaSelector + <> mbWord8 x_tlsaMtype + <> mbShortByteString x_tlsaAssocData rdDecode _ _ = const do - _tlsaUsage <- get8 - _tlsaSelector <- get8 - _tlsaMtype <- get8 - _tlsaAssocData <- getShortByteString + x_tlsaUsage <- get8 + x_tlsaSelector <- get8 + x_tlsaMtype <- get8 + x_tlsaAssocData <- getShortByteString pure $ RData (X_TLSA{..} :: X_tlsa n) -- | The @SSHFP@ resource record diff --git a/tests/extensibility.hs b/tests/extensibility.hs --- a/tests/extensibility.hs +++ b/tests/extensibility.hs @@ -91,13 +91,13 @@ Nothing -> assertFailure $ "expected T_svcb, got " ++ presentString rd mempty Just X_SVCB{..} -> - case spvLookup @SPV_EXT_port _svcParamValues of + case spvLookup @SPV_EXT_port x_svcParamValues of Just (SPV_EXT_PORT 80) -> pure () Just (SPV_EXT_PORT p) -> assertFailure $ "expected port 80, got " ++ show p Nothing -> assertFailure $ "no SPV_EXT_port in " - ++ presentString _svcParamValues mempty + ++ presentString x_svcParamValues mempty where -- | Wire form for a minimal SVCB record: priority 1, root target, -- one SvcParam (port = 80).