{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Crypto.WebAuthn.Cose.Internal.Verify
(
fromX509,
Cose.Message (..),
Cose.Signature (..),
verify,
SomeHashAlgorithm (..),
toCryptHashECDSA,
SomeHashAlgorithmASN1 (..),
toCryptHashRSA,
)
where
import Crypto.Error (CryptoFailable (CryptoFailed, CryptoPassed))
import qualified Crypto.Hash as Hash
import Crypto.Number.Serialize (i2osp)
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Types as ECC
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.RSA as RSA
import qualified Crypto.PubKey.RSA.PKCS15 as RSA
import qualified Crypto.WebAuthn.Cose.PublicKey as Cose
import qualified Crypto.WebAuthn.Cose.PublicKeyWithSignAlg as Cose
import qualified Crypto.WebAuthn.Cose.SignAlg as Cose
import qualified Data.ASN1.BinaryEncoding as ASN1
import qualified Data.ASN1.Encoding as ASN1
import qualified Data.ASN1.Types as ASN1
import Data.ByteArray (convert)
import qualified Data.ByteString as BS
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.X509 as X509
import qualified Data.X509.EC as X509
fromX509 :: X509.PubKey -> Either Text Cose.PublicKey
fromX509 :: PubKey -> Either Text PublicKey
fromX509 (X509.PubKeyEd25519 PublicKey
key) =
UncheckedPublicKey -> Either Text PublicKey
Cose.checkPublicKey
Cose.PublicKeyEdDSA
{ eddsaCurve :: CoseCurveEdDSA
eddsaCurve = CoseCurveEdDSA
Cose.CoseCurveEd25519,
eddsaX :: EdDSAKeyBytes
eddsaX = ByteString -> EdDSAKeyBytes
Cose.EdDSAKeyBytes (ByteString -> EdDSAKeyBytes) -> ByteString -> EdDSAKeyBytes
forall a b. (a -> b) -> a -> b
$ PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert PublicKey
key
}
fromX509 (X509.PubKeyEC X509.PubKeyEC_Named {CurveName
SerializedPoint
pubkeyEC_name :: CurveName
pubkeyEC_pub :: SerializedPoint
pubkeyEC_pub :: PubKeyEC -> SerializedPoint
pubkeyEC_name :: PubKeyEC -> CurveName
..}) = do
let curve :: Curve
curve = CurveName -> Curve
ECC.getCurveByName CurveName
pubkeyEC_name
CoseCurveECDSA
ecdsaCurve <- CurveName -> Either Text CoseCurveECDSA
Cose.fromCryptCurveECDSA CurveName
pubkeyEC_name
Point
point <- case Curve -> SerializedPoint -> Maybe Point
X509.unserializePoint Curve
curve SerializedPoint
pubkeyEC_pub of
Maybe Point
Nothing -> Text -> Either Text Point
forall a b. a -> Either a b
Left Text
"Failed to unserialize ECDSA point in X509 certificate"
Just Point
res -> Point -> Either Text Point
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Point
res
UncheckedPublicKey
unchecked <- case Point
point of
ECC.Point Integer
ecdsaX Integer
ecdsaY -> UncheckedPublicKey -> Either Text UncheckedPublicKey
forall a b. b -> Either a b
Right (UncheckedPublicKey -> Either Text UncheckedPublicKey)
-> UncheckedPublicKey -> Either Text UncheckedPublicKey
forall a b. (a -> b) -> a -> b
$ Cose.PublicKeyECDSA {Integer
CoseCurveECDSA
ecdsaCurve :: CoseCurveECDSA
ecdsaX :: Integer
ecdsaY :: Integer
ecdsaCurve :: CoseCurveECDSA
ecdsaX :: Integer
ecdsaY :: Integer
..}
Point
ECC.PointO -> Text -> Either Text UncheckedPublicKey
forall a b. a -> Either a b
Left Text
"The infinity point is not supported"
UncheckedPublicKey -> Either Text PublicKey
Cose.checkPublicKey UncheckedPublicKey
unchecked
fromX509 (X509.PubKeyRSA RSA.PublicKey {Int
Integer
public_size :: Int
public_n :: Integer
public_e :: Integer
public_size :: PublicKey -> Int
public_n :: PublicKey -> Integer
public_e :: PublicKey -> Integer
..}) =
UncheckedPublicKey -> Either Text PublicKey
Cose.checkPublicKey
Cose.PublicKeyRSA
{ rsaN :: Integer
rsaN = Integer
public_n,
rsaE :: Integer
rsaE = Integer
public_e
}
fromX509 PubKey
key = Text -> Either Text PublicKey
forall a b. a -> Either a b
Left (Text -> Either Text PublicKey) -> Text -> Either Text PublicKey
forall a b. (a -> b) -> a -> b
$ Text
"X509 public key algorithm is not supported: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (PubKeyALG -> [Char]
forall a. Show a => a -> [Char]
show (PubKey -> PubKeyALG
X509.pubkeyToAlg PubKey
key))
verify :: Cose.PublicKeyWithSignAlg -> Cose.Message -> Cose.Signature -> Either Text ()
verify :: PublicKeyWithSignAlg -> Message -> Signature -> Either Text ()
verify
Cose.PublicKeyWithSignAlg
{ publicKey :: PublicKeyWithSignAlg -> PublicKey
publicKey = Cose.PublicKey Cose.PublicKeyEdDSA {eddsaCurve :: UncheckedPublicKey -> CoseCurveEdDSA
eddsaCurve = CoseCurveEdDSA
Cose.CoseCurveEd25519, EdDSAKeyBytes
eddsaX :: UncheckedPublicKey -> EdDSAKeyBytes
eddsaX :: EdDSAKeyBytes
..},
signAlg :: PublicKeyWithSignAlg -> CoseSignAlg
signAlg = CoseSignAlg
Cose.CoseSignAlgEdDSA
}
Message
msg
Signature
sig = do
PublicKey
key <- case ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey (ByteString -> CryptoFailable PublicKey)
-> ByteString -> CryptoFailable PublicKey
forall a b. (a -> b) -> a -> b
$ EdDSAKeyBytes -> ByteString
Cose.unEdDSAKeyBytes EdDSAKeyBytes
eddsaX of
CryptoFailed CryptoError
err -> Text -> Either Text PublicKey
forall a b. a -> Either a b
Left (Text -> Either Text PublicKey) -> Text -> Either Text PublicKey
forall a b. (a -> b) -> a -> b
$ Text
"Failed to create Ed25519 public key: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err)
CryptoPassed PublicKey
res -> PublicKey -> Either Text PublicKey
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PublicKey
res
Signature
sig <- case ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature (Signature -> ByteString
Cose.unSignature Signature
sig) of
CryptoFailed CryptoError
err -> Text -> Either Text Signature
forall a b. a -> Either a b
Left (Text -> Either Text Signature) -> Text -> Either Text Signature
forall a b. (a -> b) -> a -> b
$ Text
"Failed to create Ed25519 signature: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (CryptoError -> [Char]
forall a. Show a => a -> [Char]
show CryptoError
err)
CryptoPassed Signature
res -> Signature -> Either Text Signature
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Signature
res
if PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
key (Message -> ByteString
Cose.unMessage Message
msg) Signature
sig
then () -> Either Text ()
forall a b. b -> Either a b
Right ()
else Text -> Either Text ()
forall a b. a -> Either a b
Left Text
"EdDSA Signature invalid"
verify
Cose.PublicKeyWithSignAlg
{ publicKey :: PublicKeyWithSignAlg -> PublicKey
publicKey = Cose.PublicKey Cose.PublicKeyECDSA {Integer
CoseCurveECDSA
ecdsaCurve :: UncheckedPublicKey -> CoseCurveECDSA
ecdsaX :: UncheckedPublicKey -> Integer
ecdsaY :: UncheckedPublicKey -> Integer
ecdsaCurve :: CoseCurveECDSA
ecdsaX :: Integer
ecdsaY :: Integer
..},
signAlg :: PublicKeyWithSignAlg -> CoseSignAlg
signAlg = Cose.CoseSignAlgECDSA (CoseHashAlgECDSA -> SomeHashAlgorithm
toCryptHashECDSA -> SomeHashAlgorithm a
hash)
}
Message
msg
Signature
sig = do
let curveName :: CurveName
curveName = CoseCurveECDSA -> CurveName
Cose.toCryptCurveECDSA CoseCurveECDSA
ecdsaCurve
public_curve :: Curve
public_curve = CurveName -> Curve
ECC.getCurveByName CurveName
curveName
public_q :: Point
public_q = Integer -> Integer -> Point
ECC.Point Integer
ecdsaX Integer
ecdsaY
let key :: PublicKey
key = ECDSA.PublicKey {Point
Curve
public_curve :: Curve
public_q :: Point
public_curve :: Curve
public_q :: Point
..}
Signature
sig <- case DER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
ASN1.decodeASN1' DER
ASN1.DER (Signature -> ByteString
Cose.unSignature Signature
sig) of
Left ASN1Error
err -> Text -> Either Text Signature
forall a b. a -> Either a b
Left (Text -> Either Text Signature) -> Text -> Either Text Signature
forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode ECDSA DER value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (ASN1Error -> [Char]
forall a. Show a => a -> [Char]
show ASN1Error
err)
Right [ASN1.Start ASN1ConstructionType
ASN1.Sequence, ASN1.IntVal Integer
r, ASN1.IntVal Integer
s, ASN1.End ASN1ConstructionType
ASN1.Sequence] ->
Signature -> Either Text Signature
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature -> Either Text Signature)
-> Signature -> Either Text Signature
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Signature
ECDSA.Signature Integer
r Integer
s
Right [ASN1]
asns -> Text -> Either Text Signature
forall a b. a -> Either a b
Left (Text -> Either Text Signature) -> Text -> Either Text Signature
forall a b. (a -> b) -> a -> b
$ Text
"Unexpected ECDSA ASN.1 structure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack ([ASN1] -> [Char]
forall a. Show a => a -> [Char]
show [ASN1]
asns)
if a -> PublicKey -> Signature -> ByteString -> Bool
forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
ECDSA.verify a
hash PublicKey
key Signature
sig (Message -> ByteString
Cose.unMessage Message
msg)
then () -> Either Text ()
forall a b. b -> Either a b
Right ()
else Text -> Either Text ()
forall a b. a -> Either a b
Left Text
"ECDSA Signature invalid"
verify
Cose.PublicKeyWithSignAlg
{ publicKey :: PublicKeyWithSignAlg -> PublicKey
publicKey = Cose.PublicKey Cose.PublicKeyRSA {Integer
rsaN :: UncheckedPublicKey -> Integer
rsaE :: UncheckedPublicKey -> Integer
rsaN :: Integer
rsaE :: Integer
..},
signAlg :: PublicKeyWithSignAlg -> CoseSignAlg
signAlg = Cose.CoseSignAlgRSA (CoseHashAlgRSA -> SomeHashAlgorithmASN1
toCryptHashRSA -> SomeHashAlgorithmASN1 a
hash)
}
Message
msg
Signature
sig = do
let key :: PublicKey
key =
RSA.PublicKey
{
public_size :: Int
public_size = ByteString -> Int
BS.length (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
rsaN),
public_n :: Integer
public_n = Integer
rsaN,
public_e :: Integer
public_e = Integer
rsaE
}
if Maybe a -> PublicKey -> ByteString -> ByteString -> Bool
forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
RSA.verify (a -> Maybe a
forall a. a -> Maybe a
Just a
hash) PublicKey
key (Message -> ByteString
Cose.unMessage Message
msg) (Signature -> ByteString
Cose.unSignature Signature
sig)
then () -> Either Text ()
forall a b. b -> Either a b
Right ()
else Text -> Either Text ()
forall a b. a -> Either a b
Left Text
"RSA Signature invalid"
verify PublicKeyWithSignAlg
key Message
_ Signature
_ = [Char] -> Either Text ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> Either Text ()) -> [Char] -> Either Text ()
forall a b. (a -> b) -> a -> b
$ [Char]
"PublicKeyWithSignAlg invariant violated for public key " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> PublicKeyWithSignAlg -> [Char]
forall a. Show a => a -> [Char]
show PublicKeyWithSignAlg
key [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
". This should not occur unless the PublicKeyWithSignAlg module has a bug"
data SomeHashAlgorithm = forall a. (Hash.HashAlgorithm a) => SomeHashAlgorithm a
toCryptHashECDSA :: Cose.CoseHashAlgECDSA -> SomeHashAlgorithm
toCryptHashECDSA :: CoseHashAlgECDSA -> SomeHashAlgorithm
toCryptHashECDSA CoseHashAlgECDSA
Cose.CoseHashAlgECDSASHA256 = SHA256 -> SomeHashAlgorithm
forall a. HashAlgorithm a => a -> SomeHashAlgorithm
SomeHashAlgorithm SHA256
Hash.SHA256
toCryptHashECDSA CoseHashAlgECDSA
Cose.CoseHashAlgECDSASHA384 = SHA384 -> SomeHashAlgorithm
forall a. HashAlgorithm a => a -> SomeHashAlgorithm
SomeHashAlgorithm SHA384
Hash.SHA384
toCryptHashECDSA CoseHashAlgECDSA
Cose.CoseHashAlgECDSASHA512 = SHA512 -> SomeHashAlgorithm
forall a. HashAlgorithm a => a -> SomeHashAlgorithm
SomeHashAlgorithm SHA512
Hash.SHA512
data SomeHashAlgorithmASN1 = forall a. (RSA.HashAlgorithmASN1 a) => SomeHashAlgorithmASN1 a
toCryptHashRSA :: Cose.CoseHashAlgRSA -> SomeHashAlgorithmASN1
toCryptHashRSA :: CoseHashAlgRSA -> SomeHashAlgorithmASN1
toCryptHashRSA CoseHashAlgRSA
Cose.CoseHashAlgRSASHA1 = SHA1 -> SomeHashAlgorithmASN1
forall a. HashAlgorithmASN1 a => a -> SomeHashAlgorithmASN1
SomeHashAlgorithmASN1 SHA1
Hash.SHA1
toCryptHashRSA CoseHashAlgRSA
Cose.CoseHashAlgRSASHA256 = SHA256 -> SomeHashAlgorithmASN1
forall a. HashAlgorithmASN1 a => a -> SomeHashAlgorithmASN1
SomeHashAlgorithmASN1 SHA256
Hash.SHA256
toCryptHashRSA CoseHashAlgRSA
Cose.CoseHashAlgRSASHA384 = SHA384 -> SomeHashAlgorithmASN1
forall a. HashAlgorithmASN1 a => a -> SomeHashAlgorithmASN1
SomeHashAlgorithmASN1 SHA384
Hash.SHA384
toCryptHashRSA CoseHashAlgRSA
Cose.CoseHashAlgRSASHA512 = SHA512 -> SomeHashAlgorithmASN1
forall a. HashAlgorithmASN1 a => a -> SomeHashAlgorithmASN1
SomeHashAlgorithmASN1 SHA512
Hash.SHA512