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

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