-- | ECDSA (NIST P-256) key operations for libp2p peer identity, using crypton.
--
-- Wire formats follow the libp2p peer-ids spec (matching go-libp2p):
-- - Public key: DER-encoded SubjectPublicKeyInfo (PKIX), uncompressed point.
-- - Private key: DER-encoded RFC 5915 ECPrivateKey (SEC1), with the named
--   curve parameters and the public key included, as emitted by Go's
--   x509.MarshalECPrivateKey.
-- - Signatures: ECDSA over SHA-256 with deterministic nonces (RFC 6979),
--   DER-encoded (SEQUENCE { r, s }).
--
-- Operates on raw 'ByteString' so this module has no dependency on
-- "LibP2P.Crypto.Key".
module LibP2P.Crypto.ECDSA
  ( generate
  , sign
  , verify
  , derivePublicKey
  ) where

import Crypto.Hash (Digest, hashWith)
import Crypto.Hash.Algorithms (SHA256 (..))
import Crypto.Number.Serialize (i2ospOf_, os2ip)
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import Crypto.PubKey.ECC.Generate (generateQ)
import Crypto.PubKey.ECC.Types
  ( Curve
  , CurveCommon (ecc_n)
  , CurveName (SEC_p256r1)
  , Point (..)
  , common_curve
  , getCurveByName
  )
import Crypto.Random (getRandomBytes)
import Data.ASN1.BinaryEncoding (DER (..))
import Data.ASN1.BitArray (toBitArray)
import Data.ASN1.Encoding (decodeASN1', encodeASN1')
import Data.ASN1.Types (ASN1 (..), ASN1Class (..), ASN1ConstructionType (..), fromASN1, toASN1)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.X509 (PubKey (PubKeyEC), PubKeyEC (PubKeyEC_Named), SerializedPoint (..))
import Data.X509.EC (unserializePoint)

-- | The NIST P-256 curve (a.k.a. prime256v1 / secp256r1).
curve :: Curve
curve :: Curve
curve = CurveName -> Curve
getCurveByName CurveName
SEC_p256r1

-- | Curve order (n).
curveOrder :: Integer
curveOrder :: Integer
curveOrder = CurveCommon -> Integer
ecc_n (Curve -> CurveCommon
common_curve Curve
curve)

-- | ASN.1 OID for prime256v1 / secp256r1.
p256Oid :: [Integer]
p256Oid :: [Integer]
p256Oid = [Integer
1, Integer
2, Integer
840, Integer
10045, Integer
3, Integer
1, Integer
7]

-- | Generate a new P-256 key pair, returning (public SPKI DER, private SEC1 DER).
generate :: IO (ByteString, ByteString)
generate :: IO (ByteString, ByteString)
generate = do
  d <- IO Integer
randomScalar
  let q = Curve -> Integer -> Point
generateQ Curve
curve Integer
d
  pure (encodePublicKey q, encodePrivateKey d q)

-- | Draw a private scalar in [1, n-1] via rejection sampling.
randomScalar :: IO Integer
randomScalar :: IO Integer
randomScalar = do
  bytes <- Int -> IO ByteString
forall byteArray. ByteArray byteArray => Int -> IO byteArray
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
32 :: IO ByteString
  let d = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
bytes
  if d >= 1 && d < curveOrder then pure d else randomScalar

-- | Sign a message with a SEC1-DER private key (ECDSA/SHA-256, DER output).
-- Nonces are deterministic per RFC 6979, so signing is pure: the same key
-- and message always produce the same signature.
sign :: ByteString -> ByteString -> Either String ByteString
sign :: ByteString -> ByteString -> Either String ByteString
sign ByteString
privDer ByteString
msg = do
  d <- ByteString -> Either String Integer
decodePrivateKey ByteString
privDer
  let priv = Curve -> Integer -> PrivateKey
ECDSA.PrivateKey Curve
curve Integer
d
      digest = SHA256 -> ByteString -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256 ByteString
msg :: Digest SHA256
      sig = SHA256
-> PrivateKey
-> Digest SHA256
-> (Integer -> Maybe Signature)
-> Signature
forall hashDRG hashDigest a.
(HashAlgorithm hashDRG, HashAlgorithm hashDigest) =>
hashDRG
-> PrivateKey -> Digest hashDigest -> (Integer -> Maybe a) -> a
ECDSA.deterministicNonce SHA256
SHA256 PrivateKey
priv Digest SHA256
digest ((Integer -> Maybe Signature) -> Signature)
-> (Integer -> Maybe Signature) -> Signature
forall a b. (a -> b) -> a -> b
$ \Integer
k ->
        Integer -> PrivateKey -> Digest SHA256 -> Maybe Signature
forall hash.
HashAlgorithm hash =>
Integer -> PrivateKey -> Digest hash -> Maybe Signature
ECDSA.signDigestWith Integer
k PrivateKey
priv Digest SHA256
digest
  pure (encodeSignature sig)

-- | Derive the SPKI-DER public key from a SEC1-DER private key.
derivePublicKey :: ByteString -> Either String ByteString
derivePublicKey :: ByteString -> Either String ByteString
derivePublicKey ByteString
privDer = Point -> ByteString
encodePublicKey (Point -> ByteString)
-> (Integer -> Point) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curve -> Integer -> Point
generateQ Curve
curve (Integer -> ByteString)
-> Either String Integer -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String Integer
decodePrivateKey ByteString
privDer

-- | Verify a DER signature against an SPKI-DER public key (ECDSA/SHA-256).
verify :: ByteString -> ByteString -> ByteString -> Bool
verify :: ByteString -> ByteString -> ByteString -> Bool
verify ByteString
pubDer ByteString
msg ByteString
sigDer =
  case (ByteString -> Either String Point
decodePublicKey ByteString
pubDer, ByteString -> Either String Signature
decodeSignature ByteString
sigDer) of
    (Right Point
pt, Right Signature
sig) -> SHA256 -> PublicKey -> Signature -> ByteString -> Bool
forall msg hash.
(ByteArrayAccess msg, HashAlgorithm hash) =>
hash -> PublicKey -> Signature -> msg -> Bool
ECDSA.verify SHA256
SHA256 (Curve -> Point -> PublicKey
ECDSA.PublicKey Curve
curve Point
pt) Signature
sig ByteString
msg
    (Either String Point, Either String Signature)
_ -> Bool
False

-- | Encode a curve point as DER SubjectPublicKeyInfo (uncompressed point).
encodePublicKey :: Point -> ByteString
encodePublicKey :: Point -> ByteString
encodePublicKey Point
PointO = ByteString
BS.empty
encodePublicKey Point
q =
  let pub :: PubKey
pub = PubKeyEC -> PubKey
PubKeyEC (CurveName -> SerializedPoint -> PubKeyEC
PubKeyEC_Named CurveName
SEC_p256r1 (ByteString -> SerializedPoint
SerializedPoint (Point -> ByteString
uncompressedPoint Point
q)))
   in DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER (PubKey -> ASN1S
forall a. ASN1Object a => a -> ASN1S
toASN1 PubKey
pub [])

-- | SEC1 uncompressed point encoding (0x04 || X || Y).
uncompressedPoint :: Point -> ByteString
uncompressedPoint :: Point -> ByteString
uncompressedPoint Point
PointO = ByteString
BS.empty
uncompressedPoint (Point Integer
x Integer
y) = Word8 -> ByteString -> ByteString
BS.cons Word8
0x04 (Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
32 Integer
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
32 Integer
y)

-- | Decode a DER SubjectPublicKeyInfo into a curve point.
decodePublicKey :: ByteString -> Either String Point
decodePublicKey :: ByteString -> Either String Point
decodePublicKey ByteString
bs =
  case DER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' DER
DER ByteString
bs of
    Left ASN1Error
err -> String -> Either String Point
forall a b. a -> Either a b
Left (String -> Either String Point) -> String -> Either String Point
forall a b. (a -> b) -> a -> b
$ String
"ECDSA.decodePublicKey: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ASN1Error -> String
forall a. Show a => a -> String
show ASN1Error
err
    Right [ASN1]
asn1 -> case [ASN1] -> Either String (PubKey, [ASN1])
forall a. ASN1Object a => [ASN1] -> Either String (a, [ASN1])
fromASN1 [ASN1]
asn1 of
      Right (PubKeyEC (PubKeyEC_Named CurveName
name SerializedPoint
sp), [ASN1]
_) ->
        case Curve -> SerializedPoint -> Maybe Point
unserializePoint (CurveName -> Curve
getCurveByName CurveName
name) SerializedPoint
sp of
          Just Point
pt -> Point -> Either String Point
forall a b. b -> Either a b
Right Point
pt
          Maybe Point
Nothing -> String -> Either String Point
forall a b. a -> Either a b
Left String
"ECDSA.decodePublicKey: invalid EC point"
      Right (PubKey, [ASN1])
_ -> String -> Either String Point
forall a b. a -> Either a b
Left String
"ECDSA.decodePublicKey: not a named EC public key"
      Left String
err -> String -> Either String Point
forall a b. a -> Either a b
Left (String -> Either String Point) -> String -> Either String Point
forall a b. (a -> b) -> a -> b
$ String
"ECDSA.decodePublicKey: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err

-- | Encode a private scalar as an RFC 5915 ECPrivateKey DER, including the
-- named-curve parameters and the public key (Go's x509.MarshalECPrivateKey
-- layout, which the peer-ids spec test vector uses).
encodePrivateKey :: Integer -> Point -> ByteString
encodePrivateKey :: Integer -> Point -> ByteString
encodePrivateKey Integer
d Point
q =
  DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1'
    DER
DER
    [ ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence
    , Integer -> ASN1
IntVal Integer
1 -- ecPrivkeyVer1
    , ByteString -> ASN1
OctetString (Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
32 Integer
d)
    , ASN1ConstructionType -> ASN1
Start (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
    , [Integer] -> ASN1
OID [Integer]
p256Oid
    , ASN1ConstructionType -> ASN1
End (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
    , ASN1ConstructionType -> ASN1
Start (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)
    , BitArray -> ASN1
BitString (ByteString -> Int -> BitArray
toBitArray (Point -> ByteString
uncompressedPoint Point
q) Int
0)
    , ASN1ConstructionType -> ASN1
End (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1)
    , ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence
    ]

-- | Decode an RFC 5915 ECPrivateKey DER into the private scalar.
-- The curve parameters and public key fields are optional; when the curve
-- is present it must be P-256.
decodePrivateKey :: ByteString -> Either String Integer
decodePrivateKey :: ByteString -> Either String Integer
decodePrivateKey ByteString
bs =
  case DER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' DER
DER ByteString
bs of
    Left ASN1Error
err -> String -> Either String Integer
forall a b. a -> Either a b
Left (String -> Either String Integer)
-> String -> Either String Integer
forall a b. (a -> b) -> a -> b
$ String
"ECDSA.decodePrivateKey: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ASN1Error -> String
forall a. Show a => a -> String
show ASN1Error
err
    Right (Start ASN1ConstructionType
Sequence : IntVal Integer
1 : OctetString ByteString
priv : [ASN1]
rest)
      | ByteString -> Int
BS.length ByteString
priv Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 ->
          String -> Either String Integer
forall a b. a -> Either a b
Left String
"ECDSA.decodePrivateKey: expected a 32-byte P-256 scalar"
      | Bool
otherwise -> ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
priv Integer -> Either String () -> Either String Integer
forall a b. a -> Either String b -> Either String a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [ASN1] -> Either String ()
forall {a}. IsString a => [ASN1] -> Either a ()
checkCurveOid [ASN1]
rest
    Right [ASN1]
_ -> String -> Either String Integer
forall a b. a -> Either a b
Left String
"ECDSA.decodePrivateKey: not an RFC 5915 ECPrivateKey"
  where
    checkCurveOid :: [ASN1] -> Either a ()
checkCurveOid (Start (Container ASN1Class
Context Int
0) : OID [Integer]
oid : End (Container ASN1Class
Context Int
0) : [ASN1]
_)
      | [Integer]
oid [Integer] -> [Integer] -> Bool
forall a. Eq a => a -> a -> Bool
== [Integer]
p256Oid = () -> Either a ()
forall a b. b -> Either a b
Right ()
      | Bool
otherwise = a -> Either a ()
forall a b. a -> Either a b
Left a
"ECDSA.decodePrivateKey: unsupported curve (expected P-256)"
    checkCurveOid [ASN1]
_ = () -> Either a ()
forall a b. b -> Either a b
Right ()

-- | Encode an ECDSA signature as DER SEQUENCE { r, s }.
encodeSignature :: ECDSA.Signature -> ByteString
encodeSignature :: Signature -> ByteString
encodeSignature (ECDSA.Signature Integer
r Integer
s) =
  DER -> [ASN1] -> ByteString
forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER [ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence, Integer -> ASN1
IntVal Integer
r, Integer -> ASN1
IntVal Integer
s, ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence]

-- | Decode a DER SEQUENCE { r, s } into an ECDSA signature.
decodeSignature :: ByteString -> Either String ECDSA.Signature
decodeSignature :: ByteString -> Either String Signature
decodeSignature ByteString
bs =
  case DER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' DER
DER ByteString
bs of
    Left ASN1Error
err -> String -> Either String Signature
forall a b. a -> Either a b
Left (String -> Either String Signature)
-> String -> Either String Signature
forall a b. (a -> b) -> a -> b
$ String
"ECDSA.decodeSignature: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ASN1Error -> String
forall a. Show a => a -> String
show ASN1Error
err
    Right (Start ASN1ConstructionType
Sequence : IntVal Integer
r : IntVal Integer
s : End ASN1ConstructionType
Sequence : [ASN1]
_) ->
      Signature -> Either String Signature
forall a b. b -> Either a b
Right (Integer -> Integer -> Signature
ECDSA.Signature Integer
r Integer
s)
    Right [ASN1]
_ -> String -> Either String Signature
forall a b. a -> Either a b
Left String
"ECDSA.decodeSignature: unexpected ASN.1 structure"