{-|
Module      : Helper functions to sign a transaction and derive address from
Description :        for the EVM given a secret key
-}
module EVM.Sign where

import Data.ByteString qualified as BS
import Data.Maybe (fromMaybe)
import Data.Word
import Crypto.Hash qualified as Crypto
import Crypto.PubKey.ECC.ECDSA (signDigestWith, PrivateKey(..), Signature(..))
import Crypto.PubKey.ECC.Types (getCurveByName, CurveName(..), Point(..))
import Crypto.PubKey.ECC.Generate (generateQ)
import Witch (unsafeInto)

import EVM.ABI (encodeAbiValue, AbiValue(..))
import EVM.Types
import EVM.Expr (exprToAddr)
import EVM.Precompiled

-- Given a secret key, generates the address
deriveAddr :: Integer -> Maybe Addr
deriveAddr :: Integer -> Maybe Addr
deriveAddr Integer
sk =
  case Point
pubPoint of
    Point
PointO -> Maybe Addr
forall a. Maybe a
Nothing
    Point Integer
x Integer
y ->
      -- See yellow paper #286
      let pub :: ByteString
pub = [ByteString] -> ByteString
BS.concat [ Integer -> ByteString
encodeInt Integer
x, Integer -> ByteString
encodeInt Integer
y ]
          addr :: Expr 'EWord
addr = W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord)
-> (ByteString -> W256) -> ByteString -> Expr 'EWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word256 -> W256
W256 (Word256 -> W256) -> (ByteString -> Word256) -> ByteString -> W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word256
word256 (ByteString -> Word256)
-> (ByteString -> ByteString) -> ByteString -> Word256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop Int
12 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.take Int
32 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
keccakBytes (ByteString -> Expr 'EWord) -> ByteString -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ ByteString
pub
      in Expr 'EWord -> Maybe Addr
exprToAddr Expr 'EWord
addr
  where
    curve :: Curve
curve = CurveName -> Curve
getCurveByName CurveName
SEC_p256k1
    pubPoint :: Point
pubPoint = Curve -> Integer -> Point
generateQ Curve
curve Integer
sk
    encodeInt :: Integer -> ByteString
encodeInt = AbiValue -> ByteString
encodeAbiValue (AbiValue -> ByteString)
-> (Integer -> AbiValue) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word256 -> AbiValue
AbiUInt Int
256 (Word256 -> AbiValue)
-> (Integer -> Word256) -> Integer -> AbiValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word256
forall a. Num a => Integer -> a
fromInteger

sign :: W256 -> Integer -> (Word8, W256, W256)
sign :: W256 -> Integer -> (Word8, W256, W256)
sign W256
hash Integer
sk = (Word8
v, W256
r, W256
s)
  where
    -- setup curve params
    curve :: Curve
curve = CurveName -> Curve
getCurveByName CurveName
SEC_p256k1
    priv :: PrivateKey
priv = Curve -> Integer -> PrivateKey
PrivateKey Curve
curve Integer
sk
    digest :: Digest Keccak_256
digest = Digest Keccak_256 -> Maybe (Digest Keccak_256) -> Digest Keccak_256
forall a. a -> Maybe a -> a
fromMaybe
      ([Char] -> Digest Keccak_256
forall a. HasCallStack => [Char] -> a
internalError ([Char] -> Digest Keccak_256) -> [Char] -> Digest Keccak_256
forall a b. (a -> b) -> a -> b
$ [Char]
"could produce a digest from " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> W256 -> [Char]
forall a. Show a => a -> [Char]
show W256
hash)
      (ByteString -> Maybe (Digest Keccak_256)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
Crypto.digestFromByteString (W256 -> ByteString
word256Bytes W256
hash))

    -- sign message
    sig :: Signature
sig = PrivateKey -> Digest Keccak_256 -> Signature
ethsign PrivateKey
priv Digest Keccak_256
digest
    r :: W256
r = Integer -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Integer -> W256) -> Integer -> W256
forall a b. (a -> b) -> a -> b
$ Signature -> Integer
sign_r Signature
sig
    s :: W256
s = Integer -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto Integer
lowS

    -- this is a little bit sad, but cryptonite doesn't give us back a v value
    -- so we compute it by guessing one, and then seeing if that gives us the right answer from ecrecover
    v :: Word8
v = if W256 -> W256 -> W256 -> W256 -> Maybe Addr
ecrec W256
28 W256
r W256
s W256
hash Maybe Addr -> Maybe Addr -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Maybe Addr
deriveAddr Integer
sk
        then Word8
28
        else Word8
27

    -- we always use the lower S value to conform with EIP2 (re: ECDSA transaction malleability)
    -- https://eips.ethereum.org/EIPS/eip-2
    secpOrder :: Integer
secpOrder = Integer
0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141 :: Integer
    lowS :: Integer
lowS = if Signature -> Integer
sign_s Signature
sig Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
secpOrder Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2
           then Integer
secpOrder Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Signature -> Integer
sign_s Signature
sig
           else Signature -> Integer
sign_s Signature
sig

-- | We don't want to introduce the machinery needed to sign with a random nonce,
-- so we just use the same nonce every time (420). This is obviously very
-- insecure, but fine for testing purposes.
ethsign :: PrivateKey -> Crypto.Digest Crypto.Keccak_256 -> Signature
ethsign :: PrivateKey -> Digest Keccak_256 -> Signature
ethsign PrivateKey
sk Digest Keccak_256
digest = Integer -> Signature
go Integer
420
  where
    go :: Integer -> Signature
go Integer
k = case Integer -> PrivateKey -> Digest Keccak_256 -> Maybe Signature
forall hash.
HashAlgorithm hash =>
Integer -> PrivateKey -> Digest hash -> Maybe Signature
signDigestWith Integer
k PrivateKey
sk Digest Keccak_256
digest of
       Maybe Signature
Nothing  -> Integer -> Signature
go (Integer
k Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
       Just Signature
sig -> Signature
sig

ecrec :: W256 -> W256 -> W256 -> W256 -> Maybe Addr
ecrec :: W256 -> W256 -> W256 -> W256 -> Maybe Addr
ecrec W256
v W256
r W256
s W256
e = W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (W256 -> Addr) -> (ByteString -> W256) -> ByteString -> Addr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> W256
word (ByteString -> Addr) -> Maybe ByteString -> Maybe Addr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
1 ByteString
input Int
32
  where input :: ByteString
input = [ByteString] -> ByteString
BS.concat (W256 -> ByteString
word256Bytes (W256 -> ByteString) -> [W256] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [W256
e, W256
v, W256
r, W256
s])