Skip to content
This repository was archived by the owner on Jan 9, 2026. It is now read-only.
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
66 changes: 66 additions & 0 deletions bench-secp256k1/Main.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,66 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module: Main
-- Copyright: Copyright © 2023 Kadena LLC.
-- License: MIT
-- Maintainer: Lars Kuhtz <lars@kadena.io>
-- Stability: experimental
--
-- TODO
--
module Main
( main
) where

import Control.DeepSeq

import Criterion
import Criterion.Main

-- internal modules

import Crypto.Secp256k1.Internal

-- -------------------------------------------------------------------------- --
-- Orphans

instance NFData Point where
rnf (Point x y) = x `seq` y `seq` ()
rnf O = ()

-- -------------------------------------------------------------------------- --
-- Main

-- randomZm :: IO M n
-- randomZm = bytesToZm <$> getEntropy 32

fn1, fn2 :: Fn
fn1 = fn 0xa1cc7887c498a8d4e948be34e9645b2db144dbc4dedb9aedda98c999d97a29ff
fn2 = fn 0x287ab1a7e15775383bf4ac0df141a72d457b39bb2bf9bbe394fd62da26e633cf

fp1 :: Fp
fp1 = fp 0x62995dd98b44b6524410c296ede3dbd80660d0fc9a8750bfd183ca815420e962
-- fp2 :: Fp
-- fp2 = fp 0xc46d0f0d64e22dfb204db3af660ed82c108eec13392dcce8aac41315454317a3

p1 :: Point
p1 = getPublicKey fn1

main :: IO ()
main = defaultMain
[ bgroup "sqrtFp"
[ bench "sqrtFp1" $ whnf sqrtFp1 fp1
, bench "sqrtFp2" $ whnf sqrtFp2 fp1
, bench "sqrtFp3" $ whnf sqrtFp3 fp1
]
, env (return p1) $ \ ~p ->
bgroup "multP"
[ bench "montgomeryMult" $ whnf (montgomeryMult fn2) p
, bench "doubleAndAdd" $ whnf (doubleAndAdd (nat fn2)) p
]
]
126 changes: 94 additions & 32 deletions ethereum.cabal
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
cabal-version: 2.4
cabal-version: 3.0
name: ethereum
version: 0.1.0.1
synopsis: Ethereum related Datatypes and Algorithms
Expand All @@ -8,15 +8,16 @@ license: BSD-3-Clause
license-file: LICENSE
author: Lars Kuhtz
maintainer: lakuhtz@gmail.com
copyright: Copyright (c) 2020-2022 Kadena LLC.
copyright: Copyright (c) 2020-2023 Kadena LLC.
category: Data
tested-with:
GHC==9.2.4
GHC==9.0.2
GHC==8.10.7
, GHC==9.4.2

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

add GHC 9.6.2?

Copy link
Copy Markdown
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That is included in #17, which can be merged as soon as chainweb-node supports aeson-2.2, which is currently blocked on haskell-servant/servant#1695.

, GHC==9.2.4
, GHC==9.0.2
, GHC==8.10.7
extra-source-files:
README.md
CHANGELOG.md
, README.md
, CHANGELOG.md

source-repository head
type: git
Expand All @@ -29,35 +30,96 @@ flag openssl-use-pkg-config

common openssl-common
c-sources:
cbits/prime.c
, cbits/prime.c
if flag(openssl-use-pkg-config)
pkgconfig-depends: libcrypto
else
extra-Libraries: crypto

-- -------------------------------------------------------------------------- --
-- Internal Library secp256k1

library secp256k1
hs-source-dirs: src-secp256k1
default-language: Haskell2010
ghc-options:
-Wall
exposed-modules:
, Crypto.Secp256k1
, Crypto.Secp256k1.Internal
build-depends:
, base >=4.11 && <5
, bytestring >=0.11.3
, exceptions >=0.10
, text >=1.2
if impl(ghc < 9.0.0)
build-depends:
, integer-gmp >=1.0.3

test-suite secp256k1-tests
type: exitcode-stdio-1.0
default-language: Haskell2010
hs-source-dirs: test-secp256k1
other-modules:
, Test.Crypto.Secp256k1.Internal
ghc-options:
-Wall
-threaded
-with-rtsopts=-N
main-is: Main.hs
build-depends:
, secp256k1

, QuickCheck >=2.14
, base >=4.11 && <5
, bytestring >=0.11.3
, entropy >=0.4
, hashes >=0.2.3
, quickcheck-instances >=0.3
, tasty >=1.3
, tasty-quickcheck >=0.10

benchmark secp256k1-benchmarks
type: exitcode-stdio-1.0
default-language: Haskell2010
hs-source-dirs: bench-secp256k1
ghc-options:
-Wall
-threaded
-with-rtsopts=-N
main-is: Main.hs
build-depends:
, secp256k1
, base >=4.11 && <5
, criterion >=1.6
, deepseq >=1.4

-- -------------------------------------------------------------------------- --
-- Library

library
import: openssl-common
hs-source-dirs: src
default-language: Haskell2010
ghc-options:
-Wall
exposed-modules:
Ethereum.Block
Ethereum.Ethhash
Ethereum.Ethhash.CacheSizes
Ethereum.Ethhash.DataSizes
Ethereum.HP
Ethereum.HP.Internal
Ethereum.Header
Ethereum.Misc
Ethereum.RLP
Ethereum.Receipt
Ethereum.Receipt.ReceiptProof
Ethereum.Transaction
Ethereum.Trie
Ethereum.Utils
, Ethereum.Block
, Ethereum.Ethhash
, Ethereum.Ethhash.CacheSizes
, Ethereum.Ethhash.DataSizes
, Ethereum.HP
, Ethereum.HP.Internal
, Ethereum.Header
, Ethereum.Misc
, Ethereum.RLP
, Ethereum.Receipt
, Ethereum.Receipt.ReceiptProof
, Ethereum.Transaction
, Ethereum.Trie
, Ethereum.Utils

Numeric.Checked
, Numeric.Checked
build-depends:
, base >=4.11 && <5
, aeson >=1.4.5
Expand All @@ -79,15 +141,15 @@ test-suite ethereum-tests
default-language: Haskell2010
hs-source-dirs: test
other-modules:
Test.Ethereum.Block
Test.Ethereum.Ethhash
Test.Ethereum.HP
-- Test.Ethereum.Header
Test.Ethereum.RLP
Test.Ethereum.Receipt
Test.Ethereum.Trie
Test.Orphans
Test.Utils
, Test.Ethereum.Block
, Test.Ethereum.Ethhash
, Test.Ethereum.HP
-- , Test.Ethereum.Header
, Test.Ethereum.RLP
, Test.Ethereum.Receipt
, Test.Ethereum.Trie
, Test.Orphans
, Test.Utils
ghc-options:
-Wall
-threaded
Expand Down
164 changes: 164 additions & 0 deletions src-secp256k1/Crypto/Secp256k1.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,164 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module: Crypto.Secp256k1
-- Copyright: Copyright © 2023 Kadena LLC.
-- License: MIT
-- Maintainer: Lars Kuhtz <lars@kadena.io>
-- Stability: experimental
--
module Crypto.Secp256k1
( EcdsaPublicKey
, ecdsaPublicKey
, ecdsaPublicKeyBytes
, EcdsaMessageDigest
, ecdsaMessageDigest
, EcdsaR
, ecdsaR
, EcdsaS
, ecdsaS
, ecdsaVerify
, ecdsaRecoverPublicKey
) where

import Control.Monad
import Control.Monad.Catch

import qualified Data.ByteString.Short as BS
import qualified Data.Text as T

import Numeric.Natural

-- internal modules

import Crypto.Secp256k1.Internal

-- -------------------------------------------------------------------------- --
-- Exceptions

newtype EcdsaException = EcdsaException T.Text
deriving (Show, Eq, Ord)

instance Exception EcdsaException

-- -------------------------------------------------------------------------- --
-- Utils

checkLength :: MonadThrow m => T.Text -> Natural -> BS.ShortByteString -> m BS.ShortByteString
checkLength label n bs
| l > n = throwM $ EcdsaException $
label <> ".checkLength: input too long. Expected " <> sshow n <> " but got " <> sshow l <> " bytes."
| l < n = throwM $ EcdsaException $
label <> ".checkLength: input too short. Expected " <> sshow n <> " but got " <> sshow l <> " bytes."
| otherwise = return bs
where
l = int $ BS.length bs

pointToBytes :: Point -> BS.ShortByteString
pointToBytes (Point x y) = BS.cons 0x04 (fpToShortBytes x <> fpToShortBytes y)
pointToBytes O = BS.pack [0x00]

publicKeyPointFromBytes :: MonadThrow m => BS.ShortByteString -> m Point
publicKeyPointFromBytes (BS.unpack -> [0x00]) = throwM $ EcdsaException
"pointFromBytes: point of infinity can't be used as public key"
publicKeyPointFromBytes bs = do
void $ checkLength "pointFrombBytes" 65 bs
(x, y) <- case BS.uncons bs of
Just (0x04, r) -> return $ BS.splitAt 32 r
Just (x, _) -> throwM $ EcdsaException $
"pointFromBytes: unsupported encoding. Expected 0x04 (uncomporessed point), but got " <> sshow x
Nothing -> error "pointFromBytes: missing first byte of input"
-- can't happend because we check that input is of length 65

case maybePublicKey (shortBytesToFp x) (shortBytesToFp y) of
Nothing -> throwM $ EcdsaException
"pointFromBytes: invalid public key. Coordinates are not a point on the curve"
Just p -> return p

-- -------------------------------------------------------------------------- --
-- Public API

newtype EcdsaPublicKey = EcdsaPublicKey Point
newtype EcdsaMessageDigest = EcdsaMessageDigest Fn
newtype EcdsaR = EcdsaR Fn
newtype EcdsaS = EcdsaS Fn

-- | Input: 65 bytes that represent an uncompressed (prefix 0x04) secp256k1
-- curve point.
--
ecdsaPublicKey :: MonadThrow m => BS.ShortByteString -> m EcdsaPublicKey
ecdsaPublicKey = fmap EcdsaPublicKey . publicKeyPointFromBytes

-- | Returns 65 bytes that represent a public key encoded as uncompressed
-- secp256k1 curve point.
--
ecdsaPublicKeyBytes :: EcdsaPublicKey -> BS.ShortByteString
ecdsaPublicKeyBytes (EcdsaPublicKey p) = pointToBytes p

-- | Input: 32 bytes that represent a message digest.
--
-- It is expected that the digest is produced by a cryptographic hash functions
-- that produceds digests of at least 32 bytes. If the original digest has more
-- than 32 bytes the input should contain only the leftmost 32 bytes (assuming
-- that security of the hash is distributed uniformily accross all bits of the
-- original digest).
--
ecdsaMessageDigest :: MonadThrow m => BS.ShortByteString -> m EcdsaMessageDigest
ecdsaMessageDigest = fmap (EcdsaMessageDigest . shortBytesToFn)
. checkLength "EcdsaMessageDigest" 32

-- | Input: 32 byte long R value of the secp256k1 ECDSA signature
--
ecdsaR :: MonadThrow m => BS.ShortByteString -> m EcdsaR
ecdsaR = fmap (EcdsaR . shortBytesToFn) . checkLength "ecdsaR" 32

-- | Input: 32 byte long S value of the secp256k1 ECDSA signature
--
ecdsaS :: MonadThrow m => BS.ShortByteString -> m EcdsaS
ecdsaS = fmap (EcdsaS . shortBytesToFn) . checkLength "ecdsaS" 32

ecdsaVerify
:: MonadThrow m
=> EcdsaMessageDigest
-- ^ A 32 bytes long message digest that was compute with the same hash
-- function that was used for producing the signature.
-> EcdsaPublicKey
-- ^ The public key of the signer encoded as 65 byte long uncompressed
-- curve point.
-> EcdsaR
-- ^ The R value of the input signature
-> EcdsaS
-- ^ The S value of the input singature
-> m Bool
ecdsaVerify (EcdsaMessageDigest d) (EcdsaPublicKey p) (EcdsaR r) (EcdsaS s) =
case verify d r s p of
Left t -> throwM $ EcdsaException t
Right b -> return b

ecdsaRecoverPublicKey
:: EcdsaMessageDigest
-- ^ A 32 bytes long message digest that was compute with the same hash
-- function that was used for producing the signature.
-> EcdsaR
-- ^ The R value of the input signature
-> EcdsaS
-- ^ The S value of the input singature
-> Bool
-- ^ whether parity of the public recovered public key is odd.
--
-- If you don't know this parameter it is safe to try both options, at
-- the cost of taking on average 1.5 times more computation time to
-- compute the result.
-> Bool
-- ^ whether the second solution for the public key is returned. This
-- parameter is almost surely always @False@.
--
-- If you don't know this value it is safe to assume that it is @False@.
--
-> Maybe EcdsaPublicKey
ecdsaRecoverPublicKey (EcdsaMessageDigest d) (EcdsaR r) (EcdsaS s) oddY secondKey =
EcdsaPublicKey <$> recoverPublicKey d r s oddY secondKey

Loading