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

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