{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- | Stability: experimental
-- This module contains a partial implementation of the
-- [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7) format,
-- limited to what is needed for Webauthn, and in a structured way.
module Crypto.WebAuthn.Cose.PublicKeyWithSignAlg
  ( -- * COSE public Key
    PublicKeyWithSignAlg (PublicKeyWithSignAlg, Crypto.WebAuthn.Cose.PublicKeyWithSignAlg.publicKey, signAlg),
    CosePublicKey,
    makePublicKeyWithSignAlg,
    Message (..),
    Signature (..),
  )
where

import Codec.CBOR.Decoding (Decoder, TokenType (TypeBool, TypeBytes), decodeBytesCanonical, decodeMapLenCanonical, peekTokenType)
import Codec.CBOR.Encoding (Encoding, encodeBytes, encodeMapLen)
import Codec.Serialise (Serialise (decode, encode))
import Control.Monad (unless)
import Crypto.Number.Serialize (i2osp, i2ospOf_, os2ip)
import qualified Crypto.WebAuthn.Cose.Internal.Registry as R
import qualified Crypto.WebAuthn.Cose.PublicKey as P
import qualified Crypto.WebAuthn.Cose.SignAlg as A
import Crypto.WebAuthn.Internal.ToJSONOrphans (PrettyHexByteString (PrettyHexByteString))
import Data.Aeson (ToJSON)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as BS
import Data.Functor (($>))
import Data.Text (Text)
import qualified Data.Text as Text
import GHC.Generics (Generic)

-- | A combination of a t'P.PublicKey' holding the public key data and a
-- 'A.CoseSignAlg' holding the exact signature algorithm that should be used.
-- This type can only be constructed with 'makePublicKeyWithSignAlg', which
-- ensures that the signature scheme matches between 'P.PublicKey' and
-- 'A.CoseSignAlg'. This type is equivalent to a COSE public key, which holds
-- the same information, see 'CosePublicKey'
data PublicKeyWithSignAlg = PublicKeyWithSignAlgInternal
  { PublicKeyWithSignAlg -> PublicKey
publicKeyInternal :: P.PublicKey,
    PublicKeyWithSignAlg -> CoseSignAlg
signAlgInternal :: A.CoseSignAlg
    -- TODO: Consider adding a RawField here to replace
    -- acdCredentialPublicKeyBytes. This would then require parametrizing
    -- 'PublicKeyWithSignAlg' with 'raw :: Bool'
  }
  deriving (PublicKeyWithSignAlg -> PublicKeyWithSignAlg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicKeyWithSignAlg -> PublicKeyWithSignAlg -> Bool
$c/= :: PublicKeyWithSignAlg -> PublicKeyWithSignAlg -> Bool
== :: PublicKeyWithSignAlg -> PublicKeyWithSignAlg -> Bool
$c== :: PublicKeyWithSignAlg -> PublicKeyWithSignAlg -> Bool
Eq, Int -> PublicKeyWithSignAlg -> ShowS
[PublicKeyWithSignAlg] -> ShowS
PublicKeyWithSignAlg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicKeyWithSignAlg] -> ShowS
$cshowList :: [PublicKeyWithSignAlg] -> ShowS
show :: PublicKeyWithSignAlg -> String
$cshow :: PublicKeyWithSignAlg -> String
showsPrec :: Int -> PublicKeyWithSignAlg -> ShowS
$cshowsPrec :: Int -> PublicKeyWithSignAlg -> ShowS
Show, forall x. Rep PublicKeyWithSignAlg x -> PublicKeyWithSignAlg
forall x. PublicKeyWithSignAlg -> Rep PublicKeyWithSignAlg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PublicKeyWithSignAlg x -> PublicKeyWithSignAlg
$cfrom :: forall x. PublicKeyWithSignAlg -> Rep PublicKeyWithSignAlg x
Generic)

-- | An arbitrary and potentially unstable JSON encoding, only intended for
-- logging purposes. To actually encode and decode structures, use the
-- "Crypto.WebAuthn.Encoding" modules
deriving instance Aeson.ToJSON PublicKeyWithSignAlg

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#credentialpublickey)
-- A structured and checked representation of a
-- [COSE_Key](https://datatracker.ietf.org/doc/html/rfc8152#section-7), limited
-- to what is know to be necessary for Webauthn public keys for the
-- [credentialPublicKey](https://www.w3.org/TR/webauthn-2/#credentialpublickey)
-- field.
type CosePublicKey = PublicKeyWithSignAlg

-- | A wrapper for the bytes of a message that should be verified.
-- This is used for both assertion and assertion.
newtype Message = Message {Message -> ByteString
unMessage :: BS.ByteString}
  deriving newtype (Message -> Message -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show)
  deriving ([Message] -> Encoding
[Message] -> Value
Message -> Encoding
Message -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Message] -> Encoding
$ctoEncodingList :: [Message] -> Encoding
toJSONList :: [Message] -> Value
$ctoJSONList :: [Message] -> Value
toEncoding :: Message -> Encoding
$ctoEncoding :: Message -> Encoding
toJSON :: Message -> Value
$ctoJSON :: Message -> Value
ToJSON) via PrettyHexByteString

-- | [(spec)](https://www.w3.org/TR/webauthn-2/#sctn-signature-attestation-types)
-- A wrapper for the bytes of a signature that can be used to verify a 'Message'.
-- The encoding is specific to webauthn and depends on the 'A.CoseSignAlg' used.
newtype Signature = Signature {Signature -> ByteString
unSignature :: BS.ByteString}
  deriving newtype (Signature -> Signature -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c== :: Signature -> Signature -> Bool
Eq, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signature] -> ShowS
$cshowList :: [Signature] -> ShowS
show :: Signature -> String
$cshow :: Signature -> String
showsPrec :: Int -> Signature -> ShowS
$cshowsPrec :: Int -> Signature -> ShowS
Show)
  deriving ([Signature] -> Encoding
[Signature] -> Value
Signature -> Encoding
Signature -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Signature] -> Encoding
$ctoEncodingList :: [Signature] -> Encoding
toJSONList :: [Signature] -> Value
$ctoJSONList :: [Signature] -> Value
toEncoding :: Signature -> Encoding
$ctoEncoding :: Signature -> Encoding
toJSON :: Signature -> Value
$ctoJSON :: Signature -> Value
ToJSON) via PrettyHexByteString

-- | Deconstructs a 'makePublicKeyWithSignAlg' into its t'P.PublicKey' and
-- 'A.CoseSignAlg'. Since t'PublicKeyWithSignAlg' can only be constructed
-- using 'makePublicKeyWithSignAlg', we can be sure that the signature scheme
-- of t'P.PublicKey' and 'A.CoseSignAlg' matches.
pattern PublicKeyWithSignAlg :: P.PublicKey -> A.CoseSignAlg -> PublicKeyWithSignAlg
pattern $mPublicKeyWithSignAlg :: forall {r}.
PublicKeyWithSignAlg
-> (PublicKey -> CoseSignAlg -> r) -> ((# #) -> r) -> r
PublicKeyWithSignAlg {PublicKeyWithSignAlg -> PublicKey
publicKey, PublicKeyWithSignAlg -> CoseSignAlg
signAlg} <- PublicKeyWithSignAlgInternal {publicKeyInternal = publicKey, signAlgInternal = signAlg}

{-# COMPLETE PublicKeyWithSignAlg #-}

-- | Constructs a t'PublicKeyWithSignAlg' from a t'P.PublicKey' and
-- 'A.CoseSignAlg', returning an error if the signature schemes between these
-- two types don't match.
makePublicKeyWithSignAlg :: P.PublicKey -> A.CoseSignAlg -> Either Text PublicKeyWithSignAlg
makePublicKeyWithSignAlg :: PublicKey -> CoseSignAlg -> Either Text PublicKeyWithSignAlg
makePublicKeyWithSignAlg key :: PublicKey
key@(P.PublicKey UncheckedPublicKey
k) CoseSignAlg
alg =
  UncheckedPublicKey -> CoseSignAlg -> Either Text ()
verifyValid UncheckedPublicKey
k CoseSignAlg
alg
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> PublicKeyWithSignAlgInternal
      { publicKeyInternal :: PublicKey
publicKeyInternal = PublicKey
key,
        signAlgInternal :: CoseSignAlg
signAlgInternal = CoseSignAlg
alg
      }
  where
    verifyValid :: P.UncheckedPublicKey -> A.CoseSignAlg -> Either Text ()
    verifyValid :: UncheckedPublicKey -> CoseSignAlg -> Either Text ()
verifyValid P.PublicKeyEdDSA {} CoseSignAlg
A.CoseSignAlgEdDSA = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    verifyValid P.PublicKeyEdDSA {} CoseSignAlg
alg = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"EdDSA public key cannot be used with signing algorithm " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show CoseSignAlg
alg)
    verifyValid P.PublicKeyECDSA {} A.CoseSignAlgECDSA {} = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    verifyValid P.PublicKeyECDSA {} CoseSignAlg
alg = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"ECDSA public key cannot be used with signing algorithm " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show CoseSignAlg
alg)
    verifyValid P.PublicKeyRSA {} A.CoseSignAlgRSA {} = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    verifyValid P.PublicKeyRSA {} CoseSignAlg
alg = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"RSA public key cannot be used with signing algorithm " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show CoseSignAlg
alg)

-- | CBOR encoding as a [COSE_Key](https://tools.ietf.org/html/rfc8152#section-7)
-- using the [CTAP2 canonical CBOR encoding form](https://fidoalliance.org/specs/fido-v2.0-ps-20190130/fido-client-to-authenticator-protocol-v2.0-ps-20190130.html#ctap2-canonical-cbor-encoding-form)
instance Serialise CosePublicKey where
  encode :: PublicKeyWithSignAlg -> Encoding
encode PublicKeyWithSignAlg {CoseSignAlg
PublicKey
signAlg :: CoseSignAlg
publicKey :: PublicKey
signAlg :: PublicKeyWithSignAlg -> CoseSignAlg
publicKey :: PublicKeyWithSignAlg -> PublicKey
..} = case PublicKey
publicKey of
    P.PublicKey P.PublicKeyEdDSA {CoseCurveEdDSA
EdDSAKeyBytes
eddsaX :: UncheckedPublicKey -> EdDSAKeyBytes
eddsaCurve :: UncheckedPublicKey -> CoseCurveEdDSA
eddsaX :: EdDSAKeyBytes
eddsaCurve :: CoseCurveEdDSA
..} ->
      CoseKeyType -> Encoding
common CoseKeyType
R.CoseKeyTypeOKP
        forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterOKP
R.CoseKeyTypeParameterOKPCrv
        forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode (CoseCurveEdDSA -> CoseEllipticCurveOKP
fromCurveEdDSA CoseCurveEdDSA
eddsaCurve)
        forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterOKP
R.CoseKeyTypeParameterOKPX
        forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBytes (EdDSAKeyBytes -> ByteString
P.unEdDSAKeyBytes EdDSAKeyBytes
eddsaX)
    P.PublicKey P.PublicKeyECDSA {Integer
CoseCurveECDSA
ecdsaY :: UncheckedPublicKey -> Integer
ecdsaX :: UncheckedPublicKey -> Integer
ecdsaCurve :: UncheckedPublicKey -> CoseCurveECDSA
ecdsaY :: Integer
ecdsaX :: Integer
ecdsaCurve :: CoseCurveECDSA
..} ->
      CoseKeyType -> Encoding
common CoseKeyType
R.CoseKeyTypeEC2
        forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2Crv
        forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode (CoseCurveECDSA -> CoseEllipticCurveEC2
fromCurveECDSA CoseCurveECDSA
ecdsaCurve)
        -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1
        -- > Leading zero octets MUST be preserved.
        forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2X
        -- This version of i2ospOf_ throws if the bytestring is larger than
        -- size, but this can't happen due to the PublicKey invariants
        forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBytes (forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
size Integer
ecdsaX)
        forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2Y
        forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBytes (forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
size Integer
ecdsaY)
      where
        size :: Int
size = CoseCurveECDSA -> Int
P.coordinateSizeECDSA CoseCurveECDSA
ecdsaCurve
    P.PublicKey P.PublicKeyRSA {Integer
rsaE :: UncheckedPublicKey -> Integer
rsaN :: UncheckedPublicKey -> Integer
rsaE :: Integer
rsaN :: Integer
..} ->
      CoseKeyType -> Encoding
common CoseKeyType
R.CoseKeyTypeRSA
        -- https://www.rfc-editor.org/rfc/rfc8230.html#section-4
        -- > The octet sequence MUST utilize the minimum
        -- number of octets needed to represent the value.
        forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterRSA
R.CoseKeyTypeParameterRSAN
        forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBytes (forall ba. ByteArray ba => Integer -> ba
i2osp Integer
rsaN)
        forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterRSA
R.CoseKeyTypeParameterRSAE
        forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBytes (forall ba. ByteArray ba => Integer -> ba
i2osp Integer
rsaE)
    where
      common :: R.CoseKeyType -> Encoding
      common :: CoseKeyType -> Encoding
common CoseKeyType
kty =
        Word -> Encoding
encodeMapLen (CoseKeyType -> Word
R.parameterCount CoseKeyType
kty)
          forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode CoseKeyCommonParameter
R.CoseKeyCommonParameterKty
          forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode CoseKeyType
kty
          forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode CoseKeyCommonParameter
R.CoseKeyCommonParameterAlg
          forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode CoseSignAlg
signAlg

  -- NOTE: CBOR itself doesn't give an ordering of map keys, but the CTAP2 canonical CBOR encoding form does:
  -- > The keys in every map must be sorted lowest value to highest. The sorting rules are:
  -- >
  -- > * If the major types are different, the one with the lower value in numerical order sorts earlier.
  -- > * If two keys have different lengths, the shorter one sorts earlier;
  -- > * If two keys have the same length, the one with the lower value in (byte-wise) lexical order sorts earlier.
  --
  -- This has the effect that numeric keys are sorted like 1, 2, 3, ..., -1, -2, -3, ...
  -- Which aligns very nicely with the fact that common parameters use positive
  -- values and can therefore be decoded first, while key type specific
  -- parameters use negative values
  decode :: forall s. Decoder s PublicKeyWithSignAlg
decode = do
    Word
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Int
decodeMapLenCanonical
    -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1
    -- This parameter MUST be present in a key object.
    forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyCommonParameter
R.CoseKeyCommonParameterKty
    CoseKeyType
kty <- forall a s. Serialise a => Decoder s a
decode
    -- https://www.w3.org/TR/webauthn-2/#credentialpublickey
    -- The COSE_Key-encoded credential public key MUST contain the "alg"
    -- parameter and MUST NOT contain any other OPTIONAL parameters.
    forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyCommonParameter
R.CoseKeyCommonParameterAlg
    CoseSignAlg
alg <- forall a s. Serialise a => Decoder s a
decode

    UncheckedPublicKey
uncheckedKey <- forall s.
Word -> CoseKeyType -> CoseSignAlg -> Decoder s UncheckedPublicKey
decodeKey Word
n CoseKeyType
kty CoseSignAlg
alg
    case UncheckedPublicKey -> Either Text PublicKey
P.checkPublicKey UncheckedPublicKey
uncheckedKey of
      Left Text
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Key check failed: " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
err
      Right PublicKey
result ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
          PublicKeyWithSignAlgInternal
            { publicKeyInternal :: PublicKey
publicKeyInternal = PublicKey
result,
              signAlgInternal :: CoseSignAlg
signAlgInternal = CoseSignAlg
alg
            }
    where
      decodeKey :: Word -> R.CoseKeyType -> A.CoseSignAlg -> Decoder s P.UncheckedPublicKey
      decodeKey :: forall s.
Word -> CoseKeyType -> CoseSignAlg -> Decoder s UncheckedPublicKey
decodeKey Word
n CoseKeyType
kty CoseSignAlg
alg = case CoseSignAlg
alg of
        CoseSignAlg
A.CoseSignAlgEdDSA -> forall s. Decoder s UncheckedPublicKey
decodeEdDSAKey
        A.CoseSignAlgECDSA CoseHashAlgECDSA
_ -> forall s. Decoder s UncheckedPublicKey
decodeECDSAKey
        A.CoseSignAlgRSA CoseHashAlgRSA
_ -> forall s. Decoder s UncheckedPublicKey
decodeRSAKey
        where
          -- [(spec)](https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-struct-15#section-7.1)
          -- Implementations MUST verify that the key type is appropriate for
          -- the algorithm being processed.
          checkKty :: R.CoseKeyType -> Decoder s ()
          checkKty :: forall s. CoseKeyType -> Decoder s ()
checkKty CoseKeyType
expectedKty = do
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CoseKeyType
expectedKty forall a. Eq a => a -> a -> Bool
== CoseKeyType
kty) forall a b. (a -> b) -> a -> b
$
              forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
                String
"Expected COSE key type "
                  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show CoseKeyType
expectedKty
                  forall a. Semigroup a => a -> a -> a
<> String
" for COSE algorithm "
                  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show CoseSignAlg
alg
                  forall a. Semigroup a => a -> a -> a
<> String
" but got COSE key type "
                  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show CoseKeyType
kty
                  forall a. Semigroup a => a -> a -> a
<> String
" instead"
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CoseKeyType -> Word
R.parameterCount CoseKeyType
kty forall a. Eq a => a -> a -> Bool
== Word
n) forall a b. (a -> b) -> a -> b
$
              forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
                String
"Expected CBOR map to contain "
                  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (CoseKeyType -> Word
R.parameterCount CoseKeyType
kty)
                  forall a. Semigroup a => a -> a -> a
<> String
" parameters for COSE key type "
                  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show CoseKeyType
kty
                  forall a. Semigroup a => a -> a -> a
<> String
" but got "
                  forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Word
n
                  forall a. Semigroup a => a -> a -> a
<> String
" parameters instead"

          decodeEdDSAKey :: Decoder s P.UncheckedPublicKey
          decodeEdDSAKey :: forall s. Decoder s UncheckedPublicKey
decodeEdDSAKey = do
            -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.2
            -- > The 'kty' field MUST be present, and it MUST be 'OKP' (Octet Key Pair).
            forall s. CoseKeyType -> Decoder s ()
checkKty CoseKeyType
R.CoseKeyTypeOKP
            -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.2
            forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterOKP
R.CoseKeyTypeParameterOKPCrv
            CoseCurveEdDSA
eddsaCurve <- CoseEllipticCurveOKP -> CoseCurveEdDSA
toCurveEdDSA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. Serialise a => Decoder s a
decode
            forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterOKP
R.CoseKeyTypeParameterOKPX
            EdDSAKeyBytes
eddsaX <- ByteString -> EdDSAKeyBytes
P.EdDSAKeyBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s ByteString
decodeBytesCanonical
            forall (f :: * -> *) a. Applicative f => a -> f a
pure P.PublicKeyEdDSA {CoseCurveEdDSA
EdDSAKeyBytes
eddsaX :: EdDSAKeyBytes
eddsaCurve :: CoseCurveEdDSA
eddsaX :: EdDSAKeyBytes
eddsaCurve :: CoseCurveEdDSA
..}

          decodeECDSAKey :: Decoder s P.UncheckedPublicKey
          decodeECDSAKey :: forall s. Decoder s UncheckedPublicKey
decodeECDSAKey = do
            -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-2.1
            -- > The 'kty' field MUST be present, and it MUST be 'EC2'.
            forall s. CoseKeyType -> Decoder s ()
checkKty CoseKeyType
R.CoseKeyTypeEC2
            -- https://datatracker.ietf.org/doc/html/draft-ietf-cose-rfc8152bis-algs-12#section-7.1.1
            forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2Crv
            CoseCurveECDSA
ecdsaCurve <- CoseEllipticCurveEC2 -> CoseCurveECDSA
toCurveECDSA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. Serialise a => Decoder s a
decode
            let size :: Int
size = CoseCurveECDSA -> Int
P.coordinateSizeECDSA CoseCurveECDSA
ecdsaCurve
            forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2X
            Integer
ecdsaX <- forall (m :: * -> *). MonadFail m => Int -> ByteString -> m Integer
os2ipWithSize Int
size forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Decoder s ByteString
decodeBytesCanonical

            forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2Y
            Integer
ecdsaY <-
              forall s. Decoder s TokenType
peekTokenType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                TokenType
TypeBytes -> forall (m :: * -> *). MonadFail m => Int -> ByteString -> m Integer
os2ipWithSize Int
size forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Decoder s ByteString
decodeBytesCanonical
                TokenType
TypeBool -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Compressed EC2 y coordinate not yet supported"
                TokenType
typ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unexpected type in EC2 y parameter: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TokenType
typ

            forall (f :: * -> *) a. Applicative f => a -> f a
pure P.PublicKeyECDSA {Integer
CoseCurveECDSA
ecdsaY :: Integer
ecdsaX :: Integer
ecdsaCurve :: CoseCurveECDSA
ecdsaY :: Integer
ecdsaX :: Integer
ecdsaCurve :: CoseCurveECDSA
..}

          decodeRSAKey :: Decoder s P.UncheckedPublicKey
          decodeRSAKey :: forall s. Decoder s UncheckedPublicKey
decodeRSAKey = do
            -- https://www.rfc-editor.org/rfc/rfc8812.html#section-2
            -- > Implementations need to check that the key type is 'RSA' when creating or verifying a signature.
            forall s. CoseKeyType -> Decoder s ()
checkKty CoseKeyType
R.CoseKeyTypeRSA
            -- https://www.rfc-editor.org/rfc/rfc8230.html#section-4
            forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterRSA
R.CoseKeyTypeParameterRSAN
            -- > The octet sequence MUST utilize the minimum number of octets needed to represent the value.
            Integer
rsaN <- forall (m :: * -> *). MonadFail m => ByteString -> m Integer
os2ipNoLeading forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Decoder s ByteString
decodeBytesCanonical
            forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterRSA
R.CoseKeyTypeParameterRSAE
            Integer
rsaE <- forall (m :: * -> *). MonadFail m => ByteString -> m Integer
os2ipNoLeading forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. Decoder s ByteString
decodeBytesCanonical
            forall (f :: * -> *) a. Applicative f => a -> f a
pure P.PublicKeyRSA {Integer
rsaE :: Integer
rsaN :: Integer
rsaE :: Integer
rsaN :: Integer
..}

-- | Same as 'os2ip', but throws an error if there are not exactly as many bytes as expected. Thus any successful result of this function will give the same 'BS.ByteString' back if encoded with @'i2ospOf_' size@.
os2ipWithSize :: MonadFail m => Int -> BS.ByteString -> m Integer
os2ipWithSize :: forall (m :: * -> *). MonadFail m => Int -> ByteString -> m Integer
os2ipWithSize Int
size ByteString
bytes
  | ByteString -> Int
BS.length ByteString
bytes forall a. Eq a => a -> a -> Bool
== Int
size = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bytes
  | Bool
otherwise =
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
        String
"bytes have length "
          forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bytes)
          forall a. Semigroup a => a -> a -> a
<> String
" when length "
          forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
size
          forall a. Semigroup a => a -> a -> a
<> String
" was expected"

-- | Same as 'os2ip', but throws an error if there are leading zero bytes. Thus any successful result of this function will give the same 'BS.ByteString' back if encoded with 'i2osp'.
os2ipNoLeading :: MonadFail m => BS.ByteString -> m Integer
os2ipNoLeading :: forall (m :: * -> *). MonadFail m => ByteString -> m Integer
os2ipNoLeading ByteString
bytes
  | Int
leadingZeroCount forall a. Eq a => a -> a -> Bool
== Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bytes
  | Bool
otherwise =
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
        String
"bytes of length "
          forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bytes)
          forall a. Semigroup a => a -> a -> a
<> String
" has "
          forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
leadingZeroCount
          forall a. Semigroup a => a -> a -> a
<> String
" leading zero bytes when none were expected"
  where
    leadingZeroCount :: Int
leadingZeroCount = ByteString -> Int
BS.length ((Word8 -> Bool) -> ByteString -> ByteString
BS.takeWhile (forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bytes)

-- | Decode a value and ensure it's the same as the value that was given
decodeExpected :: (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected :: forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected a
expected = do
  a
actual <- forall a s. Serialise a => Decoder s a
decode
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
expected forall a. Eq a => a -> a -> Bool
== a
actual) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
      String
"Expected " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
expected forall a. Semigroup a => a -> a -> a
<> String
" but got " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
actual

fromCurveEdDSA :: P.CoseCurveEdDSA -> R.CoseEllipticCurveOKP
fromCurveEdDSA :: CoseCurveEdDSA -> CoseEllipticCurveOKP
fromCurveEdDSA CoseCurveEdDSA
P.CoseCurveEd25519 = CoseEllipticCurveOKP
R.CoseEllipticCurveEd25519

toCurveEdDSA :: R.CoseEllipticCurveOKP -> P.CoseCurveEdDSA
toCurveEdDSA :: CoseEllipticCurveOKP -> CoseCurveEdDSA
toCurveEdDSA CoseEllipticCurveOKP
R.CoseEllipticCurveEd25519 = CoseCurveEdDSA
P.CoseCurveEd25519

fromCurveECDSA :: P.CoseCurveECDSA -> R.CoseEllipticCurveEC2
fromCurveECDSA :: CoseCurveECDSA -> CoseEllipticCurveEC2
fromCurveECDSA CoseCurveECDSA
P.CoseCurveP256 = CoseEllipticCurveEC2
R.CoseEllipticCurveEC2P256
fromCurveECDSA CoseCurveECDSA
P.CoseCurveP384 = CoseEllipticCurveEC2
R.CoseEllipticCurveEC2P384
fromCurveECDSA CoseCurveECDSA
P.CoseCurveP521 = CoseEllipticCurveEC2
R.CoseEllipticCurveEC2P521

toCurveECDSA :: R.CoseEllipticCurveEC2 -> P.CoseCurveECDSA
toCurveECDSA :: CoseEllipticCurveEC2 -> CoseCurveECDSA
toCurveECDSA CoseEllipticCurveEC2
R.CoseEllipticCurveEC2P256 = CoseCurveECDSA
P.CoseCurveP256
toCurveECDSA CoseEllipticCurveEC2
R.CoseEllipticCurveEC2P384 = CoseCurveECDSA
P.CoseCurveP384
toCurveECDSA CoseEllipticCurveEC2
R.CoseEllipticCurveEC2P521 = CoseCurveECDSA
P.CoseCurveP521