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

      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 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) $ do
     37   par <- try (parse_xonly tex (decodeLenient c_pk))
     38           :: IO (Either Secp256k1Exception XOnlyPub)
     39   case par of
     40     Left _ -> assertBool mempty (not c_res)
     41     Right (XOnlyPub pub) -> do
     42       let pk = Pub pub
     43       if   c_sk == mempty
     44       then do -- no signature; test verification
     45         ver <- verify_schnorr tex pk c_msg c_sig
     46         if   c_res
     47         then assertBool mempty ver
     48         else assertBool mempty (not ver)
     49       -- XX test pubkey derivation from sk
     50       else do -- signature present; test sig too
     51         sig <- sign_schnorr tex c_msg c_sk c_aux
     52         ver <- verify_schnorr tex pk c_msg sig
     53         assertEqual mempty c_sig sig
     54         if   c_res
     55         then assertBool mempty ver
     56         else assertBool mempty (not ver)
     57 
     58 header :: AT.Parser ()
     59 header = do
     60   _ <- AT.string "index,secret key,public key,aux_rand,message,signature,verification result,comment"
     61   AT.endOfLine
     62 
     63 test_case :: AT.Parser Case
     64 test_case = do
     65   c_index <- AT.decimal AT.<?> "index"
     66   _ <- AT.char ','
     67   c_sk <- fmap decodeLenient (AT.takeWhile (/= ',') AT.<?> "sk")
     68   _ <- AT.char ','
     69   c_pk <- AT.takeWhile1 (/= ',') AT.<?> "pk"
     70   _ <- AT.char ','
     71   c_aux <- fmap decodeLenient (AT.takeWhile (/= ',') AT.<?> "aux")
     72   _ <- AT.char ','
     73   c_msg <- fmap decodeLenient (AT.takeWhile (/= ',') AT.<?> "msg")
     74   _ <- AT.char ','
     75   c_sig <- fmap decodeLenient (AT.takeWhile1 (/= ',') AT.<?> "sig")
     76   _ <- AT.char ','
     77   c_res <- (AT.string "TRUE" *> pure True) <|> (AT.string "FALSE" *> pure False)
     78             AT.<?> "res"
     79   _ <- AT.char ','
     80   c_comment <- AT.takeWhile (/= '\n') AT.<?> "comment"
     81   AT.endOfLine
     82   pure Case {..}
     83 
     84 cases :: AT.Parser [Case]
     85 cases = header *> AT.many1 test_case
     86