{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Stability: internal
-- This module contains definitions for [COSE registry](https://www.iana.org/assignments/cose/cose.xhtml)
-- entries that are relevant for Webauthn COSE public keys. All the types in
-- this module implement the 'Serialise' class, mapping them to the respective
-- CBOR values/labels.
--
-- This modules sometimes uses this
-- [CBOR Grammar](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-13#section-1.4)
-- to describe CBOR value types corresponding to CBOR parameters
module Crypto.WebAuthn.Cose.Internal.Registry
  ( -- * COSE Key Types
    CoseKeyType (..),

    -- * COSE Parameters
    CoseKeyCommonParameter (..),
    CoseKeyTypeParameterOKP (..),
    CoseKeyTypeParameterEC2 (..),
    CoseKeyTypeParameterRSA (..),
    parameterCount,

    -- * COSE Elliptic Curves
    CoseEllipticCurveOKP (..),
    CoseEllipticCurveEC2 (..),
  )
where

import Codec.CBOR.Decoding (decodeIntCanonical)
import Codec.CBOR.Encoding (encodeInt)
import Codec.Serialise (Serialise)
import Codec.Serialise.Class (decode, encode)

-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-common-parameters)
-- All the entries from the [COSE Key Common Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-common-parameters)
-- that are needed for Webauthn public keys
data CoseKeyCommonParameter
  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1)
    --
    -- * COSE value type: tstr / int
    -- * Value registry: 'CoseKeyType'
    -- * Description: Identification of the key type
    --
    -- This parameter is used to identify the family of keys for this
    -- structure and, thus, the set of key-type-specific parameters to be
    -- found. The key type MUST be included as part of the trust decision
    -- process.
    CoseKeyCommonParameterKty
  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1)
    --
    -- * COSE value type: tstr / int
    -- * Value registry: 'Crypto.WebAuthn.Cose.Algorithm.CoseSignAlg'
    -- * Description: Key usage restriction to this algorithm
    --
    -- This parameter is used to restrict the algorithm that is used
    -- with the key.
    CoseKeyCommonParameterAlg
  deriving (CoseKeyCommonParameter -> CoseKeyCommonParameter -> Bool
(CoseKeyCommonParameter -> CoseKeyCommonParameter -> Bool)
-> (CoseKeyCommonParameter -> CoseKeyCommonParameter -> Bool)
-> Eq CoseKeyCommonParameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoseKeyCommonParameter -> CoseKeyCommonParameter -> Bool
$c/= :: CoseKeyCommonParameter -> CoseKeyCommonParameter -> Bool
== :: CoseKeyCommonParameter -> CoseKeyCommonParameter -> Bool
$c== :: CoseKeyCommonParameter -> CoseKeyCommonParameter -> Bool
Eq, Int -> CoseKeyCommonParameter -> ShowS
[CoseKeyCommonParameter] -> ShowS
CoseKeyCommonParameter -> String
(Int -> CoseKeyCommonParameter -> ShowS)
-> (CoseKeyCommonParameter -> String)
-> ([CoseKeyCommonParameter] -> ShowS)
-> Show CoseKeyCommonParameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoseKeyCommonParameter] -> ShowS
$cshowList :: [CoseKeyCommonParameter] -> ShowS
show :: CoseKeyCommonParameter -> String
$cshow :: CoseKeyCommonParameter -> String
showsPrec :: Int -> CoseKeyCommonParameter -> ShowS
$cshowsPrec :: Int -> CoseKeyCommonParameter -> ShowS
Show, CoseKeyCommonParameter
CoseKeyCommonParameter
-> CoseKeyCommonParameter -> Bounded CoseKeyCommonParameter
forall a. a -> a -> Bounded a
maxBound :: CoseKeyCommonParameter
$cmaxBound :: CoseKeyCommonParameter
minBound :: CoseKeyCommonParameter
$cminBound :: CoseKeyCommonParameter
Bounded, Int -> CoseKeyCommonParameter
CoseKeyCommonParameter -> Int
CoseKeyCommonParameter -> [CoseKeyCommonParameter]
CoseKeyCommonParameter -> CoseKeyCommonParameter
CoseKeyCommonParameter
-> CoseKeyCommonParameter -> [CoseKeyCommonParameter]
CoseKeyCommonParameter
-> CoseKeyCommonParameter
-> CoseKeyCommonParameter
-> [CoseKeyCommonParameter]
(CoseKeyCommonParameter -> CoseKeyCommonParameter)
-> (CoseKeyCommonParameter -> CoseKeyCommonParameter)
-> (Int -> CoseKeyCommonParameter)
-> (CoseKeyCommonParameter -> Int)
-> (CoseKeyCommonParameter -> [CoseKeyCommonParameter])
-> (CoseKeyCommonParameter
    -> CoseKeyCommonParameter -> [CoseKeyCommonParameter])
-> (CoseKeyCommonParameter
    -> CoseKeyCommonParameter -> [CoseKeyCommonParameter])
-> (CoseKeyCommonParameter
    -> CoseKeyCommonParameter
    -> CoseKeyCommonParameter
    -> [CoseKeyCommonParameter])
-> Enum CoseKeyCommonParameter
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CoseKeyCommonParameter
-> CoseKeyCommonParameter
-> CoseKeyCommonParameter
-> [CoseKeyCommonParameter]
$cenumFromThenTo :: CoseKeyCommonParameter
-> CoseKeyCommonParameter
-> CoseKeyCommonParameter
-> [CoseKeyCommonParameter]
enumFromTo :: CoseKeyCommonParameter
-> CoseKeyCommonParameter -> [CoseKeyCommonParameter]
$cenumFromTo :: CoseKeyCommonParameter
-> CoseKeyCommonParameter -> [CoseKeyCommonParameter]
enumFromThen :: CoseKeyCommonParameter
-> CoseKeyCommonParameter -> [CoseKeyCommonParameter]
$cenumFromThen :: CoseKeyCommonParameter
-> CoseKeyCommonParameter -> [CoseKeyCommonParameter]
enumFrom :: CoseKeyCommonParameter -> [CoseKeyCommonParameter]
$cenumFrom :: CoseKeyCommonParameter -> [CoseKeyCommonParameter]
fromEnum :: CoseKeyCommonParameter -> Int
$cfromEnum :: CoseKeyCommonParameter -> Int
toEnum :: Int -> CoseKeyCommonParameter
$ctoEnum :: Int -> CoseKeyCommonParameter
pred :: CoseKeyCommonParameter -> CoseKeyCommonParameter
$cpred :: CoseKeyCommonParameter -> CoseKeyCommonParameter
succ :: CoseKeyCommonParameter -> CoseKeyCommonParameter
$csucc :: CoseKeyCommonParameter -> CoseKeyCommonParameter
Enum)

-- | Serialises the parameters using the @Label@ column from the
-- [COSE Key Common Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-common-parameters)
instance Serialise CoseKeyCommonParameter where
  encode :: CoseKeyCommonParameter -> Encoding
encode CoseKeyCommonParameter
CoseKeyCommonParameterKty = Int -> Encoding
encodeInt Int
1
  encode CoseKeyCommonParameter
CoseKeyCommonParameterAlg = Int -> Encoding
encodeInt Int
3
  decode :: forall s. Decoder s CoseKeyCommonParameter
decode =
    Decoder s Int
forall s. Decoder s Int
decodeIntCanonical Decoder s Int
-> (Int -> Decoder s CoseKeyCommonParameter)
-> Decoder s CoseKeyCommonParameter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Int
1 -> CoseKeyCommonParameter -> Decoder s CoseKeyCommonParameter
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseKeyCommonParameter
CoseKeyCommonParameterKty
      Int
3 -> CoseKeyCommonParameter -> Decoder s CoseKeyCommonParameter
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseKeyCommonParameter
CoseKeyCommonParameterAlg
      Int
value -> String -> Decoder s CoseKeyCommonParameter
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s CoseKeyCommonParameter)
-> String -> Decoder s CoseKeyCommonParameter
forall a b. (a -> b) -> a -> b
$ String
"Unknown COSE key common parameter " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
value

-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type)
-- All the entries from the [COSE Key Types registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type)
-- that are known to be needed for Webauthn public keys
data CoseKeyType
  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2)
    -- Octet Key Pair.
    -- See 'CoseKeyTypeParameterOKP' for the parameters specific to this key type.
    CoseKeyTypeOKP
  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)
    -- Elliptic Curve Keys w/ x- and y-coordinate pair.
    -- See 'CoseKeyTypeParameterEC2' for the parameters specific to this key type.
    CoseKeyTypeEC2
  | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4)
    -- RSA Key.
    -- See 'CoseKeyTypeParameterRSA' for the parameters specific to this key type.
    CoseKeyTypeRSA
  deriving (CoseKeyType -> CoseKeyType -> Bool
(CoseKeyType -> CoseKeyType -> Bool)
-> (CoseKeyType -> CoseKeyType -> Bool) -> Eq CoseKeyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoseKeyType -> CoseKeyType -> Bool
$c/= :: CoseKeyType -> CoseKeyType -> Bool
== :: CoseKeyType -> CoseKeyType -> Bool
$c== :: CoseKeyType -> CoseKeyType -> Bool
Eq, Int -> CoseKeyType -> ShowS
[CoseKeyType] -> ShowS
CoseKeyType -> String
(Int -> CoseKeyType -> ShowS)
-> (CoseKeyType -> String)
-> ([CoseKeyType] -> ShowS)
-> Show CoseKeyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoseKeyType] -> ShowS
$cshowList :: [CoseKeyType] -> ShowS
show :: CoseKeyType -> String
$cshow :: CoseKeyType -> String
showsPrec :: Int -> CoseKeyType -> ShowS
$cshowsPrec :: Int -> CoseKeyType -> ShowS
Show)

-- | Serialises the key type using the @Value@ column from the
-- [COSE Key Types registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type)
instance Serialise CoseKeyType where
  encode :: CoseKeyType -> Encoding
encode CoseKeyType
CoseKeyTypeOKP = Int -> Encoding
encodeInt Int
1
  encode CoseKeyType
CoseKeyTypeEC2 = Int -> Encoding
encodeInt Int
2
  encode CoseKeyType
CoseKeyTypeRSA = Int -> Encoding
encodeInt Int
3
  decode :: forall s. Decoder s CoseKeyType
decode =
    Decoder s Int
forall s. Decoder s Int
decodeIntCanonical Decoder s Int
-> (Int -> Decoder s CoseKeyType) -> Decoder s CoseKeyType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Int
1 -> CoseKeyType -> Decoder s CoseKeyType
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseKeyType
CoseKeyTypeOKP
      Int
2 -> CoseKeyType -> Decoder s CoseKeyType
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseKeyType
CoseKeyTypeEC2
      Int
3 -> CoseKeyType -> Decoder s CoseKeyType
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseKeyType
CoseKeyTypeRSA
      Int
value -> String -> Decoder s CoseKeyType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s CoseKeyType)
-> String -> Decoder s CoseKeyType
forall a b. (a -> b) -> a -> b
$ String
"Unknown COSE key type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
value

-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)
-- All the entries from the [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)
-- for key type 'CoseKeyTypeOKP' (aka @Key Type@ is @1@) that are required for
-- public keys
data CoseKeyTypeParameterOKP
  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2)
    --
    -- * COSE value type: int / tstr
    -- * Value registry: 'CoseEllipticCurveOKP'
    -- * Description: EC identifier
    --
    -- This contains an identifier of the curve to be used with the key.
    CoseKeyTypeParameterOKPCrv
  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2)
    --
    -- * COSE value type: bstr
    -- * Description: Public Key
    --
    -- This contains the public key. The byte string contains the public key as defined by the algorithm.
    CoseKeyTypeParameterOKPX
  deriving (CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP -> Bool
(CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP -> Bool)
-> (CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP -> Bool)
-> Eq CoseKeyTypeParameterOKP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP -> Bool
$c/= :: CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP -> Bool
== :: CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP -> Bool
$c== :: CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP -> Bool
Eq, Int -> CoseKeyTypeParameterOKP -> ShowS
[CoseKeyTypeParameterOKP] -> ShowS
CoseKeyTypeParameterOKP -> String
(Int -> CoseKeyTypeParameterOKP -> ShowS)
-> (CoseKeyTypeParameterOKP -> String)
-> ([CoseKeyTypeParameterOKP] -> ShowS)
-> Show CoseKeyTypeParameterOKP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoseKeyTypeParameterOKP] -> ShowS
$cshowList :: [CoseKeyTypeParameterOKP] -> ShowS
show :: CoseKeyTypeParameterOKP -> String
$cshow :: CoseKeyTypeParameterOKP -> String
showsPrec :: Int -> CoseKeyTypeParameterOKP -> ShowS
$cshowsPrec :: Int -> CoseKeyTypeParameterOKP -> ShowS
Show, CoseKeyTypeParameterOKP
CoseKeyTypeParameterOKP
-> CoseKeyTypeParameterOKP -> Bounded CoseKeyTypeParameterOKP
forall a. a -> a -> Bounded a
maxBound :: CoseKeyTypeParameterOKP
$cmaxBound :: CoseKeyTypeParameterOKP
minBound :: CoseKeyTypeParameterOKP
$cminBound :: CoseKeyTypeParameterOKP
Bounded, Int -> CoseKeyTypeParameterOKP
CoseKeyTypeParameterOKP -> Int
CoseKeyTypeParameterOKP -> [CoseKeyTypeParameterOKP]
CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP
CoseKeyTypeParameterOKP
-> CoseKeyTypeParameterOKP -> [CoseKeyTypeParameterOKP]
CoseKeyTypeParameterOKP
-> CoseKeyTypeParameterOKP
-> CoseKeyTypeParameterOKP
-> [CoseKeyTypeParameterOKP]
(CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP)
-> (CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP)
-> (Int -> CoseKeyTypeParameterOKP)
-> (CoseKeyTypeParameterOKP -> Int)
-> (CoseKeyTypeParameterOKP -> [CoseKeyTypeParameterOKP])
-> (CoseKeyTypeParameterOKP
    -> CoseKeyTypeParameterOKP -> [CoseKeyTypeParameterOKP])
-> (CoseKeyTypeParameterOKP
    -> CoseKeyTypeParameterOKP -> [CoseKeyTypeParameterOKP])
-> (CoseKeyTypeParameterOKP
    -> CoseKeyTypeParameterOKP
    -> CoseKeyTypeParameterOKP
    -> [CoseKeyTypeParameterOKP])
-> Enum CoseKeyTypeParameterOKP
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CoseKeyTypeParameterOKP
-> CoseKeyTypeParameterOKP
-> CoseKeyTypeParameterOKP
-> [CoseKeyTypeParameterOKP]
$cenumFromThenTo :: CoseKeyTypeParameterOKP
-> CoseKeyTypeParameterOKP
-> CoseKeyTypeParameterOKP
-> [CoseKeyTypeParameterOKP]
enumFromTo :: CoseKeyTypeParameterOKP
-> CoseKeyTypeParameterOKP -> [CoseKeyTypeParameterOKP]
$cenumFromTo :: CoseKeyTypeParameterOKP
-> CoseKeyTypeParameterOKP -> [CoseKeyTypeParameterOKP]
enumFromThen :: CoseKeyTypeParameterOKP
-> CoseKeyTypeParameterOKP -> [CoseKeyTypeParameterOKP]
$cenumFromThen :: CoseKeyTypeParameterOKP
-> CoseKeyTypeParameterOKP -> [CoseKeyTypeParameterOKP]
enumFrom :: CoseKeyTypeParameterOKP -> [CoseKeyTypeParameterOKP]
$cenumFrom :: CoseKeyTypeParameterOKP -> [CoseKeyTypeParameterOKP]
fromEnum :: CoseKeyTypeParameterOKP -> Int
$cfromEnum :: CoseKeyTypeParameterOKP -> Int
toEnum :: Int -> CoseKeyTypeParameterOKP
$ctoEnum :: Int -> CoseKeyTypeParameterOKP
pred :: CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP
$cpred :: CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP
succ :: CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP
$csucc :: CoseKeyTypeParameterOKP -> CoseKeyTypeParameterOKP
Enum)

-- | Serialises the parameters using the @Label@ column from the
-- [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)
instance Serialise CoseKeyTypeParameterOKP where
  encode :: CoseKeyTypeParameterOKP -> Encoding
encode CoseKeyTypeParameterOKP
CoseKeyTypeParameterOKPCrv = Int -> Encoding
encodeInt (-Int
1)
  encode CoseKeyTypeParameterOKP
CoseKeyTypeParameterOKPX = Int -> Encoding
encodeInt (-Int
2)
  decode :: forall s. Decoder s CoseKeyTypeParameterOKP
decode =
    Decoder s Int
forall s. Decoder s Int
decodeIntCanonical Decoder s Int
-> (Int -> Decoder s CoseKeyTypeParameterOKP)
-> Decoder s CoseKeyTypeParameterOKP
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      -1 -> CoseKeyTypeParameterOKP -> Decoder s CoseKeyTypeParameterOKP
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseKeyTypeParameterOKP
CoseKeyTypeParameterOKPCrv
      -2 -> CoseKeyTypeParameterOKP -> Decoder s CoseKeyTypeParameterOKP
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseKeyTypeParameterOKP
CoseKeyTypeParameterOKPX
      Int
value -> String -> Decoder s CoseKeyTypeParameterOKP
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s CoseKeyTypeParameterOKP)
-> String -> Decoder s CoseKeyTypeParameterOKP
forall a b. (a -> b) -> a -> b
$ String
"Unknown COSE key type parameter " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
value String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for key type OKP"

-- | Elliptic curves for key type 'CoseKeyTypeOKP' from the
-- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves),
-- limited to the ones that are currently needed for Webauthn
data CoseEllipticCurveOKP
  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1)
    -- Ed25519 for use w/ EdDSA only
    CoseEllipticCurveEd25519
  deriving (CoseEllipticCurveOKP -> CoseEllipticCurveOKP -> Bool
(CoseEllipticCurveOKP -> CoseEllipticCurveOKP -> Bool)
-> (CoseEllipticCurveOKP -> CoseEllipticCurveOKP -> Bool)
-> Eq CoseEllipticCurveOKP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoseEllipticCurveOKP -> CoseEllipticCurveOKP -> Bool
$c/= :: CoseEllipticCurveOKP -> CoseEllipticCurveOKP -> Bool
== :: CoseEllipticCurveOKP -> CoseEllipticCurveOKP -> Bool
$c== :: CoseEllipticCurveOKP -> CoseEllipticCurveOKP -> Bool
Eq, Int -> CoseEllipticCurveOKP -> ShowS
[CoseEllipticCurveOKP] -> ShowS
CoseEllipticCurveOKP -> String
(Int -> CoseEllipticCurveOKP -> ShowS)
-> (CoseEllipticCurveOKP -> String)
-> ([CoseEllipticCurveOKP] -> ShowS)
-> Show CoseEllipticCurveOKP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoseEllipticCurveOKP] -> ShowS
$cshowList :: [CoseEllipticCurveOKP] -> ShowS
show :: CoseEllipticCurveOKP -> String
$cshow :: CoseEllipticCurveOKP -> String
showsPrec :: Int -> CoseEllipticCurveOKP -> ShowS
$cshowsPrec :: Int -> CoseEllipticCurveOKP -> ShowS
Show)

-- | Serialises COSE Elliptic Curves using the @Value@ column from the
-- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves).
instance Serialise CoseEllipticCurveOKP where
  encode :: CoseEllipticCurveOKP -> Encoding
encode CoseEllipticCurveOKP
CoseEllipticCurveEd25519 = Int -> Encoding
encodeInt Int
6
  decode :: forall s. Decoder s CoseEllipticCurveOKP
decode =
    Decoder s Int
forall s. Decoder s Int
decodeIntCanonical Decoder s Int
-> (Int -> Decoder s CoseEllipticCurveOKP)
-> Decoder s CoseEllipticCurveOKP
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Int
6 -> CoseEllipticCurveOKP -> Decoder s CoseEllipticCurveOKP
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseEllipticCurveOKP
CoseEllipticCurveEd25519
      Int
value -> String -> Decoder s CoseEllipticCurveOKP
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s CoseEllipticCurveOKP)
-> String -> Decoder s CoseEllipticCurveOKP
forall a b. (a -> b) -> a -> b
$ String
"Unknown COSE elliptic curve " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
value String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for key type OKP"

-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)
-- All the entries from the [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)
-- for key type 'CoseKeyTypeEC2' (aka @Key Type@ is @2@) that are required for
-- public keys
data CoseKeyTypeParameterEC2
  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)
    --
    -- * COSE value type: int / tstr
    -- * Value registry: 'CoseEllipticCurveEC2'
    -- * Description: EC identifier
    --
    -- This contains an identifier of the curve to be used with the key.
    CoseKeyTypeParameterEC2Crv
  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)
    --
    -- * COSE value type: bstr
    -- * Description: x-coordinate
    --
    -- This contains the x-coordinate for the EC point. The integer is
    -- converted to a byte string as defined in [SEC1]. Leading zero
    -- octets MUST be preserved.
    CoseKeyTypeParameterEC2X
  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1)
    --
    -- * COSE value type: bstr / bool
    -- * Description: y-coordinate
    --
    -- This contains either the sign bit or the value of the
    -- y-coordinate for the EC point. When encoding the value y, the
    -- integer is converted to an byte string (as defined in
    -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1))
    -- and encoded as a CBOR bstr. Leading zero octets MUST be
    -- preserved. The compressed point encoding is also supported.
    -- Compute the sign bit as laid out in the Elliptic-Curve-Point-to-
    -- Octet-String Conversion function of
    -- [SEC1](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#ref-SEC1).
    -- If the sign bit is zero, then encode y as a CBOR false value;
    -- otherwise, encode y as a CBOR true value.
    -- The encoding of the infinity point is not supported.
    CoseKeyTypeParameterEC2Y
  deriving (CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2 -> Bool
(CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2 -> Bool)
-> (CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2 -> Bool)
-> Eq CoseKeyTypeParameterEC2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2 -> Bool
$c/= :: CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2 -> Bool
== :: CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2 -> Bool
$c== :: CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2 -> Bool
Eq, Int -> CoseKeyTypeParameterEC2 -> ShowS
[CoseKeyTypeParameterEC2] -> ShowS
CoseKeyTypeParameterEC2 -> String
(Int -> CoseKeyTypeParameterEC2 -> ShowS)
-> (CoseKeyTypeParameterEC2 -> String)
-> ([CoseKeyTypeParameterEC2] -> ShowS)
-> Show CoseKeyTypeParameterEC2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoseKeyTypeParameterEC2] -> ShowS
$cshowList :: [CoseKeyTypeParameterEC2] -> ShowS
show :: CoseKeyTypeParameterEC2 -> String
$cshow :: CoseKeyTypeParameterEC2 -> String
showsPrec :: Int -> CoseKeyTypeParameterEC2 -> ShowS
$cshowsPrec :: Int -> CoseKeyTypeParameterEC2 -> ShowS
Show, CoseKeyTypeParameterEC2
CoseKeyTypeParameterEC2
-> CoseKeyTypeParameterEC2 -> Bounded CoseKeyTypeParameterEC2
forall a. a -> a -> Bounded a
maxBound :: CoseKeyTypeParameterEC2
$cmaxBound :: CoseKeyTypeParameterEC2
minBound :: CoseKeyTypeParameterEC2
$cminBound :: CoseKeyTypeParameterEC2
Bounded, Int -> CoseKeyTypeParameterEC2
CoseKeyTypeParameterEC2 -> Int
CoseKeyTypeParameterEC2 -> [CoseKeyTypeParameterEC2]
CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2
CoseKeyTypeParameterEC2
-> CoseKeyTypeParameterEC2 -> [CoseKeyTypeParameterEC2]
CoseKeyTypeParameterEC2
-> CoseKeyTypeParameterEC2
-> CoseKeyTypeParameterEC2
-> [CoseKeyTypeParameterEC2]
(CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2)
-> (CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2)
-> (Int -> CoseKeyTypeParameterEC2)
-> (CoseKeyTypeParameterEC2 -> Int)
-> (CoseKeyTypeParameterEC2 -> [CoseKeyTypeParameterEC2])
-> (CoseKeyTypeParameterEC2
    -> CoseKeyTypeParameterEC2 -> [CoseKeyTypeParameterEC2])
-> (CoseKeyTypeParameterEC2
    -> CoseKeyTypeParameterEC2 -> [CoseKeyTypeParameterEC2])
-> (CoseKeyTypeParameterEC2
    -> CoseKeyTypeParameterEC2
    -> CoseKeyTypeParameterEC2
    -> [CoseKeyTypeParameterEC2])
-> Enum CoseKeyTypeParameterEC2
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CoseKeyTypeParameterEC2
-> CoseKeyTypeParameterEC2
-> CoseKeyTypeParameterEC2
-> [CoseKeyTypeParameterEC2]
$cenumFromThenTo :: CoseKeyTypeParameterEC2
-> CoseKeyTypeParameterEC2
-> CoseKeyTypeParameterEC2
-> [CoseKeyTypeParameterEC2]
enumFromTo :: CoseKeyTypeParameterEC2
-> CoseKeyTypeParameterEC2 -> [CoseKeyTypeParameterEC2]
$cenumFromTo :: CoseKeyTypeParameterEC2
-> CoseKeyTypeParameterEC2 -> [CoseKeyTypeParameterEC2]
enumFromThen :: CoseKeyTypeParameterEC2
-> CoseKeyTypeParameterEC2 -> [CoseKeyTypeParameterEC2]
$cenumFromThen :: CoseKeyTypeParameterEC2
-> CoseKeyTypeParameterEC2 -> [CoseKeyTypeParameterEC2]
enumFrom :: CoseKeyTypeParameterEC2 -> [CoseKeyTypeParameterEC2]
$cenumFrom :: CoseKeyTypeParameterEC2 -> [CoseKeyTypeParameterEC2]
fromEnum :: CoseKeyTypeParameterEC2 -> Int
$cfromEnum :: CoseKeyTypeParameterEC2 -> Int
toEnum :: Int -> CoseKeyTypeParameterEC2
$ctoEnum :: Int -> CoseKeyTypeParameterEC2
pred :: CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2
$cpred :: CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2
succ :: CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2
$csucc :: CoseKeyTypeParameterEC2 -> CoseKeyTypeParameterEC2
Enum)

-- | Serialises the parameters using the @Label@ column from the
-- [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)
instance Serialise CoseKeyTypeParameterEC2 where
  encode :: CoseKeyTypeParameterEC2 -> Encoding
encode CoseKeyTypeParameterEC2
CoseKeyTypeParameterEC2Crv = Int -> Encoding
encodeInt (-Int
1)
  encode CoseKeyTypeParameterEC2
CoseKeyTypeParameterEC2X = Int -> Encoding
encodeInt (-Int
2)
  encode CoseKeyTypeParameterEC2
CoseKeyTypeParameterEC2Y = Int -> Encoding
encodeInt (-Int
3)
  decode :: forall s. Decoder s CoseKeyTypeParameterEC2
decode =
    Decoder s Int
forall s. Decoder s Int
decodeIntCanonical Decoder s Int
-> (Int -> Decoder s CoseKeyTypeParameterEC2)
-> Decoder s CoseKeyTypeParameterEC2
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      -1 -> CoseKeyTypeParameterEC2 -> Decoder s CoseKeyTypeParameterEC2
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseKeyTypeParameterEC2
CoseKeyTypeParameterEC2Crv
      -2 -> CoseKeyTypeParameterEC2 -> Decoder s CoseKeyTypeParameterEC2
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseKeyTypeParameterEC2
CoseKeyTypeParameterEC2X
      -3 -> CoseKeyTypeParameterEC2 -> Decoder s CoseKeyTypeParameterEC2
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseKeyTypeParameterEC2
CoseKeyTypeParameterEC2Y
      Int
value -> String -> Decoder s CoseKeyTypeParameterEC2
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s CoseKeyTypeParameterEC2)
-> String -> Decoder s CoseKeyTypeParameterEC2
forall a b. (a -> b) -> a -> b
$ String
"Unknown COSE key type parameter " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
value String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for key type EC2"

-- | Elliptic curves for key type 'CoseKeyTypeEC2' from the
-- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves),
-- limited to the ones that are currently needed for Webauthn
data CoseEllipticCurveEC2
  = -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1)
    -- NIST P-256 also known as secp256r1
    CoseEllipticCurveEC2P256
  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1)
    -- NIST P-384 also known as secp384r1
    CoseEllipticCurveEC2P384
  | -- | [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1)
    -- NIST P-521 also known as secp521r1
    CoseEllipticCurveEC2P521
  deriving (CoseEllipticCurveEC2 -> CoseEllipticCurveEC2 -> Bool
(CoseEllipticCurveEC2 -> CoseEllipticCurveEC2 -> Bool)
-> (CoseEllipticCurveEC2 -> CoseEllipticCurveEC2 -> Bool)
-> Eq CoseEllipticCurveEC2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoseEllipticCurveEC2 -> CoseEllipticCurveEC2 -> Bool
$c/= :: CoseEllipticCurveEC2 -> CoseEllipticCurveEC2 -> Bool
== :: CoseEllipticCurveEC2 -> CoseEllipticCurveEC2 -> Bool
$c== :: CoseEllipticCurveEC2 -> CoseEllipticCurveEC2 -> Bool
Eq, Int -> CoseEllipticCurveEC2 -> ShowS
[CoseEllipticCurveEC2] -> ShowS
CoseEllipticCurveEC2 -> String
(Int -> CoseEllipticCurveEC2 -> ShowS)
-> (CoseEllipticCurveEC2 -> String)
-> ([CoseEllipticCurveEC2] -> ShowS)
-> Show CoseEllipticCurveEC2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoseEllipticCurveEC2] -> ShowS
$cshowList :: [CoseEllipticCurveEC2] -> ShowS
show :: CoseEllipticCurveEC2 -> String
$cshow :: CoseEllipticCurveEC2 -> String
showsPrec :: Int -> CoseEllipticCurveEC2 -> ShowS
$cshowsPrec :: Int -> CoseEllipticCurveEC2 -> ShowS
Show)

-- | Serialises COSE Elliptic Curves using the @Value@ column from the
-- [COSE Elliptic Curves registry](https://www.iana.org/assignments/cose/cose.xhtml#elliptic-curves).
instance Serialise CoseEllipticCurveEC2 where
  encode :: CoseEllipticCurveEC2 -> Encoding
encode CoseEllipticCurveEC2
CoseEllipticCurveEC2P256 = Int -> Encoding
encodeInt Int
1
  encode CoseEllipticCurveEC2
CoseEllipticCurveEC2P384 = Int -> Encoding
encodeInt Int
2
  encode CoseEllipticCurveEC2
CoseEllipticCurveEC2P521 = Int -> Encoding
encodeInt Int
3
  decode :: forall s. Decoder s CoseEllipticCurveEC2
decode =
    Decoder s Int
forall s. Decoder s Int
decodeIntCanonical Decoder s Int
-> (Int -> Decoder s CoseEllipticCurveEC2)
-> Decoder s CoseEllipticCurveEC2
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Int
1 -> CoseEllipticCurveEC2 -> Decoder s CoseEllipticCurveEC2
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseEllipticCurveEC2
CoseEllipticCurveEC2P256
      Int
2 -> CoseEllipticCurveEC2 -> Decoder s CoseEllipticCurveEC2
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseEllipticCurveEC2
CoseEllipticCurveEC2P384
      Int
3 -> CoseEllipticCurveEC2 -> Decoder s CoseEllipticCurveEC2
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseEllipticCurveEC2
CoseEllipticCurveEC2P521
      Int
value -> String -> Decoder s CoseEllipticCurveEC2
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s CoseEllipticCurveEC2)
-> String -> Decoder s CoseEllipticCurveEC2
forall a b. (a -> b) -> a -> b
$ String
"Unknown COSE elliptic curve " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
value String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for key type EC2"

-- | [(spec)](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)
-- All the entries from the [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)
-- for key type 'CoseKeyTypeRSA' (aka @Key Type@ is @3@) that are required for
-- public keys
data CoseKeyTypeParameterRSA
  = -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4)
    --
    -- * COSE value type: bstr
    -- * Description: the RSA modulus n
    --
    -- The RSA modulus n is a product of u distinct odd primes
    -- r_i, i = 1, 2, ..., u, where u >= 2
    --
    -- All numeric key parameters are encoded in an unsigned big-endian
    -- representation as an octet sequence using the CBOR byte string
    -- type (major type 2). The octet sequence MUST utilize the minimum
    -- number of octets needed to represent the value. For instance, the
    -- value 32,768 is represented as the CBOR byte sequence 0b010_00010,
    -- 0x80 0x00 (major type 2, additional information 2 for the length).
    CoseKeyTypeParameterRSAN
  | -- | [(spec)](https://www.rfc-editor.org/rfc/rfc8230.html#section-4)
    --
    -- * COSE value type: bstr
    -- * Description: the RSA public exponent e
    --
    -- The RSA public exponent e is an integer between 3 and n - 1 satisfying
    -- GCD(e,\lambda(n)) = 1, where \lambda(n) = LCM(r_1 - 1, ..., r_u - 1)
    --
    -- All numeric key parameters are encoded in an unsigned big-endian
    -- representation as an octet sequence using the CBOR byte string
    -- type (major type 2). The octet sequence MUST utilize the minimum
    -- number of octets needed to represent the value. For instance, the
    -- value 32,768 is represented as the CBOR byte sequence 0b010_00010,
    -- 0x80 0x00 (major type 2, additional information 2 for the length).
    CoseKeyTypeParameterRSAE
  deriving (CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA -> Bool
(CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA -> Bool)
-> (CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA -> Bool)
-> Eq CoseKeyTypeParameterRSA
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA -> Bool
$c/= :: CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA -> Bool
== :: CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA -> Bool
$c== :: CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA -> Bool
Eq, Int -> CoseKeyTypeParameterRSA -> ShowS
[CoseKeyTypeParameterRSA] -> ShowS
CoseKeyTypeParameterRSA -> String
(Int -> CoseKeyTypeParameterRSA -> ShowS)
-> (CoseKeyTypeParameterRSA -> String)
-> ([CoseKeyTypeParameterRSA] -> ShowS)
-> Show CoseKeyTypeParameterRSA
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoseKeyTypeParameterRSA] -> ShowS
$cshowList :: [CoseKeyTypeParameterRSA] -> ShowS
show :: CoseKeyTypeParameterRSA -> String
$cshow :: CoseKeyTypeParameterRSA -> String
showsPrec :: Int -> CoseKeyTypeParameterRSA -> ShowS
$cshowsPrec :: Int -> CoseKeyTypeParameterRSA -> ShowS
Show, CoseKeyTypeParameterRSA
CoseKeyTypeParameterRSA
-> CoseKeyTypeParameterRSA -> Bounded CoseKeyTypeParameterRSA
forall a. a -> a -> Bounded a
maxBound :: CoseKeyTypeParameterRSA
$cmaxBound :: CoseKeyTypeParameterRSA
minBound :: CoseKeyTypeParameterRSA
$cminBound :: CoseKeyTypeParameterRSA
Bounded, Int -> CoseKeyTypeParameterRSA
CoseKeyTypeParameterRSA -> Int
CoseKeyTypeParameterRSA -> [CoseKeyTypeParameterRSA]
CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA
CoseKeyTypeParameterRSA
-> CoseKeyTypeParameterRSA -> [CoseKeyTypeParameterRSA]
CoseKeyTypeParameterRSA
-> CoseKeyTypeParameterRSA
-> CoseKeyTypeParameterRSA
-> [CoseKeyTypeParameterRSA]
(CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA)
-> (CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA)
-> (Int -> CoseKeyTypeParameterRSA)
-> (CoseKeyTypeParameterRSA -> Int)
-> (CoseKeyTypeParameterRSA -> [CoseKeyTypeParameterRSA])
-> (CoseKeyTypeParameterRSA
    -> CoseKeyTypeParameterRSA -> [CoseKeyTypeParameterRSA])
-> (CoseKeyTypeParameterRSA
    -> CoseKeyTypeParameterRSA -> [CoseKeyTypeParameterRSA])
-> (CoseKeyTypeParameterRSA
    -> CoseKeyTypeParameterRSA
    -> CoseKeyTypeParameterRSA
    -> [CoseKeyTypeParameterRSA])
-> Enum CoseKeyTypeParameterRSA
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CoseKeyTypeParameterRSA
-> CoseKeyTypeParameterRSA
-> CoseKeyTypeParameterRSA
-> [CoseKeyTypeParameterRSA]
$cenumFromThenTo :: CoseKeyTypeParameterRSA
-> CoseKeyTypeParameterRSA
-> CoseKeyTypeParameterRSA
-> [CoseKeyTypeParameterRSA]
enumFromTo :: CoseKeyTypeParameterRSA
-> CoseKeyTypeParameterRSA -> [CoseKeyTypeParameterRSA]
$cenumFromTo :: CoseKeyTypeParameterRSA
-> CoseKeyTypeParameterRSA -> [CoseKeyTypeParameterRSA]
enumFromThen :: CoseKeyTypeParameterRSA
-> CoseKeyTypeParameterRSA -> [CoseKeyTypeParameterRSA]
$cenumFromThen :: CoseKeyTypeParameterRSA
-> CoseKeyTypeParameterRSA -> [CoseKeyTypeParameterRSA]
enumFrom :: CoseKeyTypeParameterRSA -> [CoseKeyTypeParameterRSA]
$cenumFrom :: CoseKeyTypeParameterRSA -> [CoseKeyTypeParameterRSA]
fromEnum :: CoseKeyTypeParameterRSA -> Int
$cfromEnum :: CoseKeyTypeParameterRSA -> Int
toEnum :: Int -> CoseKeyTypeParameterRSA
$ctoEnum :: Int -> CoseKeyTypeParameterRSA
pred :: CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA
$cpred :: CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA
succ :: CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA
$csucc :: CoseKeyTypeParameterRSA -> CoseKeyTypeParameterRSA
Enum)

-- | Serialises the parameters using the @Label@ column from the
-- [COSE Key Type Parameters registry](https://www.iana.org/assignments/cose/cose.xhtml#key-type-parameters)
instance Serialise CoseKeyTypeParameterRSA where
  encode :: CoseKeyTypeParameterRSA -> Encoding
encode CoseKeyTypeParameterRSA
CoseKeyTypeParameterRSAN = Int -> Encoding
encodeInt (-Int
1)
  encode CoseKeyTypeParameterRSA
CoseKeyTypeParameterRSAE = Int -> Encoding
encodeInt (-Int
2)
  decode :: forall s. Decoder s CoseKeyTypeParameterRSA
decode =
    Decoder s Int
forall s. Decoder s Int
decodeIntCanonical Decoder s Int
-> (Int -> Decoder s CoseKeyTypeParameterRSA)
-> Decoder s CoseKeyTypeParameterRSA
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      -1 -> CoseKeyTypeParameterRSA -> Decoder s CoseKeyTypeParameterRSA
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseKeyTypeParameterRSA
CoseKeyTypeParameterRSAN
      -2 -> CoseKeyTypeParameterRSA -> Decoder s CoseKeyTypeParameterRSA
forall (f :: * -> *) a. Applicative f => a -> f a
pure CoseKeyTypeParameterRSA
CoseKeyTypeParameterRSAE
      Int
value -> String -> Decoder s CoseKeyTypeParameterRSA
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s CoseKeyTypeParameterRSA)
-> String -> Decoder s CoseKeyTypeParameterRSA
forall a b. (a -> b) -> a -> b
$ String
"Unknown COSE key type parameter " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
value String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for key type RSA"

-- | The number of parameters for a 'CoseKeyType' relevant for Webauthn public
-- keys
parameterCount :: CoseKeyType -> Word
parameterCount :: CoseKeyType -> Word
parameterCount CoseKeyType
CoseKeyTypeOKP = forall a b. (Bounded a, Enum a, Num b) => b
cardinality @CoseKeyCommonParameter Word -> Word -> Word
forall a. Num a => a -> a -> a
+ forall a b. (Bounded a, Enum a, Num b) => b
cardinality @CoseKeyTypeParameterOKP
parameterCount CoseKeyType
CoseKeyTypeEC2 = forall a b. (Bounded a, Enum a, Num b) => b
cardinality @CoseKeyCommonParameter Word -> Word -> Word
forall a. Num a => a -> a -> a
+ forall a b. (Bounded a, Enum a, Num b) => b
cardinality @CoseKeyTypeParameterEC2
parameterCount CoseKeyType
CoseKeyTypeRSA = forall a b. (Bounded a, Enum a, Num b) => b
cardinality @CoseKeyCommonParameter Word -> Word -> Word
forall a. Num a => a -> a -> a
+ forall a b. (Bounded a, Enum a, Num b) => b
cardinality @CoseKeyTypeParameterRSA

-- | A utility function for getting the number of constructors for a type
-- that implements both 'Bounded' and 'Enum'
cardinality :: forall a b. (Bounded a, Enum a, Num b) => b
cardinality :: forall a b. (Bounded a, Enum a, Num b) => b
cardinality = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ forall a. Enum a => a -> Int
fromEnum @a a
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- forall a. Enum a => a -> Int
fromEnum @a a
forall a. Bounded a => a
minBound