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