WycheproofEcdh.hs (5555B)
1 {-# LANGUAGE BangPatterns #-} 2 {-# LANGUAGE OverloadedStrings #-} 3 {-# LANGUAGE RecordWildCards #-} 4 {-# LANGUAGE ViewPatterns #-} 5 6 module WycheproofEcdh ( 7 Wycheproof(..) 8 , execute_group 9 ) where 10 11 import Crypto.Curve.Secp256k1 12 import qualified Crypto.Hash.SHA256 as SHA256 13 import Data.Aeson ((.:)) 14 import qualified Data.Aeson as A 15 import qualified Data.Attoparsec.ByteString as AT 16 import Data.Bits ((.<<.), (.>>.), (.|.)) 17 import qualified Data.ByteString as BS 18 import qualified Data.ByteString.Base16 as B16 19 import qualified Data.Text as T 20 import qualified Data.Text.Encoding as TE 21 import Test.Tasty (TestTree, testGroup) 22 import qualified Test.Tasty.HUnit as H (assertBool, assertEqual, 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 execute_group :: EcdhTestGroup -> TestTree 34 execute_group EcdhTestGroup {..} = 35 testGroup msg (fmap execute etg_tests) 36 where 37 msg = "wycheproof ecdh" 38 39 execute :: EcdhTest -> TestTree 40 execute EcdhTest {..} = H.testCase report $ do 41 case der_to_pub t_public of 42 Left _ -> 43 -- 'acceptable' in wycheproof-speak means that a public key 44 -- contains a parameter that, whilst invalid, doesn't actually 45 -- affect the ECDH computation. we work only with valid 46 -- secp256k1 points, so rule these out as invalid as well. 47 -- 48 H.assertBool "invalid" (t_result `elem` ["invalid", "acceptable"]) 49 Right pub -> do 50 let sec = parse_bigint t_private 51 sar = parse_bigint t_shared 52 h_sar = Just (SHA256.hash (unroll32 sar)) 53 out = ecdh pub sec 54 H.assertEqual mempty h_sar out 55 where 56 report = "wycheproof ecdh " <> show t_tcId 57 58 -- RFC 5280 ASN.1 59 -- SubjectPublicKeyInfo ::= SEQUENCE { 60 -- algorithm AlgorithmIdentifier, 61 -- subjectPublicKey BIT STRING 62 -- } 63 -- AlgorithmIdentifier ::= SEQUENCE { 64 -- algorithm OBJECT IDENTIFIER, 65 -- parameters ANY DEFINED BY algorithm OPTIONAL 66 -- } 67 parse_der_pub :: AT.Parser Projective 68 parse_der_pub = do 69 _ <- AT.word8 0x30 -- SEQUENCE 70 _ <- AT.anyWord8 71 _ <- parse_der_algo 72 parse_der_subjectpubkey 73 74 parse_der_algo :: AT.Parser () 75 parse_der_algo = do 76 _ <- AT.word8 0x30 -- SEQUENCE 77 _ <- AT.anyWord8 78 _ <- parse_der_ecpubkey 79 _ <- parse_der_secp256k1 80 pure () 81 82 -- RFC 5480 2.1.1 83 -- id-ecPublicKey OBJECT IDENTIFIER ::= { 84 -- iso(1) member-body(2) us(840) ansi-X9-62(10045) keyType(2) 1 } 85 -- 86 -- DER encoded -> 06 07 2A 86 48 CE 3D 02 01 87 parse_der_ecpubkey :: AT.Parser () 88 parse_der_ecpubkey = do 89 _ <- AT.word8 0x06 90 _ <- AT.word8 0x07 91 _ <- AT.word8 0x2a 92 _ <- AT.word8 0x86 93 _ <- AT.word8 0x48 94 _ <- AT.word8 0xce 95 _ <- AT.word8 0x3d 96 _ <- AT.word8 0x02 97 _ <- AT.word8 0x01 98 pure () 99 100 -- SEC1-v2 A.2 101 -- certicom-arc OBJECT IDENTIFIER ::= { 102 -- iso(1) identified-organization(3) certicom(132) 103 -- } 104 -- 105 -- ellipticCurve OBJECT IDENTIFIER ::= { certicom-arc curve(0) } 106 -- 107 -- secp256k1 OBJECT IDENTIFIER ::= { ellipticCurve 10 } 108 -- 109 -- (i.e., 1.3.132.0.10) 110 -- 111 -- DER encoded -> 06 05 2B 81 04 00 0A 112 parse_der_secp256k1 :: AT.Parser () 113 parse_der_secp256k1 = do 114 _ <- AT.word8 0x06 115 _ <- AT.word8 0x05 116 _ <- AT.word8 0x2b 117 _ <- AT.word8 0x81 118 _ <- AT.word8 0x04 119 _ <- AT.word8 0x00 120 _ <- AT.word8 0x0a 121 pure () 122 123 parse_der_subjectpubkey :: AT.Parser Projective 124 parse_der_subjectpubkey = do 125 _ <- AT.word8 0x03 -- BIT STRING 126 len <- fmap fi AT.anyWord8 127 _ <- AT.word8 0x00 -- extra bits (always 0x00 for DER) 128 content <- AT.take (len - 1) -- len counts 'extra bits' field 129 etc <- AT.takeByteString 130 if BS.length content /= len - 1 || etc /= mempty 131 then fail "invalid content" 132 else case parse_point content of 133 Nothing -> fail "invalid content" 134 Just pt -> pure pt 135 136 der_to_pub :: T.Text -> Either String Projective 137 der_to_pub (decodeLenient . TE.encodeUtf8 -> bs) = 138 AT.parseOnly parse_der_pub bs 139 140 parse_bigint :: T.Text -> Integer 141 parse_bigint (decodeLenient . TE.encodeUtf8 -> bs) = roll bs where 142 roll :: BS.ByteString -> Integer 143 roll = BS.foldl' alg 0 where 144 alg !a (fi -> !b) = (a .<<. 8) .|. b 145 146 -- big-endian bytestring encoding 147 unroll :: Integer -> BS.ByteString 148 unroll i = case i of 149 0 -> BS.singleton 0 150 _ -> BS.reverse $ BS.unfoldr step i 151 where 152 step 0 = Nothing 153 step m = Just (fi m, m .>>. 8) 154 155 -- big-endian bytestring encoding for 256-bit ints, left-padding with 156 -- zeros if necessary. the size of the integer is not checked. 157 unroll32 :: Integer -> BS.ByteString 158 unroll32 (unroll -> u) 159 | l < 32 = BS.replicate (32 - l) 0 <> u 160 | otherwise = u 161 where 162 l = BS.length u 163 164 data Wycheproof = Wycheproof { 165 wp_testGroups :: ![EcdhTestGroup] 166 } deriving Show 167 168 instance A.FromJSON Wycheproof where 169 parseJSON = A.withObject "Wycheproof" $ \m -> Wycheproof 170 <$> m .: "testGroups" 171 172 data EcdhTestGroup = EcdhTestGroup { 173 etg_tests :: ![EcdhTest] 174 } deriving Show 175 176 instance A.FromJSON EcdhTestGroup where 177 parseJSON = A.withObject "EcdhTestGroup" $ \m -> EcdhTestGroup 178 <$> m .: "tests" 179 180 data EcdhTest = EcdhTest { 181 t_tcId :: !Int 182 , t_public :: !T.Text 183 , t_private :: !T.Text 184 , t_shared :: !T.Text 185 , t_result :: !T.Text 186 } deriving Show 187 188 instance A.FromJSON EcdhTest where 189 parseJSON = A.withObject "EcdhTest" $ \m -> EcdhTest 190 <$> m .: "tcId" 191 <*> m .: "public" 192 <*> m .: "private" 193 <*> m .: "shared" 194 <*> m .: "result" 195