-- | Secp256k1 key operations for libp2p peer identity, using crypton.
--
-- Wire formats follow the libp2p peer-ids spec:
-- - Public key: 33-byte SEC1 compressed point (0x02/0x03 prefix + 32-byte X).
-- - Private key: 32-byte big-endian scalar.
-- - 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.Secp256k1
  ( generate
  , sign
  , verify
  , derivePublicKey
  , decodePoint
  ) where

import Crypto.Hash (Digest, hashWith)
import Crypto.Hash.Algorithms (SHA256 (..))
import Crypto.Number.ModArithmetic (expFast)
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 (..)
  , CurveName (SEC_p256k1)
  , CurvePrime (..)
  , Point (..)
  , getCurveByName
  )
import Crypto.Random (getRandomBytes)
import Data.ASN1.BinaryEncoding (DER (..))
import Data.ASN1.Encoding (decodeASN1', encodeASN1')
import Data.ASN1.Types (ASN1 (..), ASN1ConstructionType (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS

-- | The secp256k1 curve.
curve :: Curve
curve :: Curve
curve = CurveName -> Curve
getCurveByName CurveName
SEC_p256k1

-- | Field prime and curve coefficients (a, b) for secp256k1.
curveParams :: (Integer, Integer, Integer)
curveParams :: (Integer, Integer, Integer)
curveParams = case Curve
curve of
  CurveFP (CurvePrime Integer
p CurveCommon
cc) -> (Integer
p, CurveCommon -> Integer
ecc_a CurveCommon
cc, CurveCommon -> Integer
ecc_b CurveCommon
cc)
  Curve
_ -> String -> (Integer, Integer, Integer)
forall a. HasCallStack => String -> a
error String
"Secp256k1: expected a prime-field curve"

-- | Curve order (n).
curveOrder :: Integer
curveOrder :: Integer
curveOrder = case Curve
curve of
  CurveFP (CurvePrime Integer
_ CurveCommon
cc) -> CurveCommon -> Integer
ecc_n CurveCommon
cc
  Curve
_ -> String -> Integer
forall a. HasCallStack => String -> a
error String
"Secp256k1: expected a prime-field curve"

-- | Generate a new secp256k1 key pair, returning (compressed public, 32-byte private).
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 (encodePoint q, i2ospOf_ 32 d)

-- | 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 32-byte private scalar (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
privRaw ByteString
msg
  | ByteString -> Int
BS.length ByteString
privRaw Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 = String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Secp256k1.sign: private key must be 32 bytes"
  | Bool
otherwise =
      let priv :: PrivateKey
priv = Curve -> Integer -> PrivateKey
ECDSA.PrivateKey Curve
curve (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
privRaw)
          digest :: Digest SHA256
digest = SHA256 -> ByteString -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256 ByteString
msg :: Digest SHA256
          sig :: Signature
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
       in ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Signature -> ByteString
encodeSignature Signature
sig)

-- | Derive the 33-byte compressed public key from a 32-byte private scalar.
derivePublicKey :: ByteString -> Either String ByteString
derivePublicKey :: ByteString -> Either String ByteString
derivePublicKey ByteString
privRaw
  | ByteString -> Int
BS.length ByteString
privRaw Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 = String -> Either String ByteString
forall a b. a -> Either a b
Left String
"Secp256k1.derivePublicKey: private key must be 32 bytes"
  | Bool
otherwise = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (Point -> ByteString
encodePoint (Curve -> Integer -> Point
generateQ Curve
curve (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
privRaw)))

-- | Verify a DER signature against a 33-byte compressed public key (ECDSA/SHA-256).
verify :: ByteString -> ByteString -> ByteString -> Bool
verify :: ByteString -> ByteString -> ByteString -> Bool
verify ByteString
pubRaw ByteString
msg ByteString
sigDer =
  case (ByteString -> Either String Point
decodePoint ByteString
pubRaw, 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 a 33-byte SEC1 compressed public key.
-- The point at infinity is SEC1-encoded as a single zero byte; it never
-- arises from a valid private scalar.
encodePoint :: Point -> ByteString
encodePoint :: Point -> ByteString
encodePoint Point
PointO = Word8 -> ByteString
BS.singleton Word8
0x00
encodePoint (Point Integer
x Integer
y) =
  let prefix :: Word8
prefix = if Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
y then Word8
0x02 else Word8
0x03
   in Word8 -> ByteString -> ByteString
BS.cons Word8
prefix (Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
32 Integer
x)

-- | Decode a 33-byte SEC1 compressed public key into a curve point,
-- rejecting inputs that do not name a point on the curve: X coordinates
-- outside the field and X coordinates for which x^3 + ax + b is a
-- quadratic non-residue (the candidate square root then fails the curve
-- equation). The point at infinity is not decodable (its SEC1 form is a
-- single zero byte, rejected by the length check).
decodePoint :: ByteString -> Either String Point
decodePoint :: ByteString -> Either String Point
decodePoint ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
33 = String -> Either String Point
forall a b. a -> Either a b
Left String
"Secp256k1.decodePoint: expected 33 bytes"
  | Word8
prefix Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x02 Bool -> Bool -> Bool
&& Word8
prefix Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x03 = String -> Either String Point
forall a b. a -> Either a b
Left String
"Secp256k1.decodePoint: bad prefix"
  | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
p = String -> Either String Point
forall a b. a -> Either a b
Left String
"Secp256k1.decodePoint: X coordinate out of range"
  | (Integer
y0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y0) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
rhs = String -> Either String Point
forall a b. a -> Either a b
Left String
"Secp256k1.decodePoint: point is not on the curve"
  | Bool
otherwise = Point -> Either String Point
forall a b. b -> Either a b
Right (Integer -> Integer -> Point
Point Integer
x Integer
y)
  where
    prefix :: Word8
prefix = HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ByteString
bs
    (Integer
p, Integer
a, Integer
b) = (Integer, Integer, Integer)
curveParams
    x :: Integer
x = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
bs)
    rhs :: Integer
rhs = (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
p
    -- p = 3 (mod 4), so a square root of rhs (if one exists) is
    -- rhs^((p+1)/4) mod p.
    y0 :: Integer
y0 = Integer -> Integer -> Integer -> Integer
expFast Integer
rhs ((Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
4) Integer
p
    wantOdd :: Bool
wantOdd = Word8
prefix Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x03
    y :: Integer
y = if Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
y0 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
wantOdd then Integer
y0 else Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
y0

-- | 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
"Secp256k1.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
"Secp256k1.decodeSignature: unexpected ASN.1 structure"