csecp256k1

Haskell FFI bindings to bitcoin-core/secp256k1 (docs.ppad.tech/csecp256k1).
git clone git://git.ppad.tech/csecp256k1.git
Log | Files | Refs | README | LICENSE

BIP340.hs (2511B)

      1 {-# LANGUAGE OverloadedStrings #-}
      2 {-# LANGUAGE RecordWildCards #-}
      3 {-# LANGUAGE ViewPatterns #-}
      4 
      5 module BIP340 (
      6     cases
      7   , execute
      8   ) where
      9 
     10 import Control.Applicative
     11 import Control.Exception
     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 data Case = Case {
     20     c_index   :: !Int
     21   , c_sk      :: !BS.ByteString
     22   , c_pk      :: !BS.ByteString
     23   , c_aux     :: !BS.ByteString
     24   , c_msg     :: !BS.ByteString
     25   , c_sig     :: !BS.ByteString
     26   , c_res     :: !Bool
     27   , c_comment :: !BS.ByteString
     28   } deriving Show
     29 
     30 execute :: Context -> Case -> TestTree
     31 execute tex Case {..} = testCase ("bip0340 " <> show c_index) $ do
     32   par <- try (parse_xonly tex (B16.decodeLenient c_pk))
     33           :: IO (Either Secp256k1Exception XOnlyPub)
     34   case par of
     35     Left _ -> assertBool mempty (not c_res)
     36     Right (XOnlyPub pub) -> do
     37       let pk = Pub pub
     38       if   c_sk == mempty
     39       then do -- no signature; test verification
     40         ver <- verify_schnorr tex pk c_msg c_sig
     41         if   c_res
     42         then assertBool mempty ver
     43         else assertBool mempty (not ver)
     44       -- XX test pubkey derivation from sk
     45       else do -- signature present; test sig too
     46         sig <- sign_schnorr tex c_msg c_sk c_aux
     47         ver <- verify_schnorr tex pk c_msg sig
     48         assertEqual mempty c_sig sig
     49         if   c_res
     50         then assertBool mempty ver
     51         else assertBool mempty (not ver)
     52 
     53 header :: AT.Parser ()
     54 header = do
     55   _ <- AT.string "index,secret key,public key,aux_rand,message,signature,verification result,comment"
     56   AT.endOfLine
     57 
     58 test_case :: AT.Parser Case
     59 test_case = do
     60   c_index <- AT.decimal AT.<?> "index"
     61   _ <- AT.char ','
     62   c_sk <- fmap B16.decodeLenient (AT.takeWhile (/= ',') AT.<?> "sk")
     63   _ <- AT.char ','
     64   c_pk <- AT.takeWhile1 (/= ',') AT.<?> "pk"
     65   _ <- AT.char ','
     66   c_aux <- fmap B16.decodeLenient (AT.takeWhile (/= ',') AT.<?> "aux")
     67   _ <- AT.char ','
     68   c_msg <- fmap B16.decodeLenient (AT.takeWhile (/= ',') AT.<?> "msg")
     69   _ <- AT.char ','
     70   c_sig <- fmap B16.decodeLenient (AT.takeWhile1 (/= ',') AT.<?> "sig")
     71   _ <- AT.char ','
     72   c_res <- (AT.string "TRUE" *> pure True) <|> (AT.string "FALSE" *> pure False)
     73             AT.<?> "res"
     74   _ <- AT.char ','
     75   c_comment <- AT.takeWhile (/= '\n') AT.<?> "comment"
     76   AT.endOfLine
     77   pure Case {..}
     78 
     79 cases :: AT.Parser [Case]
     80 cases = header *> AT.many1 test_case
     81