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

BIP340.hs (2972B)

      1 {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
      2 {-# LANGUAGE OverloadedStrings #-}
      3 {-# LANGUAGE RecordWildCards #-}
      4 {-# LANGUAGE ViewPatterns #-}
      5 
      6 module BIP340 (
      7     cases
      8   , execute
      9   ) where
     10 
     11 import Control.Applicative
     12 import Crypto.Curve.Secp256k1
     13 import qualified Data.Attoparsec.ByteString.Char8 as AT
     14 import qualified Data.ByteString as BS
     15 import qualified Data.ByteString.Base16 as B16
     16 import Test.Tasty
     17 import Test.Tasty.HUnit
     18 
     19 decodeLenient :: BS.ByteString -> BS.ByteString
     20 decodeLenient bs = case B16.decode bs of
     21   Nothing -> error "bang"
     22   Just b -> b
     23 
     24 data Case = Case {
     25     c_index   :: !Int
     26   , c_sk      :: !BS.ByteString
     27   , c_pk      :: !BS.ByteString
     28   , c_aux     :: !BS.ByteString
     29   , c_msg     :: !BS.ByteString
     30   , c_sig     :: !BS.ByteString
     31   , c_res     :: !Bool
     32   , c_comment :: !BS.ByteString
     33   } deriving Show
     34 
     35 execute :: Context -> Case -> TestTree
     36 execute tex Case {..} = testCase ("bip0340 " <> show c_index) $
     37   case parse_point (decodeLenient c_pk) of
     38     Nothing -> assertBool mempty (not c_res)
     39     Just pk -> do
     40       if   c_sk == mempty
     41       then do -- no signature; test verification
     42         let ver  = verify_schnorr c_msg pk c_sig
     43             ver' = verify_schnorr' tex c_msg pk c_sig
     44         if   c_res
     45         then do
     46           assertBool mempty ver
     47           assertBool mempty ver'
     48         else do
     49           assertBool mempty (not ver)
     50           assertBool mempty (not ver')
     51       -- XX test pubkey derivation from sk
     52       else do -- signature present; test sig too
     53         let sk = unsafe_roll32 c_sk
     54             Just sig  = sign_schnorr sk c_msg c_aux
     55             Just sig' = sign_schnorr' tex sk c_msg c_aux
     56             ver  = verify_schnorr c_msg pk sig
     57             ver' = verify_schnorr' tex c_msg pk sig
     58         assertEqual mempty c_sig sig
     59         assertEqual mempty c_sig sig'
     60         if   c_res
     61         then do
     62           assertBool mempty ver
     63           assertBool mempty ver'
     64         else do
     65           assertBool mempty (not ver)
     66           assertBool mempty (not ver')
     67 
     68 header :: AT.Parser ()
     69 header = do
     70   _ <- AT.string "index,secret key,public key,aux_rand,message,signature,verification result,comment"
     71   AT.endOfLine
     72 
     73 test_case :: AT.Parser Case
     74 test_case = do
     75   c_index <- AT.decimal AT.<?> "index"
     76   _ <- AT.char ','
     77   c_sk <- fmap decodeLenient (AT.takeWhile (/= ',') AT.<?> "sk")
     78   _ <- AT.char ','
     79   c_pk <- AT.takeWhile1 (/= ',') AT.<?> "pk"
     80   _ <- AT.char ','
     81   c_aux <- fmap decodeLenient (AT.takeWhile (/= ',') AT.<?> "aux")
     82   _ <- AT.char ','
     83   c_msg <- fmap decodeLenient (AT.takeWhile (/= ',') AT.<?> "msg")
     84   _ <- AT.char ','
     85   c_sig <- fmap decodeLenient (AT.takeWhile1 (/= ',') AT.<?> "sig")
     86   _ <- AT.char ','
     87   c_res <- (AT.string "TRUE" *> pure True) <|> (AT.string "FALSE" *> pure False)
     88             AT.<?> "res"
     89   _ <- AT.char ','
     90   c_comment <- AT.takeWhile (/= '\n') AT.<?> "comment"
     91   AT.endOfLine
     92   pure Case {..}
     93 
     94 cases :: AT.Parser [Case]
     95 cases = header *> AT.many1 test_case
     96