Wycheproof.hs (5264B)
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 Crypto.Curve.Secp256k1 12 import Data.Aeson ((.:)) 13 import qualified Data.Aeson as A 14 import qualified Data.Attoparsec.ByteString as AT 15 import qualified Data.Bits as B 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 qualified GHC.Num.Integer as I 21 import Test.Tasty (TestTree, testGroup) 22 import Test.Tasty.HUnit (assertBool, testCase) 23 24 fi :: (Integral a, Num b) => a -> b 25 fi = fromIntegral 26 {-# INLINE fi #-} 27 28 -- big-endian bytestring decoding 29 roll :: BS.ByteString -> Integer 30 roll = BS.foldl' unstep 0 where 31 unstep a (fi -> b) = (a `I.integerShiftL` 8) `I.integerOr` b 32 33 execute_group :: SigType -> EcdsaTestGroup -> TestTree 34 execute_group ty EcdsaTestGroup {..} = 35 testGroup msg (fmap (execute ty pk_uncompressed) etg_tests) 36 where 37 msg = "wycheproof (" <> T.unpack etg_type <> ", " <> T.unpack etg_sha <> ")" 38 PublicKey {..} = etg_publicKey 39 40 execute :: SigType -> Projective -> EcdsaVerifyTest -> TestTree 41 execute ty pub EcdsaVerifyTest {..} = testCase report $ do 42 let msg = B16.decodeLenient (TE.encodeUtf8 t_msg) 43 sig = toEcdsa t_sig 44 case sig of 45 Left _ -> assertBool mempty (t_result == "invalid") 46 Right s -> do 47 let ver = case ty of 48 LowS -> verify_ecdsa msg pub s 49 Unrestricted -> verify_ecdsa_unrestricted msg pub s 50 if t_result == "invalid" 51 then assertBool mempty (not ver) 52 else assertBool mempty ver 53 where 54 report = "wycheproof (" <> show ty <> ") " <> show t_tcId 55 56 parse_der_sig :: AT.Parser ECDSA 57 parse_der_sig = do 58 _ <- AT.word8 0x30 59 len <- fmap fi AT.anyWord8 60 content <- AT.take len 61 etc <- AT.takeByteString 62 if BS.length content /= len || etc /= mempty 63 then fail "invalid content" 64 else case AT.parseOnly (meat len) content of 65 Left _ -> fail "invalid content" 66 Right v -> pure v 67 where 68 meat len = do 69 (lr, bs_r) <- parseAsnInt 70 (ls, bs_s) <- parseAsnInt 71 let r = fi (roll bs_r) 72 s = fi (roll bs_s) 73 checks = lr + ls == len 74 rest <- AT.takeByteString 75 if rest == mempty && checks 76 then pure (ECDSA r s) 77 else fail "input remaining or length mismatch" 78 79 parseAsnInt :: AT.Parser (Int, BS.ByteString) 80 parseAsnInt = do 81 _ <- AT.word8 0x02 82 len <- fmap fi AT.anyWord8 83 content <- AT.take len 84 if BS.length content /= len 85 then fail "invalid length" 86 else if len == 1 87 then pure (len + 2, content) -- + tag byt + len byt 88 else case BS.uncons content of 89 Nothing -> fail "invalid content" 90 Just (h0, t0) 91 | B.testBit h0 7 -> fail "negative value" 92 | otherwise -> case BS.uncons t0 of 93 Nothing -> fail "invalid content" 94 Just (h1, _) 95 | h0 == 0x00 && not (B.testBit h1 7) -> fail "invalid padding" 96 | otherwise -> case BS.unsnoc content of 97 Nothing -> fail "invalid content" 98 Just (_, tn) 99 | tn == 0x00 -> fail "invalid padding" 100 | otherwise -> pure (len + 2, content) 101 102 data Wycheproof = Wycheproof { 103 wp_algorithm :: !T.Text 104 , wp_generatorVersion :: !T.Text 105 , wp_numberOfTests :: !Int 106 , wp_testGroups :: ![EcdsaTestGroup] 107 } deriving Show 108 109 instance A.FromJSON Wycheproof where 110 parseJSON = A.withObject "Wycheproof" $ \m -> Wycheproof 111 <$> m .: "algorithm" 112 <*> m .: "generatorVersion" 113 <*> m .: "numberOfTests" 114 <*> m .: "testGroups" 115 116 data EcdsaTestGroup = EcdsaTestGroup { 117 etg_type :: !T.Text 118 , etg_publicKey :: !PublicKey 119 , etg_sha :: !T.Text 120 , etg_tests :: ![EcdsaVerifyTest] 121 } deriving Show 122 123 instance A.FromJSON EcdsaTestGroup where 124 parseJSON = A.withObject "EcdsaTestGroup" $ \m -> EcdsaTestGroup 125 <$> m .: "type" 126 <*> m .: "publicKey" 127 <*> m .: "sha" 128 <*> m .: "tests" 129 130 data PublicKey = PublicKey { 131 pk_type :: !T.Text 132 , pk_curve :: !T.Text 133 , pk_keySize :: !Int 134 , pk_uncompressed :: !Projective 135 } deriving Show 136 137 toProjective :: T.Text -> Projective 138 toProjective (TE.encodeUtf8 -> bs) = case parse_point bs of 139 Nothing -> error "wycheproof: couldn't parse pubkey" 140 Just p -> p 141 142 instance A.FromJSON PublicKey where 143 parseJSON = A.withObject "PublicKey" $ \m -> PublicKey 144 <$> m .: "type" 145 <*> m .: "curve" 146 <*> m .: "keySize" 147 <*> fmap toProjective (m .: "uncompressed") 148 149 toEcdsa :: T.Text -> Either String ECDSA 150 toEcdsa (B16.decodeLenient . TE.encodeUtf8 -> bs) = 151 AT.parseOnly parse_der_sig bs 152 153 data EcdsaVerifyTest = EcdsaVerifyTest { 154 t_tcId :: !Int 155 , t_comment :: !T.Text 156 , t_msg :: !T.Text 157 , t_sig :: !T.Text 158 , t_result :: !T.Text 159 } deriving Show 160 161 instance A.FromJSON EcdsaVerifyTest where 162 parseJSON = A.withObject "EcdsaVerifyTest" $ \m -> EcdsaVerifyTest 163 <$> m .: "tcId" 164 <*> m .: "comment" 165 <*> m .: "msg" 166 <*> m .: "sig" 167 <*> m .: "result" 168