{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

-- | Stability: internal
-- public keys and signature algorithms are represented with three
-- different types:
--
-- * 'Cose.CoseSignAlg', which is the signature algorithm used, equivalent to a
--   COSE Algorithm from the COSE registry
-- * 'Cose.CosePublicKey', which is a combination of a 'Cose.CoseSignAlg' along with
--   a public key that can be used with it. This is what the COSE_Key
--   CBOR structure decodes to
-- * 'Cose.PublicKey', only the public key part of 'Cose.CosePublicKey'
--
-- The following main operations are supported for these types:
--
-- * 'Cose.CosePublicKey' can be totally decomposed into a 'Cose.CoseSignAlg'
--   with 'Cose.signAlg' and a 'Cose.PublicKey' with 'Cose.publicKey'
-- * A 'Cose.PublicKey' can be created from an X.509 public key with 'fromX509'
-- * A 'Cose.CoseSignAlg' and a 'Cose.PublicKey' can be used to verify a signature
--   with 'verify'
module Crypto.WebAuthn.Cose.Internal.Verify
  ( -- * Public Key
    fromX509,

    -- * Signature verification
    verify,

    -- * Hash Conversions to cryptonite types
    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 Crypto.WebAuthn.Internal.ToJSONOrphans ()
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

-- | Turns a X.509 certificates 'X509.PubKey' into a 'Cose.PublicKey'
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 :: ByteString
eddsaX = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert PublicKey
key
      }
fromX509 (X509.PubKeyEC X509.PubKeyEC_Named {CurveName
SerializedPoint
pubkeyEC_pub :: PubKeyEC -> SerializedPoint
pubkeyEC_name :: PubKeyEC -> CurveName
pubkeyEC_pub :: SerializedPoint
pubkeyEC_name :: 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 -> forall a b. a -> Either a b
Left Text
"Failed to unserialize ECDSA point in X509 certificate"
    Just Point
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Point
res
  UncheckedPublicKey
unchecked <- case Point
point of
    ECC.Point Integer
ecdsaX Integer
ecdsaY -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Cose.PublicKeyECDSA {Integer
CoseCurveECDSA
ecdsaY :: Integer
ecdsaX :: Integer
ecdsaCurve :: CoseCurveECDSA
ecdsaY :: Integer
ecdsaX :: Integer
ecdsaCurve :: CoseCurveECDSA
..}
    Point
ECC.PointO -> 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 :: PublicKey -> Int
public_n :: PublicKey -> Integer
public_e :: PublicKey -> Integer
public_e :: Integer
public_n :: Integer
public_size :: Int
..}) =
  UncheckedPublicKey -> Either Text PublicKey
Cose.checkPublicKey
    Cose.PublicKeyRSA
      { rsaN :: Integer
rsaN = Integer
public_n,
        rsaE :: Integer
rsaE = Integer
public_e
      }
fromX509 PubKey
key = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"X509 public key algorithm is not supported: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show (PubKey -> PubKeyALG
X509.pubkeyToAlg PubKey
key))

-- | Verifies an asymmetric signature for a message using a
-- 'Cose.PublicKeyWithSignAlg' Returns an error if the signature algorithm
-- doesn't match. Also returns an error if the signature wasn't valid or for
-- other errors.
verify :: Cose.PublicKeyWithSignAlg -> BS.ByteString -> BS.ByteString -> Either Text ()
verify :: PublicKeyWithSignAlg -> ByteString -> ByteString -> Either Text ()
verify
  Cose.PublicKeyWithSignAlg
    { publicKey :: PublicKeyWithSignAlg -> PublicKey
publicKey = Cose.PublicKey Cose.PublicKeyEdDSA {eddsaCurve :: UncheckedPublicKey -> CoseCurveEdDSA
eddsaCurve = CoseCurveEdDSA
Cose.CoseCurveEd25519, ByteString
eddsaX :: ByteString
eddsaX :: UncheckedPublicKey -> ByteString
..},
      signAlg :: PublicKeyWithSignAlg -> CoseSignAlg
signAlg = CoseSignAlg
Cose.CoseSignAlgEdDSA
    }
  ByteString
msg
  ByteString
sig = do
    PublicKey
key <- case forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey ByteString
eddsaX of
      CryptoFailed CryptoError
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Failed to create Ed25519 public key: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show CryptoError
err)
      CryptoPassed PublicKey
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PublicKey
res
    Signature
sig <- case forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature ByteString
sig of
      CryptoFailed CryptoError
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Failed to create Ed25519 signature: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show CryptoError
err)
      CryptoPassed Signature
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Signature
res
    if forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
key ByteString
msg Signature
sig
      then forall a b. b -> Either a b
Right ()
      else 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
ecdsaY :: Integer
ecdsaX :: Integer
ecdsaCurve :: CoseCurveECDSA
ecdsaY :: UncheckedPublicKey -> Integer
ecdsaX :: UncheckedPublicKey -> Integer
ecdsaCurve :: UncheckedPublicKey -> CoseCurveECDSA
..},
      signAlg :: PublicKeyWithSignAlg -> CoseSignAlg
signAlg = Cose.CoseSignAlgECDSA (CoseHashAlgECDSA -> SomeHashAlgorithm
toCryptHashECDSA -> SomeHashAlgorithm a
hash)
    }
  ByteString
msg
  ByteString
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

    -- This check is already done in checkPublicKey
    -- unless (ECC.isPointValid public_curve public_q) $
    --  Left $ "ECDSA point is not valid for curve " <> Text.pack (show curveName) <> ": " <> Text.pack (show public_q)
    let key :: PublicKey
key = ECDSA.PublicKey {Curve
Point
public_curve :: Curve
public_q :: Point
public_q :: Point
public_curve :: Curve
..}

    -- https://www.w3.org/TR/webauthn-2/#sctn-signature-attestation-types
    -- > For COSEAlgorithmIdentifier -7 (ES256), and other ECDSA-based algorithms,
    -- the `sig` value MUST be encoded as an ASN.1 DER Ecdsa-Sig-Value, as defined
    -- in [RFC3279](https://www.w3.org/TR/webauthn-2/#biblio-rfc3279) section 2.2.3.
    Signature
sig <- case forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
ASN1.decodeASN1' DER
ASN1.DER ByteString
sig of
      Left ASN1Error
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Failed to decode ECDSA DER value: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show ASN1Error
err)
      -- Ecdsa-Sig-Value in https://datatracker.ietf.org/doc/html/rfc3279#section-2.2.3
      Right [ASN1.Start ASN1ConstructionType
ASN1.Sequence, ASN1.IntVal Integer
r, ASN1.IntVal Integer
s, ASN1.End ASN1ConstructionType
ASN1.Sequence] ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Signature
ECDSA.Signature Integer
r Integer
s
      Right [ASN1]
asns -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"Unexpected ECDSA ASN.1 structure: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack (forall a. Show a => a -> [Char]
show [ASN1]
asns)

    if forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
ECDSA.verify a
hash PublicKey
key Signature
sig ByteString
msg
      then forall a b. b -> Either a b
Right ()
      else forall a b. a -> Either a b
Left Text
"ECDSA Signature invalid"
verify
  Cose.PublicKeyWithSignAlg
    { publicKey :: PublicKeyWithSignAlg -> PublicKey
publicKey = Cose.PublicKey Cose.PublicKeyRSA {Integer
rsaE :: Integer
rsaN :: Integer
rsaE :: UncheckedPublicKey -> Integer
rsaN :: UncheckedPublicKey -> Integer
..},
      signAlg :: PublicKeyWithSignAlg -> CoseSignAlg
signAlg = Cose.CoseSignAlgRSA (CoseHashAlgRSA -> SomeHashAlgorithmASN1
toCryptHashRSA -> SomeHashAlgorithmASN1 a
hash)
    }
  ByteString
msg
  ByteString
sig = do
    let key :: PublicKey
key =
          RSA.PublicKey
            { -- https://www.rfc-editor.org/rfc/rfc8017#section-8.2.2
              -- > k is the length in octets of the RSA modulus n
              --
              -- > Length checking: If the length of the signature S is not k
              -- > octets, output "invalid signature" and stop.
              -- This is done by the RSA.verify call
              public_size :: Int
public_size = ByteString -> Int
BS.length (forall ba. ByteArray ba => Integer -> ba
i2osp Integer
rsaN),
              public_n :: Integer
public_n = Integer
rsaN,
              public_e :: Integer
public_e = Integer
rsaE
            }
    if forall hashAlg.
HashAlgorithmASN1 hashAlg =>
Maybe hashAlg -> PublicKey -> ByteString -> ByteString -> Bool
RSA.verify (forall a. a -> Maybe a
Just a
hash) PublicKey
key ByteString
msg ByteString
sig
      then forall a b. b -> Either a b
Right ()
      else forall a b. a -> Either a b
Left Text
"RSA Signature invalid"
verify PublicKeyWithSignAlg
key ByteString
_ ByteString
_ = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"PublicKeyWithSignAlg invariant violated for public key " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show PublicKeyWithSignAlg
key forall a. Semigroup a => a -> a -> a
<> [Char]
". This should not occur unless the PublicKeyWithSignAlg module has a bug"

-- | Some cryptonite 'Hash.HashAlgorithm' type, used as a return value of 'toCryptHashECDSA'
data SomeHashAlgorithm = forall a. Hash.HashAlgorithm a => SomeHashAlgorithm a

-- | Returns the cryptonite 'SomeHashAlgorithm' corresponding to this hash algorithm
toCryptHashECDSA :: Cose.CoseHashAlgECDSA -> SomeHashAlgorithm
toCryptHashECDSA :: CoseHashAlgECDSA -> SomeHashAlgorithm
toCryptHashECDSA CoseHashAlgECDSA
Cose.CoseHashAlgECDSASHA256 = forall a. HashAlgorithm a => a -> SomeHashAlgorithm
SomeHashAlgorithm SHA256
Hash.SHA256
toCryptHashECDSA CoseHashAlgECDSA
Cose.CoseHashAlgECDSASHA384 = forall a. HashAlgorithm a => a -> SomeHashAlgorithm
SomeHashAlgorithm SHA384
Hash.SHA384
toCryptHashECDSA CoseHashAlgECDSA
Cose.CoseHashAlgECDSASHA512 = forall a. HashAlgorithm a => a -> SomeHashAlgorithm
SomeHashAlgorithm SHA512
Hash.SHA512

-- | Some cryptonite 'RSA.HashAlgorithmASN1' type, used as a return value of 'toCryptHashRSA'
data SomeHashAlgorithmASN1 = forall a. RSA.HashAlgorithmASN1 a => SomeHashAlgorithmASN1 a

-- | Returns the cryptonite 'SomeHashAlgorithmASN1' corresponding to this hash algorithm
toCryptHashRSA :: Cose.CoseHashAlgRSA -> SomeHashAlgorithmASN1
toCryptHashRSA :: CoseHashAlgRSA -> SomeHashAlgorithmASN1
toCryptHashRSA CoseHashAlgRSA
Cose.CoseHashAlgRSASHA1 = forall a. HashAlgorithmASN1 a => a -> SomeHashAlgorithmASN1
SomeHashAlgorithmASN1 SHA1
Hash.SHA1
toCryptHashRSA CoseHashAlgRSA
Cose.CoseHashAlgRSASHA256 = forall a. HashAlgorithmASN1 a => a -> SomeHashAlgorithmASN1
SomeHashAlgorithmASN1 SHA256
Hash.SHA256
toCryptHashRSA CoseHashAlgRSA
Cose.CoseHashAlgRSASHA384 = forall a. HashAlgorithmASN1 a => a -> SomeHashAlgorithmASN1
SomeHashAlgorithmASN1 SHA384
Hash.SHA384
toCryptHashRSA CoseHashAlgRSA
Cose.CoseHashAlgRSASHA512 = forall a. HashAlgorithmASN1 a => a -> SomeHashAlgorithmASN1
SomeHashAlgorithmASN1 SHA512
Hash.SHA512