diff --git a/src/Simplex/Messaging/Crypto/BIP32.hs b/src/Simplex/Messaging/Crypto/BIP32.hs index 52c222b84..f68ede201 100644 --- a/src/Simplex/Messaging/Crypto/BIP32.hs +++ b/src/Simplex/Messaging/Crypto/BIP32.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -- | BIP-32 hierarchical deterministic key derivation over secp256k1. -- @@ -18,27 +16,27 @@ module Simplex.Messaging.Crypto.BIP32 hardenedOffset, hardened, isHardened, - chainCodeSize, ) where -import Control.Applicative (optional, (<|>)) +import Control.Applicative ((<|>)) +import Control.Monad (foldM) import qualified Crypto.Hash as H import qualified Crypto.MAC.HMAC as HMAC import qualified Data.Attoparsec.ByteString.Char8 as A import qualified Data.ByteArray as BA -import Data.Bits (shiftR, (.&.)) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.List (intercalate) import Data.Word (Word32) import qualified Simplex.Messaging.Crypto.Secp256k1 as S +import Simplex.Messaging.Encoding (smpEncode) import Simplex.Messaging.Parsers (parseAll) -- | An extended private key: the key plus its chain code. -- --- 'Show' is redacting — the chain code plus one child key is enough to derive +-- 'Show' is redacting - the chain code plus one child key is enough to derive -- siblings, so it is secret material too. data ExtendedKey = ExtendedKey { xkKey :: S.Secp256k1PrivateKey, @@ -49,9 +47,6 @@ data ExtendedKey = ExtendedKey instance Show ExtendedKey where show _ = "ExtendedKey " -chainCodeSize :: Int -chainCodeSize = 32 - -- | Child indexes at or above this are hardened. hardenedOffset :: Word32 hardenedOffset = 0x80000000 @@ -60,7 +55,7 @@ hardenedOffset = 0x80000000 -- unchanged, so @hardened . hardened@ is idempotent rather than overflowing. hardened :: Word32 -> Word32 hardened i - | i >= hardenedOffset = i + | isHardened i = i | otherwise = i + hardenedOffset isHardened :: Word32 -> Bool @@ -71,9 +66,9 @@ masterKey :: ByteString -> Either String ExtendedKey masterKey seed | seedLen < 16 || seedLen > 64 = Left $ "seed: expected 16 to 64 bytes, got " <> show seedLen - | otherwise = do - k <- either (const $ Left "seed: invalid master key, use a different seed") Right $ S.mkPrivateKey il - Right ExtendedKey {xkKey = k, xkChainCode = ir} + | otherwise = case S.mkPrivateKey il of + Left _ -> Left "seed: invalid master key, use a different seed" + Right k -> Right ExtendedKey {xkKey = k, xkChainCode = ir} where seedLen = B.length seed i = hmacSHA512 "Bitcoin seed" seed @@ -90,31 +85,37 @@ deriveChild xk i = Just k -> Right ExtendedKey {xkKey = k, xkChainCode = ir} where dat - | isHardened i = B.singleton 0 <> S.unPrivateKey (xkKey xk) <> ser32 i - | otherwise = S.serializePublicKey S.Compressed (S.secp256k1PublicKey (xkKey xk)) <> ser32 i + | isHardened i = B.singleton 0 <> S.unPrivateKey (xkKey xk) <> smpEncode i + | otherwise = S.serializePublicKey S.Compressed (S.secp256k1PublicKey (xkKey xk)) <> smpEncode i hm = hmacSHA512 (xkChainCode xk) dat il = B.take 32 hm ir = B.drop 32 hm derivePath :: ExtendedKey -> [Word32] -> Either String ExtendedKey -derivePath = foldl (\acc i -> acc >>= (`deriveChild` i)) . Right +derivePath = foldM deriveChild -- | Parse a path such as @m\/44'\/60'\/0'\/0\/0@. A leading @m@ or @M@ is --- optional; both @'@ and @h@ mark a hardened index. +-- optional, as is a leading @\/@; @'@, @h@ and @H@ all mark a hardened index. parsePath :: ByteString -> Either String [Word32] parsePath = parseAll pathP pathP :: A.Parser [Word32] -pathP = - optional (A.satisfy $ \c -> c == 'm' || c == 'M') - *> ((A.char '/' *> (indexP `A.sepBy'` A.char '/')) <|> (indexP `A.sepBy1'` A.char '/') <|> pure []) +pathP = do + cs <- BC.split '/' <$> A.takeByteString + case cs of + c : cs' | c == "m" || c == "M" || B.null c -> traverse indexOf cs' + _ -> traverse indexOf cs where - indexP = do - n <- A.decimal :: A.Parser Integer - hard <- (True <$ A.satisfy (\c -> c == '\'' || c == 'h' || c == 'H')) <|> pure False - if n >= toInteger hardenedOffset - then fail $ "path: index out of range: " <> show n - else pure $ fromInteger n + if hard then hardenedOffset else 0 + -- each component is validated on its own, so a bad one names itself + indexOf c + | B.null c = fail "path: empty component" + | otherwise = case A.parseOnly (indexP <* A.endOfInput) c of + Left _ -> fail $ "path: bad component " <> BC.unpack c + Right (n, hardenedIx) + | n >= toInteger hardenedOffset -> fail $ "path: index out of range: " <> show n + | otherwise -> pure $ fromInteger n + if hardenedIx then hardenedOffset else 0 + indexP = (,) <$> (A.decimal :: A.Parser Integer) <*> hardenedP + hardenedP = (True <$ A.satisfy (\c -> c == '\'' || c == 'h' || c == 'H')) <|> pure False renderPath :: [Word32] -> ByteString renderPath is = BC.pack $ intercalate "/" ("m" : map component is) @@ -125,12 +126,3 @@ renderPath is = BC.pack $ intercalate "/" ("m" : map component is) hmacSHA512 :: ByteString -> ByteString -> ByteString hmacSHA512 key msg = BA.convert (HMAC.hmac key msg :: HMAC.HMAC H.SHA512) - -ser32 :: Word32 -> ByteString -ser32 i = - B.pack - [ fromIntegral (i `shiftR` 24), - fromIntegral ((i `shiftR` 16) .&. 0xFF), - fromIntegral ((i `shiftR` 8) .&. 0xFF), - fromIntegral (i .&. 0xFF) - ] diff --git a/src/Simplex/Messaging/Crypto/BIP39.hs b/src/Simplex/Messaging/Crypto/BIP39.hs index 03388265c..3dc57cae1 100644 --- a/src/Simplex/Messaging/Crypto/BIP39.hs +++ b/src/Simplex/Messaging/Crypto/BIP39.hs @@ -1,6 +1,5 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -- | BIP-39 mnemonics over the English wordlist. -- @@ -14,7 +13,6 @@ module Simplex.Messaging.Crypto.BIP39 ( Mnemonic, MnemonicStrength (..), - mnemonicIndexes, mnemonicWords, mnemonicPhrase, entropyToMnemonic, @@ -25,16 +23,15 @@ module Simplex.Messaging.Crypto.BIP39 strengthBytes, strengthWordCount, seedSize, - wordListSize, ) where import Control.Concurrent.STM -import Crypto.Hash (Digest, SHA256, SHA512 (..), hash) +import Crypto.Hash (SHA512 (..)) import qualified Crypto.KDF.PBKDF2 as PBKDF2 -import Crypto.Random (ChaChaDRG, randomBytesGenerate) +import Crypto.Number.Serialize (i2ospOf_, os2ip) +import Crypto.Random (ChaChaDRG) import qualified Data.Attoparsec.ByteString.Char8 as A -import qualified Data.ByteArray as BA import Data.Bits (shiftL, shiftR, (.&.), (.|.)) import Data.ByteString (ByteString) import qualified Data.ByteString as B @@ -45,11 +42,11 @@ import qualified Data.IntMap.Strict as IM import Data.List (foldl') import Data.Map.Strict (Map) import qualified Data.Map.Strict as M +import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.BIP39.English (englishWordList) import Simplex.Messaging.Parsers (parseAll) --- | A validated BIP-39 mnemonic. Indexes and words are always consistent --- because the constructor is private and every index is in @[0, 2047]@. +-- | A BIP-39 mnemonic: the word indexes and the words they name. data Mnemonic = Mnemonic { mnemonicIndexes :: [Int], mnemonicWords :: [ByteString] @@ -81,9 +78,6 @@ strengthWordCount s = (entBits + entBits `div` 32) `div` 11 seedSize :: Int seedSize = 64 -wordListSize :: Int -wordListSize = 2048 - validEntropySizes :: [Int] validEntropySizes = [16, 20, 24, 28, 32] @@ -100,7 +94,7 @@ indexByWord :: Map ByteString Int indexByWord = M.fromList $ zip englishWordList [0 ..] {-# NOINLINE indexByWord #-} --- | The mnemonic as one space-separated phrase — the exact bytes BIP-39 feeds +-- | The mnemonic as one space-separated phrase - the exact bytes BIP-39 feeds -- to PBKDF2. mnemonicPhrase :: Mnemonic -> ByteString mnemonicPhrase = BC.unwords . mnemonicWords @@ -123,13 +117,13 @@ entropyToIndexes ent = entBits = B.length ent * 8 csBits = entBits `div` 32 -- csBits is at most 8 (256/32), so the first checksum byte always suffices. - csByte = B.head (sha256 ent) - combined = beToInteger ent `shiftL` csBits .|. fromIntegral (csByte `shiftR` (8 - csBits)) + csByte = B.head (C.sha256Hash ent) + combined = os2ip ent `shiftL` csBits .|. fromIntegral (csByte `shiftR` (8 - csBits)) n = (entBits + csBits) `div` 11 --- | Total: a 'Mnemonic' can only hold a valid word count and valid indexes. +-- | The entropy the mnemonic encodes. mnemonicToEntropy :: Mnemonic -> ByteString -mnemonicToEntropy m = integerToBE (entBits `div` 8) (combined `shiftR` csBits) +mnemonicToEntropy m = i2ospOf_ (entBits `div` 8) (combined `shiftR` csBits) where idxs = mnemonicIndexes m totalBits = length idxs * 11 @@ -148,7 +142,7 @@ parseMnemonic = parseAll mnemonicP mnemonicP :: A.Parser Mnemonic mnemonicP = do - ws <- A.skipSpace *> (wordP `A.sepBy1'` A.takeWhile1 isSpace) <* A.skipSpace + ws <- A.skipWhile isSpace *> (wordP `A.sepBy'` A.takeWhile1 isSpace) <* A.skipWhile isSpace let n = length ws if n `notElem` validWordCounts then fail $ "mnemonic: expected 12, 15, 18, 21 or 24 words, got " <> show n @@ -161,7 +155,7 @@ mnemonicP = do then pure m else fail "mnemonic: checksum mismatch" where - wordP = BC.map toLower <$> A.takeWhile1 A.isAlpha_ascii + wordP = BC.map toLower <$> A.takeWhile1 (not . isSpace) lookupWord w = maybe (fail $ "mnemonic: not in wordlist: " <> BC.unpack w) pure $ M.lookup w indexByWord -- | PBKDF2-HMAC-SHA512, 2048 iterations, salt @\"mnemonic\" <> passphrase@. @@ -174,12 +168,9 @@ mnemonicToSeed m passphrase = (mnemonicPhrase m) ("mnemonic" <> passphrase :: ByteString) --- | Generate a fresh mnemonic. Shaped like 'Simplex.Messaging.Crypto.randomBytes' --- so it composes with the agent's DRG instead of reaching for system entropy. +-- | Generate a fresh mnemonic from the agent's DRG. randomMnemonic :: MnemonicStrength -> TVar ChaChaDRG -> STM Mnemonic -randomMnemonic s gVar = do - ent <- stateTVar gVar $ randomBytesGenerate (strengthBytes s) - pure $ mnemonicFromIndexes $ entropyToIndexes ent +randomMnemonic s gVar = mnemonicFromIndexes . entropyToIndexes <$> C.randomBytes (strengthBytes s) gVar -- Internal @@ -192,12 +183,3 @@ mnemonicFromIndexes idxs = Mnemonic {mnemonicIndexes = idxs, mnemonicWords = map wordAt idxs} where wordAt i = IM.findWithDefault "" i wordByIndex - -sha256 :: ByteString -> ByteString -sha256 bs = BA.convert (hash bs :: Digest SHA256) - -beToInteger :: ByteString -> Integer -beToInteger = B.foldl' (\acc w -> acc `shiftL` 8 .|. fromIntegral w) 0 - -integerToBE :: Int -> Integer -> ByteString -integerToBE n x = B.pack [fromIntegral (x `shiftR` (8 * (n - 1 - i))) | i <- [0 .. n - 1]] diff --git a/src/Simplex/Messaging/Crypto/Secp256k1.hs b/src/Simplex/Messaging/Crypto/Secp256k1.hs index 5c6e2374f..33ca218b4 100644 --- a/src/Simplex/Messaging/Crypto/Secp256k1.hs +++ b/src/Simplex/Messaging/Crypto/Secp256k1.hs @@ -1,22 +1,23 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} -- | FFI bindings to libsecp256k1 (ECDSA over secp256k1 with public key recovery). -- -- Only what Ethereum signing needs: key validation, public key derivation and --- serialization, scalar addition (for BIP-32 child derivation), recoverable --- signing and recovery. +-- serialization, scalar addition (for BIP-32 child derivation), point addition +-- and multiplication (for ERC-5564 stealth addresses), recoverable signing and +-- recovery. -- -- Signatures are produced with libsecp256k1's default RFC-6979 deterministic --- nonce, so signing is a pure function of (key, digest) — which is why this +-- nonce, so signing is a pure function of (key, digest) - which is why this -- module exposes a pure API over 'unsafePerformIO'. libsecp256k1 also always -- emits the low-@s@ form, so every signature from 'signRecoverable' is already -- EIP-2 compliant; 'isLowS' is provided so callers can assert that rather than --- trust it. Note there is deliberately no normalization entry point: we never --- accept a foreign signature, we only produce our own. +-- trust it. A foreign signature can reach 'recoverPublicKey', which rejects a +-- malformed one; there is no normalization entry point, as recovery does not +-- need low-s. module Simplex.Messaging.Crypto.Secp256k1 ( Secp256k1PrivateKey, Secp256k1PublicKey, @@ -41,6 +42,7 @@ module Simplex.Messaging.Crypto.Secp256k1 where import Control.Monad (when) +import Crypto.Number.Serialize (os2ip) import Crypto.Random (drgNew, randomBytesGenerate) import qualified Data.ByteArray as BA import Data.ByteString (ByteString) @@ -83,8 +85,9 @@ compactSize = 64 -- | A validated secp256k1 private key: 32 bytes, in @[1, n-1]@. -- --- There is no 'Show' instance, so the key cannot reach a log, and 'Eq' is --- constant-time: this key authorises transfers of assets with monetary value. +-- There is no 'Show' instance, so the key cannot be logged by accident, and +-- 'Eq' is constant-time: this key authorises transfers of assets with monetary +-- value. newtype Secp256k1PrivateKey = Secp256k1PrivateKey ByteString instance Eq Secp256k1PrivateKey where @@ -139,6 +142,7 @@ foreign import ccall "secp256k1_ec_seckey_tweak_add" foreign import ccall "secp256k1_ec_pubkey_tweak_mul" c_ec_pubkey_tweak_mul :: Ptr Ctx -> Ptr PubKeyRaw -> Ptr Word8 -> IO CInt + foreign import ccall "secp256k1_ec_pubkey_tweak_add" c_ec_pubkey_tweak_add :: Ptr Ctx -> Ptr PubKeyRaw -> Ptr Word8 -> IO CInt @@ -158,13 +162,6 @@ foreign import ccall "secp256k1_ecdsa_recover" contextNone :: CUInt contextNone = 1 --- SECP256K1_EC_COMPRESSED = SECP256K1_FLAGS_TYPE_COMPRESSION | SECP256K1_FLAGS_BIT_COMPRESSION --- SECP256K1_EC_UNCOMPRESSED = SECP256K1_FLAGS_TYPE_COMPRESSION -formatFlag :: PubKeyFormat -> CUInt -formatFlag = \case - Compressed -> 2 .|. 256 - Uncompressed -> 2 - -- | The process-wide context, created and blinded once. -- -- Randomization is a side-channel countermeasure only: it does not affect any @@ -189,7 +186,7 @@ withBS bs f = BU.unsafeUseAsCString bs $ f . castPtr packPtr :: Ptr Word8 -> Int -> IO ByteString packPtr p n = B.packCStringLen (castPtr p, n) --- | Marshal a 'PublicKey' back into its opaque C representation. +-- | Marshal a 'Secp256k1PublicKey' back into its opaque C representation. withPubKeyRaw :: Secp256k1PublicKey -> (Ptr PubKeyRaw -> IO a) -> IO a withPubKeyRaw (Secp256k1PublicKey bs) f = withBS bs $ f . castPtr @@ -208,7 +205,7 @@ withRecSigRaw (RecoverableSignature compact recId) f -- Public API -- | Validate 32 bytes as a private key. Rejects zero and anything at or above --- the group order, which is what makes 'publicKey' and 'signRecoverable' total. +-- the group order, which is what makes 'secp256k1PublicKey' and 'signRecoverable' total. mkPrivateKey :: ByteString -> Either String Secp256k1PrivateKey mkPrivateKey bs | B.length bs /= privateKeySize = Left $ "private key: expected 32 bytes, got " <> show (B.length bs) @@ -219,7 +216,7 @@ mkPrivateKey bs unPrivateKey :: Secp256k1PrivateKey -> ByteString unPrivateKey (Secp256k1PrivateKey bs) = bs --- | Derive the public key. Total, because 'PrivateKey' is validated. +-- | Derive the public key. Total, because 'Secp256k1PrivateKey' is validated. secp256k1PublicKey :: Secp256k1PrivateKey -> Secp256k1PublicKey secp256k1PublicKey (Secp256k1PrivateKey sk) = unsafePerformIO $ allocaBytes pubKeyInternalSize $ \pkPtr -> @@ -250,18 +247,20 @@ serializePublicKey fmt pk = unsafePerformIO $ alloca $ \lenPtr -> withPubKeyRaw pk $ \pkPtr -> do poke lenPtr (fromIntegral outLen) - rc <- c_ec_pubkey_serialize secp256k1Ctx outPtr lenPtr pkPtr (formatFlag fmt) + rc <- c_ec_pubkey_serialize secp256k1Ctx outPtr lenPtr pkPtr flag when (rc /= 1) $ ioError (userError "secp256k1_ec_pubkey_serialize failed") written <- peek lenPtr packPtr outPtr (fromIntegral written) where - outLen = case fmt of - Compressed -> compressedSize - Uncompressed -> uncompressedSize + -- SECP256K1_EC_COMPRESSED = SECP256K1_FLAGS_TYPE_COMPRESSION | SECP256K1_FLAGS_BIT_COMPRESSION + -- SECP256K1_EC_UNCOMPRESSED = SECP256K1_FLAGS_TYPE_COMPRESSION + (flag, outLen) = case fmt of + Compressed -> (2 .|. 256, compressedSize) + Uncompressed -> (2, uncompressedSize) -- | @sk + tweak mod n@, as BIP-32 child derivation needs. -- --- 'Nothing' when the result is zero or the tweak is out of range — BIP-32 +-- 'Nothing' when the result is zero or the tweak is out of range - BIP-32 -- requires the caller to skip to the next child index in that case. privateKeyTweakAdd :: Secp256k1PrivateKey -> ByteString -> Maybe Secp256k1PrivateKey privateKeyTweakAdd (Secp256k1PrivateKey sk) tweak @@ -346,10 +345,7 @@ recoverPublicKey sig digest -- tests can assert it rather than assume it. isLowS :: RecoverableSignature -> Bool isLowS (RecoverableSignature compact _) = - B.length compact == compactSize && beToInteger (B.drop 32 compact) <= halfOrder + B.length compact == compactSize && os2ip (B.drop privateKeySize compact) <= halfOrder where halfOrder :: Integer halfOrder = 0x7FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF5D576E7357A4501DDFE92F46681B20A0 - -beToInteger :: ByteString -> Integer -beToInteger = B.foldl' (\acc w -> acc * 256 + fromIntegral w) 0 diff --git a/src/Simplex/Messaging/Eth/Address.hs b/src/Simplex/Messaging/Eth/Address.hs index 9646cadc6..9f34536db 100644 --- a/src/Simplex/Messaging/Eth/Address.hs +++ b/src/Simplex/Messaging/Eth/Address.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -- | Ethereum addresses: derivation from a public key, and EIP-55 mixed-case -- checksum encoding. @@ -45,7 +44,7 @@ instance StrEncoding Address where strEncode = checksumAddress strP = do _ <- optional $ A.string "0x" <|> A.string "0X" - body <- A.takeWhile1 isHexDigit + body <- A.takeWhile isHexDigit if B.length body /= addressSize * 2 then fail $ "address: expected 40 hex digits, got " <> show (B.length body) else case fromHex (BC.map toLower body) of @@ -89,10 +88,10 @@ addressFromPrivateKey = addressFromPublicKey . S.secp256k1PublicKey -- | EIP-55: @0x@ followed by 40 hex digits whose case encodes a checksum over -- the lowercase hex form. checksumAddress :: Address -> ByteString -checksumAddress (Address bs) = "0x" <> B.pack (zipWith adjust [0 ..] lowerHex) +checksumAddress (Address bs) = "0x" <> B.pack (zipWith adjust [0 ..] (B.unpack lowerHex)) where - lowerHex = B.unpack (toHex bs) - hashed = keccak256 (B.pack lowerHex) + lowerHex = toHex bs + hashed = keccak256 lowerHex adjust :: Int -> Word8 -> Word8 adjust i c | isHexLetter c && nibbleAt i >= 8 = upper c @@ -110,19 +109,18 @@ parseAddress :: ByteString -> Either String Address parseAddress = strDecode -- | BIP-44 path for Ethereum account @i@, address @k@: @m\/44'\/60'\/i'\/0\/k@. --- The account must be below 'hardenedOffset', as 'hardened' returns anything +-- The account must be below @hardenedOffset@, as 'hardened' returns anything -- at or above it unchanged and the path would be another account's. ethereumPath :: Word32 -> Word32 -> [Word32] ethereumPath account address = [hardened 44, hardened 60, hardened account, 0, address] --- Hex via memory's Base16, which this package already depends on and which --- Crypto.Secp256k1 already uses. Base16 emits lowercase, which is what EIP-55 --- needs as its starting point - 'checksumAddress' is what introduces case. +-- Hex via memory's Base16, which this package already depends on. Base16 emits +-- lowercase, which is what EIP-55 needs as its starting point - 'checksumAddress' +-- is what introduces case. toHex :: ByteString -> ByteString toHex = BAE.convertToBase BAE.Base16 --- | Decodes and validates: a non-hex or odd-length input is a Left, so callers --- do not have to scan for hex digits themselves. +-- | Decodes base16; a non-hex or odd-length input is a Left. fromHex :: ByteString -> Either String ByteString fromHex = BAE.convertFromBase BAE.Base16 diff --git a/src/Simplex/Messaging/Eth/EIP712.hs b/src/Simplex/Messaging/Eth/EIP712.hs index a2ba2a81e..82161f855 100644 --- a/src/Simplex/Messaging/Eth/EIP712.hs +++ b/src/Simplex/Messaging/Eth/EIP712.hs @@ -1,11 +1,10 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -- | EIP-712 typed structured data hashing. -- --- This implements the hashing half of EIP-712 — @typeHash@, @encodeData@, --- @hashStruct@ and the final @0x19 0x01@ digest — over an explicit list of +-- This implements the hashing half of EIP-712 - @typeHash@, @encodeData@, +-- @hashStruct@ and the final @0x19 0x01@ digest - over an explicit list of -- member values. It deliberately does *not* derive the canonical type string -- from a schema: the caller supplies it. Our structs are a handful of fixed -- shapes agreed with the contracts, and a hand-written type string that is @@ -29,15 +28,14 @@ module Simplex.Messaging.Eth.EIP712 ) where -import Data.Bits (shiftR, (.&.)) +import Crypto.Number.Serialize (i2ospOf_) import Data.ByteString (ByteString) import qualified Data.ByteString as B import Simplex.Messaging.Eth.Address (Address, unAddress) import Simplex.Messaging.Eth.Keccak (keccak256) --- | The standard EIP-712 domain. All four fields are used; the spec allows --- omitting any of them, but every contract in this project includes all four, --- and fixing the shape keeps 'domainSeparator' total. +-- | The standard EIP-712 domain. The spec allows omitting any of the four +-- fields, but every contract in this project includes all four. data Eip712Domain = Eip712Domain { edName :: ByteString, edVersion :: ByteString, @@ -86,7 +84,7 @@ encodeValue = \case | otherwise -> Right (bs <> B.replicate (32 - B.length bs) 0) VBytes bs -> Right (keccak256 bs) VString bs -> Right (keccak256 bs) - VArray vs -> keccak256 . B.concat <$> traverse encodeValue vs + VArray vs -> keccak256 <$> encodeData vs VStruct h | B.length h /= 32 -> Left $ "eip712: struct hash must be 32 bytes, got " <> show (B.length h) | otherwise -> Right h @@ -97,7 +95,7 @@ encodeValue = \case encodeData :: [Eip712Value] -> Either String ByteString encodeData vs = B.concat <$> traverse encodeValue vs --- | @keccak256(typeHash ‖ encodeData(members))@. +-- | @keccak256(typeHash || encodeData(members))@. hashStruct :: ByteString -> [Eip712Value] -> Either String ByteString hashStruct typeString members = keccak256 . (typeHash typeString <>) <$> encodeData members @@ -111,7 +109,7 @@ domainSeparator d = VAddress (edVerifyingContract d) ] --- | The final digest to sign: @keccak256(0x19 ‖ 0x01 ‖ domainSeparator ‖ hashStruct)@. +-- | The final digest to sign: @keccak256(0x19 || 0x01 || domainSeparator || hashStruct)@. hashTypedData :: Eip712Domain -> ByteString -> [Eip712Value] -> Either String ByteString hashTypedData d typeString members = do ds <- domainSeparator d @@ -119,4 +117,4 @@ hashTypedData d typeString members = do pure $ keccak256 (B.pack [0x19, 0x01] <> ds <> hs) word256 :: Integer -> ByteString -word256 x = B.pack [fromIntegral ((x `shiftR` (8 * (31 - i))) .&. 0xFF) | i <- [0 .. 31]] +word256 = i2ospOf_ 32 diff --git a/src/Simplex/Messaging/Eth/Keccak.hs b/src/Simplex/Messaging/Eth/Keccak.hs index 763eac0fb..a81c58031 100644 --- a/src/Simplex/Messaging/Eth/Keccak.hs +++ b/src/Simplex/Messaging/Eth/Keccak.hs @@ -1,14 +1,12 @@ --- | Keccak-256 — the hash Ethereum uses everywhere. +-- | Keccak-256 - the hash Ethereum uses everywhere. -- -- This is *not* SHA3-256. The two differ only in the padding byte (0x01 vs -- 0x06) and produce completely different digests, and crypton exposes both as -- @Keccak_256@ and @SHA3_256@. Confusing them is the classic way to write an -- Ethereum implementation that is wrong in a way nothing catches until a --- signature is rejected on-chain, so every Ethereum hash in this codebase goes --- through this module rather than reaching for @Crypto.Hash@ directly. +-- signature is rejected on-chain. module Simplex.Messaging.Eth.Keccak ( keccak256, - keccak256Size, ) where @@ -18,6 +16,3 @@ import Data.ByteString (ByteString) keccak256 :: ByteString -> ByteString keccak256 bs = BA.convert (hash bs :: Digest Keccak_256) - -keccak256Size :: Int -keccak256Size = 32 diff --git a/src/Simplex/Messaging/Eth/Stealth.hs b/src/Simplex/Messaging/Eth/Stealth.hs index daf0dc216..a4da47b47 100644 --- a/src/Simplex/Messaging/Eth/Stealth.hs +++ b/src/Simplex/Messaging/Eth/Stealth.hs @@ -1,11 +1,9 @@ -{-# LANGUAGE OverloadedStrings #-} - -- | ERC-5564 stealth addresses on secp256k1, scheme id 1 ("with view tags"). -- -- A recipient publishes a __meta-address__: two public keys, spending and -- viewing. A sender picks a random ephemeral key, derives a one-time address -- from it and the meta-address, and publishes the ephemeral public key. Only --- the recipient — who holds the viewing key — can tell which one-time addresses +-- the recipient - who holds the viewing key - can tell which one-time addresses -- are theirs, and only they can spend from them. -- -- The meta-address is not an address and never appears on chain, so publishing @@ -20,13 +18,13 @@ -- -- * the shared secret point is serialized __uncompressed with no SEC1 prefix__, -- as @x || y@, 64 bytes; --- * it is hashed with __keccak256__, not SHA-256 — which is why this module +-- * it is hashed with __keccak256__, not SHA-256 - which is why this module -- multiplies points directly rather than calling @secp256k1_ecdh@, whose -- built-in hash is SHA-256; -- * the __view tag is the first byte__ of that hash. -- -- Encoding the point the same way an Ethereum address encodes a public key is --- not a coincidence, and it means 'Simplex.Messaging.Eth.Address' already +-- not a coincidence, and it means "Simplex.Messaging.Eth.Address" already -- performs the last step unchanged. module Simplex.Messaging.Eth.Stealth ( StealthMetaAddress (..), @@ -46,9 +44,9 @@ where import Data.ByteString (ByteString) import qualified Data.ByteString as B import Data.Word (Word8) +import qualified Simplex.Messaging.Crypto.Secp256k1 as S import Simplex.Messaging.Eth.Address (Address, addressFromPublicKey) import Simplex.Messaging.Eth.Keccak (keccak256) -import qualified Simplex.Messaging.Crypto.Secp256k1 as S -- | A recipient's published key pair: spending key, then viewing key. data StealthMetaAddress = StealthMetaAddress @@ -95,13 +93,12 @@ parseMetaAddress bs let (spend, view) = B.splitAt S.compressedSize bs StealthMetaAddress <$> S.parsePublicKey spend <*> S.parsePublicKey view --- | @keccak256(x || y)@ of @sk * P@ — the value both sides arrive at, the +-- | @keccak256(x || y)@ of @sk * P@ - the value both sides arrive at, the -- sender from the ephemeral key and the recipient from the viewing key. sharedSecretHash :: S.Secp256k1PrivateKey -> S.Secp256k1PublicKey -> Either String ByteString sharedSecretHash sk pk = - case S.publicKeyTweakMul pk (S.unPrivateKey sk) of - Nothing -> Left "stealth: shared secret is not a valid point" - Just p -> Right . keccak256 . B.drop 1 $ S.serializePublicKey S.Uncompressed p + maybe (Left "stealth: shared secret is not a valid point") (Right . keccak256 . B.drop 1 . S.serializePublicKey S.Uncompressed) $ + S.publicKeyTweakMul pk (S.unPrivateKey sk) -- | Sender side. @ephemeral@ must be freshly random and used once: reusing it -- across recipients lets them link the destinations, and reusing it for one @@ -117,10 +114,13 @@ stealthDestination ephemeral ma = do sdViewTag = B.head sh } --- | Recipient side. Returns the address when this announcement is ours. +-- | Recipient side. Returns the address this announcement would pay us at, +-- when its view tag matches. The tag is one byte, so one announcement in 256 +-- matches by chance: the caller must compare the result with the announced +-- address to know the announcement is theirs. -- -- The view tag is checked before the point addition, which is the whole reason --- it exists — a non-match costs one multiplication and one hash. +-- it exists - a non-match costs one multiplication and one hash. stealthMatch :: S.Secp256k1PrivateKey -> S.Secp256k1PublicKey -> ByteString -> ViewTag -> Either String (Maybe Address) stealthMatch view spend ephemeralPub tag = do eph <- S.parsePublicKey ephemeralPub @@ -137,11 +137,7 @@ stealthPrivateKey :: S.Secp256k1PrivateKey -> S.Secp256k1PrivateKey -> ByteStrin stealthPrivateKey spend view ephemeralPub = do eph <- S.parsePublicKey ephemeralPub sh <- sharedSecretHash view eph - case S.privateKeyTweakAdd spend sh of - Nothing -> Left "stealth: derived key out of range" - Just sk -> Right sk + maybe (Left "stealth: derived key out of range") Right $ S.privateKeyTweakAdd spend sh tweakSpend :: S.Secp256k1PublicKey -> ByteString -> Either String S.Secp256k1PublicKey -tweakSpend spend sh = case S.publicKeyTweakAdd spend sh of - Nothing -> Left "stealth: derived point out of range" - Just p -> Right p +tweakSpend spend sh = maybe (Left "stealth: derived point out of range") Right $ S.publicKeyTweakAdd spend sh diff --git a/tests/CoreTests/EthCryptoTests.hs b/tests/CoreTests/EthCryptoTests.hs index b146666b1..76d4eaf2c 100644 --- a/tests/CoreTests/EthCryptoTests.hs +++ b/tests/CoreTests/EthCryptoTests.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -- | Tests for the Ethereum crypto primitives: secp256k1, BIP-39, BIP-32, -- Keccak-256, EIP-55 and EIP-712. @@ -18,7 +17,8 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.Char (toLower) -import Data.Either (isLeft) +import Data.Either (isLeft, isRight) +import Data.List (nub) import Data.Word (Word32) import qualified Simplex.Messaging.Crypto as C import qualified Simplex.Messaging.Crypto.BIP32 as B32 @@ -71,8 +71,12 @@ secp256k1Tests :: Spec secp256k1Tests = do it "derives the known address for a known key" $ show (addressFromPrivateKey testKey) `shouldBe` "0x2c7536E3605D9C16a7a3D7b1898e529396a65c23" - it "signs deterministically (RFC 6979)" $ - right (S.signRecoverable testKey testDigest) `shouldBe` testSig + -- cross-checked against an independent RFC-6979 implementation, so this pins + -- interoperability rather than our own output + it "signs deterministically (RFC 6979)" $ do + toHex (S.rsCompact testSig) + `shouldBe` "51a4302323b42bae74eab7dc05d46141492eb44e37d24b5bd1f922225da8fc512bbf35fea4a63077fe5220fcdcadc56016c402462f5021d5b80bacd8b84bbdec" + S.rsRecId testSig `shouldBe` 0 it "produces low-s signatures (EIP-2)" $ S.isLowS testSig `shouldBe` True it "recovers the signing key" $ @@ -117,8 +121,6 @@ bip39Tests = do B39.mnemonicPhrase m `shouldBe` phrase toHex (B39.mnemonicToEntropy p) `shouldBe` entHex toHex (B39.mnemonicToSeed p "TREZOR") `shouldBe` seedHex - it "has a 2048-word list" $ - B39.wordListSize `shouldBe` 2048 it "embeds the upstream wordlist, unchanged" $ -- sha256 of bitcoin/bips/bip-0039/english.txt C.sha256Hash (BC.unlines englishWordList) @@ -131,6 +133,11 @@ bip39Tests = do it "rejects a word outside the list" $ B39.parseMnemonic "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon simplex" `shouldSatisfy` isLeft + it "rejects an empty phrase, counting the words" $ + B39.parseMnemonic "" `shouldBe` Left "Failed reading: mnemonic: expected 12, 15, 18, 21 or 24 words, got 0" + it "rejects a word with trailing punctuation, naming it" $ + B39.parseMnemonic "abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon abandon about." + `shouldBe` Left "Failed reading: mnemonic: not in wordlist: about." it "rejects a wrong word count" $ B39.parseMnemonic "abandon abandon about" `shouldSatisfy` isLeft it "accepts a capitalised phrase and normalises it" $ @@ -185,8 +192,14 @@ bip32Tests = do B32.parsePath (B32.renderPath (ethereumPath 7 3)) `shouldBe` Right (ethereumPath 7 3) it "rejects a non-numeric component" $ B32.parsePath "m/44x/60" `shouldSatisfy` isLeft - it "rejects an index at the hardened boundary" $ - B32.parsePath "m/2147483648" `shouldSatisfy` isLeft + it "rejects an index at the hardened boundary, saying so" $ + B32.parsePath "m/2147483648" `shouldBe` Left "Failed reading: path: index out of range: 2147483648" + it "rejects a path that ends at the separator" $ + B32.parsePath "m/" `shouldBe` Left "Failed reading: path: empty component" + it "rejects an index glued to the leading m" $ + B32.parsePath "m44" `shouldBe` Left "Failed reading: path: bad component m44" + it "accepts a leading slash" $ + B32.parsePath "/44'/60" `shouldBe` Right [hardened' 44, 60] where master1 = right $ B32.masterKey (hx "000102030405060708090a0b0c0d0e0f") master2 = @@ -237,13 +250,12 @@ derivationTests = do it "derives account 2" $ show (addrAt 2) `shouldBe` "0x07B5FdfEB4E11826D233403Fe8Db0611CCF4c231" it "gives each chat profile a distinct address" $ - map addrAt [0 .. 4] `shouldSatisfy` \as -> length as == length (foldr dedup [] as) + map addrAt [0 .. 4] `shouldSatisfy` \as -> length as == length (nub as) where m = right $ B39.parseMnemonic canonicalPhrase seed = B39.mnemonicToSeed m "" master = right $ B32.masterKey seed addrAt i = addressFromPrivateKey . B32.xkKey . right $ B32.derivePath master (ethereumPath i 0) - dedup a as = if a `elem` as then as else a : as eip55Tests :: Spec eip55Tests = do @@ -252,17 +264,18 @@ eip55Tests = do it (BC.unpack a) $ BC.pack (show . right $ parseAddress a) `shouldBe` a it "accepts an all-lowercase address" $ - parseAddress "0x5aaeb6053f3e94c9b9a09f33669435e7ef1beaed" `shouldSatisfy` isRight' + parseAddress "0x5aaeb6053f3e94c9b9a09f33669435e7ef1beaed" `shouldSatisfy` isRight it "accepts an all-uppercase address" $ - parseAddress "0x5AAEB6053F3E94C9B9A09F33669435E7EF1BEAED" `shouldSatisfy` isRight' + parseAddress "0x5AAEB6053F3E94C9B9A09F33669435E7EF1BEAED" `shouldSatisfy` isRight it "accepts an address without the 0x prefix" $ - parseAddress "5aaeb6053f3e94c9b9a09f33669435e7ef1beaed" `shouldSatisfy` isRight' + parseAddress "5aaeb6053f3e94c9b9a09f33669435e7ef1beaed" `shouldSatisfy` isRight it "rejects a bad EIP-55 checksum" $ parseAddress "0x5aAeb6053f3E94C9b9A09f33669435E7Ef1BeAed" `shouldSatisfy` isLeft it "rejects the wrong length" $ parseAddress "0x5aAeb6053F3E94C9b9A09f33669435E7Ef1BeAe" `shouldSatisfy` isLeft it "rejects non-hex characters" $ - parseAddress "0xZaAeb6053F3E94C9b9A09f33669435E7Ef1BeAed" `shouldSatisfy` isLeft + parseAddress "0xZaAeb6053F3E94C9b9A09f33669435E7Ef1BeAed" + `shouldBe` Left "Failed reading: address: expected 40 hex digits, got 0" it "rejects raw bytes of the wrong length" $ mkAddress (B.replicate 19 0) `shouldSatisfy` isLeft -- Between them these cover every byte value 0x00..0xff going out through the @@ -275,7 +288,6 @@ eip55Tests = do forM_ everyByteAddresses $ \a -> parseAddress (BC.map toLower (checksumAddress a)) `shouldBe` Right a where - isRight' = either (const False) (const True) -- 13 x 20 = 260 bytes, so every value 0x00..0xff appears at least once everyByteAddresses = [ right . mkAddress . B.pack $ @@ -308,7 +320,8 @@ eip712Tests = do toHex (right . encodeValue . VAddress . right $ parseAddress "0xCcCCccccCCCCcCCCCCCcCcCccCcCCCcCcccccccC") `shouldBe` "000000000000000000000000cccccccccccccccccccccccccccccccccccccccc" it "hashes an array to a single word" $ - B.length (right $ encodeValue (VArray [VUint 1, VUint 2])) `shouldBe` 32 + toHex (right $ encodeValue (VArray [VUint 1, VUint 2])) + `shouldBe` "e90b7bceb6e7df5418fb78d8ee546e97c83a08bbccc01a0644d599ccd2a7c2e0" it "rejects a uint above 2^256" $ encodeValue (VUint (2 ^ (256 :: Int))) `shouldSatisfy` isLeft it "rejects a negative uint" $