Noble.hs (4893B)
1 {-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns -fno-warn-orphans #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE OverloadedStrings #-} 4 {-# LANGUAGE RecordWildCards #-} 5 {-# LANGUAGE ViewPatterns #-} 6 7 module Noble ( 8 Ecdsa(..) 9 , execute_ecdsa 10 ) where 11 12 import Control.Exception 13 import Crypto.Curve.Secp256k1 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 Data.Word.Wider (Wider(..)) 21 import qualified Data.Word.Wider as Wider 22 import Test.Tasty (TestTree, testGroup) 23 import Test.Tasty.HUnit (assertEqual, assertBool, assertFailure, testCase) 24 25 decodeLenient :: BS.ByteString -> BS.ByteString 26 decodeLenient bs = case B16.decode bs of 27 Nothing -> error "bang" 28 Just b -> b 29 30 instance Eq ECDSA where 31 ECDSA r0 s0 == ECDSA r1 s1 = Wider.eq_vartime r0 r1 && Wider.eq_vartime s0 s1 32 33 data Ecdsa = Ecdsa { 34 ec_valid :: ![(Int, ValidTest)] 35 , ec_invalid :: !InvalidTest 36 } deriving Show 37 38 execute_ecdsa :: Context -> Ecdsa -> TestTree 39 execute_ecdsa tex Ecdsa {..} = testGroup "noble_ecdsa" [ 40 testGroup "valid" (fmap (execute_valid tex) ec_valid) 41 , testGroup "invalid (sign)" (fmap (execute_invalid_sign tex) iv_sign) 42 , testGroup "invalid (verify)" (fmap (execute_invalid_verify tex) iv_verify) 43 ] 44 where 45 InvalidTest {..} = ec_invalid 46 47 execute_valid :: Context -> (Int, ValidTest) -> TestTree 48 execute_valid tex (label, ValidTest {..}) = 49 testCase ("noble-secp256k1, valid (" <> show label <> ")") $ do 50 let msg = vt_m 51 x = vt_d 52 pec = parse_compact vt_signature 53 Just sig = _sign_ecdsa_no_hash x msg 54 Just sig' = _sign_ecdsa_no_hash' tex x msg 55 Just pub = derive_pub x 56 assertEqual mempty sig sig' 57 assertEqual mempty pec sig 58 assertBool mempty (_verify_ecdsa_no_hash msg pub sig) 59 assertBool mempty (_verify_ecdsa_no_hash' tex msg pub sig) 60 61 execute_invalid_sign :: Context -> (Int, InvalidSignTest) -> TestTree 62 execute_invalid_sign tex (label, InvalidSignTest {..}) = 63 testCase ("noble-secp256k1, invalid sign (" <> show label <> ")") $ do 64 let x = ivs_d 65 m = ivs_m 66 err <- catch (pure (_sign_ecdsa_no_hash x m) >> pure False) handler 67 err' <- catch (pure (_sign_ecdsa_no_hash' tex x m) >> pure False) handler 68 if err || err' 69 then assertFailure "expected error not caught" 70 else pure () 71 where 72 handler :: ErrorCall -> IO Bool 73 handler _ = pure True 74 75 execute_invalid_verify :: Context -> (Int, InvalidVerifyTest) -> TestTree 76 execute_invalid_verify tex (label, InvalidVerifyTest {..}) = 77 testCase ("noble-secp256k1, invalid verify (" <> show label <> ")") $ 78 case parse_point (decodeLenient ivv_Q) of 79 Nothing -> assertBool "no parse" True 80 Just pub -> do 81 let sig = parse_compact ivv_signature 82 ver = verify_ecdsa ivv_m pub sig 83 ver' = verify_ecdsa' tex ivv_m pub sig 84 assertBool mempty (not ver) 85 assertBool mempty (not ver') 86 87 -- parser helper 88 toBS :: T.Text -> BS.ByteString 89 toBS = decodeLenient . TE.encodeUtf8 90 91 -- parser helper 92 toSecKey :: T.Text -> Wider 93 toSecKey = unsafe_roll32 . toBS 94 95 instance A.FromJSON Ecdsa where 96 parseJSON = A.withObject "Ecdsa" $ \m -> Ecdsa 97 <$> fmap (zip [0..]) (m .: "valid") 98 <*> m .: "invalid" 99 100 data ValidTest = ValidTest { 101 vt_d :: !Wider 102 , vt_m :: !BS.ByteString 103 , vt_signature :: !BS.ByteString 104 } deriving Show 105 106 instance A.FromJSON ValidTest where 107 parseJSON = A.withObject "ValidTest" $ \m -> ValidTest 108 <$> fmap toSecKey (m .: "d") 109 <*> fmap toBS (m .: "m") 110 <*> fmap toBS (m .: "signature") 111 112 parse_compact :: BS.ByteString -> ECDSA 113 parse_compact bs = case parse_sig bs of 114 Nothing -> error "bang" 115 Just s -> s 116 117 data InvalidTest = InvalidTest { 118 iv_sign :: ![(Int, InvalidSignTest)] 119 , iv_verify :: ![(Int, InvalidVerifyTest)] 120 } deriving Show 121 122 instance A.FromJSON InvalidTest where 123 parseJSON = A.withObject "InvalidTest" $ \m -> InvalidTest 124 <$> fmap (zip [0..]) (m .: "sign") 125 <*> fmap (zip [0..]) (m .: "verify") 126 127 data InvalidSignTest = InvalidSignTest { 128 ivs_d :: !Wider 129 , ivs_m :: !BS.ByteString 130 } deriving Show 131 132 instance A.FromJSON InvalidSignTest where 133 parseJSON = A.withObject "InvalidSignTest" $ \m -> InvalidSignTest 134 <$> fmap toSecKey (m .: "d") 135 <*> fmap toBS (m .: "m") 136 137 data InvalidVerifyTest = InvalidVerifyTest { 138 ivv_Q :: !BS.ByteString 139 , ivv_m :: !BS.ByteString 140 , ivv_signature :: !BS.ByteString 141 } deriving Show 142 143 instance A.FromJSON InvalidVerifyTest where 144 parseJSON = A.withObject "InvalidVerifyTest" $ \m -> InvalidVerifyTest 145 <$> fmap TE.encodeUtf8 (m .: "Q") 146 <*> fmap toBS (m .: "m") 147 <*> fmap toBS (m .: "signature") 148