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

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