secp256k1

Pure Haskell Schnorr, ECDSA on the elliptic curve secp256k1 (docs.ppad.tech/secp256k1).
git clone git://git.ppad.tech/secp256k1.git
Log | Files | Refs | README | LICENSE

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