secp256k1

Pure Haskell Schnorr, ECDSA on the elliptic curve secp256k1 (docs.ppad.tech/secp256k1).
git clone git://git.ppad.tech/secp256k1.git
Log | Files | Refs | README | LICENSE

Noble.hs (4625B)

      1 {-# LANGUAGE BangPatterns #-}
      2 {-# LANGUAGE OverloadedStrings #-}
      3 {-# LANGUAGE RecordWildCards #-}
      4 {-# LANGUAGE ViewPatterns #-}
      5 
      6 module Noble (
      7     Ecdsa(..)
      8   , execute_ecdsa
      9   ) where
     10 
     11 import Control.Exception
     12 import Crypto.Curve.Secp256k1
     13 import Data.Aeson ((.:))
     14 import qualified Data.Aeson as A
     15 import qualified Data.ByteString as BS
     16 import qualified Data.ByteString.Base16 as B16
     17 import qualified Data.Text as T
     18 import qualified Data.Text.Encoding as TE
     19 import qualified GHC.Num.Integer as I
     20 import Test.Tasty (TestTree, testGroup)
     21 import Test.Tasty.HUnit (assertEqual, assertBool, assertFailure, testCase)
     22 
     23 data Ecdsa = Ecdsa {
     24     ec_valid   :: ![(Int, ValidTest)]
     25   , ec_invalid :: !InvalidTest
     26   } deriving Show
     27 
     28 execute_ecdsa :: Context -> Ecdsa -> TestTree
     29 execute_ecdsa tex Ecdsa {..} = testGroup "noble_ecdsa" [
     30       testGroup "valid" (fmap (execute_valid tex) ec_valid)
     31     , testGroup "invalid (sign)" (fmap (execute_invalid_sign tex) iv_sign)
     32     , testGroup "invalid (verify)" (fmap (execute_invalid_verify tex) iv_verify)
     33     ]
     34   where
     35     InvalidTest {..} = ec_invalid
     36 
     37 execute_valid :: Context -> (Int, ValidTest) -> TestTree
     38 execute_valid tex (label, ValidTest {..}) =
     39   testCase ("noble-secp256k1, valid (" <> show label <> ")") $ do
     40     let msg = vt_m
     41         x   = vt_d
     42         pec = parse_compact vt_signature
     43         sig = _sign_ecdsa_no_hash x msg
     44         sig' = _sign_ecdsa_no_hash' tex x msg
     45     assertEqual mempty sig sig'
     46     assertEqual mempty pec sig
     47 
     48 execute_invalid_sign :: Context -> (Int, InvalidSignTest) -> TestTree
     49 execute_invalid_sign tex (label, InvalidSignTest {..}) =
     50     testCase ("noble-secp256k1, invalid sign (" <> show label <> ")") $ do
     51       let x   = ivs_d
     52           m   = ivs_m
     53       err <- catch (pure (_sign_ecdsa_no_hash x m) >> pure False) handler
     54       err' <- catch (pure (_sign_ecdsa_no_hash' tex x m) >> pure False) handler
     55       if   err || err'
     56       then assertFailure "expected error not caught"
     57       else pure ()
     58   where
     59     handler :: ErrorCall -> IO Bool
     60     handler _ = pure True
     61 
     62 execute_invalid_verify :: Context -> (Int, InvalidVerifyTest) -> TestTree
     63 execute_invalid_verify tex (label, InvalidVerifyTest {..}) =
     64   testCase ("noble-secp256k1, invalid verify (" <> show label <> ")") $
     65     case parse_point (B16.decodeLenient ivv_Q) of
     66       Nothing -> assertBool "no parse" True
     67       Just pub -> do
     68         let sig = parse_compact ivv_signature
     69             ver = verify_ecdsa ivv_m pub sig
     70             ver' = verify_ecdsa' tex ivv_m pub sig
     71         assertBool mempty (not ver)
     72         assertBool mempty (not ver')
     73 
     74 fi :: (Integral a, Num b) => a -> b
     75 fi = fromIntegral
     76 {-# INLINE fi #-}
     77 
     78 -- parser helper
     79 toBS :: T.Text -> BS.ByteString
     80 toBS = B16.decodeLenient . TE.encodeUtf8
     81 
     82 -- parser helper
     83 toSecKey :: T.Text -> Integer
     84 toSecKey = roll . toBS
     85 
     86 -- big-endian bytestring decoding
     87 roll :: BS.ByteString -> Integer
     88 roll = BS.foldl' unstep 0 where
     89   unstep a (fi -> b) = (a `I.integerShiftL` 8) `I.integerOr` b
     90 
     91 instance A.FromJSON Ecdsa where
     92   parseJSON = A.withObject "Ecdsa" $ \m -> Ecdsa
     93     <$> fmap (zip [0..]) (m .: "valid")
     94     <*> m .: "invalid"
     95 
     96 data ValidTest = ValidTest {
     97     vt_d           :: !Integer
     98   , vt_m           :: !BS.ByteString
     99   , vt_signature   :: !BS.ByteString
    100   } deriving Show
    101 
    102 instance A.FromJSON ValidTest where
    103   parseJSON = A.withObject "ValidTest" $ \m -> ValidTest
    104     <$> fmap toSecKey (m .: "d")
    105     <*> fmap toBS (m .: "m")
    106     <*> fmap toBS (m .: "signature")
    107 
    108 parse_compact :: BS.ByteString -> ECDSA
    109 parse_compact bs = case parse_sig bs of
    110   Nothing -> error "bang"
    111   Just s -> s
    112 
    113 data InvalidTest = InvalidTest {
    114     iv_sign   :: ![(Int, InvalidSignTest)]
    115   , iv_verify :: ![(Int, InvalidVerifyTest)]
    116   } deriving Show
    117 
    118 instance A.FromJSON InvalidTest where
    119   parseJSON = A.withObject "InvalidTest" $ \m -> InvalidTest
    120     <$> fmap (zip [0..]) (m .: "sign")
    121     <*> fmap (zip [0..]) (m .: "verify")
    122 
    123 data InvalidSignTest = InvalidSignTest {
    124     ivs_d           :: !Integer
    125   , ivs_m           :: !BS.ByteString
    126   } deriving Show
    127 
    128 instance A.FromJSON InvalidSignTest where
    129   parseJSON = A.withObject "InvalidSignTest" $ \m -> InvalidSignTest
    130     <$> fmap toSecKey (m .: "d")
    131     <*> fmap toBS (m .: "m")
    132 
    133 data InvalidVerifyTest = InvalidVerifyTest {
    134     ivv_Q           :: !BS.ByteString
    135   , ivv_m           :: !BS.ByteString
    136   , ivv_signature   :: !BS.ByteString
    137   } deriving Show
    138 
    139 instance A.FromJSON InvalidVerifyTest where
    140   parseJSON = A.withObject "InvalidVerifyTest" $ \m -> InvalidVerifyTest
    141     <$> fmap TE.encodeUtf8 (m .: "Q")
    142     <*> fmap toBS (m .: "m")
    143     <*> fmap toBS (m .: "signature")
    144