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

Wycheproof.hs (3116B)

      1 {-# LANGUAGE BangPatterns #-}
      2 {-# LANGUAGE OverloadedStrings #-}
      3 {-# LANGUAGE RecordWildCards #-}
      4 {-# LANGUAGE ViewPatterns #-}
      5 
      6 module Wycheproof (
      7     Wycheproof(..)
      8   , execute_group
      9   )  where
     10 
     11 import Control.Exception
     12 import Crypto.Curve.Secp256k1
     13 import qualified Crypto.Hash.SHA256 as SHA256
     14 import Data.Aeson ((.:))
     15 import qualified Data.Aeson as A
     16 import qualified Data.ByteString.Base16 as B16
     17 import qualified Data.Text as T
     18 import qualified Data.Text.Encoding as TE
     19 import Test.Tasty (TestTree, testGroup)
     20 import Test.Tasty.HUnit (assertBool, testCase)
     21 
     22 execute_group :: Context -> EcdsaTestGroup -> IO TestTree
     23 execute_group tex EcdsaTestGroup {..} = do
     24     let raw = B16.decodeLenient (TE.encodeUtf8 pk_uncompressed)
     25     pub <- parse_pub tex raw
     26     let tests = fmap (execute tex pub) etg_tests
     27     pure (testGroup msg tests)
     28   where
     29     msg = "wycheproof (" <> T.unpack etg_type <> ", " <> T.unpack etg_sha <> ")"
     30     PublicKey {..} = etg_publicKey
     31 
     32 execute :: Context -> Pub -> EcdsaVerifyTest -> TestTree
     33 execute tex pub EcdsaVerifyTest {..} = testCase report $ do
     34     let msg = SHA256.hash (B16.decodeLenient (TE.encodeUtf8 t_msg))
     35         sig = B16.decodeLenient (TE.encodeUtf8 t_sig)
     36     syg <- try (parse_der tex sig) :: IO (Either Secp256k1Exception Sig)
     37     case syg of
     38       Left _  -> assertBool mempty (t_result == "invalid")
     39       Right s -> do
     40         ver <- verify_ecdsa tex pub msg s
     41         if   t_result == "invalid"
     42         then assertBool mempty (not ver)
     43         else assertBool mempty ver
     44   where
     45     report = "wycheproof " <> show t_tcId
     46 
     47 data Wycheproof = Wycheproof {
     48     wp_algorithm        :: !T.Text
     49   , wp_generatorVersion :: !T.Text
     50   , wp_numberOfTests    :: !Int
     51   , wp_testGroups       :: ![EcdsaTestGroup]
     52   } deriving Show
     53 
     54 instance A.FromJSON Wycheproof where
     55   parseJSON = A.withObject "Wycheproof" $ \m -> Wycheproof
     56     <$> m .: "algorithm"
     57     <*> m .: "generatorVersion"
     58     <*> m .: "numberOfTests"
     59     <*> m .: "testGroups"
     60 
     61 data EcdsaTestGroup = EcdsaTestGroup {
     62     etg_type      :: !T.Text
     63   , etg_publicKey :: !PublicKey
     64   , etg_sha       :: !T.Text
     65   , etg_tests     :: ![EcdsaVerifyTest]
     66   } deriving Show
     67 
     68 instance A.FromJSON EcdsaTestGroup where
     69   parseJSON = A.withObject "EcdsaTestGroup" $ \m -> EcdsaTestGroup
     70     <$> m .: "type"
     71     <*> m .: "publicKey"
     72     <*> m .: "sha"
     73     <*> m .: "tests"
     74 
     75 data PublicKey = PublicKey {
     76     pk_type         :: !T.Text
     77   , pk_curve        :: !T.Text
     78   , pk_keySize      :: !Int
     79   , pk_uncompressed :: !T.Text
     80   } deriving Show
     81 
     82 instance A.FromJSON PublicKey where
     83   parseJSON = A.withObject "PublicKey" $ \m -> PublicKey
     84     <$> m .: "type"
     85     <*> m .: "curve"
     86     <*> m .: "keySize"
     87     <*> m .: "uncompressed"
     88 
     89 data EcdsaVerifyTest = EcdsaVerifyTest {
     90     t_tcId    :: !Int
     91   , t_comment :: !T.Text
     92   , t_msg     :: !T.Text
     93   , t_sig     :: !T.Text
     94   , t_result  :: !T.Text
     95   } deriving Show
     96 
     97 instance A.FromJSON EcdsaVerifyTest where
     98   parseJSON = A.withObject "EcdsaVerifyTest" $ \m -> EcdsaVerifyTest
     99     <$> m .: "tcId"
    100     <*> m .: "comment"
    101     <*> m .: "msg"
    102     <*> m .: "sig"
    103     <*> m .: "result"
    104