{-|
Module      : Net.DNSBase.EDNS.Option.Secalgs
Description : EDNS signalling of DNSSEC algorithms understood by the client
Copyright   : (c) Viktor Dukhovni, 2020
License     : BSD-3-Clause
Maintainer  : ietf-dane@dukhovni.org
Stability   : experimental

RFC 6975 specifies a way for validating end-system resolvers to signal
to a server which digital signature and hash algorithms they support.
This signalling does not alter server behaviour, rather it just provides
a means to server operators to collect data on client algorithm support
to assist in planning future algorithm selection.

The format of the associated EDNS options is defined in
[RFC6975, Section 3](https://tools.ietf.org/html/rfc6975#section-3)
as follows:

>  0                       8                      16
>  +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
>  |                  OPTION-CODE                  |
>  +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
>  |                  LIST-LENGTH                  |
>  +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
>  |       ALG-CODE        |        ...            /
>  +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+

i.e. a 16-bit count, followed by a sequence of 8-bit algorithm numbers.

The use of SHA-1 in NSEC3 is essentially light-weight obfuscation to
discourage casual zone walking. Implementation and adoption of successor
algorithms seems unlikely, and would in also be most counter-productive.
Therefore, while the N3U option is defined here, it is best left unused.
As of February 2020, the IANA registry of
[NSEC3 hash algorithms](https://www.iana.org/assignments/dnssec-nsec3-parameters/dnssec-nsec3-parameters.xhtml#dnssec-nsec3-parameters-3)
lists just SHA-1:

 +---------+---------------+-----------+
 | Value   | Description   | Reference |
 +=========+===============+===========+
 | 0       | Reserved      | [RFC5155] |
 +---------+---------------+-----------+
 | 1       | SHA-1         | [RFC5155] |
 +---------+---------------+-----------+
 | 2-255   | Unassigned    |           |
 +---------+---------------+-----------+

This is not expected to change.
-}

module Net.DNSBase.EDNS.Option.Secalgs
    ( O_dau(..)
    , O_dhu(..)
    , O_n3u(..)
    ) where

import Net.DNSBase.Decode.Internal.State
import Net.DNSBase.EDNS.Internal.OptNum
import Net.DNSBase.EDNS.Internal.Option
import Net.DNSBase.Encode.Internal.State
import Net.DNSBase.Encode.Internal.Metric
import Net.DNSBase.Internal.Present
import Net.DNSBase.Internal.Util

import Net.DNSBase.Secalgs

-- | DNSSEC Algorithm Understood (RFC6975).
newtype O_dau = O_DAU [DNSKEYAlg] deriving (O_dau -> O_dau -> Bool
(O_dau -> O_dau -> Bool) -> (O_dau -> O_dau -> Bool) -> Eq O_dau
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: O_dau -> O_dau -> Bool
== :: O_dau -> O_dau -> Bool
$c/= :: O_dau -> O_dau -> Bool
/= :: O_dau -> O_dau -> Bool
Eq, Int -> O_dau -> ShowS
[O_dau] -> ShowS
O_dau -> String
(Int -> O_dau -> ShowS)
-> (O_dau -> String) -> ([O_dau] -> ShowS) -> Show O_dau
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> O_dau -> ShowS
showsPrec :: Int -> O_dau -> ShowS
$cshow :: O_dau -> String
show :: O_dau -> String
$cshowList :: [O_dau] -> ShowS
showList :: [O_dau] -> ShowS
Show)
-- | DS Hash Understood (RFC6975).
newtype O_dhu = O_DHU [DSHashAlg] deriving (O_dhu -> O_dhu -> Bool
(O_dhu -> O_dhu -> Bool) -> (O_dhu -> O_dhu -> Bool) -> Eq O_dhu
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: O_dhu -> O_dhu -> Bool
== :: O_dhu -> O_dhu -> Bool
$c/= :: O_dhu -> O_dhu -> Bool
/= :: O_dhu -> O_dhu -> Bool
Eq, Int -> O_dhu -> ShowS
[O_dhu] -> ShowS
O_dhu -> String
(Int -> O_dhu -> ShowS)
-> (O_dhu -> String) -> ([O_dhu] -> ShowS) -> Show O_dhu
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> O_dhu -> ShowS
showsPrec :: Int -> O_dhu -> ShowS
$cshow :: O_dhu -> String
show :: O_dhu -> String
$cshowList :: [O_dhu] -> ShowS
showList :: [O_dhu] -> ShowS
Show)
-- | NSEC3 Hash Understood (RFC6975).
newtype O_n3u = O_N3U [NSEC3HashAlg] deriving (O_n3u -> O_n3u -> Bool
(O_n3u -> O_n3u -> Bool) -> (O_n3u -> O_n3u -> Bool) -> Eq O_n3u
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: O_n3u -> O_n3u -> Bool
== :: O_n3u -> O_n3u -> Bool
$c/= :: O_n3u -> O_n3u -> Bool
/= :: O_n3u -> O_n3u -> Bool
Eq, Int -> O_n3u -> ShowS
[O_n3u] -> ShowS
O_n3u -> String
(Int -> O_n3u -> ShowS)
-> (O_n3u -> String) -> ([O_n3u] -> ShowS) -> Show O_n3u
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> O_n3u -> ShowS
showsPrec :: Int -> O_n3u -> ShowS
$cshow :: O_n3u -> String
show :: O_n3u -> String
$cshowList :: [O_n3u] -> ShowS
showList :: [O_n3u] -> ShowS
Show)

instance Presentable O_dau where
    present :: O_dau -> Builder -> Builder
present (O_DAU [DNSKEYAlg]
val) = case [DNSKEYAlg]
val of
        []     -> Char -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present Char
'-'
        (DNSKEYAlg
v:[DNSKEYAlg]
vs) -> DNSKEYAlg -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present DNSKEYAlg
v (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> [DNSKEYAlg] -> Builder)
-> [DNSKEYAlg] -> Builder -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((DNSKEYAlg -> Builder -> Builder)
-> Builder -> [DNSKEYAlg] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DNSKEYAlg -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentSp) [DNSKEYAlg]
vs

instance Presentable O_dhu where
    present :: O_dhu -> Builder -> Builder
present (O_DHU [DSHashAlg]
val) = case [DSHashAlg]
val of
        []     -> Char -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present Char
'-'
        (DSHashAlg
v:[DSHashAlg]
vs) -> DSHashAlg -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present DSHashAlg
v (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> [DSHashAlg] -> Builder)
-> [DSHashAlg] -> Builder -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((DSHashAlg -> Builder -> Builder)
-> Builder -> [DSHashAlg] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DSHashAlg -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentSp) [DSHashAlg]
vs

instance Presentable O_n3u where
    present :: O_n3u -> Builder -> Builder
present (O_N3U [NSEC3HashAlg]
val) = case [NSEC3HashAlg]
val of
        []     -> Char -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present Char
'-'
        (NSEC3HashAlg
v:[NSEC3HashAlg]
vs) -> NSEC3HashAlg -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
present NSEC3HashAlg
v (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> [NSEC3HashAlg] -> Builder)
-> [NSEC3HashAlg] -> Builder -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((NSEC3HashAlg -> Builder -> Builder)
-> Builder -> [NSEC3HashAlg] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NSEC3HashAlg -> Builder -> Builder
forall a. Presentable a => a -> Builder -> Builder
presentSp) [NSEC3HashAlg]
vs

instance KnownEdnsOption O_dau where
    optNum :: forall b -> (b ~ O_dau) => OptNum
optNum _ = OptNum
DAU
    {-# INLINE optNum #-}
    optEncode :: forall s r. (Typeable r, Eq r, Show r) => O_dau -> SPut s r
optEncode  = SizedBuilder -> SPut s r
forall r s. ErrorContext r => SizedBuilder -> SPut s r
putSizedBuilder (SizedBuilder -> SPut s r)
-> (O_dau -> SizedBuilder) -> O_dau -> SPut s r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([DNSKEYAlg] -> SizedBuilder) -> O_dau -> SizedBuilder
forall a b. Coercible a b => a -> b
coerce [DNSKEYAlg] -> SizedBuilder
foldDAU
      where
        foldDAU :: [DNSKEYAlg] -> SizedBuilder
        foldDAU :: [DNSKEYAlg] -> SizedBuilder
foldDAU = (DNSKEYAlg -> SizedBuilder) -> [DNSKEYAlg] -> SizedBuilder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DNSKEYAlg -> SizedBuilder
mbDAU
        mbDAU :: DNSKEYAlg -> SizedBuilder
        mbDAU :: DNSKEYAlg -> SizedBuilder
mbDAU = (Word8 -> SizedBuilder) -> DNSKEYAlg -> SizedBuilder
forall a b. Coercible a b => a -> b
coerce Word8 -> SizedBuilder
mbWord8
    optDecode :: forall b ->
(b ~ O_dau) => OptionExtensionVal b -> Int -> SGet EdnsOption
optDecode _ OptionExtensionVal b
_ Int
len =
        O_dau -> EdnsOption
forall a. KnownEdnsOption a => a -> EdnsOption
EdnsOption (O_dau -> EdnsOption)
-> ([DNSKEYAlg] -> O_dau) -> [DNSKEYAlg] -> EdnsOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DNSKEYAlg] -> O_dau
O_DAU ([DNSKEYAlg] -> EdnsOption) -> SGet [DNSKEYAlg] -> SGet EdnsOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> SGet DNSKEYAlg -> Int -> SGet [DNSKEYAlg]
forall a. Int -> SGet a -> Int -> SGet [a]
getFixedWidthSequence Int
1 (Word8 -> DNSKEYAlg
forall a b. Coercible a b => a -> b
coerce (Word8 -> DNSKEYAlg) -> SGet Word8 -> SGet DNSKEYAlg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word8
get8) Int
len

instance KnownEdnsOption O_dhu where
    optNum :: forall b -> (b ~ O_dhu) => OptNum
optNum _ = OptNum
DHU
    {-# INLINE optNum #-}
    optEncode :: forall s r. (Typeable r, Eq r, Show r) => O_dhu -> SPut s r
optEncode  = SizedBuilder -> SPut s r
forall r s. ErrorContext r => SizedBuilder -> SPut s r
putSizedBuilder (SizedBuilder -> SPut s r)
-> (O_dhu -> SizedBuilder) -> O_dhu -> SPut s r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([DSHashAlg] -> SizedBuilder) -> O_dhu -> SizedBuilder
forall a b. Coercible a b => a -> b
coerce [DSHashAlg] -> SizedBuilder
foldDHU
      where
        foldDHU :: [DSHashAlg] -> SizedBuilder
        foldDHU :: [DSHashAlg] -> SizedBuilder
foldDHU = (DSHashAlg -> SizedBuilder) -> [DSHashAlg] -> SizedBuilder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap DSHashAlg -> SizedBuilder
mbDHU
        mbDHU :: DSHashAlg -> SizedBuilder
        mbDHU :: DSHashAlg -> SizedBuilder
mbDHU = (Word8 -> SizedBuilder) -> DSHashAlg -> SizedBuilder
forall a b. Coercible a b => a -> b
coerce Word8 -> SizedBuilder
mbWord8
    optDecode :: forall b ->
(b ~ O_dhu) => OptionExtensionVal b -> Int -> SGet EdnsOption
optDecode _ OptionExtensionVal b
_ Int
len =
        O_dhu -> EdnsOption
forall a. KnownEdnsOption a => a -> EdnsOption
EdnsOption (O_dhu -> EdnsOption)
-> ([DSHashAlg] -> O_dhu) -> [DSHashAlg] -> EdnsOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DSHashAlg] -> O_dhu
O_DHU ([DSHashAlg] -> EdnsOption) -> SGet [DSHashAlg] -> SGet EdnsOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> SGet DSHashAlg -> Int -> SGet [DSHashAlg]
forall a. Int -> SGet a -> Int -> SGet [a]
getFixedWidthSequence Int
1 (Word8 -> DSHashAlg
forall a b. Coercible a b => a -> b
coerce (Word8 -> DSHashAlg) -> SGet Word8 -> SGet DSHashAlg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word8
get8) Int
len

instance KnownEdnsOption O_n3u where
    optNum :: forall b -> (b ~ O_n3u) => OptNum
optNum _ = OptNum
N3U
    {-# INLINE optNum #-}
    optEncode :: forall s r. (Typeable r, Eq r, Show r) => O_n3u -> SPut s r
optEncode  = SizedBuilder -> SPut s r
forall r s. ErrorContext r => SizedBuilder -> SPut s r
putSizedBuilder (SizedBuilder -> SPut s r)
-> (O_n3u -> SizedBuilder) -> O_n3u -> SPut s r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([NSEC3HashAlg] -> SizedBuilder) -> O_n3u -> SizedBuilder
forall a b. Coercible a b => a -> b
coerce [NSEC3HashAlg] -> SizedBuilder
foldN3U
      where
        foldN3U :: [NSEC3HashAlg] -> SizedBuilder
        foldN3U :: [NSEC3HashAlg] -> SizedBuilder
foldN3U = (NSEC3HashAlg -> SizedBuilder) -> [NSEC3HashAlg] -> SizedBuilder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NSEC3HashAlg -> SizedBuilder
mbN3U
        mbN3U :: NSEC3HashAlg -> SizedBuilder
        mbN3U :: NSEC3HashAlg -> SizedBuilder
mbN3U = (Word8 -> SizedBuilder) -> NSEC3HashAlg -> SizedBuilder
forall a b. Coercible a b => a -> b
coerce Word8 -> SizedBuilder
mbWord8
    optDecode :: forall b ->
(b ~ O_n3u) => OptionExtensionVal b -> Int -> SGet EdnsOption
optDecode _ OptionExtensionVal b
_ Int
len =
        O_n3u -> EdnsOption
forall a. KnownEdnsOption a => a -> EdnsOption
EdnsOption (O_n3u -> EdnsOption)
-> ([NSEC3HashAlg] -> O_n3u) -> [NSEC3HashAlg] -> EdnsOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NSEC3HashAlg] -> O_n3u
O_N3U ([NSEC3HashAlg] -> EdnsOption)
-> SGet [NSEC3HashAlg] -> SGet EdnsOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> SGet NSEC3HashAlg -> Int -> SGet [NSEC3HashAlg]
forall a. Int -> SGet a -> Int -> SGet [a]
getFixedWidthSequence Int
1 (Word8 -> NSEC3HashAlg
forall a b. Coercible a b => a -> b
coerce (Word8 -> NSEC3HashAlg) -> SGet Word8 -> SGet NSEC3HashAlg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SGet Word8
get8) Int
len