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 (4740B)

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