{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Crypto.WebAuthn.Cose.PublicKeyWithSignAlg
(
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)
data PublicKeyWithSignAlg = PublicKeyWithSignAlgInternal
{ PublicKeyWithSignAlg -> PublicKey
publicKeyInternal :: P.PublicKey,
PublicKeyWithSignAlg -> CoseSignAlg
signAlgInternal :: A.CoseSignAlg
}
deriving (PublicKeyWithSignAlg -> PublicKeyWithSignAlg -> Bool
(PublicKeyWithSignAlg -> PublicKeyWithSignAlg -> Bool)
-> (PublicKeyWithSignAlg -> PublicKeyWithSignAlg -> Bool)
-> Eq PublicKeyWithSignAlg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKeyWithSignAlg -> PublicKeyWithSignAlg -> Bool
== :: PublicKeyWithSignAlg -> PublicKeyWithSignAlg -> Bool
$c/= :: PublicKeyWithSignAlg -> PublicKeyWithSignAlg -> Bool
/= :: PublicKeyWithSignAlg -> PublicKeyWithSignAlg -> Bool
Eq, Int -> PublicKeyWithSignAlg -> ShowS
[PublicKeyWithSignAlg] -> ShowS
PublicKeyWithSignAlg -> String
(Int -> PublicKeyWithSignAlg -> ShowS)
-> (PublicKeyWithSignAlg -> String)
-> ([PublicKeyWithSignAlg] -> ShowS)
-> Show PublicKeyWithSignAlg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicKeyWithSignAlg -> ShowS
showsPrec :: Int -> PublicKeyWithSignAlg -> ShowS
$cshow :: PublicKeyWithSignAlg -> String
show :: PublicKeyWithSignAlg -> String
$cshowList :: [PublicKeyWithSignAlg] -> ShowS
showList :: [PublicKeyWithSignAlg] -> ShowS
Show, (forall x. PublicKeyWithSignAlg -> Rep PublicKeyWithSignAlg x)
-> (forall x. Rep PublicKeyWithSignAlg x -> PublicKeyWithSignAlg)
-> Generic PublicKeyWithSignAlg
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
$cfrom :: forall x. PublicKeyWithSignAlg -> Rep PublicKeyWithSignAlg x
from :: forall x. PublicKeyWithSignAlg -> Rep PublicKeyWithSignAlg x
$cto :: forall x. Rep PublicKeyWithSignAlg x -> PublicKeyWithSignAlg
to :: forall x. Rep PublicKeyWithSignAlg x -> PublicKeyWithSignAlg
Generic)
deriving instance Aeson.ToJSON PublicKeyWithSignAlg
type CosePublicKey = PublicKeyWithSignAlg
newtype Message = Message {Message -> ByteString
unMessage :: BS.ByteString}
deriving newtype (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
/= :: Message -> Message -> Bool
Eq, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Message -> ShowS
showsPrec :: Int -> Message -> ShowS
$cshow :: Message -> String
show :: Message -> String
$cshowList :: [Message] -> ShowS
showList :: [Message] -> ShowS
Show)
deriving ([Message] -> Value
[Message] -> Encoding
Message -> Value
Message -> Encoding
(Message -> Value)
-> (Message -> Encoding)
-> ([Message] -> Value)
-> ([Message] -> Encoding)
-> ToJSON Message
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Message -> Value
toJSON :: Message -> Value
$ctoEncoding :: Message -> Encoding
toEncoding :: Message -> Encoding
$ctoJSONList :: [Message] -> Value
toJSONList :: [Message] -> Value
$ctoEncodingList :: [Message] -> Encoding
toEncodingList :: [Message] -> Encoding
ToJSON) via PrettyHexByteString
newtype Signature = Signature {Signature -> ByteString
unSignature :: BS.ByteString}
deriving newtype (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> String
show :: Signature -> String
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show)
deriving ([Signature] -> Value
[Signature] -> Encoding
Signature -> Value
Signature -> Encoding
(Signature -> Value)
-> (Signature -> Encoding)
-> ([Signature] -> Value)
-> ([Signature] -> Encoding)
-> ToJSON Signature
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Signature -> Value
toJSON :: Signature -> Value
$ctoEncoding :: Signature -> Encoding
toEncoding :: Signature -> Encoding
$ctoJSONList :: [Signature] -> Value
toJSONList :: [Signature] -> Value
$ctoEncodingList :: [Signature] -> Encoding
toEncodingList :: [Signature] -> Encoding
ToJSON) via PrettyHexByteString
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 #-}
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
Either Text ()
-> PublicKeyWithSignAlg -> Either Text PublicKeyWithSignAlg
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 = () -> Either Text ()
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
verifyValid P.PublicKeyEdDSA {} CoseSignAlg
alg = Text -> Either Text ()
forall a b. a -> Either a b
Left (Text -> Either Text ()) -> Text -> Either Text ()
forall a b. (a -> b) -> a -> b
$ Text
"EdDSA public key cannot be used with signing algorithm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (CoseSignAlg -> String
forall a. Show a => a -> String
show CoseSignAlg
alg)
verifyValid P.PublicKeyECDSA {} A.CoseSignAlgECDSA {} = () -> Either Text ()
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
verifyValid P.PublicKeyECDSA {} CoseSignAlg
alg = Text -> Either Text ()
forall a b. a -> Either a b
Left (Text -> Either Text ()) -> Text -> Either Text ()
forall a b. (a -> b) -> a -> b
$ Text
"ECDSA public key cannot be used with signing algorithm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (CoseSignAlg -> String
forall a. Show a => a -> String
show CoseSignAlg
alg)
verifyValid P.PublicKeyRSA {} A.CoseSignAlgRSA {} = () -> Either Text ()
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
verifyValid P.PublicKeyRSA {} CoseSignAlg
alg = Text -> Either Text ()
forall a b. a -> Either a b
Left (Text -> Either Text ()) -> Text -> Either Text ()
forall a b. (a -> b) -> a -> b
$ Text
"RSA public key cannot be used with signing algorithm " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (CoseSignAlg -> String
forall a. Show a => a -> String
show CoseSignAlg
alg)
instance Serialise CosePublicKey where
encode :: PublicKeyWithSignAlg -> Encoding
encode PublicKeyWithSignAlg {CoseSignAlg
PublicKey
publicKey :: PublicKeyWithSignAlg -> PublicKey
signAlg :: PublicKeyWithSignAlg -> CoseSignAlg
publicKey :: PublicKey
signAlg :: CoseSignAlg
..} = case PublicKey
publicKey of
P.PublicKey P.PublicKeyEdDSA {CoseCurveEdDSA
EdDSAKeyBytes
eddsaCurve :: CoseCurveEdDSA
eddsaX :: EdDSAKeyBytes
eddsaCurve :: UncheckedPublicKey -> CoseCurveEdDSA
eddsaX :: UncheckedPublicKey -> EdDSAKeyBytes
..} ->
CoseKeyType -> Encoding
common CoseKeyType
R.CoseKeyTypeOKP
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseKeyTypeParameterOKP -> Encoding
forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterOKP
R.CoseKeyTypeParameterOKPCrv
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseEllipticCurveOKP -> Encoding
forall a. Serialise a => a -> Encoding
encode (CoseCurveEdDSA -> CoseEllipticCurveOKP
fromCurveEdDSA CoseCurveEdDSA
eddsaCurve)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseKeyTypeParameterOKP -> Encoding
forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterOKP
R.CoseKeyTypeParameterOKPX
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBytes (EdDSAKeyBytes -> ByteString
P.unEdDSAKeyBytes EdDSAKeyBytes
eddsaX)
P.PublicKey P.PublicKeyECDSA {Integer
CoseCurveECDSA
ecdsaCurve :: CoseCurveECDSA
ecdsaX :: Integer
ecdsaY :: Integer
ecdsaCurve :: UncheckedPublicKey -> CoseCurveECDSA
ecdsaX :: UncheckedPublicKey -> Integer
ecdsaY :: UncheckedPublicKey -> Integer
..} ->
CoseKeyType -> Encoding
common CoseKeyType
R.CoseKeyTypeEC2
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseKeyTypeParameterEC2 -> Encoding
forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2Crv
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseEllipticCurveEC2 -> Encoding
forall a. Serialise a => a -> Encoding
encode (CoseCurveECDSA -> CoseEllipticCurveEC2
fromCurveECDSA CoseCurveECDSA
ecdsaCurve)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseKeyTypeParameterEC2 -> Encoding
forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2X
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBytes (Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
size Integer
ecdsaX)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseKeyTypeParameterEC2 -> Encoding
forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2Y
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBytes (Int -> Integer -> ByteString
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
rsaN :: Integer
rsaE :: Integer
rsaN :: UncheckedPublicKey -> Integer
rsaE :: UncheckedPublicKey -> Integer
..} ->
CoseKeyType -> Encoding
common CoseKeyType
R.CoseKeyTypeRSA
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseKeyTypeParameterRSA -> Encoding
forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterRSA
R.CoseKeyTypeParameterRSAN
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBytes (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
rsaN)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseKeyTypeParameterRSA -> Encoding
forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterRSA
R.CoseKeyTypeParameterRSAE
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodeBytes (Integer -> ByteString
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)
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseKeyCommonParameter -> Encoding
forall a. Serialise a => a -> Encoding
encode CoseKeyCommonParameter
R.CoseKeyCommonParameterKty
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseKeyType -> Encoding
forall a. Serialise a => a -> Encoding
encode CoseKeyType
kty
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseKeyCommonParameter -> Encoding
forall a. Serialise a => a -> Encoding
encode CoseKeyCommonParameter
R.CoseKeyCommonParameterAlg
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CoseSignAlg -> Encoding
forall a. Serialise a => a -> Encoding
encode CoseSignAlg
signAlg
decode :: forall s. Decoder s PublicKeyWithSignAlg
decode = do
Word
n <- Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Decoder s Int -> Decoder s Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
forall s. Decoder s Int
decodeMapLenCanonical
CoseKeyCommonParameter -> Decoder s ()
forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyCommonParameter
R.CoseKeyCommonParameterKty
CoseKeyType
kty <- Decoder s CoseKeyType
forall s. Decoder s CoseKeyType
forall a s. Serialise a => Decoder s a
decode
CoseKeyCommonParameter -> Decoder s ()
forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyCommonParameter
R.CoseKeyCommonParameterAlg
CoseSignAlg
alg <- Decoder s CoseSignAlg
forall s. Decoder s CoseSignAlg
forall a s. Serialise a => Decoder s a
decode
UncheckedPublicKey
uncheckedKey <- Word -> CoseKeyType -> CoseSignAlg -> Decoder s UncheckedPublicKey
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 -> String -> Decoder s PublicKeyWithSignAlg
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s PublicKeyWithSignAlg)
-> String -> Decoder s PublicKeyWithSignAlg
forall a b. (a -> b) -> a -> b
$ String
"Key check failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
err
Right PublicKey
result ->
PublicKeyWithSignAlg -> Decoder s PublicKeyWithSignAlg
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PublicKeyWithSignAlg -> Decoder s PublicKeyWithSignAlg)
-> PublicKeyWithSignAlg -> Decoder s PublicKeyWithSignAlg
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 -> Decoder s UncheckedPublicKey
forall s. Decoder s UncheckedPublicKey
decodeEdDSAKey
A.CoseSignAlgECDSA CoseHashAlgECDSA
_ -> Decoder s UncheckedPublicKey
forall s. Decoder s UncheckedPublicKey
decodeECDSAKey
A.CoseSignAlgRSA CoseHashAlgRSA
_ -> Decoder s UncheckedPublicKey
forall s. Decoder s UncheckedPublicKey
decodeRSAKey
where
checkKty :: R.CoseKeyType -> Decoder s ()
checkKty :: forall s. CoseKeyType -> Decoder s ()
checkKty CoseKeyType
expectedKty = do
Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CoseKeyType
expectedKty CoseKeyType -> CoseKeyType -> Bool
forall a. Eq a => a -> a -> Bool
== CoseKeyType
kty) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
String
"Expected COSE key type "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CoseKeyType -> String
forall a. Show a => a -> String
show CoseKeyType
expectedKty
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" for COSE algorithm "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CoseSignAlg -> String
forall a. Show a => a -> String
show CoseSignAlg
alg
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but got COSE key type "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CoseKeyType -> String
forall a. Show a => a -> String
show CoseKeyType
kty
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" instead"
Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CoseKeyType -> Word
R.parameterCount CoseKeyType
kty Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
n) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
String
"Expected CBOR map to contain "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show (CoseKeyType -> Word
R.parameterCount CoseKeyType
kty)
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" parameters for COSE key type "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> CoseKeyType -> String
forall a. Show a => a -> String
show CoseKeyType
kty
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but got "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall a. Show a => a -> String
show Word
n
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" parameters instead"
decodeEdDSAKey :: Decoder s P.UncheckedPublicKey
decodeEdDSAKey :: forall s. Decoder s UncheckedPublicKey
decodeEdDSAKey = do
CoseKeyType -> Decoder s ()
forall s. CoseKeyType -> Decoder s ()
checkKty CoseKeyType
R.CoseKeyTypeOKP
CoseKeyTypeParameterOKP -> Decoder s ()
forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterOKP
R.CoseKeyTypeParameterOKPCrv
CoseCurveEdDSA
eddsaCurve <- CoseEllipticCurveOKP -> CoseCurveEdDSA
toCurveEdDSA (CoseEllipticCurveOKP -> CoseCurveEdDSA)
-> Decoder s CoseEllipticCurveOKP -> Decoder s CoseCurveEdDSA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s CoseEllipticCurveOKP
forall s. Decoder s CoseEllipticCurveOKP
forall a s. Serialise a => Decoder s a
decode
CoseKeyTypeParameterOKP -> Decoder s ()
forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterOKP
R.CoseKeyTypeParameterOKPX
EdDSAKeyBytes
eddsaX <- ByteString -> EdDSAKeyBytes
P.EdDSAKeyBytes (ByteString -> EdDSAKeyBytes)
-> Decoder s ByteString -> Decoder s EdDSAKeyBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ByteString
forall s. Decoder s ByteString
decodeBytesCanonical
UncheckedPublicKey -> Decoder s UncheckedPublicKey
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure P.PublicKeyEdDSA {CoseCurveEdDSA
EdDSAKeyBytes
eddsaCurve :: CoseCurveEdDSA
eddsaX :: EdDSAKeyBytes
eddsaCurve :: CoseCurveEdDSA
eddsaX :: EdDSAKeyBytes
..}
decodeECDSAKey :: Decoder s P.UncheckedPublicKey
decodeECDSAKey :: forall s. Decoder s UncheckedPublicKey
decodeECDSAKey = do
CoseKeyType -> Decoder s ()
forall s. CoseKeyType -> Decoder s ()
checkKty CoseKeyType
R.CoseKeyTypeEC2
CoseKeyTypeParameterEC2 -> Decoder s ()
forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2Crv
CoseCurveECDSA
ecdsaCurve <- CoseEllipticCurveEC2 -> CoseCurveECDSA
toCurveECDSA (CoseEllipticCurveEC2 -> CoseCurveECDSA)
-> Decoder s CoseEllipticCurveEC2 -> Decoder s CoseCurveECDSA
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s CoseEllipticCurveEC2
forall s. Decoder s CoseEllipticCurveEC2
forall a s. Serialise a => Decoder s a
decode
let size :: Int
size = CoseCurveECDSA -> Int
P.coordinateSizeECDSA CoseCurveECDSA
ecdsaCurve
CoseKeyTypeParameterEC2 -> Decoder s ()
forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2X
Integer
ecdsaX <- Int -> ByteString -> Decoder s Integer
forall (m :: * -> *). MonadFail m => Int -> ByteString -> m Integer
os2ipWithSize Int
size (ByteString -> Decoder s Integer)
-> Decoder s ByteString -> Decoder s Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Decoder s ByteString
forall s. Decoder s ByteString
decodeBytesCanonical
CoseKeyTypeParameterEC2 -> Decoder s ()
forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2Y
Integer
ecdsaY <-
Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s Integer) -> Decoder s Integer
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TokenType
TypeBytes -> Int -> ByteString -> Decoder s Integer
forall (m :: * -> *). MonadFail m => Int -> ByteString -> m Integer
os2ipWithSize Int
size (ByteString -> Decoder s Integer)
-> Decoder s ByteString -> Decoder s Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Decoder s ByteString
forall s. Decoder s ByteString
decodeBytesCanonical
TokenType
TypeBool -> String -> Decoder s Integer
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Compressed EC2 y coordinate not yet supported"
TokenType
typ -> String -> Decoder s Integer
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s Integer) -> String -> Decoder s Integer
forall a b. (a -> b) -> a -> b
$ String
"Unexpected type in EC2 y parameter: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TokenType -> String
forall a. Show a => a -> String
show TokenType
typ
UncheckedPublicKey -> Decoder s UncheckedPublicKey
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure P.PublicKeyECDSA {Integer
CoseCurveECDSA
ecdsaCurve :: CoseCurveECDSA
ecdsaX :: Integer
ecdsaY :: Integer
ecdsaCurve :: CoseCurveECDSA
ecdsaX :: Integer
ecdsaY :: Integer
..}
decodeRSAKey :: Decoder s P.UncheckedPublicKey
decodeRSAKey :: forall s. Decoder s UncheckedPublicKey
decodeRSAKey = do
CoseKeyType -> Decoder s ()
forall s. CoseKeyType -> Decoder s ()
checkKty CoseKeyType
R.CoseKeyTypeRSA
CoseKeyTypeParameterRSA -> Decoder s ()
forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterRSA
R.CoseKeyTypeParameterRSAN
Integer
rsaN <- ByteString -> Decoder s Integer
forall (m :: * -> *). MonadFail m => ByteString -> m Integer
os2ipNoLeading (ByteString -> Decoder s Integer)
-> Decoder s ByteString -> Decoder s Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Decoder s ByteString
forall s. Decoder s ByteString
decodeBytesCanonical
CoseKeyTypeParameterRSA -> Decoder s ()
forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterRSA
R.CoseKeyTypeParameterRSAE
Integer
rsaE <- ByteString -> Decoder s Integer
forall (m :: * -> *). MonadFail m => ByteString -> m Integer
os2ipNoLeading (ByteString -> Decoder s Integer)
-> Decoder s ByteString -> Decoder s Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Decoder s ByteString
forall s. Decoder s ByteString
decodeBytesCanonical
UncheckedPublicKey -> Decoder s UncheckedPublicKey
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure P.PublicKeyRSA {Integer
rsaN :: Integer
rsaE :: Integer
rsaN :: Integer
rsaE :: Integer
..}
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
size = Integer -> m Integer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bytes
| Bool
otherwise =
String -> m Integer
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Integer) -> String -> m Integer
forall a b. (a -> b) -> a -> b
$
String
"bytes have length "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bytes)
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" when length "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
size
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" was expected"
os2ipNoLeading :: (MonadFail m) => BS.ByteString -> m Integer
os2ipNoLeading :: forall (m :: * -> *). MonadFail m => ByteString -> m Integer
os2ipNoLeading ByteString
bytes
| Int
leadingZeroCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Integer -> m Integer
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bytes
| Bool
otherwise =
String -> m Integer
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Integer) -> String -> m Integer
forall a b. (a -> b) -> a -> b
$
String
"bytes of length "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bytes)
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" has "
String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
leadingZeroCount
String -> ShowS
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 (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bytes)
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 <- Decoder s a
forall s. Decoder s a
forall a s. Serialise a => Decoder s a
decode
Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
actual) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
String
"Expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
expected String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
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