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

      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 Crypto.Curve.Secp256k1
     12 import qualified Data.Attoparsec.ByteString.Char8 as AT
     13 import qualified Data.ByteString as BS
     14 import qualified Data.ByteString.Base16 as B16
     15 import qualified GHC.Num.Integer as I
     16 import Test.Tasty
     17 import Test.Tasty.HUnit
     18 
     19 -- XX make a test prelude instead of copying/pasting these things everywhere
     20 
     21 fi :: (Integral a, Num b) => a -> b
     22 fi = fromIntegral
     23 {-# INLINE fi #-}
     24 
     25 roll :: BS.ByteString -> Integer
     26 roll = BS.foldl' unstep 0 where
     27   unstep a (fi -> b) = (a `I.integerShiftL` 8) `I.integerOr` b
     28 
     29 data Case = Case {
     30     c_index   :: !Int
     31   , c_sk      :: !BS.ByteString
     32   , c_pk      :: !BS.ByteString
     33   , c_aux     :: !BS.ByteString
     34   , c_msg     :: !BS.ByteString
     35   , c_sig     :: !BS.ByteString
     36   , c_res     :: !Bool
     37   , c_comment :: !BS.ByteString
     38   } deriving Show
     39 
     40 execute :: Case -> TestTree
     41 execute Case {..} = testCase ("bip0340 " <> show c_index) $
     42   case parse_point c_pk of
     43     Nothing -> assertBool mempty (not c_res)
     44     Just pk -> do
     45       if   c_sk == mempty
     46       then do -- no signature; test verification
     47         let ver = verify_schnorr c_msg pk c_sig
     48         if   c_res
     49         then assertBool mempty ver
     50         else assertBool mempty (not ver)
     51       -- XX test pubkey derivation from sk
     52       else do -- signature present; test sig too
     53         let sk = roll c_sk
     54             sig = sign_schnorr sk c_msg c_aux
     55             ver = verify_schnorr c_msg pk sig
     56         assertEqual mempty c_sig sig
     57         if   c_res
     58         then assertBool mempty ver
     59         else assertBool mempty (not ver)
     60 
     61 header :: AT.Parser ()
     62 header = do
     63   _ <- AT.string "index,secret key,public key,aux_rand,message,signature,verification result,comment"
     64   AT.endOfLine
     65 
     66 test_case :: AT.Parser Case
     67 test_case = do
     68   c_index <- AT.decimal AT.<?> "index"
     69   _ <- AT.char ','
     70   c_sk <- fmap B16.decodeLenient (AT.takeWhile (/= ',') AT.<?> "sk")
     71   _ <- AT.char ','
     72   c_pk <- AT.takeWhile1 (/= ',') AT.<?> "pk"
     73   _ <- AT.char ','
     74   c_aux <- fmap B16.decodeLenient (AT.takeWhile (/= ',') AT.<?> "aux")
     75   _ <- AT.char ','
     76   c_msg <- fmap B16.decodeLenient (AT.takeWhile (/= ',') AT.<?> "msg")
     77   _ <- AT.char ','
     78   c_sig <- fmap B16.decodeLenient (AT.takeWhile1 (/= ',') AT.<?> "sig")
     79   _ <- AT.char ','
     80   c_res <- (AT.string "TRUE" *> pure True) <|> (AT.string "FALSE" *> pure False)
     81             AT.<?> "res"
     82   _ <- AT.char ','
     83   c_comment <- AT.takeWhile (/= '\n') AT.<?> "comment"
     84   AT.endOfLine
     85   pure Case {..}
     86 
     87 cases :: AT.Parser [Case]
     88 cases = header *> AT.many1 test_case
     89