{-# 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
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)
deriving instance Aeson.ToJSON PublicKeyWithSignAlg
type CosePublicKey = PublicKeyWithSignAlg
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
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
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
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)
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)
forall a. Semigroup a => a -> a -> a
<> forall a. Serialise a => a -> Encoding
encode CoseKeyTypeParameterEC2
R.CoseKeyTypeParameterEC2X
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
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
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
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
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
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
forall s. CoseKeyType -> Decoder s ()
checkKty CoseKeyType
R.CoseKeyTypeOKP
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
forall s. CoseKeyType -> Decoder s ()
checkKty CoseKeyType
R.CoseKeyTypeEC2
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
forall s. CoseKeyType -> Decoder s ()
checkKty CoseKeyType
R.CoseKeyTypeRSA
forall a s. (Show a, Eq a, Serialise a) => a -> Decoder s ()
decodeExpected CoseKeyTypeParameterRSA
R.CoseKeyTypeParameterRSAN
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
..}
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"
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)
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