fix review findings iterate self-reviews with /goal

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 <redacted>"
 
-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)
-    ]

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]]

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

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

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

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

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

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" $